No OneTemporary
Actions

Size

4 MB

Subscribers

None

View Options

This file is larger than 256 KB, so syntax highlighting was skipped.

	diff --git a/metadata/metadata b/metadata/metadata
	--- a/metadata/metadata
	+++ b/metadata/metadata
	@@ -1,10454 +1,10600 @@
	[Arith_Prog_Rel_Primes]
	title = Arithmetic progressions and relative primes
	author = José Manuel Rodríguez Caballero <https://josephcmac.github.io/>
	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
	<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?

	[Banach_Steinhaus]
	title = Banach-Steinhaus Theorem
	author = Dominique Unruh <http://kodu.ut.ee/~unruh/> <mailto:unruh@ut.ee>, Jose Manuel Rodriguez Caballero <https://josephcmac.github.io/> <mailto:jose.manuel.rodriguez.caballero@ut.ee>
	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ć <http://www.matf.bg.ac.rs/~filip>, Danijela Simić <http://poincare.matf.bg.ac.rs/~danijela>
	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ć <http://poincare.matf.bg.ac.rs/~danijela>, Filip Marić <http://www.matf.bg.ac.rs/~filip>, Pierre Boutry <mailto:boutry@unistra.fr>
	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 <https://www.cl.cam.ac.uk/~lp15/>
	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 <mailto:jonas.raedle@gmail.com>, Lars Hupel <https://www21.in.tum.de/~hupel/>
	topic = Computer science/Data structures
	date = 2018-11-06
	notify = jonas.raedle@gmail.com
	abstract =
	<p>We provide a framework for automatically deriving instances for
	generic type classes. Our approach is inspired by Haskell's
	<i>generic-deriving</i> package and Scala's
	<i>shapeless</i> 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.</p>
	<p>Note: There are already articles in the AFP that provide
	automatic instantiation for a number of classes. Concretely, <a href="https://www.isa-afp.org/entries/Deriving.html">Deriving</a> allows the automatic instantiation of comparators, linear orders, equality, and hashing. <a href="https://www.isa-afp.org/entries/Show.html">Show</a> instantiates a Haskell-style <i>show</i> class.</p><p>Our approach works for arbitrary classes (with some Isabelle/HOL overhead for each class), but a smaller set of datatypes.</p>


	[Partial_Order_Reduction]
	title = Partial Order Reduction
	author = Julian Brunner <http://www21.in.tum.de/~brunnerj/>
	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 <https://www21.in.tum.de/~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 <https://lars.hupel.info/>
	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 <http://lig-membres.imag.fr/mechenim/>
	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 <a
	href="https://hal.archives-ouvertes.fr/hal-01562944">paper</a>.
	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)<br>


	[Pell]
	title = Pell's Equation
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2018-06-23
	notify = eberlm@in.tum.de
	abstract =
	<p> This article gives the basic theory of Pell's equation
	<em>x</em><sup>2</sup> = 1 +
	<em>D</em> <em>y</em><sup>2</sup>,
	where
	<em>D</em> ∈ ℕ is
	a parameter and <em>x</em>, <em>y</em> are
	integer variables. </p> <p> The main result that is proven
	is the following: If <em>D</em> is not a perfect square,
	then there exists a <em>fundamental solution</em>
	(<em>x</em><sub>0</sub>,
	<em>y</em><sub>0</sub>) that is not the
	trivial solution (1, 0) and which generates all other solutions
	(<em>x</em>, <em>y</em>) in the sense that
	there exists some
	<em>n</em> ∈ ℕ
	such that \|<em>x</em>\| +
	\|<em>y</em>\| √<span
	style="text-decoration:
	overline"><em>D</em></span> =
	(<em>x</em><sub>0</sub> +
	<em>y</em><sub>0</sub> √<span
	style="text-decoration:
	overline"><em>D</em></span>)<sup><em>n</em></sup>.
	This also implies that the set of solutions is infinite, and it gives
	us an explicit and executable characterisation of all the solutions.
	</p> <p> Based on this, simple executable algorithms for
	computing the fundamental solution and the infinite sequence of all
	non-negative solutions are also provided. </p>

	[WebAssembly]
	title = WebAssembly
	author = Conrad Watt <http://www.cl.cam.ac.uk/~caw77/>
	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 <mailto:hellauer@in.tum.de>, Peter Lammich <http://www21.in.tum.de/~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 <i>s</i> in a text
	<i>t</i> can be solved deterministically in
	<i>O(\|s\| + \|t\|)</i> time. We use the Isabelle
	Refinement Framework to formulate and verify the algorithm. Via
	refinement, we apply some optimisations and finally use the
	<em>Sepref</em> tool to obtain executable code in
	<em>Imperative/HOL</em>.

	[Minkowskis_Theorem]
	title = Minkowski's Theorem
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Geometry, Mathematics/Number theory
	date = 2017-07-13
	notify = eberlm@in.tum.de
	abstract =
	<p>Minkowski's theorem relates a subset of
	ℝ<sup>n</sup>, the Lebesgue measure, and the
	integer lattice ℤ<sup>n</sup>: It states that
	any convex subset of ℝ<sup>n</sup> with volume
	greater than 2<sup>n</sup> contains at least one lattice
	point from ℤ<sup>n</sup>\{0}, i. e. a
	non-zero point with integer coefficients.</p> <p>A
	related theorem which directly implies this is Blichfeldt's
	theorem, which states that any subset of
	ℝ<sup>n</sup> with a volume greater than 1
	contains two different points whose difference vector has integer
	components.</p> <p>The entry contains a proof of both
	theorems.</p>

	[Name_Carrying_Type_Inference]
	title = Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus
	author = Michael Rawson <mailto:michaelrawson76@gmail.com>
	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 <a
	href="http://www.openthesis.org/documents/Verified-Metatheory-Type-Inference-Simply-603182.html">undergraduate
	dissertation</a>.

	[Propositional_Proof_Systems]
	title = Propositional Proof Systems
	author = Julius Michaelis <http://liftm.de>, Tobias Nipkow <http://www21.in.tum.de/~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 <mailto:simon.foster@york.ac.uk>, Frank Zeyda <mailto:frank.zeyda@york.ac.uk>
	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, <em>get</em>, the return a value
	from the source type, and <em>put</em> 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)
	[2021-01-27]
	Addition of new theorems throughout, particularly for prisms.
	New "chantype" command allows the definition of an algebraic datatype with generated prisms.
	New "dataspace" command allows the definition of a local-based state space, including lenses and prisms.
	Addition of various examples for the above.
	(revision 89cf045a)

	[Game_Based_Crypto]
	title = Game-based cryptography in HOL
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, S. Reza Sefidgar <>, Bhargav Bhatt <mailto:bhargav.bhatt@inf.ethz.ch>
	topic = Computer science/Security/Cryptography
	date = 2017-05-05
	notify = mail@andreas-lochbihler.de
	abstract =
	<p>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.
	</p><p>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.</p>
	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 <http://homepages.inf.ed.ac.uk/da/>, David Butler <mailto:dbutler@turing.ac.uk>
	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 <https://www.turing.ac.uk/people/doctoral-students/david-butler>, Andreas Lochbihler <http://www.andreas-lochbihler.de>
	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 <http://www.andreas-lochbihler.de>
	topic = Computer science/Security/Cryptography, Computer science/Functional programming, Mathematics/Probability theory
	date = 2017-05-05
	notify = mail@andreas-lochbihler.de
	abstract =
	<p>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.
	</p><p>
	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.</p>

	[Constructive_Cryptography]
	title = Constructive Cryptography in HOL
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de/>, 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 <http://www.andreas-lochbihler.de>
	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)<br>


	[Monad_Normalisation]
	title = Monad normalisation
	author = Joshua Schneider <>, Manuel Eberl <https://www21.in.tum.de/~eberlm>, Andreas Lochbihler <http://www.andreas-lochbihler.de>
	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 <http://www.andreas-lochbihler.de>
	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)<br>


	[Constructor_Funs]
	title = Constructor Functions
	author = Lars Hupel <https://www21.in.tum.de/~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 <https://www21.in.tum.de/~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, <tt>if-then-else</tt> 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 <tt>if-then-else</tt> as functions.

	[Dict_Construction]
	title = Dictionary Construction
	author = Lars Hupel <https://www21.in.tum.de/~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 <https://lars.hupel.info/>
	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 <a
	href="http://dx.doi.org/10.1007/978-3-319-89884-1_35">verified
	compiler from Isabelle to CakeML</a>. 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
	<a
	href="https://www.isa-afp.org/entries/Lambda_Free_RPOs.html">Blanchette’s
	λ-free higher-order terms</a>. Furthermore, I
	implement translation functions between de-Bruijn terms and named
	terms and prove their correctness.

	[Subresultants]
	title = Subresultants
	author = Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	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 <https://www21.in.tum.de/~eberlm>
	topic = Computer science/Algorithms
	date = 2017-03-15
	notify = eberlm@in.tum.de
	abstract =
	<p>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 <em>n</em> is at
	least <em>log<sub>2</sub> (n!)</em>
	in the worst case, i. e. <em>Ω(n log
	n)</em>.</p> <p>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.</p>

	[Quick_Sort_Cost]
	title = The number of comparisons in QuickSort
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Computer science/Algorithms
	date = 2017-03-15
	notify = eberlm@in.tum.de
	abstract =
	<p>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
	<em>2 (n+1) H<sub>n</sub> -
	4 n</em>, which is asymptotically equivalent to
	<em>2 n ln n</em>; second, the number of
	comparisons performed by the classic non-randomised QuickSort has the
	same distribution in the average case as the randomised one.</p>

	[Random_BSTs]
	title = Expected Shape of Random Binary Search Trees
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Computer science/Data structures
	date = 2017-04-04
	notify = eberlm@in.tum.de
	abstract =
	<p>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.</p> <p>In particular, we prove a logarithmic upper
	bound on the expected height and the <em>Θ(n log n)</em>
	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.</p>

	[Randomised_BSTs]
	title = Randomised Binary Search Trees
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Computer science/Data structures
	date = 2018-10-19
	notify = eberlm@in.tum.de
	abstract =
	<p>This work is a formalisation of the Randomised Binary Search
	Trees introduced by Martínez and Roura, including definitions and
	correctness proofs.</p> <p>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.</p>

	[E_Transcendental]
	title = The Transcendence of e
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Analysis, Mathematics/Number theory
	date = 2017-01-12
	notify = eberlm@in.tum.de
	abstract =
	<p>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.</p> <p>This kind of approach can be found in
	many different sources; this formalisation mostly follows a <a href="http://planetmath.org/proofoflindemannweierstrasstheoremandthateandpiaretranscendental">PlanetMath article</a> by Roger Lipsett.</p>

	[Pi_Transcendental]
	title = The Transcendence of π
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2018-09-28
	notify = eberlm@in.tum.de
	abstract =
	<p>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
	<em>e</em>.</p>

	[Hermite_Lindemann]
	title = The Hermite–Lindemann–Weierstraß Transcendence Theorem
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2021-03-03
	notify = eberlm@in.tum.de
	abstract =
	<p>This article provides a formalisation of the
	Hermite-Lindemann-Weierstraß Theorem (also known as simply
	Hermite-Lindemann or Lindemann-Weierstraß). This theorem is one of the
	crowning achievements of 19th century number theory.</p>
	<p>The theorem states that if $\alpha_1, \ldots,
	\alpha_n\in\mathbb{C}$ are algebraic numbers that are linearly
	independent over $\mathbb{Z}$, then $e^{\alpha_1},\ldots,e^{\alpha_n}$
	are algebraically independent over $\mathbb{Q}$.</p>
	<p>Like the <a
	href="https://doi.org/10.1007/978-3-319-66107-0_5">previous
	formalisation in Coq by Bernard</a>, I proceeded by formalising
	<a
	href="https://doi.org/10.1017/CBO9780511565977">Baker's
	version of the theorem and proof</a> and then deriving the
	original one from that. Baker's version states that for any
	algebraic numbers $\beta_1, \ldots, \beta_n\in\mathbb{C}$ and distinct
	algebraic numbers $\alpha_i, \ldots, \alpha_n\in\mathbb{C}$, we have
	$\beta_1 e^{\alpha_1} + \ldots + \beta_n e^{\alpha_n} = 0$ if and only
	if all the $\beta_i$ are zero.</p> <p>This has a number of
	direct corollaries, e.g.:</p> <ul> <li>$e$ and $\pi$
	are transcendental</li> <li>$e^z$, $\sin z$, $\tan z$,
	etc. are transcendental for algebraic
	$z\in\mathbb{C}\setminus\{0\}$</li> <li>$\ln z$ is
	transcendental for algebraic $z\in\mathbb{C}\setminus\{0,
	1\}$</li> </ul>

	[DFS_Framework]
	title = A Framework for Verifying Depth-First Search Algorithms
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, René Neumann <mailto:neumannr@in.tum.de>
	notify = lammich@in.tum.de
	date = 2016-07-05
	topic = Computer science/Algorithms/Graph
	abstract =
	<p>
	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.
	</p><p>
	[CPP-2015] Peter Lammich, René Neumann: A Framework for Verifying
	Depth-First Search Algorithms. CPP 2015: 137-146</p>

	[Flow_Networks]
	title = Flow Networks and the Min-Cut-Max-Flow Theorem
	author = Peter Lammich <http://www21.in.tum.de/~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 <http://www21.in.tum.de/~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 <http://ualberta.ca/~jsylvest/>
	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 <i>group_add</i> 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 <mailto:victor.gomes@cl.cam.ac.uk>, Georg Struth <mailto:g.struth@sheffield.ac.uk>
	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 <mailto:maxime.buyse@polytechnique.edu>, Jason Jaskolka <https://carleton.ca/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 <mailto:lukas.bulwahn@gmail.com>
	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 <mailto:lukas.bulwahn@gmail.com>
	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 <mailto:lukas.bulwahn@gmail.com>
	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 <mailto:stark@cs.stonybrook.edu>
	notify = stark@cs.stonybrook.edu
	date = 2016-06-26
	topic = Mathematics/Category theory
	abstract =
	<p>
	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.
	</p><p>
	Revisions made subsequent to the first version of this article added
	material on equivalence of categories, cartesian categories,
	categories with pullbacks, categories with finite limits, and
	cartesian closed categories. A construction was given of the category
	of hereditarily finite sets and functions between them, and it was
	shown that this category is cartesian closed.
	</p>
	extra-history =
	Change history:
	[2018-05-29]:
	Revised axioms for the category locale. Introduced notation for composition and "in hom".
	(revision 8318366d4575)<br>
	[2020-02-15]:
	Move ConcreteCategory.thy from Bicategory to Category3 and use it systematically.
	Make other minor improvements throughout.
	(revision a51840d36867)<br>
	[2020-07-10]:
	Added new material, mostly centered around cartesian categories.
	(revision 06640f317a79)<br>
	[2020-11-04]:
	Minor modifications and extensions made in conjunction with the addition
	of new material to Bicategory.
	(revision 472cb2268826)<br>

	[MonoidalCategory]
	title = Monoidal Categories
	author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu>
	topic = Mathematics/Category theory
	date = 2017-05-04
	notify = stark@cs.stonybrook.edu
	abstract =
	<p>
	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.
	</p><p>
	Revisions made subsequent to the first version of this article added
	material on cartesian monoidal categories; showing that the underlying
	category of a cartesian monoidal category is a cartesian category, and
	that every cartesian category extends to a cartesian monoidal
	category.
	</p>
	extra-history =
	Change history:
	[2017-05-18]:
	Integrated material from MonoidalCategory/Category3Adapter into Category3/ and deleted adapter.
	(revision 015543cdd069)<br>
	[2018-05-29]:
	Modifications required due to 'Category3' changes. Introduced notation for "in hom".
	(revision 8318366d4575)<br>
	[2020-02-15]:
	Cosmetic improvements.
	(revision a51840d36867)<br>
	[2020-07-10]:
	Added new material on cartesian monoidal categories.
	(revision 06640f317a79)<br>

	[Card_Multisets]
	title = Cardinality of Multisets
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	notify = lukas.bulwahn@gmail.com
	date = 2016-06-26
	topic = Mathematics/Combinatorics
	abstract =
	<p>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.</p> <p>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.</p>

	[Posix-Lexing]
	title = POSIX Lexing with Derivatives of Regular Expressions
	author = Fahad Ausaf <http://kcl.academia.edu/FahadAusaf>, Roy Dyckhoff <https://rd.host.cs.st-andrews.ac.uk>, Christian Urban <http://www.inf.kcl.ac.uk/staff/urbanc/>
	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 <mailto:steven@recursivemind.com>
	topic = Computer science/Automata and formal languages
	date = 2017-04-28
	notify = steven@recursivemind.com
	abstract =
	This formalisation accompanies the paper <a
	href="https://arxiv.org/abs/1702.03277">Local
	Lexing</a> 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 <http://www.andreas-lochbihler.de>
	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
	<emph>The Max-Flow Min-Cut theorem for countable networks</emph> 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)<br>
	[2020-12-19]:
	simpler proof of linkability for bounded unhindered bipartite webs, leading to a simpler proof for networks with bounded out-capacities
	(revision 93ca33f4d915)<br>

	[Liouville_Numbers]
	title = Liouville numbers
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	date = 2015-12-28
	topic = Mathematics/Analysis, Mathematics/Number theory
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p><p>
	The proof is very elementary and requires only standard arithmetic, the Mean
	Value Theorem for polynomials, and the boundedness of polynomials on compact
	intervals.
	</p>
	notify = eberlm@in.tum.de

	[Triangle]
	title = Basic Geometric Properties of Triangles
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	date = 2015-12-28
	topic = Mathematics/Geometry
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p>
	notify = eberlm@in.tum.de

	[Prime_Harmonic_Series]
	title = The Divergence of the Prime Harmonic Series
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	date = 2015-12-28
	topic = Mathematics/Number theory
	abstract =
	<p>
	In this work, we prove the lower bound <span class="nobr">ln(H_n) -
	ln(5/3)</span> for the
	partial sum of the Prime Harmonic series and, based on this, the divergence of
	the Prime Harmonic Series
	<span class="nobr">∑[p prime] · 1/p.</span>
	</p><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.
	</p>
	notify = eberlm@in.tum.de

	[Descartes_Sign_Rule]
	title = Descartes' Rule of Signs
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	date = 2015-12-28
	topic = Mathematics/Analysis
	abstract =
	<p>
	Descartes' Rule of Signs relates the number of positive real roots of a
	polynomial with the number of sign changes in its coefficient sequence.
	</p><p>
	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.
	</p>
	notify = eberlm@in.tum.de

	[Euler_MacLaurin]
	title = The Euler–MacLaurin Formula
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Analysis
	date = 2017-03-10
	notify = eberlm@in.tum.de
	abstract =
	<p>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.</p> <p>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 <em>Concrete Mathematics</em> that is
	more useful for deriving asymptotic estimates.</p> <p>As
	example applications, we use that formula to derive the full
	asymptotic expansion of the harmonic numbers and the sum of inverse
	squares.</p>

	[Card_Partitions]
	title = Cardinality of Set Partitions
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	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 <mailto:lukas.bulwahn@gmail.com>
	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 <http://www.sci.kagoshima-u.ac.jp/~furusawa/>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>
	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 <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-06-11
	topic = Computer science/Security, Computer science/Concurrency/Process calculi
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p><p>
	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.
	</p><p>
	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.
	</p>
	notify =

	[Noninterference_Ipurge_Unwinding]
	title = The Ipurge Unwinding Theorem for CSP Noninterference Security
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-06-11
	topic = Computer science/Security
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p><p>
	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.
	</p><p>
	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.
	</p>
	notify =

	[Relational_Method]
	title = The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	topic = Computer science/Security
	date = 2020-12-05
	notify = pasquale.noce.lavoro@gmail.com
	abstract =
	This paper introduces a new method for the formal verification of
	cryptographic protocols, the relational method, derived from
	Paulson's inductive method by means of some enhancements aimed at
	streamlining formal definitions and proofs, specially for protocols
	using public key cryptography. Moreover, this paper proposes a method
	to formalize a further security property, message anonymity, in
	addition to message confidentiality and authenticity. The relational
	method, including message anonymity, is then applied to the
	verification of a sample authentication protocol, comprising Password
	Authenticated Connection Establishment (PACE) with Chip Authentication
	Mapping followed by the explicit verification of an additional
	password over the PACE secure channel.

	[List_Interleaving]
	title = Reasoning about Lists via List Interleaving
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-06-11
	topic = Computer science/Data structures
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p>
	notify =

	[Residuated_Lattices]
	title = Residuated Lattices
	author = Victor B. F. Gomes <mailto:vborgesferreiragomes1@sheffield.ac.uk>, Georg Struth <mailto:g.struth@sheffield.ac.uk>
	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 <http://peteg.org>, Tony Hosking <https://www.cs.purdue.edu/homes/hosking/>, Kai Engelhardt <>
	date = 2015-04-13
	topic = Computer science/Algorithms/Concurrent
	abstract =
	<p>
	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.</p>
	<p>
	This development accompanies the PLDI 2015 paper of the same name.
	</p>
	notify = peteg42@gmail.com

	[List_Update]
	title = Analysis of List Update Algorithms
	author = Maximilian P.L. Haslbeck <http://in.tum.de/~haslbema/>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2016-02-17
	topic = Computer science/Algorithms/Online
	abstract =
	<p>
	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 <i>Online Computation
	and Competitive Analysis</i> by Borodin and El-Yaniv.
	</p>
	<p>
	For an informal description see the FSTTCS 2016 publication
	<a href="http://www21.in.tum.de/~nipkow/pubs/fsttcs16.html">Verified Analysis of List Update Algorithms</a>
	by Haslbeck and Nipkow.
	</p>
	notify = nipkow@in.tum.de

	[ConcurrentIMP]
	title = Concurrent IMP
	author = Peter Gammie <http://peteg.org>
	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 <http://peteg.org>
	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 <mailto:adbrucker@0x5f.org>, Lukas Brügger <mailto:lukas.a.bruegger@gmail.com>, Burkhart Wolff <mailto:wolff@lri.fr>
	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 <https://www.brucker.ch>, Lukas Brügger<>, Burkhart Wolff <https://www.lri.fr/~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 <http://www.tbrk.org>, Peter Höfner <http://www.hoefner-online.de/>
	date = 2014-10-23
	topic = Computer science/Concurrency/Process calculi
	abstract =
	<p>
	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.
	<p>
	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.
	</p><p>
	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.
	</p>
	notify = tim@tbrk.org

	[Show]
	title = Haskell's Show Class in Isabelle/HOL
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	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.<br>
	[2015-04-10]: Moved development for old-style datatypes into subdirectory
	"Old_Datatype".<br>
	notify = christian.sternagel@uibk.ac.at, rene.thiemann@uibk.ac.at

	[Certification_Monads]
	title = Certification Monads
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	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 <mailto:Freek.Verbeek@ou.nl>, Sergey Tverdyshev <mailto:stv@sysgo.com>, Oto Havle <mailto:oha@sysgo.com>, Holger Blasum <mailto:holger.blasum@sysgo.com>, Bruno Langenstein <mailto:langenstein@dfki.de>, Werner Stephan <mailto:stephan@dfki.de>, Yakoub Nemouchi <mailto:nemouchi@lri.fr>, Abderrahmane Feliachi <mailto:abderrahmane.feliachi@lri.fr>, Burkhart Wolff <mailto:wolff@lri.fr>, Julien Schmaltz <mailto:Julien.Schmaltz@ou.nl>
	date = 2014-07-18
	topic = Computer science/Security
	abstract =
	<p>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.</p>
	<p>
	This document corresponds to the deliverable D31.1 of the EURO-MILS
	Project <a href="http://www.euromils.eu">http://www.euromils.eu</a>.</p>
	notify =

	[pGCL]
	title = pGCL for Isabelle
	author = David Cock <mailto:david.cock@nicta.com.au>
	date = 2014-07-13
	topic = Computer science/Programming languages/Language definitions
	abstract =
	<p>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.</p>
	<p> This package provides both a shallow embedding of the language
	primitives, and an annotation and refinement framework. The generated
	document includes a brief tutorial.</p>
	notify =

	[Noninterference_CSP]
	title = Noninterference Security in Communicating Sequential Processes
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2014-05-23
	topic = Computer science/Security
	abstract =
	<p>
	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.
	</p>
	<p>
	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.
	</p>
	<p>
	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.
	</p>
	notify = pasquale.noce.lavoro@gmail.com

	[Floyd_Warshall]
	title = The Floyd-Warshall Algorithm for Shortest Paths
	author = Simon Wimmer <http://in.tum.de/~wimmers>, Peter Lammich <http://www21.in.tum.de/~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 <http://www.doc.ic.ac.uk/~jpw48>
	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 <http://www.tbrk.org>
	date = 2014-03-08
	topic = Computer science/Concurrency/Process calculi
	abstract =
	<p>
	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.</p>
	<p>
	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).</p>
	notify = tim@tbrk.org

	[Selection_Heap_Sort]
	title = Verification of Selection and Heap Sort Using Locales
	author = Danijela Petrovic <http://www.matf.bg.ac.rs/~danijela>
	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 <mailto:rene.thiemann@uibk.ac.at>
	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.
	<p>
	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 <https://www.mpi-inf.mpg.de/~crizkall/>
	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 <http://pp.ipd.kit.edu/~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 <http://pp.ipd.kit.edu/~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).
	<p>
	We use syntax and the denotational semantics from the entry
	"Launchbury", where we formalized Launchbury's natural semantics for
	lazy evaluation.
	<p>
	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.
	<p>
	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 <http://www.itu.dk/people/jebe>
	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.
	<p>
	This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>.
	notify =

	[Pi_Calculus]
	title = The pi-calculus in nominal logic
	author = Jesper Bengtson <http://www.itu.dk/people/jebe>
	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.
	<p>
	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.
	<p>
	This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>.
	notify =

	[Psi_Calculi]
	title = Psi-calculi in Isabelle
	author = Jesper Bengtson <http://www.itu.dk/people/jebe>
	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.
	<p>
	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.
	<p>
	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.
	<p>
	This entry is described in detail in <a href="http://www.itu.dk/people/jebe/files/thesis.pdf">Bengtson's thesis</a>.
	notify =

	[Encodability_Process_Calculi]
	title = Analysing and Comparing Encodability Criteria for Process Calculi
	author = Kirstin Peters <mailto:kirstin.peters@tu-berlin.de>, Rob van Glabbeek <http://theory.stanford.edu/~rvg/>
	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 <mailto:abderrahmane.feliachi@lri.fr>, Burkhart Wolff <mailto:wolff@lri.fr>, Marie-Claude Gaudel <mailto:mcg@lri.fr>
	contributors = Makarius Wenzel <mailto:Makarius.wenzel@lri.fr>
	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).
	<p>
	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 <mailto:b.n@wwu.de>, Peter Lammich <http://www21.in.tum.de/~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 <http://www21.in.tum.de/~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.
	<p>
	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.
	<p>
	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<br>
	[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.<br>
	[2012-07] New example: Nested DFS for emptiness check of Buchi-automata with witness.<br>
	New feature:
	fo_rule method to apply resolution using first-order matching. Useful for arg_conf, fun_cong.<br>
	[2012-08] Adaptation to ICF v2.<br>
	[2012-10-05] Adaptations to include support for Automatic Refinement Framework.<br>
	[2013-09] This entry now depends on Automatic Refinement<br>
	[2014-06] New feature: vc_solve method to solve verification conditions.
	Maintenace changes: VCG-rules for nfoldli, improved setup for FOREACH-loops.<br>
	[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.<br>
	[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 <http://www21.in.tum.de/~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 <mailto:lammich@in.tum.de>
	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.
	<p>
	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 <mailto:lammich@in.tum.de>, 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 <http://www21.in.tum.de/~lammich>, Simon Wimmer <http://in.tum.de/~wimmers>
	topic = Computer science/Algorithms
	date = 2018-04-27
	notify = lammich@in.tum.de
	abstract =
	<a
	href="http://www.pm.inf.ethz.ch/research/verifythis.html">VerifyThis
	2018</a> 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 <http://users.abo.fi/vpreotea/>
	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 <http://users.abo.fi/vpreotea/>
	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 <http://users.abo.fi/vpreotea/>
	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 <mailto:ralph.romanos@student.ecp.fr>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	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 <http://net.in.tum.de/~diekmann>, Julius Michaelis <http://liftm.de>, Lars Hupel <https://www21.in.tum.de/~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 <http://net.in.tum.de/~diekmann>, Julius Michaelis <http://liftm.de>, Maximilian Haslbeck<http://cl-informatik.uibk.ac.at/users/mhaslbeck//>
	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
	<a href="http://dl.ifip.org/db/conf/networking/networking2016/1570232858.pdf">Verified iptables Firewall
	Analysis</a>, IFIP Networking 2016.

	[Iptables_Semantics]
	title = Iptables Semantics
	author = Cornelius Diekmann <http://net.in.tum.de/~diekmann>, Lars Hupel <https://www21.in.tum.de/~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 <a
	href="https://www.isa-afp.org/entries/Simple_Firewall.html">Simple_Firewall</a>)
	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 <a
	href="http://iptables.isabelle.systems">fffuu</a>. The tool does not
	require any input —except for the <tt>iptables-save</tt> 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 <http://liftm.de>, Cornelius Diekmann <http://net.in.tum.de/~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 <http://peteg.org>
	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 <mailto:tjm1983@gmail.com>
	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.
	<p>
	An earlier version of this work was the subject of the author's
	<a href="http://researcharchive.vuw.ac.nz/handle/10063/2315">MSc thesis</a>,
	which contains natural-language explanations of some of the
	more interesting proofs.
	notify = tjm1983@gmail.com

	[IsaGeoCoq]
	title = Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid
	author = Roland Coghetto <mailto:roland_coghetto@hotmail.com>
	topic = Mathematics/Geometry
	license = LGPL
	date = 2021-01-31
	notify = roland_coghetto@hotmail.com
	abstract =
	<p>The <a href="https://geocoq.github.io/GeoCoq/">GeoCoq library</a> contains a formalization
	of geometry using the Coq proof assistant. It contains both proofs
	about the foundations of geometry and high-level proofs in the same
	style as in high school. We port a part of the GeoCoq
	2.4.0 library to Isabelle/HOL: more precisely,
	the files Chap02.v to Chap13_3.v, suma.v as well as the associated
	definitions and some useful files for the demonstration of certain
	parallel postulates. The synthetic approach of the demonstrations is directly
	inspired by those contained in GeoCoq. The names of the lemmas and
	theorems used are kept as far as possible as well as the definitions.
	</p>
	<p>It should be noted that T.J.M. Makarios has done
	<a href="https://www.isa-afp.org/entries/Tarskis_Geometry.html">some proofs in Tarski's Geometry</a>. It uses a definition that does not quite
	coincide with the definition used in Geocoq and here.
	Furthermore, corresponding definitions in the <a href="https://www.isa-afp.org/entries/Poincare_Disc.html">Poincaré Disc Model
	development</a> are not identical to those defined in GeoCoq.
	</p>
	<p>In the last part, it is
	formalized that, in the neutral/absolute space, the axiom of the
	parallels of Tarski's system implies the Playfair axiom, the 5th
	postulate of Euclid and Euclid's original parallel postulate. These
	proofs, which are not constructive, are directly inspired by Pierre
	Boutry, Charly Gries, Julien Narboux and Pascal Schreck.
	</p>

	[General-Triangle]
	title = The General Triangle Is Unique
	author = Joachim Breitner <mailto:mail@joachim-breitner.de>
	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 <http://rok.strnisa.com/lj/>, Matthew Parkinson <http://research.microsoft.com/people/mattpark/>
	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 <mailto:grechukbogdan@yandex.ru>
	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 <mailto:immler@in.tum.de>
	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 <http://www.in.tum.de/~krauss>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	contributors = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	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. <i>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.</i> <P> 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<br>
	[2012-05-10]: Tobias Nipkow added extended regular expressions<br>
	[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 <http://www21.in.tum.de/~nipkow>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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.
	<a href="http://www21.in.tum.de/~nipkow/pubs/itp14.html">
	The formalization is described in a paper of the same name presented at
	Interactive Theorem Proving 2014</a>.
	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 <https://traytel.bitbucket.io>, Tobias Nipkow <http://www21.in.tum.de/~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.
	<p>
	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.
	<p>
	The formalization is described in this <a href="http://www21.in.tum.de/~nipkow/pubs/icfp13.html">ICFP 2013 functional pearl</a>.
	notify = traytel@in.tum.de, nipkow@in.tum.de

	[Formula_Derivatives]
	title = Derivatives of Logical Formulas
	author = Dmitriy Traytel <https://traytel.bitbucket.io>
	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 <em>not</em> 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).
	<p>
	The WS1S instance is described in the draft paper <a
	href="https://people.inf.ethz.ch/trayteld/papers/csl15-ws1s_derivatives/index.html">A
	Coalgebraic Decision Procedure for WS1S</a> 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 <http://www.inf.kcl.ac.uk/staff/urbanc/>
	contributors = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	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 <https://nms.kcl.ac.uk/christian.urban/>, Sebastiaan J. C. Joosten <http://sjcjoosten.nl/>
	+author = Jian Xu<>, Xingyuan Zhang<>, Christian Urban <https://nms.kcl.ac.uk/christian.urban/>, Sebastiaan J. C. Joosten <https://sjcjoosten.nl/>
	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 <mailto:Maksym.Bortin@nicta.com.au>
	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 <http://www21.in.tum.de/~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 <http://www.in.tum.de/~berghofe>, 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 <http://www21.in.tum.de/~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 <mailto:helke@cs.tu-berlin.de>, Florian Kammüller <mailto:flokam@cs.tu-berlin.de>
	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 <http://www.loria.fr/~merz>
	topic = Computer science/Automata and formal languages
	date = 2012-05-07
	abstract = <p>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.</p> <p>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.</p>
	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 <https://traytel.bitbucket.io>
	topic = Computer science/Automata and formal languages
	date = 2013-11-15
	abstract = <p>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.</p>
	<p>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.</p>
	<p>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.</p>
	notify = traytel@in.tum.de

	[Tree-Automata]
	title = Tree Automata
	author = Peter Lammich <http://www21.in.tum.de/~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 <http://www21.in.tum.de/~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 <http://www21.in.tum.de/~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 <mailto:hoelzl@in.tum.de>
	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.
	<p>
	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 <http://users.abo.fi/vpreotea/>, Ralph-Johan Back <http://users.abo.fi/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 <i>next</i> 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 <mailto:c.sternagel@gmail.com>
	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.<br>
	[2018-09-17]:
	Added theory Efficient_Mergesort that works exclusively with the mutual
	induction schemas generated by the function package.<br>
	[2018-09-19]:
	Added theory Mergesort_Complexity that proves an upper bound on the number of
	comparisons that are required by mergesort.<br>
	[2018-09-19]:
	Theory Efficient_Mergesort replaces theory Efficient_Sort but keeping the old
	name Efficient_Sort.
	[2020-11-20]:
	Additional theory Natural_Mergesort that developes an efficient mergesort
	algorithm without key-functions for educational purposes.
	notify = c.sternagel@gmail.com

	[SATSolverVerification]
	title = Formal Verification of Modern SAT Solvers
	author = Filip Marić <http://poincare.matf.bg.ac.rs/~filip/>
	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: <ul> <li> a solver based on classical DPLL procedure (using only a backtrack-search with unit propagation),</li> <li> a very general solver with backjumping and learning (similar to the description given in (Nieuwenhuis et al., 2006)), and</li> <li> a solver with a specific conflict analysis algorithm (similar to the description given in (Krstic et al., 2007)).</li> </ul> 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 <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	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 <mailto:rene.thiemann@uibk.ac.at>
	license = LGPL
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p>
	notify = rene.thiemann@uibk.ac.at

	[MuchAdoAboutTwo]
	title = Much Ado About Two
	author = Sascha Böhme <http://www21.in.tum.de/~boehmes/>
	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 <http://www.fceia.unr.edu.ar/~mauro/>, Stephan Merz <http://www.loria.fr/~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 <http://users.cecs.anu.edu.au/~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 <http://www.cs.famaf.unc.edu.ar/~damian/>
	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 <a href="http://users.rsise.anu.edu.au/~tiu/clocksync.pdf">"Verification of Clock Synchronization Algorithms: Experiments on a combination of deductive tools"</a> in proceedings of AVOCS 2005. In this work the correctness of Schneider schema was also verified using Isabelle (entry <a href="GenClock.html">GenClock</a> 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 <mailto:henri.debrat@loria.fr>, Stephan Merz <http://www.loria.fr/~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".
	<p>
	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.
	<p>
	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 <mailto:sprenger@inf.ethz.ch>
	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 <mailto:joseph.lallemand@loria.fr>, Christoph Sprenger <mailto:sprenger@inf.ethz.ch>
	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 <mailto:sprenger@inf.ethz.ch>, 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 <mailto:rachid.guerraoui@epfl.ch>, Viktor Kuncak <http://lara.epfl.ch/~kuncak/>, Giuliano Losa <mailto:giuliano.losa@epfl.ch>
	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 <http://www21.in.tum.de/~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.
	<p>
	A preliminary version of this work (without pairing heaps) is described
	in a <a href="http://www21.in.tum.de/~nipkow/pubs/itp15.html">paper</a>
	published in the proceedings of the conference on Interactive
	Theorem Proving ITP 2015. An extended version of this publication
	is available <a href="http://www21.in.tum.de/~nipkow/pubs/jfp16.html">here</a>.
	extra-history =
	Change history:
	[2015-03-17]: Added pairing heaps by Hauke Brinkop.<br>
	[2016-07-12]: Moved splay heaps from here to Splay_Tree<br>
	[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 <http://www21.in.tum.de/~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.
	<P>
	A full description is found in a
	<a href="http://www21.in.tum.de/~nipkow/pubs">companion paper</a>.
	notify = nipkow@in.tum.de

	[AVL-Trees]
	title = AVL Trees
	author = Tobias Nipkow <http://www21.in.tum.de/~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 <tt>gerwin.klein@nicta.com.au</tt>.
	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 <http://lara.epfl.ch/~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 <http://www21.in.tum.de/~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).
	<p>
	The amortized complexity of splay trees and heaps is analyzed in the AFP entry
	<a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>.
	extra-history =
	Change history:
	[2016-07-12]: Moved splay heaps here from Amortized_Complexity

	[Root_Balanced_Tree]
	title = Root-Balanced Tree
	author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	notify = nipkow@in.tum.de
	date = 2017-08-20
	topic = Computer science/Data structures
	abstract =
	<p>
	Andersson introduced <em>general balanced trees</em>,
	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 <em>root-balanced trees</em>. Using a lightweight model
	of execution time, amortized logarithmic complexity is verified in
	the theorem prover Isabelle.
	</p>
	<p>
	This is the Isabelle formalization of the material decribed in the APLAS 2017 article
	<a href="http://www21.in.tum.de/~nipkow/pubs/aplas17.html">Verified Root-Balanced Trees</a>
	by the same author, which also presents experimental results that show
	competitiveness of root-balanced with AVL and red-black trees.
	</p>

	[Skew_Heap]
	title = Skew Heap
	author = Tobias Nipkow <http://www21.in.tum.de/~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.
	<p>
	The amortized complexity of skew heaps is analyzed in the AFP entry
	<a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>.
	notify = nipkow@in.tum.de

	[Pairing_Heap]
	title = Pairing Heap
	author = Hauke Brinkop <mailto:hauke.brinkop@googlemail.com>, Tobias Nipkow <http://www21.in.tum.de/~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.
	<p>
	The amortized complexity of pairing heaps is analyzed in the AFP article
	<a href="http://isa-afp.org/entries/Amortized_Complexity.html">Amortized Complexity</a>.
	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 <http://www21.in.tum.de/~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 <mailto:neumannr@in.tum.de>
	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 <mailto:rene.meis@uni-muenster.de>, Finn Nielsen <mailto:finn.nielsen@uni-muenster.de>, Peter Lammich <http://www21.in.tum.de/~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 <em>findMin</em>, <em>deleteMin</em>,
	<em>insert</em>, and <em>meld</em> operations,
	skew binomial heaps have constant time <em>findMin</em>, <em>insert</em>,
	and <em>meld</em> operations, and only the <em>deleteMin</em>-operation is
	logarithmic. This is achieved by using <em>skew links</em> to avoid
	cascading linking on <em>insert</em>-operations, and <em>data-structural
	bootstrapping</em> to get constant-time <em>findMin</em> and <em>meld</em>
	operations. Our implementation follows the paper by Brodal and Okasaki.
	notify = peter.lammich@uni-muenster.de

	[Finger-Trees]
	title = Finger Trees
	author = Benedikt Nordhoff <mailto:b_nord01@uni-muenster.de>, Stefan Körner <mailto:s_koer03@uni-muenster.de>, Peter Lammich <http://www21.in.tum.de/~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
	<em>monotone predicate</em> 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 <http://www.andreas-lochbihler.de>, Tobias Nipkow <http://www21.in.tum.de/~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 <http://www.andreas-lochbihler.de>
	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)<br>
	[2010-11-04]:
	new conversion function from FinFun to list of elements in the domain
	(revision 0c167102e6ed)<br>
	[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 <http://www21.in.tum.de/~lammich>
	contributors = Andreas Lochbihler <http://www.andreas-lochbihler.de>, 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.<br>
	[2010-12-01]: New Interfaces: Priority Queues, Annotated Lists. Implemented by finger trees, (skew) binomial queues.<br>
	[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<br>
	[2012-04-25]: New iterator foundation by Tuerk. Various maintenance changes.<br>
	[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.<br>
	[2013-09]: Added Generic Collection Framework based on Autoref. The GenCF provides: Arbitrary nesting, full integration with Autoref.<br>
	[2014-06]: Maintenace changes to GenCF: Optimized inj_image on list_set. op_set_cart (Cartesian product). big-Union operation. atLeastLessThan - operation ({a..<b})<br>
	notify = lammich@in.tum.de

	[Containers]
	title = Light-weight Containers
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>
	contributors = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	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.
	<p>
	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)<br>
	[2013-09-20]:
	provide generators for canonical type class instantiations
	(revision 159f4401f4a8 by René Thiemann)<br>
	[2014-07-08]: add support for going from partial functions to mappings (revision 7a6fc957e8ed)<br>
	[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 <http://www.mit.edu/~kkz/>, Viktor Kuncak <http://lara.epfl.ch/~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 <mailto:rene.thiemann@uibk.ac.at>
	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.
	<p>
	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.
	<p>
	Our formalization was performed as part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA</a> project.
	With our new tactic we could completely remove
	tedious proofs for linear orders of two datatypes.
	<p>
	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 <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	date = 2015-03-11
	topic = Computer science/Data structures
	abstract =
	<p>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.</p>
	<p>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.</p>
	<p>Our formalization was performed as part of the <a href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA</a> 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.</p>
	notify = rene.thiemann@uibk.ac.at

	[List-Index]
	title = List Index
	date = 2010-02-20
	author = Tobias Nipkow <http://www21.in.tum.de/~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 <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~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 <a
	href="http://cl-informatik.uibk.ac.at/software/ceta">CeTA</a> 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 <mailto:prathamesh@imsc.res.in>
	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 <http://www21.in.tum.de/~blanchet>
	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 <mailto:rene.thiemann@uibk.ac.at>
	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 <mailto:rene.thiemann@uibk.ac.at>
	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 <tt>{x :: 'a. P x}</tt>,
	provided the definition is of the form
	<tt>f ys = (if check ys then Some(generate ys :: 'a) else None)</tt> where
	<tt>ys</tt> is a list of variables <tt>y1 ... yn</tt> and
	<tt>check ys ==> P(generate ys)</tt> can be proved.
	<p>
	In principle, such a definition is also directly possible using the
	<tt>lift_definition</tt> 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 <tt>check ys</tt> 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 <http://www.andreas-lochbihler.de>
	contributors = Johannes Hölzl <mailto:hoelzl@in.tum.de>
	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.<br>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)<br>
	[2010-06-28]:
	new codatatype terminated lazy lists
	(revision e12de475c558)<br>
	[2010-08-04]:
	terminated lazy lists: setup for quotient package;
	more lemmas
	(revision 6ead626f1d01)<br>
	[2010-08-17]:
	Koenig's lemma as an example application for coinductive lists
	(revision f81ce373fa96)<br>
	[2011-02-01]:
	lazy implementation of coinductive (terminated) lists for the code generator
	(revision 6034973dce83)<br>
	[2011-07-20]:
	new codatatype resumption
	(revision 811364c776c7)<br>
	[2012-06-27]:
	new codatatype stream with operations (with contributions by Peter Gammie)
	(revision dd789a56473c)<br>
	[2013-03-13]:
	construct codatatypes with the BNF package and adjust the definitions and proofs,
	setup for lifting and transfer packages
	(revision f593eda5b2c0)<br>
	[2013-09-20]:
	stream theory uses type and operations from HOL/BNF/Examples/Stream
	(revision 692809b2b262)<br>
	[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)<br>
	notify = mail@andreas-lochbihler.de

	[Stream-Fusion]
	title = Stream Fusion
	author = Brian Huffman <http://cs.pdx.edu/~brianh>
	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 <a href="http://hackage.haskell.org/package/stream-fusion">online</a>.)<br><br>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 <mailto:huffman@in.tum.de>
	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 <i>Formal Verification of Monad
	Transformers</i> by the author. The formalization is a revised and
	updated version of earlier joint work with Matthews and White.
	<P>
	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 <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	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 <http://www.cs.cornell.edu/~jnfoster/>, Dimitrios Vytiniotis <http://research.microsoft.com/en-us/people/dimitris/>
	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 <http://www.cse.unsw.edu.au/~kleing/>, Tobias Nipkow <http://www21.in.tum.de/~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 <http://www.andreas-lochbihler.de>
	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)<br>
	[2009-04-27]:
	added verified compiler from source code to bytecode;
	encapsulate native methods in separate semantics
	(revision e4f26541e58a)<br>
	[2009-11-30]:
	extended compiler correctness proof to infinite and deadlocking computations
	(revision e50282397435)<br>
	[2010-06-08]:
	added thread interruption;
	new abstract memory model with sequential consistency as implementation
	(revision 0cb9e8dbd78d)<br>
	[2010-06-28]:
	new thread interruption model
	(revision c0440d0a1177)<br>
	[2010-10-15]:
	preliminary version of the Java memory model for source code
	(revision 02fee0ef3ca2)<br>
	[2010-12-16]:
	improved version of the Java memory model, also for bytecode
	executable scheduler for source code semantics
	(revision 1f41c1842f5a)<br>
	[2011-02-02]:
	simplified code generator setup
	new random scheduler
	(revision 3059dafd013f)<br>
	[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)<br>
	[2012-02-16]:
	added example programs
	(revision bf0b06c8913d)<br>
	[2012-11-21]:
	type safety proof for the Java memory model,
	allow spurious wake-ups
	(revision 76063d860ae0)<br>
	[2013-05-16]:
	support for non-deterministic memory allocators
	(revision cc3344a49ced)<br>
	[2017-10-20]:
	add an atomic compare-and-swap operation for volatile fields
	(revision a6189b1d6b30)<br>
	notify = mail@andreas-lochbihler.de

	[Locally-Nameless-Sigma]
	title = Locally Nameless Sigma Calculus
	author = Ludovic Henrio <mailto:Ludovic.Henrio@sophia.inria.fr>, Florian Kammüller <mailto:flokam@cs.tu-berlin.de>, Bianca Lutz <mailto:sowilo@cs.tu-berlin.de>, Henry Sudhof <mailto:hsudhof@cs.tu-berlin.de>
	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 <http://www.cs.mdx.ac.uk/people/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 <mailto:maria.spichkova@rmit.edu.au>
	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 <mailto:tuong@users.gforge.inria.fr>, Burkhart Wolff <https://www.lri.fr/~wolff/>
	date = 2015-09-16
	topic = Computer science/Programming languages/Language definitions
	abstract =
	We represent a theory <i>of</i> (a fragment of) Isabelle/HOL <i>in</i>
	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.
	<p>
	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.
	<p>
	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.
	<p>
	This theory is drawn from the
	<a href="http://isa-afp.org/entries/Featherweight_OCL.html">Featherweight OCL</a>
	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.
	<p>
	Gained experience from this project shows that the compiled code is sufficiently
	efficient for practical purposes while being based on a formal <i>model</i>
	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 <https://www.lri.fr/~ftuong/>, Burkhart Wolff <https://www.lri.fr/~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 <mailto:peteg42@gmail.com>
	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 <http://www.in.tum.de/~berghofe>
	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<sub><:</sub>. 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<sub><:</sub>, 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 <mailto:doczkal@ps.uni-saarland.de>
	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 <http://www21.in.tum.de/~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 <i>W</i> for MiniML (simply-typed lambda terms with <tt>let</tt>) due to Milner. It proves the soundness and completeness of <i>W</i> 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 <mailto:kleing@cse.unsw.edu.au>, Rafal Kolanski <mailto:rafal.kolanski@nicta.com.au>, Andrew Boyton <mailto:andrew.boyton@nicta.com.au>
	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. <P> The ex directory contains example instantiations that include structures such as a heap or virtual memory. <P> 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. <P> 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 <http://www21.in.tum.de/~lammich>, Rene Meis <mailto:rene.meis@uni-due.de>
	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.
	<br>
	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 <http://www.dmi.unict.it/~giamp/>
	date = 2012-05-02
	topic = Computer science/Security
	abstract = This document contains the full theory files accompanying article <i>Inductive Study of Confidentiality --- for Everyone</i> in <i>Formal Aspects of Computing</i>. 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 <https://www.andreipopescu.uk>, Johannes Hölzl <mailto:hoelzl@in.tum.de>
	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.
	<p>
	An <a href="http://www21.in.tum.de/~nipkow/pubs/cpp12.html">article</a>
	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 <mailto:grewe@cs.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Daniel Schoepe <mailto:daniel@schoepe.org>
	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.
	<p>
	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 =

	[Dependent_SIFUM_Type_Systems]
	title = A Dependent Security Type System for Concurrent Imperative Programs
	author = Toby Murray <http://people.eng.unimelb.edu.au/tobym/>, Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah<https://www.mpi-inf.mpg.de/~crizkall/>
	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 <http://people.eng.unimelb.edu.au/tobym/>, Robert Sison<>, Edward Pierzchalski<>, Christine Rizkallah<https://www.mpi-inf.mpg.de/~crizkall/>
	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 <https://people.eng.unimelb.edu.au/tobym/>
	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 <mailto:grewe@cs.tu-darmstadt.de>, Alexander Lux <mailto:lux@mais.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Jens Sauer <mailto:sauer@mais.informatik.tu-darmstadt.de>
	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.
	<p>
	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.
	<p>
	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 =

	[WHATandWHERE_Security]
	title = A Formalization of Declassification with WHAT-and-WHERE-Security
	author = Sylvia Grewe <mailto:grewe@cs.tu-darmstadt.de>, Alexander Lux <mailto:lux@mais.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Jens Sauer <mailto:sauer@mais.informatik.tu-darmstadt.de>
	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.
	<p>
	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.
	<p>
	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.
	<p>
	This Isabelle/HOL formalization uses theories from the entry
	Strong Security.
	notify =

	[VolpanoSmith]
	title = A Correctness Proof for the Volpano/Smith Security Typing System
	author = Gregor Snelting <http://pp.info.uni-karlsruhe.de/personhp/gregor_snelting.php>, Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	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 <http://www21.in.tum.de/~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 <http://www.cosc.canterbury.ac.nz/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 <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>, Tjark Weber <http://user.it.uu.se/~tjawe125/>
	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.
	<p>
	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).
	<p>
	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 <http://www.dcs.shef.ac.uk/~victor>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>
	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 <http://www.dcs.shef.ac.uk/~victor>, Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Peter Höfner <http://www.hoefner-online.de/>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>, Tjark Weber <http://user.it.uu.se/~tjawe125/>
	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 <http://www-users.cs.york.ac.uk/~simonf>, Georg Struth <http://www.dcs.shef.ac.uk/~georg>
	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 <http://www.tcs.informatik.uni-muenchen.de/~mhofmann>
	date = 2008-12-12
	topic = Computer science/Programming languages/Logics
	abstract = This document contains the Isabelle/HOL sources underlying the paper <i>A bytecode logic for JML and types</i> 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 <http://users.abo.fi/vpreotea/>, Ralph-Johan Back <http://users.abo.fi/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 <mailto:viorel.preoteasa@aalto.fi>
	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 <http://www.tcs.informatik.uni-muenchen.de/~mhofmann>
	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.<br><br>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 <http://homepages.inf.ed.ac.uk/ggrov>, Stephan Merz <http://www.loria.fr/~merz>
	date = 2011-11-19
	topic = Computer science/Programming languages/Logics
	abstract = We mechanise the logic TLA*
	<a href="http://www.springerlink.com/content/ax3qk557qkdyt7n6/">[Merz 1999]</a>,
	an extension of Lamport's Temporal Logic of Actions (TLA)
	<a href="http://dl.acm.org/citation.cfm?doid=177492.177726">[Lamport 1994]</a>
	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:
	<ul>
	<li>a theory of infinite sequences, including a formalisation of the concepts of stuttering invariance central to TLA and TLA*;
	<li>a definition of the semantics of TLA*, which extends TLA by a mutually-recursive definition of formulas and pre-formulas, generalising TLA action formulas;
	<li>a substantial set of derived proof rules, including the TLA* axioms and Lamport's proof rules for system verification;
	<li>a set of examples illustrating the usage of Isabelle/TLA* for reasoning about systems.
	</ul>
	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 <a href="http://www.springerlink.com/content/354026160p14j175/">[Chaudhuri et al 2010]</a>.
	notify = ggrov@inf.ed.ac.uk

	[Compiling-Exceptions-Correctly]
	title = Compiling Exceptions Correctly
	author = Tobias Nipkow <http://www21.in.tum.de/~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 <a href="http://www.cs.nott.ac.uk/~gmh/">Hutton</a> and Wright.
	notify = nipkow@in.tum.de

	[NormByEval]
	title = Normalization by Evaluation
	author = Klaus Aehlig <http://www.linta.de/~aehlig/>, Tobias Nipkow <http://www21.in.tum.de/~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 <http://www21.in.tum.de/~lammich>, Markus Müller-Olm <http://cs.uni-muenster.de/u/mmo/>
	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 <mailto:mail@joachim-breitner.de>
	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 <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	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.<br><br>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 <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2009-11-13
	topic = Computer science/Programming languages/Static analysis
	abstract = After verifying <a href="Slicing.html">dynamic and static interprocedural slicing</a>, 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 <http://peteg.org>
	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 <mailto:rauch@informatik.uni-kl.de>, 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 <http://www21.in.tum.de/~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 <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2010-03-23
	topic = Computer science/Security
	abstract =
	<p>
	In this contribution, we show how correctness proofs for <a
	href="Slicing.html">intra-</a> and <a
	href="HRB-Slicing.html">interprocedural slicing</a> 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.
	</p>
	<p>
	This entry contains the part for intra-procedural slicing. See entry
	<a href="InformationFlowSlicing_Inter.html">InformationFlowSlicing_Inter</a>
	for the inter-procedural part.
	</p>
	extra-history =
	Change history:
	[2016-06-10]: The original entry <a
	href="InformationFlowSlicing.html">InformationFlowSlicing</a> contained both
	the <a href="InformationFlowSlicing_Inter.html">inter-</a> and <a
	href="InformationFlowSlicing.html">intra-procedural</a> case was split into
	two for easier maintenance.
	notify =

	[InformationFlowSlicing_Inter]
	title = Inter-Procedural Information Flow Noninterference via Slicing
	author = Daniel Wasserrab <http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php>
	date = 2010-03-23
	topic = Computer science/Security
	abstract =
	<p>
	In this contribution, we show how correctness proofs for <a
	href="Slicing.html">intra-</a> and <a
	href="HRB-Slicing.html">interprocedural slicing</a> 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.
	</p>
	<p>
	This entry contains the part for inter-procedural slicing. See entry
	<a href="InformationFlowSlicing.html">InformationFlowSlicing</a>
	for the intra-procedural part.
	</p>
	extra-history =
	Change history:
	[2016-06-10]: The original entry <a
	href="InformationFlowSlicing.html">InformationFlowSlicing</a> contained both
	the <a href="InformationFlowSlicing_Inter.html">inter-</a> and <a
	href="InformationFlowSlicing.html">intra-procedural</a> case was split into
	two for easier maintenance.
	notify =

	[ComponentDependencies]
	title = Formalisation and Analysis of Component Dependencies
	author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au>
	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 <i>Proof Theory</i> 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 <a href="Completeness-paper.pdf">[pdf]</a>.
	notify = lp15@cam.ac.uk

	[Ordinal]
	title = Countable Ordinals
	author = Brian Huffman <http://web.cecs.pdx.edu/~brianh/>
	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 <https://www.andreipopescu.uk>
	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 <http://www.in.tum.de/~berghofe>
	contributors = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	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: Completeness of Modal Logics
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	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).
	The extensions of system K (T, KB, K4, S4, S5) and their completeness proofs
	are based on the textbook "Modal Logic" by Blackburn, de Rijke and Venema
	(Cambridge University Press 2001).
	extra-history =
	Change history:
	[2020-04-15]: Added completeness of modal logics T, KB, K4, S4 and S5.

	[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 <http://www21.in.tum.de/~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 <http://web.cecs.pdx.edu/~brianh/>
	date = 2010-03-29
	abstract = This theory defines a type constructor representing the free Boolean algebra over a set of generators. Values of type (α)<i>formula</i> 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 <http://www21.in.tum.de/~blanchet>, Andrei Popescu <https://www.andreipopescu.uk>
	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.
	<p>
	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.
	<p>
	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 <mailto:jasmin.blanchette@gmail.com>, Uwe Waldmann <mailto:waldmann@mpi-inf.mpg.de>, Daniel Wand <mailto:dwand@mpi-inf.mpg.de>
	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 <mailto:hbecker@mpi-sws.org>, Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Uwe Waldmann <mailto:waldmann@mpi-inf.mpg.de>, Daniel Wand <mailto:dwand@mpi-inf.mpg.de>
	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 <https://www.cs.vu.nl/~abp290/>
	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 <mailto:jasmin.blanchette@gmail.com>, Mathias Fleury <mailto:fleury@mpi-inf.mpg.de>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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 <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~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
	<i>joinability</i>, <i>meetability</i>, <i>conversion</i>, 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 <a
	href="http://cl-informatik.uibk.ac.at/software/ceta">CeTA</a> (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. <br>
	[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 <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/users/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 <i>Isabelle
	Formalization of Rewriting</i> <a
	href="http://cl-informatik.uibk.ac.at/isafor">IsaFoR</a>,
	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 <mailto:mail@joachim-breitner.de>
	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 <http://kasterma.net>
	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, <i>A Complete Proof of the Robbins Conjecture</i>, 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 <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	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 <i>Linear Algebra Done Right</i>. 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 <http://www21.in.tum.de/~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<br>
	[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 <https://home.in.tum.de/~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 <http://www-lti.informatik.rwth-aachen.de/~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 <http://www21.in.tum.de/~immler>, Johannes Hölzl <http://in.tum.de/~hoelzl>
	topic = Mathematics/Analysis
	date = 2012-04-26
	abstract =
	<p>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 <i>flow</i> of ODEs.</p>
	<p>
	Not in the generated document are the following sessions:
	<ul>
	<li> 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.</li>
	<li> HOL-ODE-Examples:
	Applications of the numerical algorithms to concrete systems of ODEs.</li>
	<li> Lorenz_C0, Lorenz_C1:
	Verified algorithms for checking C1-information according to Tucker's proof,
	computation of C0-information.</li>
	</ul>
	</p>
	extra-history =
	Change history:
	[2014-02-13]: added an implementation of the Euler method based on affine arithmetic<br>
	[2016-04-14]: added flow and variational equation<br>
	[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<br>
	[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 <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann>, Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>, Fabian Immler <http://www21.in.tum.de/~immler>, Florian Haftmann <http://isabelle.in.tum.de/~haftmann>, Andreas Lochbihler <http://www.andreas-lochbihler.de>, Alexander Bentkamp <mailto:bentkamp@gmail.com>
	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 <a
	href="http://cl-informatik.uibk.ac.at/software/ceta">IsaFoR/CeTA-system</a>
	which contains several termination techniques. The provided theories have
	been essential to formalize polynomial interpretations.
	<p>
	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.<br>
	[2016-10-28]: Added abstract representation of polynomials and authors Maletzky/Immler.<br>
	[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".<br>
	[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 <mailto:rene.thiemann@uibk.ac.at>
	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 <https://www21.in.tum.de/~eberlm>
	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 <mailto:wl302@cam.ac.uk>
	+author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	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 <http://in.tum.de/~hoelzl>, Tobias Nipkow <http://www21.in.tum.de/~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.
	<p>
	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.
	<a href="http://arxiv.org/abs/1212.3870">See here for the corresponding paper.</a>
	notify = hoelzl@in.tum.de

	[Probabilistic_System_Zoo]
	title = A Zoo of Probabilistic Systems
	author = Johannes Hölzl <http://in.tum.de/~hoelzl>,
	Andreas Lochbihler <http://www.andreas-lochbihler.de>,
	Dmitriy Traytel <https://traytel.bitbucket.io>
	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.
	<p>
	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 <https://www21.in.tum.de/~eberlm>, Johannes Hölzl <http://in.tum.de/~hoelzl>, Tobias Nipkow <http://www21.in.tum.de/~nipkow>
	date = 2014-10-09
	topic = Mathematics/Probability theory, Computer science/Programming languages/Compiling
	abstract =
	<a href="https://doi.org/10.1007/978-3-642-36742-7_35">Bhat et al. [TACAS 2013]</a> 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.
	<p>
	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 <http://www21.in.tum.de/~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.
	<p>
	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.
	<p>
	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.
	<p>
	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 <https://www7.in.tum.de/~sickert>
	contributors = Benedikt Seidl <mailto:benedikt.seidl@tum.de>
	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. <br>
	notify = sickert@in.tum.de

	[LTL_to_GBA]
	title = Converting Linear-Time Temporal Logic to Generalized Büchi Automata
	author = Alexander Schimpf <mailto:schimpfa@informatik.uni-freiburg.de>, Peter Lammich <http://www21.in.tum.de/~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.
	<p>
	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 <http://www21.in.tum.de/~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 <mailto:rene.neumann@in.tum.de>
	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 <https://www7.in.tum.de/~esparza/>,
	Peter Lammich <http://www21.in.tum.de/~lammich>,
	René Neumann <mailto:rene.neumann@in.tum.de>,
	Tobias Nipkow <http://www21.in.tum.de/~nipkow>,
	Alexander Schimpf <mailto:schimpfa@informatik.uni-freiburg.de>,
	Jan-Georg Smaus <http://www.irit.fr/~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.
	<p>
	An early version of this model checker is described in the
	<a href="http://www21.in.tum.de/~nipkow/pubs/cav13.html">CAV 2013 paper</a>
	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<ul><li>Fermat's Last Theorem for exponents 3 and 4 and</li><li>the parametrisation of Pythagorean Triples.</li></ul>
	notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com

	[Perfect-Number-Thm]
	title = Perfect Number Theorem
	author = Mark Ijbema <mailto:ijbema@fmf.nl>
	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:<ul><li>any prime number of the form 4m+1 can be written as the sum of two squares;</li><li>any natural number can be written as the sum of four squares</li></ul>
	notify = nipkow@in.tum.de, roelofoosterhuis@gmail.com

	[Lehmer]
	title = Lehmer's Theorem
	author = Simon Wimmer <mailto:simon.wimmer@tum.de>, Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	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.
	<p>
	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 <mailto:simon.wimmer@tum.de>, Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	date = 2013-07-22
	topic = Mathematics/Number theory
	abstract = In 1975, Pratt introduced a proof system for certifying primes. He showed that a number <i>p</i> is prime iff a primality certificate for <i>p</i> 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 <http://home.in.tum.de/~wimmers/>, Shuwei Hu <mailto:shuwei.hu@tum.de>, Tobias Nipkow <http://www21.in.tum.de/~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 <http://in.tum.de/~wimmers>, Johannes Hölzl <http://home.in.tum.de/~hoelzl>
	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 <http://in.tum.de/~wimmers>
	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 <http://www21.in.tum.de/~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.<br><br>An article about these proofs is found <a href="http://www21.in.tum.de/~nipkow/pubs/arrow.html">here</a>.
	notify = nipkow@in.tum.de

	[SenSocialChoice]
	title = Some classical results in Social Choice Theory
	author = Peter Gammie <http://peteg.org>
	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 <http://www.cs.bham.ac.uk/~mmk>, Christoph Lange<mailto:math.semantic.web@gmail.com>, Colin Rowat<mailto:c.rowat@bham.ac.uk>
	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, <tt>Topology</tt>, develops the basic notions of general topology. The second, which can be viewed as a demonstration of the first, is called <tt>LList_Topology</tt>. It develops the topology of lazy lists.
	notify = lcp@cl.cam.ac.uk

	[Knot_Theory]
	title = Knot Theory
	author = T.V.H. Prathamesh <mailto:prathamesh@imsc.res.in>
	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 <http://www21.in.tum.de/~noschinl/>
	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.
	<p>
	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 <http://www21.in.tum.de/~noschinl/>
	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 <https://www.mpi-inf.mpg.de/~crizkall/>
	date = 2011-07-21
	topic = Mathematics/Graph theory
	abstract =
	<p>
	A <em>matching</em> in a graph <i>G</i> is a subset <i>M</i> of the
	edges of <i>G</i> 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 <em>odd-set cover</em> <i>OSC</i> of a graph <i>G</i> is a
	labeling of the nodes of <i>G</i> with integers such that every edge of
	<i>G</i> is either incident to a node labeled 1 or connects two nodes
	labeled with the same number <i>i ≥ 2</i>.
	</p><p>
	This article proves Edmonds theorem:<br>
	Let <i>M</i> be a matching in a graph <i>G</i> and let <i>OSC</i> be an
	odd-set cover of <i>G</i>.
	For any <i>i ≥ 0</i>, let <var>n(i)</var> be the number of nodes
	labeled <i>i</i>. If <i>\|M\| = n(1) +
	∑<sub>i ≥ 2</sub>(n(i) div 2)</i>,
	then <i>M</i> is a maximum cardinality matching.
	</p>
	notify = nipkow@in.tum.de

	[Girth_Chromatic]
	title = A Probabilistic Proof of the Girth-Chromatic Number Theorem
	author = Lars Noschinski <http://www21.in.tum.de/~noschinl/>
	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 <mailto:hupel@in.tum.de>
	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 <http://www21.in.tum.de/~nipkow>
	date = 2006-05-22
	topic = Mathematics/Graph theory
	abstract =
	These theories present the verified enumeration of <i>tame</i> plane graphs
	as defined by Thomas C. Hales in his proof of the Kepler Conjecture in his
	book <i>Dense Sphere Packings. A Blueprint for Formal Proofs.</i> [CUP 2012].
	The values of the constants in the definition of tameness are identical to
	those in the <a href="https://code.google.com/p/flyspeck/">Flyspeck project</a>.
	The <a href="http://www21.in.tum.de/~nipkow/pubs/Flyspeck/">IJCAR 2006 paper by Nipkow, Bauer and Schultz</a> refers to the original version of Hales' proof,
	the <a href="http://www21.in.tum.de/~nipkow/pubs/itp11.html">ITP 2011 paper by Nipkow</a> 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.<br>
	[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 <mailto:c.sternagel@gmail.com>
	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:
	<ul>
	<li>If the sets A and B are wqo then their Cartesian product is wqo.</li>
	<li>If the set A is wqo then the set of finite lists over A is wqo.</li>
	<li>If the set A is wqo then the set of finite trees over A is wqo.</li>
	</ul>
	The research was funded by the Austrian Science Fund (FWF): J3202.
	extra-history =
	Change history:
	[2012-06-11]: Added Kruskal's Tree Theorem.<br>
	[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.<br>
	[2013-05-16]: Simplified construction of minimal bad sequences.<br>
	[2014-07-09]: Simplified proofs of Higman's lemma and Kruskal's tree theorem,
	based on homogeneous sequences.<br>
	[2016-01-03]: An alternative proof of Higman's lemma by open induction.<br>
	[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 <mailto:dongchenjiang@googlemail.com>, Tobias Nipkow <http://www21.in.tum.de/~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 <http://www.andrew.cmu.edu/user/avigad/>, Stefan Hetzl <http://www.logic.at/people/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, <i>Computability and Logic</i>, 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 <mailto:lukas.bulwahn@gmail.com>
	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
	``<a href="http://www.cs.ru.nl/~freek/100/">Top 100 Mathematical Theorems</a>''.
	notify = lukas.bulwahn@gmail.com

	[Euler_Partition]
	title = Euler's Partition Theorem
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	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 <http://isabelle.in.tum.de/~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 <mailto:c.sternagel@gmail.com>
	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, <i>Information Processing Letters</i> 29, 1988, pp.19-23.
	<p>This research was supported by the Austrian Science Fund (FWF): J3202.</p>
	notify = c.sternagel@gmail.com

	[Category]
	title = Category Theory to Yoneda's Lemma
	author = Greg O'Keefe <http://users.rsise.anu.edu.au/~okeefe/>
	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 <tt>equinumerous</tt> was slightly too weak in the original submission and has been fixed in revision <a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/3498bb1e4c7ba468db8588eb7184c1849641f7d3">8c2b5b3c995f</a>.
	notify = lcp@cl.cam.ac.uk

	[Category2]
	title = Category Theory
	author = Alexander Katovsky <mailto:apk32@cam.ac.uk>
	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 <a href="http://www.srcf.ucam.org/~apk32/Isabelle/Category/Cat.pdf">here [pdf]</a>.
	notify = alexander.katovsky@cantab.net

	[FunWithFunctions]
	title = Fun With Functions
	author = Tobias Nipkow <http://www21.in.tum.de/~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 <http://www21.in.tum.de/~nipkow>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	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 <a href="http://www.cl.cam.ac.uk/~lp15/">Larry Paulson</a>, 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. <p> 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 <mailto:wl302@cam.ac.uk>
	+author = Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	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 <http://logic.las.tu-berlin.de/Members/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 <mailto:isabelle@christoph-d.de>
	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 <mailto:ly271@cam.ac.uk>
	contributors = Fabian Hellauer <mailto:hellauer@in.tum.de>, Fabian Immler <http://www21.in.tum.de/~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).<br>
	[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 <http://www.andreas-lochbihler.de>
	contributors = Peter Lammich <http://www21.in.tum.de/~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)<br>
	[2014-03-31]:
	added words of default size in the target language (by Peter Lammich)
	(revision 25caf5065833)<br>
	[2014-10-06]:
	proper test setup with compilation and execution of tests in all target languages
	(revision 5d7a1c9ae047)<br>
	[2017-09-02]:
	added 64-bit words (revision c89f86244e3c)<br>
	[2018-07-15]:
	added cast operators for default-size words (revision fc1f1fb8dd30)<br>
	notify = mail@andreas-lochbihler.de

	[XML]
	title = XML
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	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 <http://www.cl.cam.ac.uk/~lp15/>
	date = 2013-11-17
	topic = Logic/Set theory
	abstract = The theory of hereditarily finite sets is formalised, following
	the <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">development</a> 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 <a href="Incompleteness.html">formalised separately</a>.
	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 <http://www.cl.cam.ac.uk/~lp15/>
	date = 2013-11-17
	topic = Logic/Proof theory
	abstract = Gödel's two incompleteness theorems are formalised, following a careful <a href="http://journals.impan.gov.pl/dm/Inf/422-0-1.html">presentation</a> by Swierczkowski, in the theory of <a href="HereditarilyFinite.html">hereditarily finite sets</a>. 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 <http://www.cl.cam.ac.uk/~lp15/>
	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 <http://cl-informatik.uibk.ac.at/users/hzankl>
	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 <mailto:bertram.felgenhauer@uibk.ac.at>
	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 <http://page.mi.fu-berlin.de/cbenzmueller/>, Bruno Woltzenlogel Paleo <http://www.logic.at/staff/bruno/>
	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 <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://www.christoph-benzmueller.de>
	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 <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://christoph-benzmueller.de>
	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)<br>

	[Lowe_Ontological_Argument]
	title = Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument
	author = David Fuenmayor <mailto:davfuenmayor@gmail.com>, Christoph Benzmüller <http://www.christoph-benzmueller.de>
	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 <https://philpapers.org/profile/805>
	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 <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2013-12-01
	topic = Computer science/Functional programming
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p>
	notify = pasquale.noce.lavoro@gmail.com

	[CryptoBasedCompositionalProperties]
	title = Compositional Properties of Crypto-Based Components
	author = Maria Spichkova <mailto:maria.spichkova@rmit.edu.au>
	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 <mailto:brucker@spamfence.net>, Frédéric Tuong <mailto:tuong@users.gforge.inria.fr>, Burkhart Wolff <mailto:wolff@lri.fr>
	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]:
	<a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/e68e1996d5d4926397c9244e786446e99ab17e63">afp-devel@ea3b38fc54d6</a> and
	<a href="https://projects.brucker.ch/hol-testgen/log/trunk?rev=12148">hol-testgen@12148</a><br>
	Update of Featherweight OCL including a change in the abstract.<br>
	[2014-01-16]:
	<a href="https://foss.heptapod.net/isa-afp/afp-devel/-/commit/6217cc5b29c560f24ecc64c81047778becb69f51">afp-devel@9091ce05cb20</a> and
	<a href="https://projects.brucker.ch/hol-testgen/log/trunk?rev=10241">hol-testgen@10241</a><br>
	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 <mailto:simon.foster@york.ac.uk>,
	Georg Struth <http://staffwww.dcs.shef.ac.uk/people/G.Struth/>,
	Tjark Weber <http://user.it.uu.se/~tjawe125/>
	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 <mailto:brijesh.dongol@brunel.ac.uk>, Victor B. F. Gomes <mailto:victor.gomes@cl.cam.ac.uk>, Ian J. Hayes <mailto:ian.hayes@itee.uq.edu.au>, Georg Struth <mailto:g.struth@sheffield.ac.uk>
	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 <mailto:psxjv4@nottingham.ac.uk>
	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 <mailto:psxjv4@nottingham.ac.uk>
	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 <http://nm.wu.ac.at/nm/sadelsbe>,
	Stefan Hetzl <http://www.logic.at/people/hetzl/>,
	Florian Pollak <mailto:florian.pollak@gmail.com>
	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 <https://www.andreipopescu.uk>, Johannes Hölzl <http://in.tum.de/~hoelzl>
	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 <http://www.react.uni-saarland.de/people/rabe.html>, Peter Lammich <http://www21.in.tum.de/~lammich>, Andrei Popescu <https://www.andreipopescu.uk>
	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 <https://www.andreipopescu.uk>, Peter Lammich <http://www21.in.tum.de/~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 <http://net.in.tum.de/~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.
	<ul>
	<li>Secure auto-completion of scenario-specific knowledge, which eases usability.</li>
	<li>Security violations can be repaired by tightening the policy iff the
	security invariants hold for the deny-all policy.</li>
	<li>An algorithm to compute a security policy.</li>
	<li>A formalization of stateful connection semantics in network security mechanisms.</li>
	<li>An algorithm to compute a secure stateful implementation of a policy.</li>
	<li>An executable implementation of all the theory.</li>
	<li>Examples, ranging from an aircraft cabin data network to the analysis
	of a large real-world firewall.</li>
	<li>More examples: A fully automated translation of high-level security goals to both
	firewall and SDN configurations (see Examples/Distributed_WebApp.thy).</li>
	</ul>
	For a detailed description, see
	<ul>
	<li>C. Diekmann, A. Korsten, and G. Carle.
	<a href="http://www.net.in.tum.de/fileadmin/bibtex/publications/papers/diekmann2015mansdnnfv.pdf">Demonstrating
	topoS: Theorem-prover-based synthesis of secure network configurations.</a>
	In 2nd International Workshop on Management of SDN and NFV Systems, manSDN/NFV, Barcelona, Spain, November 2015.</li>
	<li>C. Diekmann, S.-A. Posselt, H. Niedermayer, H. Kinkelin, O. Hanka, and G. Carle.
	<a href="http://www.net.in.tum.de/pub/diekmann/forte14.pdf">Verifying Security Policies using Host Attributes.</a>
	In FORTE, 34th IFIP International Conference on Formal Techniques for Distributed Objects,
	Components and Systems, Berlin, Germany, June 2014.</li>
	<li>C. Diekmann, L. Hupel, and G. Carle. Directed Security Policies:
	<a href="http://rvg.web.cse.unsw.edu.au/eptcs/paper.cgi?ESSS2014.3">A Stateful Network Implementation.</a>
	In J. Pang and Y. Liu, editors, Engineering Safety and Security Systems,
	volume 150 of Electronic Proceedings in Theoretical Computer Science,
	pages 20-34, Singapore, May 2014. Open Publishing Association.</li>
	</ul>
	extra-history =
	Change history:
	[2015-04-14]:
	Added Distributed WebApp example and improved graphviz visualization
	(revision 4dde08ca2ab8)<br>
	notify = diekmann@net.in.tum.de

	[Abstract_Completeness]
	title = Abstract Completeness
	author = Jasmin Christian Blanchette <http://www21.in.tum.de/~blanchet>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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 <http://www.kestrel.edu/~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 <mailto:holdenl@princeton.edu>
	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 <http://www.cl.cam.ac.uk/~lp15/>
	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 <https://www21.in.tum.de/~eberlm>
	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 <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Analysis
	date = 2018-02-06
	notify = eberlm@in.tum.de
	abstract =
	<p> 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. </p>

	[Akra_Bazzi]
	title = The Akra-Bazzi theorem and the Master theorem
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	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.
	<p>
	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 <https://www21.in.tum.de/~eberlm>
	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: <ul> <li>Definitions and
	basic properties for several number-theoretic functions (Euler's
	φ, Möbius μ, Liouville's λ,
	the divisor function σ, von Mangoldt's
	Λ)</li> <li>Executable code for most of these
	functions, the most efficient implementations using the factoring
	algorithm by Thiemann <i>et al.</i></li>
	<li>Dirichlet products and formal Dirichlet series</li>
	<li>Analytic results connecting convergent formal Dirichlet
	series to complex functions</li> <li>Euler product
	expansions</li> <li>Asymptotic estimates of
	number-theoretic functions including the density of squarefree
	integers and the average number of divisors of a natural
	number</li> </ul> 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 <https://people.epfl.ch/rodrigo.raya>, Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2019-12-10
	notify = manuel.eberl@tum.de
	abstract =
	<p>This article provides a full formalisation of Chapter 8 of
	Apostol's <em><a
	href="https://www.springer.com/de/book/9780387901633">Introduction
	to Analytic Number Theory</a></em>. Subjects that are
	covered are:</p> <ul> <li>periodic arithmetic
	functions and their finite Fourier series</li>
	<li>(generalised) Ramanujan sums</li> <li>Gauss sums
	and separable characters</li> <li>induced moduli and
	primitive characters</li> <li>the
	Pólya—Vinogradov inequality</li> </ul>

	[Zeta_Function]
	title = The Hurwitz and Riemann ζ Functions
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory, Mathematics/Analysis
	date = 2017-10-12
	notify = eberlm@in.tum.de
	abstract =
	<p>This entry builds upon the results about formal and analytic Dirichlet
	series to define the Hurwitz ζ function ζ(<em>a</em>,<em>s</em>) and,
	based on that, the Riemann ζ function ζ(<em>s</em>).
	This is done by first defining them for &real;(<em>z</em>) > 1
	and then successively extending the domain to the left using the
	Euler–MacLaurin formula.</p>
	<p>Apart from the most basic facts such as analyticity, the following
	results are provided:</p>
	<ul>
	<li>the Stieltjes constants and the Laurent expansion of
	ζ(<em>s</em>) at <em>s</em> = 1</li>
	<li>the non-vanishing of ζ(<em>s</em>)
	for &real;(<em>z</em>) ≥ 1</li>
	<li>the relationship between ζ(<em>a</em>,<em>s</em>) and Γ</li>
	<li>the special values at negative integers and positive even integers</li>
	<li>Hurwitz's formula and the reflection formula for ζ(<em>s</em>)</li>
	<li>the <a href="https://arxiv.org/abs/math/0405478">
	Hadjicostas–Chapman formula</a></li>
	</ul>
	<p>The entry also contains Euler's analytic proof of the infinitude of primes,
	based on the fact that ζ(<i>s</i>) has a pole at <i>s</i> = 1.</p>

	[Linear_Recurrences]
	title = Linear Recurrences
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Analysis
	date = 2017-10-12
	notify = eberlm@in.tum.de
	abstract =
	<p> 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 <i>f</i>(<i>n</i>) =
	<i>f</i>(<i>n</i>-1) +
	<i>f</i>(<i>n</i> - 2) and the quite
	non-obvious closed form
	(<i>φ</i><sup><i>n</i></sup>
	-
	(-<i>φ</i>)<sup>-<i>n</i></sup>)
	/ √<span style="text-decoration:
	overline">5</span> where φ is the golden ratio.
	</p> <p> 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. </p>

	[Lambert_W]
	title = The Lambert W Function on the Reals
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Analysis
	date = 2020-04-24
	notify = eberlm@in.tum.de
	abstract =
	<p>The Lambert <em>W</em> function is a multi-valued
	function defined as the inverse function of <em>x</em>
	↦ <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>

	[Cartan_FP]
	title = The Cartan Fixed Point Theorems
	author = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	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 C<sup>n</sup>. 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 <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	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 <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	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 <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	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 <http://www.unirioja.es/cu/jodivaso>, Jesús Aransay <http://www.unirioja.es/cu/jearansa>
	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 <mailto:c.sternagel@gmail.com>
	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 <http://www.andreas-lochbihler.de>, Alexandra Maximova <mailto:amaximov@student.ethz.ch>
	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 <a href="http://isa-afp.org/entries/Stream-Fusion.html">AFP entry</a> 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 <http://www21.in.tum.de/~noschinl/>
	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 <tt>casify</tt>, 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 <tt>casify</tt>.
	<p>
	As examples, this work contains verification condition generators
	producing named cases for three languages: The Hoare language from
	<tt>HOL/Library</tt>, 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 <tt>DPT_SAT_Solver</tt>, 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 <http://ualberta.ca/~jsylvest/>
	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 <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2015-08-18
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p>
	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 <mailto:pasquale.noce.lavoro@gmail.com>
	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 <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	contributors = Alexander Bentkamp <mailto:bentkamp@gmail.com>
	date = 2015-08-21
	abstract =
	<p>
	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.
	</p><p>
	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.
	</p><p>
	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.
	</p><p>
	All the results have been applied to improve CeTA, our certifier to validate termination and complexity proof certificates.
	</p>
	extra-history =
	Change history:
	[2016-01-07]: Added Schur-decomposition, Gram-Schmidt orthogonalization, uniqueness of Jordan normal forms<br/>
	[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 <mailto:sickert@in.tum.de>
	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.<br>
	[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 <http://in.tum.de/~wimmers>
	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 <http://logic.las.tu-berlin.de/Members/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 <mailto:sebastien.gouezel@univ-rennes1.fr>
	contributors = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	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 <mailto:bentkamp@gmail.com>
	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 <mailto:bentkamp@gmail.com>
	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

	[Inductive_Inference]
	title = Some classical results in inductive inference of recursive functions
	author = Frank J. Balbach <mailto:frank-balbach@gmx.de>
	topic = Logic/Computability, Computer science/Machine learning
	date = 2020-08-31
	notify = frank-balbach@gmx.de
	abstract =
	<p> This entry formalizes some classical concepts and results
	from inductive inference of recursive functions. In the basic setting
	a partial recursive function ("strategy") must identify
	("learn") all functions from a set ("class") of
	recursive functions. To that end the strategy receives more and more
	values $f(0), f(1), f(2), \ldots$ of some function $f$ from the given
	class and in turn outputs descriptions of partial recursive functions,
	for example, Gödel numbers. The strategy is considered successful if
	the sequence of outputs ("hypotheses") converges to a
	description of $f$. A class of functions learnable in this sense is
	called "learnable in the limit". The set of all these
	classes is denoted by LIM. </p> <p> Other types of
	inference considered are finite learning (FIN), behaviorally correct
	learning in the limit (BC), and some variants of LIM with restrictions
	on the hypotheses: total learning (TOTAL), consistent learning (CONS),
	and class-preserving learning (CP). The main results formalized are
	the proper inclusions $\mathrm{FIN} \subset \mathrm{CP} \subset
	\mathrm{TOTAL} \subset \mathrm{CONS} \subset \mathrm{LIM} \subset
	\mathrm{BC} \subset 2^{\mathcal{R}}$, where $\mathcal{R}$ is the set
	of all total recursive functions. Further results show that for all
	these inference types except CONS, strategies can be assumed to be
	total recursive functions; that all inference types but CP are closed
	under the subset relation between classes; and that no inference type
	is closed under the union of classes. </p> <p> The above
	is based on a formalization of recursive functions heavily inspired by
	the <a
	href="https://www.isa-afp.org/entries/Universal_Turing_Machine.html">Universal
	Turing Machine</a> entry by Xu et al., but different in that it
	models partial functions with codomain <em>nat
	option</em>. The formalization contains a construction of a
	universal partial recursive function, without resorting to Turing
	machines, introduces decidability and recursive enumerability, and
	proves some standard results: existence of a Kleene normal form, the
	<em>s-m-n</em> theorem, Rice's theorem, and assorted
	fixed-point theorems (recursion theorems) by Kleene, Rogers, and
	Smullyan. </p>

	[Applicative_Lifting]
	title = Applicative Lifting
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, 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.
	</p><p>
	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.
	</p><p>
	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.
	</p><p>
	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.
	</p>
	extra-history =
	Change history:
	[2016-03-03]: added formalisation of lifting with combinators<br>
	[2016-06-10]:
	implemented automatic derivation of lifted combinator reductions;
	support arbitrary lifted relations using relators;
	improved compatibility with locale interpretation
	(revision ec336f354f37)<br>
	notify = mail@andreas-lochbihler.de

	[Stern_Brocot]
	title = The Stern-Brocot Tree
	author = Peter Gammie <http://peteg.org>, Andreas Lochbihler <http://www.andreas-lochbihler.de>
	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.
	</p><p>
	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.
	</p>
	notify = mail@andreas-lochbihler.de

	[Algebraic_Numbers]
	title = Algebraic Numbers in Isabelle/HOL
	topic = Mathematics/Algebra
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>, Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>
	contributors = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	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.
	</p><p>
	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.
	</p>
	extra-history =
	Change history:
	[2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization<br>
	[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 <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	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 <i>p</i> such that
	<i>p(0) = 0</i> and <i>p(2) = 1</i>. 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.
	<p>
	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 <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	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.
	<p>
	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 <http://www.unirioja.es/cu/jodivaso>, Ondřej Kunčar <http://www21.in.tum.de/~kuncar/>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	notify = rene.thiemann@uibk.ac.at
	date = 2016-05-20
	topic = Mathematics/Algebra
	abstract =
	<p>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 A<sup>n</sup> 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
	<em>complex</em> 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 <em>real</em> eigenvalues of A, i.e., applying Sturm's method can
	decide the polynomial growth of A<sup>n</sup>. </p><p> 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 A<sup>n</sup> is polynomially bounded in n. </p>
	extra-history =
	Change history:
	[2017-10-18]:
	added Perron-Frobenius theorem for irreducible matrices with generalization
	(revision bda1f1ce8a1c)<br/>
	[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 <http://cl-informatik.uibk.ac.at/~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 <mailto:sebasti@nullri.ch>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88>
	date = 2016-02-05
	topic = Computer science/Algorithms, Computer science/Programming languages/Transformations
	abstract =
	<p>
	We define a functional variant of the static single assignment (SSA)
	form construction algorithm described by <a
	href="https://doi.org/10.1007/978-3-642-37051-9_6">Braun et al.</a>,
	which combines simplicity and efficiency. The definition is based on a
	general, abstract control flow graph representation using Isabelle locales.
	</p>
	<p>
	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.
	</p>
	<p>
	Furthermore, we use a generic instantiation based on typedefs in order
	to extract OCaml code and replace the unverified SSA construction
	algorithm of the <a href="https://doi.org/10.1145/2579080">CompCertSSA
	project</a> with it.
	</p>
	<p>
	A more detailed description of the verified SSA construction can be found
	in the paper <a href="https://doi.org/10.1145/2892208.2892211">Verified
	Construction of Static Single Assignment Form</a>, CC 2016.
	</p>
	notify = denis.lohner@kit.edu

	[Minimal_SSA]
	title = Minimal Static Single Assignment Form
	author = Max Wagner <mailto:max@trollbu.de>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88>
	topic = Computer science/Programming languages/Transformations
	date = 2017-01-17
	notify = denis.lohner@kit.edu
	abstract =
	<p>This formalization is an extension to <a
	href="https://www.isa-afp.org/entries/Formal_SSA.html">"Verified
	Construction of Static Single Assignment Form"</a>. In
	their work, the authors have shown that <a
	href="https://doi.org/10.1007/978-3-642-37051-9_6">Braun
	et al.'s static single assignment (SSA) construction
	algorithm</a> 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.<br> In this
	formalization we support that claim by giving a mechanized proof.
	</p>
	<p>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 <a href="https://doi.org/10.1145/115372.115320">Cytron et
	al.</a>.</p>

	[PropResPI]
	title = Propositional Resolution and Prime Implicates Generation
	author = Nicolas Peltier <http://membres-lig.imag.fr/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 <http://membres-lig.imag.fr/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 <http://www.inf.kcl.ac.uk/staff/urbanc/>, Stefan Berghofer <http://www.in.tum.de/~berghofe>, Cezary Kaliszyk <http://cl-informatik.uibk.ac.at/users/cek/>
	date = 2013-02-21
	topic = Tools
	abstract =
	<p>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.
	</p><p>
	This entry can be used as a more advanced replacement for
	HOL/Nominal in the Isabelle distribution.
	</p>
	notify = christian.urban@kcl.ac.uk

	[First_Welfare_Theorem]
	title = Microeconomics and the First Welfare Theorem
	author = Julian Parsert <mailto:julian.parsert@gmail.com>, Cezary Kaliszyk<http://cl-informatik.uibk.ac.at/users/cek/>
	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
	<i>First Theorem of Welfare Economics</i> holds within
	both. The theorem is the mathematical formulation of Adam Smith's
	famous <i>invisible hand</i> 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.
	<br>

	[Noninterference_Sequential_Composition]
	title = Conservation of CSP Noninterference Security under Sequential Composition
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	date = 2016-04-26
	topic = Computer science/Security, Computer science/Concurrency/Process calculi
	abstract =
	<p>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.</p>
	<p>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.</p>
	notify = pasquale.noce.lavoro@gmail.com

	[Noninterference_Concurrent_Composition]
	title = Conservation of CSP Noninterference Security under Concurrent Composition
	author = Pasquale Noce <mailto:pasquale.noce.lavoro@gmail.com>
	notify = pasquale.noce.lavoro@gmail.com
	date = 2016-06-13
	topic = Computer science/Security, Computer science/Concurrency/Process calculi
	abstract =
	<p>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.</p>
	<p>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.</p>

	[ROBDD]
	title = Algorithms for Reduced Ordered Binary Decision Diagrams
	author = Julius Michaelis <http://liftm.de>, Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck//>, Peter Lammich <http://www21.in.tum.de/~lammich>, Lars Hupel <https://www21.in.tum.de/~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 <mailto:m.stannett@sheffield.ac.uk>, István Németi <http://www.renyi.hu/~nemeti/>
	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 <http://www21.in.tum.de/~immler>, Alexander Maletzky <https://risc.jku.at/m/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.<br>
	notify = alexander.maletzky@risc.jku.at

	[Nullstellensatz]
	title = Hilbert's Nullstellensatz
	author = Alexander Maletzky <https://risc.jku.at/m/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 <a
	href="https://link.springer.com/book/10.1007/978-0-387-35651-8">Ideals,
	Varieties, and Algorithms</a> by Cox, Little and O'Shea.

	[Bell_Numbers_Spivey]
	title = Spivey's Generalized Recurrence for Bell Numbers
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	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.
	<p>
	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 <mailto:eberlm@in.tum.de>
	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 <mailto:eberlm@in.tum.de>
	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 <https://www21.in.tum.de/~eberlm>
	topic = Computer science/Algorithms
	date = 2017-12-21
	notify = eberlm@in.tum.de
	abstract =
	<p>This entry provides an executable functional implementation
	of the Median-of-Medians algorithm for selecting the
	<em>k</em>-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. </p>

	[Mason_Stothers]
	title = The Mason–Stothers Theorem
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Algebra
	date = 2017-12-21
	notify = eberlm@in.tum.de
	abstract =
	<p>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.</p> <p>In short, the statement of the
	theorem is that three non-zero coprime polynomials
	<em>A</em>, <em>B</em>, <em>C</em>
	over a field which sum to 0 and do not all have vanishing derivatives
	fulfil max{deg(<em>A</em>), deg(<em>B</em>),
	deg(<em>C</em>)} < deg(rad(<em>ABC</em>))
	where the rad(<em>P</em>) denotes the
	<em>radical</em> of <em>P</em>,
	i. e. the product of all unique irreducible factors of
	<em>P</em>.</p> <p>This theorem also implies a
	kind of polynomial analogue of Fermat’s Last Theorem for polynomials:
	except for trivial cases,
	<em>A<sup>n</sup></em> +
	<em>B<sup>n</sup></em> +
	<em>C<sup>n</sup></em> = 0 implies
	n ≤ 2 for coprime polynomials
	<em>A</em>, <em>B</em>, <em>C</em>
	over a field.</em></p>

	[FLP]
	title = A Constructive Proof for FLP
	author = Benjamin Bisping <mailto:benjamin.bisping@campus.tu-berlin.de>, Paul-David Brodmann <mailto:p.brodmann@tu-berlin.de>, Tim Jungnickel <mailto:tim.jungnickel@tu-berlin.de>, Christina Rickmann <mailto:c.rickmann@tu-berlin.de>, Henning Seidler <mailto:henning.seidler@mailbox.tu-berlin.de>, Anke Stüber <mailto:anke.stueber@campus.tu-berlin.de>, Arno Wilhelm-Weidner <mailto:arno.wilhelm-weidner@tu-berlin.de>, Kirstin Peters <mailto:kirstin.peters@tu-berlin.de>, Uwe Nestmann <https://www.mtv.tu-berlin.de/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 <mailto:tim.jungnickel@tu-berlin.de>, 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 <http://pp.ipd.kit.edu/~breitner>, Denis Lohner <http://pp.ipd.kit.edu/person.php?id=88>
	date = 2016-05-20
	topic = Logic/Proof theory
	abstract =
	The <a href="http://incredible.pm">Incredible Proof Machine</a> 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 <http://www.cse.unsw.edu.au/~kleing/>, 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 <https://www21.in.tum.de/~eberlm>
	notify = eberlm@in.tum.de
	date = 2016-06-21
	topic = Mathematics/Combinatorics
	abstract =
	<p>In this work, we define the Catalan numbers <em>C<sub>n</sub></em>
	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 <em>n</em>), prove the asymptotic growth
	approximation <em>C<sub>n</sub> &sim; 4<sup>n</sup> / (√<span
	style="text-decoration: overline">π</span> ·
	n<sup>1.5</sup>)</em>, and provide reasonably efficient executable
	code to compute them.</p> <p>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.</p>

	[Fisher_Yates]
	title = Fisher–Yates shuffle
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	notify = eberlm@in.tum.de
	date = 2016-09-30
	topic = Computer science/Algorithms
	abstract =
	<p>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.</p>

	[Bertrands_Postulate]
	title = Bertrand's postulate
	author = Julian Biendarra<>, Manuel Eberl <https://www21.in.tum.de/~eberlm>
	contributors = Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Number theory
	date = 2017-01-17
	notify = eberlm@in.tum.de
	abstract =
	<p>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. </p>

	[Rewriting_Z]
	title = The Z Property
	author = Bertram Felgenhauer<>, Julian Nagele<>, Vincent van Oostrom<>, Christian Sternagel <mailto:c.sternagel@gmail.com>
	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 <https://people.compute.dtu.dk/andschl/>
	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]. <p>
	<a name="Sch18"></a>[Sch18] Anders Schlichtkrull. "Formalization of the
	Resolution Calculus for First-Order Logic". Journal of Automated
	Reasoning, 2018.<br> <a name="Sch16"></a>[Sch16] Anders
	Schlichtkrull. "Formalization of the Resolution Calculus for First-Order
	Logic". In: ITP 2016. Vol. 9807. LNCS. Springer, 2016.<br>
	<a name="Sch15"></a>[Sch15] Anders Schlichtkrull. <a href="https://people.compute.dtu.dk/andschl/Thesis.pdf">
	"Formalization of Resolution Calculus in Isabelle"</a>.
	<a href="https://people.compute.dtu.dk/andschl/Thesis.pdf">https://people.compute.dtu.dk/andschl/Thesis.pdf</a>.
	MSc thesis. Technical University of Denmark, 2015.<br>
	<a name="BA12"></a>[BA12] Mordechai Ben-Ari. <i>Mathematical Logic for
	Computer Science</i>. 3rd. Springer, 2012.<br> <a
	name="CL73"></a>[CL73] Chin-Liang Chang and Richard Char-Tung Lee.
	<i>Symbolic Logic and Mechanical Theorem Proving</i>. 1st. Academic
	Press, Inc., 1973.<br> <a name="Lei97"></a>[Lei97] Alexander
	Leitsch. <i>The Resolution Calculus</i>. Texts in theoretical computer
	science. Springer, 1997.<br> <a name="IsaFoL"></a>[IsaFoL]
	IsaFoL authors. <a href="https://bitbucket.org/jasmin_blanchette/isafol">
	IsaFoL: Isabelle Formalization of Logic</a>.
	<a href="https://bitbucket.org/jasmin_blanchette/isafol">https://bitbucket.org/jasmin_blanchette/isafol</a>.
	extra-history =
	Change history:
	[2018-01-24]: added several new versions of the soundness and completeness theorems as described in the paper [Sch18]. <br>
	[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 <http://pp.ipd.kit.edu/~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 <mailto:lukas.bulwahn@gmail.com>
	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 <mailto:lukas.bulwahn@gmail.com>
	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 <mailto:wolff@lri.fr>
	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 <https://www21.in.tum.de/~eberlm>
	notify = eberlm@in.tum.de
	date = 2016-09-01
	topic = Mathematics/Analysis
	abstract =
	<p>This work contains a proof of Stirling's formula both for the factorial $n! \sim \sqrt{2\pi n} (n/e)^n$ on natural numbers and the real
	Gamma function $\Gamma(x)\sim \sqrt{2\pi/x} (x/e)^x$. The proof is based on work by <a
	href="http://www.maths.lancs.ac.uk/~jameson/stirlgamma.pdf">Graham Jameson</a>.</p>
	<p>This is then extended to the full asymptotic expansion
	$$\log\Gamma(z) = \big(z - \tfrac{1}{2}\big)\log z - z + \tfrac{1}{2}\log(2\pi) + \sum_{k=1}^{n-1} \frac{B_{k+1}}{k(k+1)} z^{-k}\\
	{} - \frac{1}{n} \int_0^\infty B_n([t])(t + z)^{-n}\,\text{d}t$$
	uniformly for all complex $z\neq 0$ in the cone $\text{arg}(z)\leq \alpha$ for any $\alpha\in(0,\pi)$, with which the above asymptotic
	relation for Γ is also extended to complex arguments.</p>

	[Lp]
	title = Lp spaces
	author = Sebastien Gouezel <http://www.math.sciences.univ-nantes.fr/~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 <http://www.unirioja.es/cu/jodivaso>, Sebastiaan Joosten <mailto:sebastiaan.joosten@uibk.ac.at>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>, Akihisa Yamada <mailto:akihisa.yamada@uibk.ac.at>
	notify = rene.thiemann@uibk.ac.at
	date = 2016-10-14
	topic = Mathematics/Algebra
	abstract =
	<p>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.
	</p>
	<p>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.
	</p>
	<p>Through experiments we verify that our algorithm factors polynomials of degree
	100 within seconds.
	</p>

	[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 <mailto:qh225@cl.cam.ac.uk>, Lawrence C. Paulson <mailto:lp15@cam.ac.uk>
	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 <https://www21.in.tum.de/~eberlm>
	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 <mailto:zhe.hou@ntu.edu.sg>, David Sanan <mailto:sanan@ntu.edu.sg>, Alwen Tiu <mailto:ATiu@ntu.edu.sg>, Yang Liu <mailto:yangliu@ntu.edu.sg>
	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 <mailto:zhe.hou@ntu.edu.sg>, David Sanan <mailto:sanan@ntu.edu.sg>, Alwen Tiu <mailto:ATiu@ntu.edu.sg>, Rajeev Gore <mailto:rajeev.gore@anu.edu.au>, Ranald Clouston <mailto:ranald.clouston@cs.au.dk>
	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 <http://liftm.de>, Cornelius Diekmann <http://net.in.tum.de/~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 <http://peteg.org>
	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 <mailto:tjark.weber@it.uu.se>, Lars-Henrik Eriksson <mailto:lhe@it.uu.se>, Joachim Parrow <mailto:joachim.parrow@it.uu.se>, Johannes Borgström <mailto:johannes.borgstrom@it.uu.se>, Ramunas Gutkovas <mailto:ramunas.gutkovas@it.uu.se>
	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 <http://www21.in.tum.de/~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 <a href="https://doi.org/10.1007/978-3-642-32347-8_9">ITP 2012 paper</a>.
	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
	<a href="https://doi.org/10.1007/978-3-319-10542-0">Concrete Semantics</a>.

	[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 <https://people.compute.dtu.dk/andschl/>, Jørgen Villadsen <https://people.compute.dtu.dk/jovi/>
	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 <mailto:julian.fell@uq.net.au>, Ian J. Hayes <mailto:ian.hayes@itee.uq.edu.au>, Andrius Velykis <http://andrius.velykis.lt>
	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 <i>c</i> and
	<i>i</i> is the process that, if executed in parallel with
	<i>i</i> implements <i>c</i>. 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 <https://people.compute.dtu.dk/aleje/>, Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>, Jørgen Villadsen <https://people.compute.dtu.dk/jovi/>
	topic = Logic/General logic/Mechanization of proofs
	date = 2017-01-01
	notify = aleje@dtu.dk, andschl@dtu.dk, jovi@dtu.dk
	abstract =
	<p>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.</p>
	<p>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. <a href="https://content.iospress.com/articles/ai-communications/aic764">
	https://content.iospress.com/articles/ai-communications/aic764</a></p>
	<p>See also: Students' Proof Assistant (SPA).
	<a href=https://github.com/logic-tools/spa>
	https://github.com/logic-tools/spa</a></p>
	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<mailto:lukas.bulwahn@gmail.com>, Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Analysis, Mathematics/Number theory
	date = 2017-01-24
	notify = eberlm@in.tum.de
	abstract =
	<p>Bernoulli numbers were first discovered in the closed-form
	expansion of the sum 1<sup>m</sup> +
	2<sup>m</sup> + … + n<sup>m</sup>
	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.</p>
	<p>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.</p>
	<p>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.</p>

	[Stone_Relation_Algebras]
	title = Stone Relation Algebras
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/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 <http://www.cosc.canterbury.ac.nz/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 <mailto:jasmin.blanchette@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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 <em>Journal of Automated
	Reasoning</em>. 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 <mailto:bbohrer@cs.cmu.edu>
	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.

	[Syntax_Independent_Logic]
	title = Syntax-Independent Logic Infrastructure
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We formalize a notion of logic whose terms and formulas are kept
	abstract. In particular, logical connectives, substitution, free
	variables, and provability are not defined, but characterized by their
	general properties as locale assumptions. Based on this abstract
	characterization, we develop further reusable reasoning
	infrastructure. For example, we define parallel substitution (along
	with proving its characterizing theorems) from single-point
	substitution. Similarly, we develop a natural deduction style proof
	system starting from the abstract Hilbert-style one. These one-time
	efforts benefit different concrete logics satisfying our locales'
	assumptions. We instantiate the syntax-independent logic
	infrastructure to Robinson arithmetic (also known as Q) in the AFP
	entry <a
	href="https://www.isa-afp.org/entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a>
	and to hereditarily finite set theory in the AFP entries <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	and <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>,
	which are part of our formalization of Gödel's
	Incompleteness Theorems described in our CADE-27 paper <a
	href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A
	Formally Verified Abstract Account of Gödel's Incompleteness
	Theorems</a>.

	[Goedel_Incompleteness]
	title = An Abstract Formalization of Gödel's Incompleteness Theorems
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We present an abstract formalization of Gödel's
	incompleteness theorems. We analyze sufficient conditions for the
	theorems' applicability to a partially specified logic. Our
	abstract perspective enables a comparison between alternative
	approaches from the literature. These include Rosser's variation
	of the first theorem, Jeroslow's variation of the second theorem,
	and the Swierczkowski–Paulson semantics-based approach. This
	AFP entry is the main entry point to the results described in our
	CADE-27 paper <a
	href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A
	Formally Verified Abstract Account of Gödel's Incompleteness
	Theorems</a>. As part of our abstract formalization's
	validation, we instantiate our locales twice in the separate AFP
	entries <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	and <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>.

	[Goedel_HFSet_Semantic]
	title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part I
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We validate an abstract formulation of Gödel's First and
	Second Incompleteness Theorems from a <a
	href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate
	AFP entry</a> by instantiating them to the case of
	<i>finite sound extensions of the Hereditarily Finite (HF) Set
	theory</i>, i.e., FOL theories extending the HF Set theory with
	a finite set of axioms that are sound in the standard model. The
	concrete results had been previously formalised in an <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">AFP
	entry by Larry Paulson</a>; our instantiation reuses the
	infrastructure developed in that entry.

	[Goedel_HFSet_Semanticless]
	title = From Abstract to Concrete Gödel's Incompleteness Theorems—Part II
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We validate an abstract formulation of Gödel's Second
	Incompleteness Theorem from a <a
	href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate
	AFP entry</a> by instantiating it to the case of <i>finite
	consistent extensions of the Hereditarily Finite (HF) Set
	theory</i>, i.e., consistent FOL theories extending the HF Set
	theory with a finite set of axioms. The instantiation draws heavily
	on infrastructure previously developed by Larry Paulson in his <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">direct
	formalisation of the concrete result</a>. It strengthens
	Paulson's formalization of Gödel's Second from that
	entry by <i>not</i> assuming soundness, and in fact not
	relying on any notion of model or semantic interpretation. The
	strengthening was obtained by first replacing some of Paulson’s
	semantic arguments with proofs within his HF calculus, and then
	plugging in some of Paulson's (modified) lemmas to instantiate
	our soundness-free Gödel's Second locale.

	[Robinson_Arithmetic]
	title = Robinson Arithmetic
	author = Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Logic/Proof theory
	date = 2020-09-16
	notify = a.popescu@sheffield.ac.uk, traytel@di.ku.dk
	abstract =
	We instantiate our syntax-independent logic infrastructure developed
	in <a
	href="https://www.isa-afp.org/entries/Syntax_Independent_Logic.html">a
	separate AFP entry</a> to the FOL theory of Robinson arithmetic
	(also known as Q). The latter was formalised using Nominal Isabelle by
	adapting <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">Larry
	Paulson’s formalization of the Hereditarily Finite Set
	theory</a>.

	[Elliptic_Curves_Group_Law]
	title = The Group Law for Elliptic Curves
	author = Stefan Berghofer <http://www.in.tum.de/~berghofe>
	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 <http://www.cse.unsw.edu.au/~kleing/>
	topic = Mathematics/Analysis, Mathematics/Number theory
	date = 2004-02-25
	notify = kleing@cse.unsw.edu.au
	abstract =
	<p>This is an example submission to the Archive of Formal Proofs. It shows
	submission requirements and explains the structure of a simple typical
	submission.</p>
	<p>Note that you can use <em>HTML tags</em> 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
	<a href="../submitting.html">submission guidelines</a> before using this.</p>
	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 <mailto:vb358@cam.ac.uk>, Martin Kleppmann<mailto:martin.kleppmann@cl.cam.ac.uk>, Dominic P. Mulligan<mailto:dominic.p.mulligan@googlemail.com>, Alastair R. Beresford<mailto:arb33@cam.ac.uk>
	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<mailto:joachim@cis.upenn.edu>, Brian Huffman<>, Neil Mitchell<>, Christian Sternagel<mailto:c.sternagel@gmail.com>
	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 <http://homes.soic.indiana.edu/jsiek/>
	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.
	<br>
	The paper that accompanies these Isabelle theories is <a href="https://arxiv.org/abs/1707.03762">available on arXiv</a>.

	[DynamicArchitectures]
	title = Dynamic Architectures
	author = Diego Marmsoler <http://marmsoler.com>
	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)<br>

	[Stewart_Apollonius]
	title = Stewart's Theorem and Apollonius' Theorem
	author = Lukas Bulwahn <mailto:lukas.bulwahn@gmail.com>
	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 <mailto:cris.matache@gmail.com>, Victor B. F. Gomes <mailto:victorborgesfg@gmail.com>, Dominic P. Mulligan <mailto:dominic.p.mulligan@googlemail.com>
	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 <mailto:jonas.raedle@tum.de>
	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 <mailto:daniel@ekpyron.org>
	topic = Logic/Philosophical aspects
	date = 2017-09-17
	notify = daniel@ekpyron.org
	abstract =
	<p> We present an embedding of the second-order fragment of the
	Theory of Abstract Objects as described in Edward Zalta's
	upcoming work <a
	href="https://mally.stanford.edu/principia.pdf">Principia
	Logico-Metaphysica (PLM)</a> 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
	<b>abstract objects</b> 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 <a
	href="https://mally.stanford.edu/Papers/rtt.pdf">known to
	be challenging</a>. </p> <p> 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.
	</p> <p> Our work thereby supports the concept of shallow
	semantical embeddings of logical systems in HOL as a universal tool
	for logical reasoning <a
	href="http://www.mi.fu-berlin.de/inf/groups/ag-ki/publications/Universal-Reasoning/1703_09620_pd.pdf">as
	promoted by Christoph Benzmüller</a>. </p>
	<p> 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. </p>

	[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 <a
	href="https://dl.acm.org/citation.cfm?doid=361002.361007">Multidimensional
	binary search trees used for associative searching</a> and <a
	href="https://dl.acm.org/citation.cfm?doid=355744.355745">
	An Algorithm for Finding Best Matches in Logarithmic Expected
	Time</a>.
	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 <mailto:martin.rau@tum.de>, Tobias Nipkow <http://www.in.tum.de/~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 <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.
	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 <mailto:robin.essmann@tum.de>, Tobias Nipkow <http://www.in.tum.de/~nipkow/>, Simon Robillard <https://simon-robillard.net/>
	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, set cover, independent set,
	load balancing, and bin packing. The proofs correct incompletenesses
	in existing proofs and improve the approximation ratio in one case.
	A detailed description of our work has been published in the proceedings of
	<a href="https://doi.org/10.1007/978-3-030-51054-1_17">IJCAR 2020</a>.

	[Diophantine_Eqns_Lin_Hom]
	title = Homogeneous Linear Diophantine Equations
	author = Florian Messner <mailto:florian.g.messner@uibk.ac.at>, Julian Parsert <mailto:julian.parsert@gmail.com>, Jonas Schöpf <mailto:jonas.schoepf@uibk.ac.at>, Christian Sternagel <mailto:c.sternagel@gmail.com>
	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 <https://www.cl.cam.ac.uk/~wl302/>
	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 <https://www.cl.cam.ac.uk/~wl302/>
	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 <http://www21.in.tum.de/~brunnerj/>
	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: <ol>
	<li>Definition of odd rankings and proof that an automaton
	rejects a word iff there exists an odd ranking for it.</li>
	<li>Definition of the complement automaton and proof that it
	accepts exactly those words for which there is an odd
	ranking.</li> <li>Verified implementation of the
	complement automaton using the Isabelle Collections
	Framework.</li> </ol>

	[Transition_Systems_and_Automata]
	title = Transition Systems and Automata
	author = Julian Brunner <http://www21.in.tum.de/~brunnerj/>
	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 <http://peteg.org>, 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 <mailto:s.linker@liverpool.ac.uk>
	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 <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory, Mathematics/Algebra
	date = 2017-12-21
	notify = eberlm@in.tum.de
	abstract =
	<p>This article provides a formalisation of Dirichlet characters
	and Dirichlet <em>L</em>-functions including proofs of
	their basic properties – most notably their analyticity,
	their areas of convergence, and their non-vanishing for &Re;(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.</p> <p>This
	also leads to a relatively short proof of Dirichlet’s Theorem, which
	states that, if <em>h</em> and <em>n</em> are
	coprime, there are infinitely many primes <em>p</em> with
	<em>p</em> &equiv; <em>h</em> (mod
	<em>n</em>).</p>

	[Symmetric_Polynomials]
	title = Symmetric Polynomials
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Algebra
	date = 2018-09-25
	notify = eberlm@in.tum.de
	abstract =
	<p>A symmetric polynomial is a polynomial in variables
	<em>X</em><sub>1</sub>,…,<em>X</em><sub>n</sub>
	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.</p> <p>This article provides a definition of
	symmetric polynomials and the elementary symmetric polynomials
	e<sub>1</sub>,…,e<sub>n</sub> and
	proofs of their basic properties, including three notable
	ones:</p> <ul> <li> Vieta's formula, which
	gives an explicit expression for the <em>k</em>-th
	coefficient of a univariate monic polynomial in terms of its roots
	<em>x</em><sub>1</sub>,…,<em>x</em><sub>n</sub>,
	namely
	<em>c</em><sub><em>k</em></sub> = (-1)<sup><em>n</em>-<em>k</em></sup> e<sub><em>n</em>-<em>k</em></sub>(<em>x</em><sub>1</sub>,…,<em>x</em><sub>n</sub>).</li>
	<li>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.</li> <li>Third, as a corollary of the
	previous two, that given a polynomial over some ring
	<em>R</em>, any symmetric polynomial combination of its
	roots is also in <em>R</em> even when the roots are not.
	</ul> <p> Both the symmetry property itself and the
	witness for the Fundamental Theorem are executable. </p>

	[Taylor_Models]
	title = Taylor Models
	author = Christoph Traut<>, Fabian Immler <http://www21.in.tum.de/~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 <http://home.in.tum.de/~mansour/>, Lawrence C. Paulson <http://www.cl.cam.ac.uk/~lp15/>
	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.

	[AI_Planning_Languages_Semantics]
	title = AI Planning Languages Semantics
	author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Peter Lammich <http://www21.in.tum.de/~lammich>
	topic = Computer science/Artificial intelligence
	date = 2020-10-29
	notify = mohammad.abdulaziz8@gmail.com
	abstract =
	This is an Isabelle/HOL formalisation of the semantics of the
	multi-valued planning tasks language that is used by the planning
	system Fast-Downward, the STRIPS fragment of the Planning Domain
	Definition Language (PDDL), and the STRIPS soundness meta-theory
	developed by Vladimir Lifschitz. It also contains formally verified
	checkers for checking the well-formedness of problems specified in
	either language as well the correctness of potential solutions. The
	formalisation in this entry was described in an earlier publication.

	[Verified_SAT_Based_AI_Planning]
	title = Verified SAT-Based AI Planning
	author = Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>, Friedrich Kurz <>
	topic = Computer science/Artificial intelligence
	date = 2020-10-29
	notify = mohammad.abdulaziz8@gmail.com
	abstract =
	We present an executable formally verified SAT encoding of classical
	AI planning that is based on the encodings by Kautz and Selman and the
	one by Rintanen et al. The encoding was experimentally tested and
	shown to be usable for reasonably sized standard AI planning
	benchmarks. We also use it as a reference to test a state-of-the-art
	SAT-based planner, showing that it sometimes falsely claims that
	problems have no solutions of certain lengths. The formalisation in
	this submission was described in an independent publication.

	[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 <https://people.compute.dtu.dk/andschl/>, Jasmin Christian Blanchette <mailto:j.c.blanchette@vu.nl>, Dmitriy Traytel <https://traytel.bitbucket.io>, Uwe Waldmann <mailto:uwe@mpi-inf.mpg.de>
	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
	<em>Handbook of Automated Reasoning</em>. 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.

	[Chandy_Lamport]
	title = A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm
	author = Ben Fiedler <mailto:ben.fiedler@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io>
	topic = Computer science/Algorithms/Distributed
	date = 2020-07-21
	notify = ben.fiedler@inf.ethz.ch, traytel@inf.ethz.ch
	abstract =
	We provide a suitable distributed system model and implementation of the
	Chandy--Lamport distributed snapshot algorithm [ACM Transactions on
	Computer Systems, 3, 63-75, 1985]. Our main result is a formal
	termination and correctness proof of the Chandy--Lamport algorithm and
	its use in stable property detection.

	[BNF_Operations]
	title = Operations on Bounded Natural Functors
	author = Jasmin Christian Blanchette <mailto:jasmin.blanchette@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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 <http://www.unirioja.es/cu/jodivaso/>, Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Sebastiaan Joosten <http://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Akihisa Yamada<>
	+author = Ralph Bottesch <>, Jose Divasón <http://www.unirioja.es/cu/jodivaso/>, Maximilian Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Sebastiaan Joosten <https://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/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 <http://www.unirioja.es/cu/jodivaso/>, Sebastiaan Joosten <http://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Akihisa Yamada <mailto:ayamada@trs.cm.is.nagoya-u.ac.jp>
	+author = Jose Divasón <http://www.unirioja.es/cu/jodivaso/>, Sebastiaan Joosten <https://sjcjoosten.nl/>, René Thiemann <http://cl-informatik.uibk.ac.at/users/thiemann/>, Akihisa Yamada <mailto:ayamada@trs.cm.is.nagoya-u.ac.jp>
	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 <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Manuel Eberl <https://www.in.tum.de/~eberlm>, Tobias Nipkow <https://www.in.tum.de/~nipkow>
	topic = Computer science/Data structures
	date = 2018-02-06
	notify = eberlm@in.tum.de
	abstract =
	<p> 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. </p>
	<p> In particular, by choosing these priorities at random upon
	insertion of an element, we can pretend that we inserted the elements
	in <em>random order</em>, 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.</p>

	[Skip_Lists]
	title = Skip Lists
	author = Max W. Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, Manuel Eberl <https://www21.in.tum.de/~eberlm/>
	topic = Computer science/Data structures
	date = 2020-01-09
	notify = max.haslbeck@gmx.de
	abstract =
	<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>

	[Mersenne_Primes]
	title = Mersenne primes and the Lucas–Lehmer test
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2020-01-17
	notify = eberlm@in.tum.de
	abstract =
	<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–Lehmer test is
	developed. This test decides primality for Mersenne numbers in time
	polynomial in <em>n</em>.</p>

	[Hoare_Time]
	title = Hoare Logics for Time Bounds
	author = Maximilian P. L. Haslbeck <http://www.in.tum.de/~haslbema>, Tobias Nipkow <https://www.in.tum.de/~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 <i>et al.</i> and a <i>separation
	logic</i> 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 <http://marmsoler.com>
	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)<br>
	[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 <https://www.in.tum.de/~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 <a
	href="https://doi.org/10.1017/S0956796811000104">Hirai
	and Yamamoto</a> 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 <http://dss.in.tum.de/staff/brandt.html>, Manuel Eberl <https://www21.in.tum.de/~eberlm>, Christian Saile <http://dss.in.tum.de/staff/christian-saile.html>, Christian Stricker <http://dss.in.tum.de/staff/christian-stricker.html>
	topic = Mathematics/Games and economics
	date = 2018-03-22
	notify = eberlm@in.tum.de
	abstract =
	<p>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 <a
	href="http://dss.in.tum.de/files/brandt-research/stratset.pdf">Brandt
	<em>et al.</em></a>, 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.</p>

	[BNF_CC]
	title = Bounded Natural Functors with Covariance and Contravariance
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>
	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 BNF<sub>CC</sub> that extends the mapper
	and relator to covariant and contravariant parameters. We show that
	<ol> <li> BNF<sub>CC</sub>s are closed under
	functor composition and least and greatest fixpoints,</li>
	<li> subtypes inherit the BNF<sub>CC</sub> structure
	under conditions that generalise those for the BNF case,
	and</li> <li> BNF<sub>CC</sub>s preserve
	quotients under mild conditions.</li> </ol> These proofs
	are carried out for abstract BNF<sub>CC</sub>s similar to
	the AFP entry BNF Operations. In addition, we apply the
	BNF<sub>CC</sub> 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 <mailto:bracevac@st.informatik.tu-darmstadt.de>, Richard Gay <mailto:gay@mais.informatik.tu-darmstadt.de>, Sylvia Grewe <mailto:grewe@st.informatik.tu-darmstadt.de>, Heiko Mantel <mailto:mantel@mais.informatik.tu-darmstadt.de>, Henning Sudbrock <mailto:sudbrock@mais.informatik.tu-darmstadt.de>, Markus Tasch <mailto:tasch@mais.informatik.tu-darmstadt.de>
	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 <http://christoph-benzmueller.de>, Dana Scott <http://www.cs.cmu.edu/~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 <mailto:mk428@cl.cam.ac.uk>, Victor B. F. Gomes <mailto:vb358@cl.cam.ac.uk>, Dominic P. Mulligan <mailto:Dominic.Mulligan@arm.com>, Alastair R. Beresford <mailto:arb33@cl.cam.ac.uk>
	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 <http://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <http://www.cl.cam.ac.uk/~wl302/>
	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 <https://www.in.tum.de/~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
	<a href="Monad_Memo_DP.html">Monadification, Memoization and Dynamic Programming</a>,
	thus yielding dynamic programming algorithms.

	[Projective_Geometry]
	title = Projective Geometry
	author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>
	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 <https://sites.google.com/site/anthonybordg/>
	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 =
	<p> We formalize undecidablity results for Minsky machines. To
	this end, we also formalize recursive inseparability.
	</p><p> 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. </p><p> 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. </p><p> We do
	<em>not</em> prove that recursive functions can simulate
	Minsky machines. </p>

	[Neumann_Morgenstern_Utility]
	title = Von-Neumann-Morgenstern Utility Theorem
	author = Julian Parsert<mailto:julian.parsert@gmail.com>, Cezary Kaliszyk<http://cl-informatik.uibk.ac.at/users/cek/>
	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ć <mailto:filip@matf.bg.ac.rs>, Mirko Spasić <mailto:mirko@matf.bg.ac.rs>, René Thiemann <http://cl-informatik.uibk.ac.at/~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 <https://www.cl.cam.ac.uk/~wl302/>
	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 <https://www.cl.cam.ac.uk/~lp15/>
	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 <http://www.cl.cam.ac.uk/~ak2110/>
	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 <http://www.cosc.canterbury.ac.nz/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 <https://www21.in.tum.de/~eberlm>, Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Number theory
	date = 2018-09-19
	notify = eberlm@in.tum.de
	abstract =
	<p>This article provides a short proof of the Prime Number
	Theorem in several equivalent forms, most notably
	π(<em>x</em>) ~ <em>x</em>/ln
	<em>x</em> where π(<em>x</em>) is the
	number of primes no larger than <em>x</em>. It also
	defines other basic number-theoretic functions related to primes like
	Chebyshev's functions &thetasym; and ψ and the
	“<em>n</em>-th prime number” function
	p<sub><em>n</em></sub>. We also show various
	bounds and relationship between these functions are shown. Lastly, we
	derive Mertens' First and Second Theorem, i. e.
	∑<sub><em>p</em>≤<em>x</em></sub>
	ln <em>p</em>/<em>p</em> = ln
	<em>x</em> + <em>O</em>(1) and
	∑<sub><em>p</em>≤<em>x</em></sub>
	1/<em>p</em> = ln ln <em>x</em> + M +
	<em>O</em>(1/ln <em>x</em>). We also give
	explicit bounds for the remainder terms.</p> <p>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
	∑<sub><em>p</em>≤<em>x</em></sub>
	ln <em>p</em>/<em>p</em> = ln
	<em>x</em> + c + <em>o</em>(1).</p>
	<p>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 <em>et al.</em> 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.</p>

	[Signature_Groebner]
	title = Signature-Based Gröbner Basis Algorithms
	author = Alexander Maletzky <https://risc.jku.at/m/alexander-maletzky/>
	topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical
	date = 2018-09-20
	notify = alexander.maletzky@risc.jku.at
	abstract =
	<p>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.</p>
	<p>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.</p><p>The formalization follows the recent survey article by
	Eder and Faugère.</p>

	[Factored_Transition_System_Bounding]
	title = Upper Bounding Diameters of State Spaces of Factored Transition Systems
	author = Friedrich Kurz <>, Mohammad Abdulaziz <http://home.in.tum.de/~mansour/>
	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 <http://home.in.tum.de/~immler/>, Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>
	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 =
	<p>This article defines the combinatorial structures known as
	<em>Independence Systems</em> and
	<em>Matroids</em> 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
	<a href="http://www.math.lsu.edu/~oxley/survey4.pdf">`What
	is a Matroid?'</a>.</p>

	[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 <a href="https://doi.org/10.1016/j.jlamp.2018.06.005">paper by the author</a> 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 <https://people.compute.dtu.dk/andschl/>, Jasmin Christian Blanchette <mailto:j.c.blanchette@vu.nl>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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
	<i>Handbook of Automated Reasoning</i>. The result is a
	functional implementation of a first-order prover.

	[Auto2_HOL]
	title = Auto2 Prover
	author = Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>
	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 <http://staffwww.dcs.shef.ac.uk/people/G.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 <http://staffwww.dcs.shef.ac.uk/people/G.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 <http://staffwww.dcs.shef.ac.uk/people/G.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 <mailto:Roy.Overbeek@cwi.nl>
	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 <em>determinacy</em>:
	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 <https://www.brucker.ch/>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.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.

	[Core_SC_DOM]
	title = The Safely Composable DOM
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	In this AFP entry, we formalize the core of the Safely Composable
	Document Object Model (SC DOM). The SC DOM improve the standard DOM
	(as formalized in the AFP entry "Core DOM") by strengthening
	the tree boundaries set by shadow roots: in the SC DOM, the shadow
	root is a sub-class of the document class (instead of a base class).
	This modifications also results in changes to some API methods (e.g.,
	getOwnerDocument) to return the nearest shadow root rather than the
	document root. As a result, many API methods that, when called on a
	node inside a shadow tree, would previously ``break out''
	and return or modify nodes that are possibly outside the shadow tree,
	now stay within its boundaries. This change in behavior makes programs
	that operate on shadow trees more predictable for the developer and
	allows them to make more assumptions about other code accessing the
	DOM.

	[Shadow_SC_DOM]
	title = A Formal Model of the Safely Composable Document Object Model with Shadow Roots
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	In this AFP entry, we extend our formalization of the safely
	composable DOM with Shadow Roots. This is a proposal for Shadow Roots
	with stricter safety guarantess than the standard compliant
	formalization (see "Shadow DOM"). Shadow Roots are a recent
	proposal of the web community to support a component-based development
	approach for client-side web applications. Shadow roots are a
	significant extension to the DOM standard and, as web standards are
	condemned to be backward compatible, such extensions often result in
	complex specification that may contain unwanted subtleties that can be
	detected by a formalization. Our Isabelle/HOL formalization is, in
	the sense of object-orientation, an extension of our formalization of
	the core DOM and enjoys the same basic properties, i.e., it is
	extensible, i.e., can be extended without the need of re-proving
	already proven properties and executable, i.e., we can generate
	executable code from our specification. We exploit the executability
	to show that our formalization complies to the official standard of
	the W3C, respectively, the WHATWG.

	[SC_DOM_Components]
	title = A Formalization of Safely Composable Web Components
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	While the (safely composable) DOM with shadow trees provide the
	technical basis for defining web components, it does neither defines
	the concept of web components nor specifies the safety properties that
	web components should guarantee. Consequently, the standard also does
	not discuss how or even if the methods for modifying the DOM respect
	component boundaries. In AFP entry, we present a formally verified
	model of safely composable web components and define safety properties
	which ensure that different web components can only interact with each
	other using well-defined interfaces. Moreover, our verification of the
	application programming interface (API) of the DOM revealed numerous
	invariants that implementations of the DOM API need to preserve to
	ensure the integrity of components. In comparison to the strict
	standard compliance formalization of Web Components in the AFP entry
	"DOM_Components", the notion of components in this entry
	(based on "SC_DOM" and "Shadow_SC_DOM") provides
	much stronger safety guarantees.

	[Store_Buffer_Reduction]
	title = A Reduction Theorem for Store Buffers
	author = Ernie Cohen <mailto:ecohen@amazon.com>, Norbert Schirmer <mailto:norbert.schirmer@web.de>
	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 <http://www21.in.tum.de/~lammich>, Simon Wimmer <http://in.tum.de/~wimmers>
	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: <ul> <li>Bisection
	Square Root, </li> <li>Extended Euclid, </li>
	<li>Exponentiation by Squaring, </li> <li>Binary
	Search, </li> <li>Insertion Sort, </li>
	<li>Quicksort, </li> <li>Depth First Search.
	</li> </ul> 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 <http://cl-informatik.uibk.ac.at/users/bottesch/>, Max W. Haslbeck <http://cl-informatik.uibk.ac.at/users/mhaslbeck/>, René Thiemann <http://cl-informatik.uibk.ac.at/~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 <http://lcs.ios.ac.cn/~bzhan/>
	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 <https://www-users.cs.york.ac.uk/~simonf/>, Frank Zeyda<>, Yakoub Nemouchi <mailto:yakoub.nemouchi@york.ac.uk>, Pedro Ribeiro<>, Burkhart Wolff<mailto:wolff@lri.fr>
	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 <mailto:safouan.taha@lri.fr>, Lina Ye <mailto:lina.ye@lri.fr>, Burkhart Wolff<mailto:wolff@lri.fr>
	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 <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2019-02-11
	notify = eberlm@in.tum.de
	abstract =
	<p>The most efficient known primality tests are
	<em>probabilistic</em> 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.</p> <p>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.</p>

	[Kruskal]
	title = Kruskal's Algorithm for Minimum Spanning Forest
	author = Maximilian P.L. Haslbeck <http://in.tum.de/~haslbema/>, Peter Lammich <http://www21.in.tum.de/~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 <https://www21.in.tum.de/~eberlm>
	topic = Computer science/Algorithms
	date = 2019-02-01
	notify = eberlm@in.tum.de
	abstract =
	<p>This entry defines the set of <em>inversions</em>
	of a list, i.e. the pairs of indices that violate sortedness. It also
	proves the correctness of the well-known
	<em>O</em>(<em>n log n</em>)
	divide-and-conquer algorithm to compute the number of
	inversions.</p>

	[Prime_Distribution_Elementary]
	title = Elementary Facts About the Distribution of Primes
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2019-02-21
	notify = eberlm@in.tum.de
	abstract =
	<p>This entry is a formalisation of Chapter 4 (and parts of
	Chapter 3) of Apostol's <a
	href="https://www.springer.com/de/book/9780387901633"><em>Introduction
	to Analytic Number Theory</em></a>. 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
	<em>n</em>, the divisor function
	<em>d(n)</em>, Euler's totient function
	<em>φ(n)</em>, and
	lcm(1,…,<em>n</em>).</p>

	[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 =
	<p>The theory is a formalization of the
	<a href="https://www.omg.org/spec/OCL/">OCL</a> type system, its abstract
	syntax and expression typing rules. The theory does not define a concrete
	syntax and a semantics. In contrast to
	<a href="https://www.isa-afp.org/entries/Featherweight_OCL.html">Featherweight OCL</a>,
	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.</p>
	<p>The Safe OCL distincts nullable and non-nullable types. Also the theory gives a
	formal definition of <a href="http://ceur-ws.org/Vol-1512/paper07.pdf">safe
	navigation operations</a>. 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.</p>
	<p>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.</p>
	<p>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.</p>

	[QHLProver]
	title = Quantum Hoare Logic
	author = Junyi Liu<>, Bohua Zhan <http://lcs.ios.ac.cn/~bzhan/>, 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 <https://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	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 <mailto:lor.gheri@gmail.com>, Andrei Popescu <https://www.andreipopescu.uk>
	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 <mailto:benedikt.seidl@tum.de>, Salomon Sickert <mailto:s.sickert@tum.de>
	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.
	<p>
	[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 <https://traytel.bitbucket.io>
	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. <a
	href="https://doi.org/10.1145/2535838.2535851">Miller et
	al.</a> introduced λ• (pronounced
	<i>lambda auth</i>)—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 an <a
	href="https://doi.org/10.4230/LIPIcs.ITP.2019.10">ITP'19 paper</a>.

	[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 <https://risc.jku.at/m/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 <http://cl-informatik.uibk.ac.at/users/bottesch/>, Alban Reynaud <>, René Thiemann <http://cl-informatik.uibk.ac.at/~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 <http://www.parsert.com/>, Cezary Kaliszyk <http://cl-informatik.uibk.ac.at/cek/>
	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 <http://www.cs.cmu.edu/~aplatzer/>
	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.

	+[BenOr_Kozen_Reif]
	+title = The BKR Decision Procedure for Univariate Real Arithmetic
	+author = Katherine Cordwell <https://www.cs.cmu.edu/~kcordwel/>, Yong Kiam Tan <https://www.cs.cmu.edu/~yongkiat/>, André Platzer <https://www.cs.cmu.edu/~aplatzer/>
	+topic = Computer science/Algorithms/Mathematical
	+date = 2021-04-24
	+notify = kcordwel@cs.cmu.edu, yongkiat@cs.cmu.edu, aplatzer@cs.cmu.edu
	+abstract =
	+ We formalize the univariate case of Ben-Or, Kozen, and Reif's
	+ decision procedure for first-order real arithmetic (the BKR
	+ algorithm). We also formalize the univariate case of Renegar's
	+ variation of the BKR algorithm. The two formalizations differ
	+ mathematically in minor ways (that have significant impact on the
	+ multivariate case), but are quite similar in proof structure. Both
	+ rely on sign-determination (finding the set of consistent sign
	+ assignments for a set of polynomials). The method used for
	+ sign-determination is similar to Tarski's original quantifier
	+ elimination algorithm (it stores key information in a matrix
	+ equation), but with a reduction step to keep complexity low.
	+
	[Complete_Non_Orders]
	title = Complete Non-Orders and Fixed Points
	author = Akihisa Yamada <http://group-mmm.org/~ayamada/>, Jérémy Dubut <http://group-mmm.org/~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 <http://www21.in.tum.de/~lammich>, Tobias Nipkow <http://www21.in.tum.de/~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 <em>priority search tree</em>. 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 <em>Purely Functional, Simple and Efficient Priority
	Search Trees and Applications to Prim and Dijkstra</em>.

	[Prim_Dijkstra_Simple]
	title = Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra
	author = Peter Lammich <http://www21.in.tum.de/~lammich>, Tobias Nipkow <http://www21.in.tum.de/~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 <em>Purely Functional, Simple and Efficient
	Priority Search Trees and Applications to Prim and Dijkstra</em>.

	[MFOTL_Monitor]
	title = Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic
	author = Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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 <a href="https://doi.org/10.1007/978-3-030-32079-9_18">RV
	2019 paper</a>, 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.
	extra-history =
	Change history:
	[2020-08-13]:
	added the formalization of the abstract slicing framework and joint data
	slicer (revision b1639ed541b7)<br>

	[FOL_Seq_Calc1]
	title = A Sequent Calculus for First-Order Logic
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	contributors = Alexander Birch Jensen <https://people.compute.dtu.dk/aleje/>,
	Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>,
	Jørgen Villadsen <https://people.compute.dtu.dk/jovi/>
	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 = Order Extension and Szpilrajn's Extension Theorem
	author = Peter Zeller <mailto:p_zeller@cs.uni-kl.de>, Lukas Stevens <https://www21.in.tum.de/team/stevensl>
	topic = Mathematics/Order
	date = 2019-07-27
	notify = p_zeller@cs.uni-kl.de
	abstract =
	This entry is concerned with the principle of order extension, i.e. the extension of an order relation to a total order relation.
	To this end, we prove a more general version of Szpilrajn's extension theorem employing terminology from the book "Consistency, Choice, and Rationality" by Bossert and Suzumura.
	We also formalize theorem 2.7 of their book.
	extra-history =
	Change history:
	[2021-03-22]:
	(by Lukas Stevens) generalise Szpilrajn's extension theorem and add material from the book "Consistency, Choice, and Rationality"

	[TESL_Language]
	title = A Formal Development of a Polychronous Polytimed Coordination Language
	author = Hai Nguyen Van <mailto:hai.nguyenvan.phie@gmail.com>, Frédéric Boulanger <mailto:frederic.boulanger@centralesupelec.fr>, Burkhart Wolff <mailto:burkhart.wolff@lri.fr>
	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:
	<ul><li>the
	behavior of the sub-systems is observed only at a series of discrete
	instants,</li><li>events may occur in different sub-systems at unrelated
	times, leading to polychronous systems, which do not necessarily have
	a common base clock,</li><li>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,</li><li>the domain of time
	(discrete, rational, continuous...) may be different in the
	subsystems, leading to polytimed systems,</li><li>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).</li></ul>
	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 <mailto:giuliano@galois.com>
	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 <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Misc
	date = 2019-08-05
	notify = eberlm@in.tum.de
	abstract =
	<p>This entry contains formalisations of the answers to three of
	the six problem of the International Mathematical Olympiad 2019,
	namely Q1, Q4, and Q5.</p> <p>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.</p>

	[Adaptive_State_Counting]
	title = Formalisation of an Adaptive State Counting Algorithm
	author = Robert Sachtleben <mailto:rob_sac@uni-bremen.de>
	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 <a
	href="https://doi.org/10.1109/TC.2004.85">Testing from a
	Non-Deterministic Finite State Machine Using Adaptive State
	Counting</a>. 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 <http://www21.in.tum.de/~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 <i>Basic Algebra</i>
	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.
	extra-history =
	Change history:
	[2020-12-13]: added components based on Kleene algebras with tests. These implement differential Hoare logic (dH) and a Morgan-style differential refinement calculus (dR) for verification of hybrid programs.

	[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, <a
	href="https://doi.org/10.1145/2590989.2590991">Ngo, Ré,
	and Rudra</a> 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 <https://www.cl.cam.ac.uk/~ak2110/>
	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 <a
	href="https://plato.stanford.edu/entries/aristotle-logic/">article from the Stanford Encyclopedia of Philosophy by Robin Smith.</a> 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<http://home.in.tum.de/~wimmers/>
	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 <https://www.cl.cam.ac.uk/~lp15/>
	topic = Logic/Set theory
	date = 2019-10-24
	notify = lp15@cam.ac.uk
	abstract =
	<p>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.</p>
	<p>There is a type <em>V</em> of sets and a function <em>elts :: V => V
	set</em> mapping a set to its elements. Classes simply have type <em>V
	set</em>, 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.</p>
	<p>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.</p>
	<p>The theory provides two type classes with the aim of facilitating
	developments that combine <em>V</em> with other Isabelle/HOL types:
	<em>embeddable</em>, the class of types that can be injected into <em>V</em>
	(including <em>V</em> itself as well as <em>V*V</em>, etc.), and
	<em>small</em>, the class of types that correspond to some ZF set.</p>
	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 <mailto:bbohrer@cs.cmu.edu>
	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 <a href="https://www.isa-afp.org/entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a> 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 <mailto:pasquale.noce.lavoro@gmail.com>
	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 <http://home.in.tum.de/~immler/>, Yong Kiam Tan <https://www.cs.cmu.edu/~yongkiat/>
	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 <https://www.lri.fr/~ftuong/>, Burkhart Wolff <https://www.lri.fr/~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 <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2019-12-27
	notify = manuel.eberl@tum.de
	abstract =
	<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>

	[Hybrid_Logic]
	title = Formalizing a Seligman-Style Tableau System for Hybrid Logic
	author = Asta Halkjær From <https://people.compute.dtu.dk/ahfrom/>
	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
	previous 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 that these are sufficient.
	The GoTo rule is restricted using a notion of potential such that each
	application consumes potential and potential is 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 unit. Finally, Nom is restricted by
	a fixed set of allowed nominals. The resulting system should be terminating.
	extra-history =
	Change history:
	[2020-06-03]: The fully restricted system has been shown complete by updating the synthetic completeness proof.

	[Bicategory]
	title = Bicategories
	author = Eugene W. Stark <mailto:stark@cs.stonybrook.edu>
	topic = Mathematics/Category theory
	date = 2020-01-06
	notify = stark@cs.stonybrook.edu
	abstract =
	<p>
	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.
	</p><p>
	Revisions made subsequent to the first version of this article added
	additional material on pseudofunctors, pseudonatural transformations,
	modifications, and equivalence of bicategories; the main thrust being
	to give a proof that a pseudofunctor is a biequivalence if and only
	if it can be extended to an equivalence of bicategories.
	</p>
	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)<br>
	[2020-11-04]:
	Added new material on equivalence of bicategories, with associated changes.
	(revision 472cb2268826)<br>

	[Subset_Boolean_Algebras]
	title = A Hierarchy of Algebras for Boolean Subsets
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Bernhard Möller <https://www.informatik.uni-augsburg.de/en/chairs/dbis/pmi/staff/moeller/>
	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 <mailto:int-e@gmx.de>
	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 <https://martin.desharnais.me>
	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 <http://net.in.tum.de/~diekmann>, Lars Hupel <https://www21.in.tum.de/~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 <https://orcid.org/0000-0003-3290-5034>, Edgar Gonzàlez <mailto:edgargip@google.com>
	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 <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2020-03-22
	notify = manuel.eberl@tum.de
	abstract =
	<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>

	[Saturation_Framework]
	title = A Comprehensive Framework for Saturation Theorem Proving
	author = Sophie Tourret <https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/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 <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.

	[Saturation_Framework_Extensions]
	title = Extensions to the Comprehensive Framework for Saturation Theorem Proving
	author = Jasmin Blanchette <https://www.cs.vu.nl/~jbe248/>, Sophie Tourret <https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret>
	topic = Logic/General logic/Mechanization of proofs
	date = 2020-08-25
	notify = jasmin.blanchette@gmail.com
	abstract =
	This Isabelle/HOL formalization extends the AFP entry
	<em>Saturation_Framework</em> with the following
	contributions: <ul> <li>an application of the framework
	to prove Bachmair and Ganzinger's resolution prover RP
	refutationally complete, which was formalized in a more ad hoc fashion
	by Schlichtkrull et al. in the AFP entry
	<em>Ordered_Resultion_Prover</em>;</li>
	<li>generalizations of various basic concepts formalized by
	Schlichtkrull et al., which were needed to verify RP and could be
	useful to formalize other calculi, such as superposition;</li>
	<li>alternative proofs of fairness (and hence saturation and
	ultimately refutational completeness) for the given clause procedures
	GC and LGC, based on invariance.</li> </ul>

	[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 <mailto:martin.raszyk@inf.ethz.ch>, Joshua Schneider <mailto:joshua.schneider@inf.ethz.ch>, Dmitriy Traytel <https://traytel.bitbucket.io>
	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 <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.

	[Sliding_Window_Algorithm]
	title = Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows
	author = Lukas Heimes<>, Dmitriy Traytel <https://traytel.bitbucket.io>, 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 <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.

	[Lucas_Theorem]
	title = Lucas's Theorem
	author = Chelsea Edmonds <mailto:cle47@cam.ac.uk>
	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 <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.

	[ADS_Functor]
	title = Authenticated Data Structures As Functors
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, Ognjen Marić <mailto:ogi.afp@mynosefroze.com>
	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 <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.

	[Power_Sum_Polynomials]
	title = Power Sum Polynomials
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Algebra
	date = 2020-04-24
	notify = eberlm@in.tum.de
	abstract =
	<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>,…,
	<em>X</em><sub><em>k</em></sub>) =
	<em>X</em><sub>1</sub><sup>n</sup>
	+ … +
	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>
	=
	∑<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> .</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>,
	…,
	<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>
	+ … +
	<em>x</em><sub><em>k</em></sub><sup><em>j</em></sup>.
	Then for each vector <em>a</em> &isinv;
	ℂ<sup><em>k</em></sup>, show that
	there is exactly one solution to the system p<sub>1</sub>
	= a<sub>1</sub>, …,
	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>k.</p>

	[Formal_Puiseux_Series]
	title = Formal Puiseux Series
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Algebra
	date = 2021-02-17
	notify = eberlm@in.tum.de
	abstract =
	<p>Formal Puiseux series are generalisations of formal power
	series and formal Laurent series that also allow for fractional
	exponents. They have the following general form: \[\sum_{i=N}^\infty
	a_{i/d} X^{i/d}\] where <em>N</em> is an integer and
	<em>d</em> is a positive integer.</p> <p>This
	entry defines these series including their basic algebraic properties.
	Furthermore, it proves the Newton–Puiseux Theorem, namely that the
	Puiseux series over an algebraically closed field of characteristic 0
	are also algebraically closed.</p>

	[Gaussian_Integers]
	title = Gaussian Integers
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Number theory
	date = 2020-04-24
	notify = eberlm@in.tum.de
	abstract =
	<p>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.</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>

	[Forcing]
	title = Formalization of Forcing in Isabelle/ZF
	author = Emmanuel Gunther <mailto:gunther@famaf.unc.edu.ar>, Miguel Pagano <https://cs.famaf.unc.edu.ar/~mpagano/>, Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro/home_en>
	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.

	[Delta_System_Lemma]
	title = Cofinality and the Delta System Lemma
	author = Pedro Sánchez Terraf <https://cs.famaf.unc.edu.ar/~pedro/home_en.html>
	topic = Mathematics/Combinatorics, Logic/Set theory
	date = 2020-12-27
	notify = sterraf@famaf.unc.edu.ar
	abstract =
	We formalize the basic results on cofinality of linearly ordered sets
	and ordinals and Šanin’s Lemma for uncountable families of finite
	sets. This last result is used to prove the countable chain condition
	for Cohen posets. We work in the set theory framework of Isabelle/ZF,
	using the Axiom of Choice as needed.

	[Recursion-Addition]
	title = Recursion Theorem in ZF
	author = Georgy Dunaev <mailto:georgedunaev@gmail.com>
	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 <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.

	[LTL_Normal_Form]
	title = An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation
	author = Salomon Sickert <mailto:s.sickert@tum.de>
	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 <mailto:jjhuertaymunive1@sheffield.ac.uk>
	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 <https://www.cl.cam.ac.uk/~ak2110/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	topic = Mathematics/Number theory, Mathematics/Analysis
	date = 2020-05-12
	notify = ak2110@cam.ac.uk, wl302@cam.ac.uk, liwenda1990@hotmail.com
	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
	<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.

	[Knuth_Bendix_Order]
	title = A Formalization of Knuth–Bendix Orders
	author = Christian Sternagel <mailto:c.sternagel@gmail.com>, René Thiemann <http://cl-informatik.uibk.ac.at/~thiemann/>
	topic = Logic/Rewriting
	date = 2020-05-13
	notify = c.sternagel@gmail.com, rene.thiemann@uibk.ac.at
	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 <mailto:avhe@dtu.dk>, Sebastian Mödersheim <https://people.compute.dtu.dk/samo/>, Achim D. Brucker <https://www.brucker.ch/>
	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 <mailto:avhe@dtu.dk>, Sebastian Mödersheim <https://people.compute.dtu.dk/samo/>, Achim D. Brucker <https://www.brucker.ch/>, Anders Schlichtkrull <https://people.compute.dtu.dk/andschl/>
	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.

	[Smith_Normal_Form]
	title = A verified algorithm for computing the Smith normal form of a matrix
	author = Jose Divasón <https://www.unirioja.es/cu/jodivaso/>
	topic = Mathematics/Algebra, Computer science/Algorithms/Mathematical
	date = 2020-05-23
	notify = jose.divason@unirioja.es
	abstract =
	This work presents a formal proof in Isabelle/HOL of an algorithm to
	transform a matrix into its Smith normal form, a canonical matrix
	form, in a general setting: the algorithm is parameterized by
	operations to prove its existence over elementary divisor rings, while
	execution is guaranteed over Euclidean domains. We also provide a
	formal proof on some results about the generality of this algorithm as
	well as the uniqueness of the Smith normal form. Since Isabelle/HOL
	does not feature dependent types, the development is carried out
	switching conveniently between two different existing libraries: the
	Hermite normal form (based on HOL Analysis) and the Jordan normal form
	AFP entries. This permits to reuse results from both developments and
	it is done by means of the lifting and transfer package together with
	the use of local type definitions.

	[Nash_Williams]
	title = The Nash-Williams Partition Theorem
	author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Combinatorics
	date = 2020-05-16
	notify = lp15@cam.ac.uk
	abstract =
	In 1965, Nash-Williams discovered a generalisation of the infinite
	form of Ramsey's theorem. Where the latter concerns infinite sets
	of n-element sets for some fixed n, the Nash-Williams theorem concerns
	infinite sets of finite sets (or lists) subject to a “no initial
	segment” condition. The present formalisation follows a
	monograph on Ramsey Spaces by Todorčević.

	[Safe_Distance]
	title = A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles
	author = Albert Rizaldi <mailto:albert.rizaldi@ntu.edu.sg>, Fabian Immler <http://home.in.tum.de/~immler/>
	topic = Computer science/Algorithms/Mathematical, Mathematics/Physics
	date = 2020-06-01
	notify = albert.rizaldi@ntu.edu.sg, fimmler@andrew.cmu.edu, martin.rau@tum.de
	abstract =
	The Vienna Convention on Road Traffic defines the safe distance
	traffic rules informally. This could make autonomous vehicle liable
	for safe-distance-related accidents because there is no clear
	definition of how large a safe distance is. We provide a formally
	proven prescriptive definition of a safe distance, and checkers which
	can decide whether an autonomous vehicle is obeying the safe distance
	rule. Not only does our work apply to the domain of law, but it also
	serves as a specification for autonomous vehicle manufacturers and for
	online verification of path planners.

	[Relational_Paths]
	title = Relational Characterisations of Paths
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Peter Höfner <http://www.hoefner-online.de/>
	topic = Mathematics/Graph theory
	date = 2020-07-13
	notify = walter.guttmann@canterbury.ac.nz, peter@hoefner-online.de
	abstract =
	Binary relations are one of the standard ways to encode, characterise
	and reason about graphs. Relation algebras provide equational axioms
	for a large fragment of the calculus of binary relations. Although
	relations are standard tools in many areas of mathematics and
	computing, researchers usually fall back to point-wise reasoning when
	it comes to arguments about paths in a graph. We present a purely
	algebraic way to specify different kinds of paths in Kleene relation
	algebras, which are relation algebras equipped with an operation for
	reflexive transitive closure. We study the relationship between paths
	with a designated root vertex and paths without such a vertex. Since
	we stay in first-order logic this development helps with mechanising
	proofs. To demonstrate the applicability of the algebraic framework we
	verify the correctness of three basic graph algorithms.

	[Amicable_Numbers]
	title = Amicable Numbers
	author = Angeliki Koutsoukou-Argyraki <https://www.cl.cam.ac.uk/~ak2110/>
	topic = Mathematics/Number theory
	date = 2020-08-04
	notify = ak2110@cam.ac.uk
	abstract =
	This is a formalisation of Amicable Numbers, involving some relevant
	material including Euler's sigma function, some relevant
	definitions, results and examples as well as rules such as
	Thābit ibn Qurra's Rule, Euler's Rule, te
	Riele's Rule and Borho's Rule with breeders.

	[Ordinal_Partitions]
	title = Ordinal Partitions
	author = Lawrence C. Paulson <https://www.cl.cam.ac.uk/~lp15/>
	topic = Mathematics/Combinatorics, Logic/Set theory
	date = 2020-08-03
	notify = lp15@cam.ac.uk
	abstract =
	The theory of partition relations concerns generalisations of
	Ramsey's theorem. For any ordinal $\alpha$, write $\alpha \to
	(\alpha, m)^2$ if for each function $f$ from unordered pairs of
	elements of $\alpha$ into $\{0,1\}$, either there is a subset
	$X\subseteq \alpha$ order-isomorphic to $\alpha$ such that
	$f\{x,y\}=0$ for all $\{x,y\}\subseteq X$, or there is an $m$ element
	set $Y\subseteq \alpha$ such that $f\{x,y\}=1$ for all
	$\{x,y\}\subseteq Y$. (In both cases, with $\{x,y\}$ we require
	$x\not=y$.) In particular, the infinite Ramsey theorem can be written
	in this notation as $\omega \to (\omega, \omega)^2$, or if we
	restrict $m$ to the positive integers as above, then $\omega \to
	(\omega, m)^2$ for all $m$. This entry formalises Larson's proof
	of $\omega^\omega \to (\omega^\omega, m)^2$ along with a similar proof
	of a result due to Specker: $\omega^2 \to (\omega^2, m)^2$. Also
	proved is a necessary result by Erdős and Milner:
	$\omega^{1+\alpha\cdot n} \to (\omega^{1+\alpha}, 2^n)^2$.

	[Relational_Disjoint_Set_Forests]
	title = Relational Disjoint-Set Forests
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>
	topic = Computer science/Data structures
	date = 2020-08-26
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We give a simple relation-algebraic semantics of read and write
	operations on associative arrays. The array operations seamlessly
	integrate with assignments in the Hoare-logic library. Using relation
	algebras and Kleene algebras we verify the correctness of an
	array-based implementation of disjoint-set forests with a naive union
	operation and a find operation with path compression.

	[PAC_Checker]
	title = Practical Algebraic Calculus Checker
	author = Mathias Fleury <http://fmv.jku.at/fleury>, Daniela Kaufmann <http://fmv.jku.at/kaufmann>
	topic = Computer science/Algorithms
	date = 2020-08-31
	notify = mathias.fleury@jku.at
	abstract =
	Generating and checking proof certificates is important to increase
	the trust in automated reasoning tools. In recent years formal
	verification using computer algebra became more important and is
	heavily used in automated circuit verification. An existing proof
	format which covers algebraic reasoning and allows efficient proof
	checking is the practical algebraic calculus (PAC). In this
	development, we present the verified checker Pastèque that is obtained
	by synthesis via the Refinement Framework. This is the formalization
	going with our FMCAD'20 tool presentation.

	[BirdKMP]
	title = Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching
	author = Peter Gammie <http://peteg.org>
	topic = Computer science/Functional programming
	date = 2020-08-25
	notify = peteg42@gmail.com
	abstract =
	Richard Bird and collaborators have proposed a derivation of an
	intricate cyclic program that implements the Morris-Pratt string
	matching algorithm. Here we provide a proof of total correctness for
	Bird's derivation and complete it by adding Knuth's
	optimisation.

	[Extended_Finite_State_Machines]
	title = A Formal Model of Extended Finite State Machines
	author = Michael Foster <mailto:jmafoster1@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk>
	topic = Computer science/Automata and formal languages
	date = 2020-09-07
	notify = jmafoster1@sheffield.ac.uk, adbrucker@0x5f.org
	abstract =
	In this AFP entry, we provide a formalisation of extended finite state
	machines (EFSMs) where models are represented as finite sets of
	transitions between states. EFSMs execute traces to produce observable
	outputs. We also define various simulation and equality metrics for
	EFSMs in terms of traces and prove their strengths in relation to each
	other. Another key contribution is a framework of function definitions
	such that LTL properties can be phrased over EFSMs. Finally, we
	provide a simple example case study in the form of a drinks machine.

	[Extended_Finite_State_Machine_Inference]
	title = Inference of Extended Finite State Machines
	author = Michael Foster <mailto:jmafoster1@sheffield.ac.uk>, Achim D. Brucker <mailto:a.brucker@exeter.ac.uk>, Ramsay G. Taylor <mailto:r.g.taylor@sheffield.ac.uk>, John Derrick <mailto:j.derrick@sheffield.ac.uk>
	topic = Computer science/Automata and formal languages
	date = 2020-09-07
	notify = jmafoster1@sheffield.ac.uk, adbrucker@0x5f.org
	abstract =
	In this AFP entry, we provide a formal implementation of a
	state-merging technique to infer extended finite state machines
	(EFSMs), complete with output and update functions, from black-box
	traces. In particular, we define the subsumption in context relation
	as a means of determining whether one transition is able to account
	for the behaviour of another. Building on this, we define the direct
	subsumption relation, which lifts the subsumption in context relation
	to EFSM level such that we can use it to determine whether it is safe
	to merge a given pair of transitions. Key proofs include the
	conditions necessary for subsumption to occur and that subsumption
	and direct subsumption are preorder relations. We also provide a
	number of different heuristics which can be used to abstract away
	concrete values into registers so that more states and transitions can
	be merged and provide proofs of the various conditions which must hold
	for these abstractions to subsume their ungeneralised counterparts. A
	Code Generator setup to create executable Scala code is also defined.

	[Physical_Quantities]
	title = A Sound Type System for Physical Quantities, Units, and Measurements
	author = Simon Foster <https://www-users.cs.york.ac.uk/~simonf/>, Burkhart Wolff <https://www.lri.fr/~wolff/>
	topic = Mathematics/Physics, Computer science/Programming languages/Type systems
	date = 2020-10-20
	notify = simon.foster@york.ac.uk, wolff@lri.fr
	abstract =
	The present Isabelle theory builds a formal model for both the
	International System of Quantities (ISQ) and the International System
	of Units (SI), which are both fundamental for physics and engineering.
	Both the ISQ and the SI are deeply integrated into Isabelle's
	type system. Quantities are parameterised by dimension types, which
	correspond to base vectors, and thus only quantities of the same
	dimension can be equated. Since the underlying "algebra of
	quantities" induces congruences on quantity and SI types,
	specific tactic support is developed to capture these. Our
	construction is validated by a test-set of known equivalences between
	both quantities and SI units. Moreover, the presented theory can be
	used for type-safe conversions between the SI system and others, like
	the British Imperial System (BIS).

	[Shadow_DOM]
	title = A Formal Model of the Document Object Model with Shadow Roots
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	In this AFP entry, we extend our formalization of the core DOM with
	Shadow Roots. Shadow roots are a recent proposal of the web community
	to support a component-based development approach for client-side web
	applications. Shadow roots are a significant extension to the DOM
	standard and, as web standards are condemned to be backward
	compatible, such extensions often result in complex specification that
	may contain unwanted subtleties that can be detected by a
	formalization. Our Isabelle/HOL formalization is, in the sense of
	object-orientation, an extension of our formalization of the core DOM
	and enjoys the same basic properties, i.e., it is extensible, i.e.,
	can be extended without the need of re-proving already proven
	properties and executable, i.e., we can generate executable code from
	our specification. We exploit the executability to show that our
	formalization complies to the official standard of the W3C,
	respectively, the WHATWG.

	[DOM_Components]
	title = A Formalization of Web Components
	author = Achim D. Brucker <https://www.brucker.ch>, Michael Herzberg <http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg>
	topic = Computer science/Data structures
	date = 2020-09-28
	notify = adbrucker@0x5f.org, mail@michael-herzberg.de
	abstract =
	While the DOM with shadow trees provide the technical basis for
	defining web components, the DOM standard neither defines the concept
	of web components nor specifies the safety properties that web
	components should guarantee. Consequently, the standard also does not
	discuss how or even if the methods for modifying the DOM respect
	component boundaries. In AFP entry, we present a formally verified
	model of web components and define safety properties which ensure that
	different web components can only interact with each other using
	well-defined interfaces. Moreover, our verification of the application
	programming interface (API) of the DOM revealed numerous invariants
	that implementations of the DOM API need to preserve to ensure the
	integrity of components.

	[Interpreter_Optimizations]
	title = Inline Caching and Unboxing Optimization for Interpreters
	author = Martin Desharnais <https://martin.desharnais.me>
	topic = Computer science/Programming languages/Misc
	date = 2020-12-07
	notify = martin.desharnais@unibw.de
	abstract =
	This Isabelle/HOL formalization builds on the
	<em>VeriComp</em> entry of the <em>Archive of Formal
	Proofs</em> to provide the following contributions: <ul>
	<li>an operational semantics for a realistic virtual machine
	(Std) for dynamically typed programming languages;</li>
	<li>the formalization of an inline caching optimization (Inca),
	a proof of bisimulation with (Std), and a compilation
	function;</li> <li>the formalization of an unboxing
	optimization (Ubx), a proof of bisimulation with (Inca), and a simple
	compilation function.</li> </ul> This formalization was
	described in the CPP 2021 paper <em>Towards Efficient and
	Verified Virtual Machines for Dynamic Languages</em>

	[Isabelle_Marries_Dirac]
	title = Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information
	-author = Anthony Bordg <mailto:apdb3@cam.ac.uk>, Hanna Lachnitt<mailto:lachnitt@stanford.edu>, Yijun He<mailto:yh403@cam.ac.uk>
	+author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>, Hanna Lachnitt<mailto:lachnitt@stanford.edu>, Yijun He<mailto:yh403@cam.ac.uk>
	topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information
	date = 2020-11-22
	notify = apdb3@cam.ac.uk, lachnitt@stanford.edu
	abstract =
	This work is an effort to formalise some quantum algorithms and
	results in quantum information theory. Formal methods being critical
	for the safety and security of algorithms and protocols, we foresee
	their widespread use for quantum computing in the future. We have
	developed a large library for quantum computing in Isabelle based on a
	matrix representation for quantum circuits, successfully formalising
	the no-cloning theorem, quantum teleportation, Deutsch's
	algorithm, the Deutsch-Jozsa algorithm and the quantum Prisoner's
	Dilemma.

	[Projective_Measurements]
	title = Quantum projective measurements and the CHSH inequality
	author = Mnacho Echenim <https://lig-membres.imag.fr/mechenim/>
	topic = Computer science/Algorithms/Quantum computing, Mathematics/Physics/Quantum information
	date = 2021-03-03
	notify = mnacho.echenim@univ-grenoble-alpes.fr
	abstract =
	This work contains a formalization of quantum projective measurements,
	also known as von Neumann measurements, which are based on elements of
	spectral theory. We also formalized the CHSH inequality, an inequality
	involving expectations in a probability space that is violated by
	quantum measurements, thus proving that quantum mechanics cannot be modeled with an underlying local hidden-variable theory.

	[Finite-Map-Extras]
	title = Finite Map Extras
	author = Javier Díaz <mailto:javier.diaz.manzi@gmail.com>
	topic = Computer science/Data structures
	date = 2020-10-12
	notify = javier.diaz.manzi@gmail.com
	abstract =
	This entry includes useful syntactic sugar, new operators and functions, and
	their associated lemmas for finite maps which currently are not
	present in the standard Finite_Map theory.

	[Relational_Minimum_Spanning_Trees]
	title = Relational Minimum Spanning Tree Algorithms
	author = Walter Guttmann <http://www.cosc.canterbury.ac.nz/walter.guttmann/>, Nicolas Robinson-O'Brien<>
	topic = Computer science/Algorithms/Graph
	date = 2020-12-08
	notify = walter.guttmann@canterbury.ac.nz
	abstract =
	We verify the correctness of Prim's, Kruskal's and
	Borůvka's minimum spanning tree algorithms based on algebras for
	aggregation and minimisation.

	[Topological_Semantics]
	title = Topological semantics for paraconsistent and paracomplete logics
	author = David Fuenmayor <mailto:davfuenmayor@gmail.com>
	topic = Logic/General logic
	date = 2020-12-17
	notify = davfuenmayor@gmail.com
	abstract =
	We introduce a generalized topological semantics for paraconsistent
	and paracomplete logics by drawing upon early works on topological
	Boolean algebras (cf. works by Kuratowski, Zarycki, McKinsey &
	Tarski, etc.). In particular, this work exemplarily illustrates the
	shallow semantical embeddings approach (<a
	href="http://dx.doi.org/10.1007/s11787-012-0052-y">SSE</a>)
	employing the proof assistant Isabelle/HOL. By means of the SSE
	technique we can effectively harness theorem provers, model finders
	and 'hammers' for reasoning with quantified non-classical
	logics.

	[CSP_RefTK]
	title = The HOL-CSP Refinement Toolkit
	author = Safouan Taha <mailto:safouan.taha@lri.fr>, Burkhart Wolff <https://www.lri.fr/~wolff/>, Lina Ye <mailto:lina.ye@lri.fr>
	topic = Computer science/Concurrency/Process calculi, Computer science/Semantics
	date = 2020-11-19
	notify = wolff@lri.fr
	abstract =
	We use a formal development for CSP, called HOL-CSP2.0, to analyse a
	family of refinement notions, comprising classic and new ones. This
	analysis enables to derive a number of properties that allow to deepen
	the understanding of these notions, in particular with respect to
	specification decomposition principles for the case of infinite sets
	of events. The established relations between the refinement relations
	help to clarify some obscure points in the CSP literature, but also
	provide a weapon for shorter refinement proofs. Furthermore, we
	provide a framework for state-normalisation allowing to formally
	reason on parameterised process architectures. As a result, we have a
	modern environment for formal proofs of concurrent systems that allow
	for the combination of general infinite processes with locally finite
	ones in a logically safe way. We demonstrate these
	verification-techniques for classical, generalised examples: The
	CopyBuffer for arbitrary data and the Dijkstra's Dining
	Philosopher Problem of arbitrary size.

	[Hood_Melville_Queue]
	title = Hood-Melville Queue
	author = Alejandro Gómez-Londoño<mailto:alejandro.gomez@chalmers.se>
	topic = Computer science/Data structures
	date = 2021-01-18
	notify = nipkow@in.tum.de
	abstract =
	This is a verified implementation of a constant time queue. The
	original design is due to <a
	href="https://doi.org/10.1016/0020-0190(81)90030-2">Hood
	and Melville</a>. This formalization follows the presentation in
	<em>Purely Functional Data Structures</em>by Okasaki.

	[JinjaDCI]
	title = JinjaDCI: a Java semantics with dynamic class initialization
	author = Susannah Mansky <mailto:sjohnsn2@illinois.edu>
	topic = Computer science/Programming languages/Language definitions
	date = 2021-01-11
	notify = sjohnsn2@illinois.edu, susannahej@gmail.com
	abstract =
	We extend Jinja to include static fields, methods, and instructions,
	and dynamic class initialization, based on the Java SE 8
	specification. This includes extension of definitions and proofs. This
	work is partially described in Mansky and Gunter's paper at CPP
	2019 and Mansky's doctoral thesis (UIUC, 2020).

	[Blue_Eyes]
	title = Solution to the xkcd Blue Eyes puzzle
	author = Jakub Kądziołka <mailto:kuba@kadziolka.net>
	topic = Logic/General logic/Logics of knowledge and belief
	date = 2021-01-30
	notify = kuba@kadziolka.net
	abstract =
	In a <a href="https://xkcd.com/blue_eyes.html">puzzle published by
	Randall Munroe</a>, perfect logicians forbidden
	from communicating are stranded on an island, and may only leave once
	they have figured out their own eye color. We present a method of
	modeling the behavior of perfect logicians and formalize a solution of
	the puzzle.

	[Laws_of_Large_Numbers]
	title = The Laws of Large Numbers
	author = Manuel Eberl <https://www21.in.tum.de/~eberlm>
	topic = Mathematics/Probability theory
	date = 2021-02-10
	notify = eberlm@in.tum.de
	abstract =
	<p>The Law of Large Numbers states that, informally, if one
	performs a random experiment $X$ many times and takes the average of
	the results, that average will be very close to the expected value
	$E[X]$.</p> <p> More formally, let
	$(X_i)_{i\in\mathbb{N}}$ be a sequence of independently identically
	distributed random variables whose expected value $E[X_1]$ exists.
	Denote the running average of $X_1, \ldots, X_n$ as $\overline{X}_n$.
	Then:</p> <ul> <li>The Weak Law of Large Numbers
	states that $\overline{X}_{n} \longrightarrow E[X_1]$ in probability
	for $n\to\infty$, i.e. $\mathcal{P}(\|\overline{X}_{n} - E[X_1]\| >
	\varepsilon) \longrightarrow 0$ as $n\to\infty$ for any $\varepsilon
	> 0$.</li> <li>The Strong Law of Large Numbers states
	that $\overline{X}_{n} \longrightarrow E[X_1]$ almost surely for
	$n\to\infty$, i.e. $\mathcal{P}(\overline{X}_{n} \longrightarrow
	E[X_1]) = 1$.</li> </ul> <p>In this entry, I
	formally prove the strong law and from it the weak law. The approach
	used for the proof of the strong law is a particularly quick and slick
	one based on ergodic theory, which was formalised by Gouëzel in
	another AFP entry.</p>

	[BTree]
	title = A Verified Imperative Implementation of B-Trees
	author = Niels Mündler <mailto:n.muendler@tum.de>
	topic = Computer science/Data structures
	date = 2021-02-24
	notify = n.muendler@tum.de
	abstract =
	In this work, we use the interactive theorem prover Isabelle/HOL to
	verify an imperative implementation of the classical B-tree data
	structure invented by Bayer and McCreight [ACM 1970]. The
	implementation supports set membership, insertion and deletion queries with
	efficient binary search for intra-node navigation. This is
	accomplished by first specifying the structure abstractly in the
	functional modeling language HOL and proving functional correctness.
	Using manual refinement, we derive an imperative implementation in
	Imperative/HOL. We show the validity of this refinement using the
	separation logic utilities from the <a
	href="https://www.isa-afp.org/entries/Refine_Imperative_HOL.html">
	Isabelle Refinement Framework </a> . The code can be exported to
	the programming languages SML, OCaml and Scala. We examine the runtime of all
	operations indirectly by reproducing results of the logarithmic
	relationship between height and the number of nodes. The results are
	discussed in greater detail in the corresponding <a
	href="https://mediatum.ub.tum.de/1596550">Bachelor's
	Thesis</a>.
	extra-history =
	Change history:
	[2021-05-02]:
	Add implementation and proof of correctness of imperative deletion operations.
	Further add the option to export code to OCaml.
	<br>

	[Sunflowers]
	title = The Sunflower Lemma of Erdős and Rado
	author = René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Mathematics/Combinatorics
	date = 2021-02-25
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We formally define sunflowers and provide a formalization of the
	sunflower lemma of Erd&odblac;s and Rado: whenever a set of
	size-<i>k</i>-sets has a larger cardinality than
	<i>(r - 1)<sup>k</sup> · k!</i>,
	then it contains a sunflower of cardinality <i>r</i>.

	[Mereology]
	title = Mereology
	author = Ben Blumson <https://philpeople.org/profiles/ben-blumson>
	topic = Logic/Philosophical aspects
	date = 2021-03-01
	notify = benblumson@gmail.com
	abstract =
	We use Isabelle/HOL to verify elementary theorems and alternative
	axiomatizations of classical extensional mereology.

	[Modular_arithmetic_LLL_and_HNF_algorithms]
	title = Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation
	author = Ralph Bottesch <>, Jose Divasón <https://www.unirioja.es/cu/jodivaso/>, René Thiemann <mailto:rene.thiemann@uibk.ac.at>
	topic = Computer science/Algorithms/Mathematical
	date = 2021-03-12
	notify = rene.thiemann@uibk.ac.at
	abstract =
	We verify two algorithms for which modular arithmetic plays an
	essential role: Storjohann's variant of the LLL lattice basis
	reduction algorithm and Kopparty's algorithm for computing the
	Hermite normal form of a matrix. To do this, we also formalize some
	facts about the modulo operation with symmetric range. Our
	implementations are based on the original papers, but are otherwise
	efficient. For basis reduction we formalize two versions: one that
	includes all of the optimizations/heuristics from Storjohann's
	paper, and one excluding a heuristic that we observed to often
	decrease efficiency. We also provide a fast, self-contained certifier
	for basis reduction, based on the efficient Hermite normal form
	algorithm.

	[Constructive_Cryptography_CM]
	title = Constructive Cryptography in HOL: the Communication Modeling Aspect
	author = Andreas Lochbihler <http://www.andreas-lochbihler.de>, S. Reza Sefidgar <>
	topic = Computer science/Security/Cryptography, Mathematics/Probability theory
	date = 2021-03-17
	notify = mail@andreas-lochbihler.de, reza.sefidgar@inf.ethz.ch
	-abstract =
	+abstract =
	Constructive Cryptography (CC) [<a
	href="https://conference.iiis.tsinghua.edu.cn/ICS2011/content/papers/14.html">ICS
	2011</a>, <a
	href="https://doi.org/10.1007/978-3-642-27375-9_3">TOSCA
	2011</a>, <a
	href="https://doi.org/10.1007/978-3-662-53641-4_1">TCC
	2016</a>] introduces an abstract approach to composable security
	statements that allows one to focus on a particular aspect of security
	proofs at a time. Instead of proving the properties of concrete
	systems, CC studies system classes, i.e., the shared behavior of
	similar systems, and their transformations. Modeling of systems
	communication plays a crucial role in composability and reusability of
	security statements; yet, this aspect has not been studied in any of
	the existing CC results. We extend our previous CC formalization
	[<a href="https://isa-afp.org/entries/Constructive_Cryptography.html">Constructive_Cryptography</a>,
	<a href="https://doi.org/10.1109/CSF.2019.00018">CSF
	2019</a>] with a new semantic domain called Fused Resource
	Templates (FRT) that abstracts over the systems communication patterns
	in CC proofs. This widens the scope of cryptography proof
	formalizations in the CryptHOL library [<a
	href="https://isa-afp.org/entries/CryptHOL.html">CryptHOL</a>,
	<a
	href="https://doi.org/10.1007/978-3-662-49498-1_20">ESOP
	2016</a>, <a
	href="https://doi.org/10.1007/s00145-019-09341-z">J
	Cryptol 2020</a>]. This formalization is described in <a
	href="http://www.andreas-lochbihler.de/pub/basin2021.pdf">Abstract
	Modeling of Systems Communication in Constructive Cryptography using
	CryptHOL</a>.

	-
	+[IFC_Tracking]
	+title = Information Flow Control via Dependency Tracking
	+author = Benedikt Nordhoff <mailto:b.n@wwu.de>
	+topic = Computer science/Security
	+date = 2021-04-01
	+notify = b.n@wwu.de
	+abstract =
	+ We provide a characterisation of how information is propagated by
	+ program executions based on the tracking data and control dependencies
	+ within executions themselves. The characterisation might be used for
	+ deriving approximative safety properties to be targeted by static
	+ analyses or checked at runtime. We utilise a simple yet versatile
	+ control flow graph model as a program representation. As our model is
	+ not assumed to be finite it can be instantiated for a broad class of
	+ programs. The targeted security property is indistinguishable
	+ security where executions produce sequences of observations and only
	+ non-terminating executions are allowed to drop a tail of those. A
	+ very crude approximation of our characterisation is slicing based on
	+ program dependence graphs, which we use as a minimal example and
	+ derive a corresponding soundness result. For further details and
	+ applications refer to the authors upcoming dissertation.
	+
	+[Grothendieck_Schemes]
	+title = Grothendieck's Schemes in Algebraic Geometry
	+author = Anthony Bordg <https://sites.google.com/site/anthonybordg/>, Lawrence Paulson <https://www.cl.cam.ac.uk/~lp15/>, Wenda Li <https://www.cl.cam.ac.uk/~wl302/>
	+topic = Mathematics/Algebra, Mathematics/Geometry
	+date = 2021-03-29
	+notify = apdb3@cam.ac.uk, lp15@cam.ac.uk
	+abstract =
	+ We formalize mainstream structures in algebraic geometry culminating
	+ in Grothendieck's schemes: presheaves of rings, sheaves of rings,
	+ ringed spaces, locally ringed spaces, affine schemes and schemes. We
	+ prove that the spectrum of a ring is a locally ringed space, hence an
	+ affine scheme. Finally, we prove that any affine scheme is a scheme.
	+
	+[Progress_Tracking]
	+title = Formalization of Timely Dataflow's Progress Tracking Protocol
	+author = Matthias Brun<>, Sára Decova<>, Andrea Lattuada<https://andrea.lattuada.me>, Dmitriy Traytel <https://traytel.bitbucket.io/>
	+topic = Computer science/Algorithms/Distributed
	+date = 2021-04-13
	+notify = matthias.brun@inf.ethz.ch, traytel@di.ku.dk
	+abstract =
	+ Large-scale stream processing systems often follow the dataflow
	+ paradigm, which enforces a program structure that exposes a high
	+ degree of parallelism. The Timely Dataflow distributed system supports
	+ expressive cyclic dataflows for which it offers low-latency data- and
	+ pipeline-parallel stream processing. To achieve high expressiveness
	+ and performance, Timely Dataflow uses an intricate distributed
	+ protocol for tracking the computation’s progress. We formalize this
	+ progress tracking protocol and verify its safety. Our formalization is
	+ described in detail in our forthcoming <a
	+ href="https://traytel.bitbucket.io/papers/itp21-progress_tracking/safe.pdf">ITP'21
	+ paper</a>.
	+
	+[GaleStewart_Games]
	+title = Gale-Stewart Games
	+author = Sebastiaan Joosten <https://sjcjoosten.nl>
	+topic = Mathematics/Games and economics
	+date = 2021-04-23
	+notify = sjcjoosten@gmail.com
	+abstract =
	+ This is a formalisation of the main result of Gale and Stewart from
	+ 1953, showing that closed finite games are determined. This property
	+ is now known as the Gale Stewart Theorem. While the original paper
	+ shows some additional theorems as well, we only formalize this main
	+ result, but do so in a somewhat general way. We formalize games of a
	+ fixed arbitrary length, including infinite length, using co-inductive
	+ lists, and show that defensive strategies exist unless the other
	+ player is winning. For closed games, defensive strategies are winning
	+ for the closed player, proving that such games are determined. For
	+ finite games, which are a special case in our formalisation, all games
	+ are closed.
	+
	+[Metalogic_ProofChecker]
	+title = Isabelle's Metalogic: Formalization and Proof Checker
	+author = Tobias Nipkow <http://www21.in.tum.de/~nipkow>, Simon Roßkopf <http://www21.in.tum.de/~rosskops>
	+topic = Logic/General logic
	+date = 2021-04-27
	+notify = rosskops@in.tum.de
	+abstract =
	+ In this entry we formalize Isabelle's metalogic in Isabelle/HOL.
	+ Furthermore, we define a language of proof terms and an executable
	+ proof checker and prove its soundness wrt. the metalogic. The
	+ formalization is intentionally kept close to the Isabelle
	+ implementation(for example using de Brujin indices) to enable easy
	+ integration of generated code with the Isabelle system without a
	+ complicated translation layer. The formalization is described in our
	+ <a href="https://arxiv.org/pdf/2104.12224.pdf">CADE 28 paper</a>.
	+
	+[Regression_Test_Selection]
	+title = Regression Test Selection
	+author = Susannah Mansky <mailto:sjohnsn2@illinois.edu>
	+topic = Computer science/Algorithms
	+date = 2021-04-30
	+notify = sjohnsn2@illinois.edu, susannahej@gmail.com
	+abstract =
	+ This development provides a general definition for safe Regression
	+ Test Selection (RTS) algorithms. RTS algorithms select which tests to
	+ rerun on revised code, reducing the time required to check for newly
	+ introduced errors. An RTS algorithm is considered safe if and only if
	+ all deselected tests would have unchanged results. This definition is
	+ instantiated with two class-collection-based RTS algorithms run over
	+ the JVM as modeled by JinjaDCI. This is achieved with a general
	+ definition for Collection Semantics, small-step semantics instrumented
	+ to collect information during execution. As the RTS definition
	+ mandates safety, these instantiations include proofs of safety. This
	+ work is described in Mansky and Gunter's LSFA 2020 paper and
	+ Mansky's doctoral thesis (UIUC, 2020).
	+
	+[Padic_Ints]
	+title = Hensel's Lemma for the p-adic Integers
	+author = Aaron Crighton <mailto:crightoa@mcmaster.ca>
	+topic = Mathematics/Number theory
	+date = 2021-03-23
	+notify = crightoa@mcmaster.ca
	+abstract =
	+ We formalize the ring of <em>p</em>-adic integers within the framework of the
	+ HOL-Algebra library. The carrier of the ring is formalized as the
	+ inverse limit of quotients of the integers by powers of a fixed prime
	+ <em>p</em>. We define an integer-valued valuation, as well as an
	+ extended-integer valued valuation which sends 0 to the infinite
	+ element. Basic topological facts about the <em>p</em>-adic integers are
	+ formalized, including completeness and sequential compactness. Taylor
	+ expansions of polynomials over a commutative ring are defined,
	+ culminating in the formalization of Hensel's Lemma based on a
	+ proof due to Keith Conrad.
	+
	+
	diff --git a/metadata/templates/about.tpl b/metadata/templates/about.tpl
	--- a/metadata/templates/about.tpl
	+++ b/metadata/templates/about.tpl
	@@ -1,78 +1,78 @@
	{% extends "base.tpl" %}

	{% block headline %}
	<font class="first">A</font>rchive of
	<font class="first">F</font>ormal
	<font class="first">P</font>roofs</h1>
	{% endblock %}

	{% block content %}
	<table width="80%" class="descr">
	<tbody>
	<tr><td>

	<h2>About</h2>
	<p>The Archive of Formal Proofs is a collection of proof libraries, examples,
	and larger scientific developments, mechanically checked in the theorem prover
	<a href="http://isabelle.in.tum.de/">Isabelle</a>. It is organized in the way
	of a scientific journal. <a href="submitting.html">Submissions</a> are
	refereed.</p>

	<p>The archive repository is hosted on <a href="https://foss.heptapod.net/isa-afp/">Heptapod</a> to
	provide easy free access to archive entries. The entries are
	tested and maintained continuously against the current stable release of
	Isabelle. Older versions of archive entries will remain available.</p>

	<h2>Editors</h2>
	<p><a name="editors">The editors of the archive are</a></p>
	<ul>
	<li><a href="http://www.in.tum.de/~eberlm/">Manuel Eberl</a>,
	<a href="http://www.tum.de/">Technische Universität München</a></li>
	<li><a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>,
	- <a href="http://www.data61.csiro.au">Data61</a></li>
	+ <a href="https://proofcraft.systems">Proofcraft</a> & <a href="https://unsw.edu.au">UNSW</a></li>
	<li><a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>,
	<a href="https://www.digitalasset.com">Digital Asset</a></li>
	<li><a href="http://www.in.tum.de/~nipkow/">Tobias Nipkow</a>,
	<a href="http://www.tum.de/">Technische Universität München</a></li>
	<li><a href="http://www.cl.cam.ac.uk/users/lcp/">Larry Paulson</a>,
	<a href="http://www.cam.ac.uk/">University of Cambridge</a></li>
	<li><a href="http://cl-informatik.uibk.ac.at/users/thiemann/">René Thiemann</a>,
	<a href="https://www.uibk.ac.at/">University of Innsbruck</a></li>
	</ul>

	<h2>Why</h2>
	<p>We aim to strengthen the community and to foster the development of formal
	proofs.</p>

	<p>We hope that the archive will provide</p>
	<ul>
	<li>a resource of knowledge, examples, and libraries for users,</li>
	<li>a large and relevant test bed of theories for Isabelle developers, and</li>
	<li>a central, citable place for authors to publish their theories</li>
	</ul>

	<p>We encourage authors of publications that contain Isabelle developments
	to make their theories available in the Archive of Formal Proofs and to refer
	to the archive entry in their publication. It makes it easier for referees to
	check the validity of theorems (all entries in the archive are
	mechanically checked), it makes it easier for readers of the publication to
	understand details of your development, and it makes it easier to use and
	build on your work.</p>

	<h2>License</h2>
	<p>All entries in the Archive of Formal Proofs are licensed under
	a <a href="LICENSE">BSD-style License</a> or
	the <a href="http://www.gnu.org/copyleft/lesser.html">GNU LGPL</a>.
	This means they are free to download, free to use, free to change, and
	free to redistribute with minimal restrictions.</p>

	<p>The authors retain their full copyright on their original work,
	including their right to make the development available under another,
	additional license in the future.</p>


	</td></tr>
	</tbody>
	</table>
	{% endblock %}

	diff --git a/metadata/templates/using.tpl b/metadata/templates/using.tpl
	--- a/metadata/templates/using.tpl
	+++ b/metadata/templates/using.tpl
	@@ -1,58 +1,58 @@
	{% extends "base.tpl" %}

	{% block headline %}
	<font class="first">R</font>eferring to
	<font class="first">A</font>FP
	<font class="first">E</font>ntries
	{% endblock %}

	{% block content %}
	<table width="80%" class="descr">
	<tbody>
	<tr><td>

	<p>
	Once you have downloaded the AFP, you can include its articles and theories in
	your own developments. If you would like to make your work available to others
	<i>without</i> having to include the AFP articles you depend on, here is how to do it.
	</p>
	<p>
	-If you are using Isabelle2021, and have downloaded your AFP directory to
	-<code>/home/myself/afp</code>, for Linux/Mac you can run the following command to make the AFP session ROOTS available to Isabelle:</p>
	+From Isabelle2021 on, the recommended method for making the whole AFP available to Isabelle
	+is the <code>isabelle components -u</code> command.
	+</p>
	+
	+<h2>Linux/Mac</h2>
	<p>
	+Assuming you have downloaded and unzipped the afp to <code>/home/myself/afp</code>, run
	+</p>
	<pre class="code">
	- echo "/home/myself/afp/thys" >> ~/.isabelle/Isabelle2021/ROOTS
	+ isabelle components -u /home/myself/afp
	</pre>
	-This adds the path <code>/home/myself/afp/thys/</code> to the ROOTS file, which
	-Isabelle will scan by default. You can also manually edit and/or create that
	-ROOTS file. There are many other ways to achieve the same outcome, this is just
	-one option.
	-</p>
	+
	+<h2>Windows</h2>
	<p>
	-For Windows, the idea is the same just the path is slightly different. If the
	-AFP is in <code>C:\afp</code>, you should be able to run the following in a
	-Cygwin terminal.
	+If the AFP is in <code>C:\afp</code>, run the following command in a Cygwin terminal:
	<pre class="code">
	- echo "/cygdrive/c/afp/thys" >> ~/.isabelle/Isabelle2021/ROOTS
	+ isabelle components -u /cygdrive/c/afp
	</pre>
	</p>

	+<h2>Use</h2>
	<p>
	-You can now refer to article <code>ABC</code> from the AFP in some theory of
	-yours via</p>
	+You can now refer to article <code>ABC</code> from the AFP in another theory via</p>

	<pre class="code">
	imports "ABC.Some_ABC_Theory"
	</pre>

	<p>This allows you to distribute your material separately from any AFP
	theories. Users of your distribution also need to install the AFP in the above
	manner.</p>

	<p> </p>

	</td></tr>
	</tbody>
	</table>
	{% endblock %}

	diff --git a/thys/BenOr_Kozen_Reif/BKR_Algorithm.thy b/thys/BenOr_Kozen_Reif/BKR_Algorithm.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/BKR_Algorithm.thy
	@@ -0,0 +1,146 @@
	+theory BKR_Algorithm
	+ imports
	+ "More_Matrix"
	+ "Sturm_Tarski.Sturm_Tarski"
	+begin
	+
	+section "Setup"
	+
	+definition retrieve_polys:: "real poly list \<Rightarrow> nat list \<Rightarrow> real poly list"
	+ where "retrieve_polys qss index_list = (map (nth qss) index_list)"
	+
	+definition construct_NofI:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat"
	+ where "construct_NofI p I = rat_of_int (changes_R_smods p ((pderiv p)*(prod_list I)))"
	+
	+definition construct_rhs_vector:: "real poly \<Rightarrow> real poly list \<Rightarrow> nat list list \<Rightarrow> rat vec"
	+ where "construct_rhs_vector p qs Is = vec_of_list (map (\<lambda> I.(construct_NofI p (retrieve_polys qs I))) Is)"
	+
	+section "Base Case"
	+
	+definition base_case_info:: "(rat mat \<times> (nat list list \<times> rat list list))"
	+ where "base_case_info =
	+ ((mat_of_rows_list 2 [[1,1], [1,-1]]), ([[],[0]], [[1],[-1]]))"
	+
	+(* When p, q are coprime, this will actually be an int vec, which is why taking the floor is okay *)
	+definition base_case_solve_for_lhs:: "real poly \<Rightarrow> real poly \<Rightarrow> rat vec"
	+ where "base_case_solve_for_lhs p q = (mult_mat_vec (mat_of_rows_list 2 [[1/2, 1/2], [1/2, -1/2]]) (construct_rhs_vector p [q] [[], [0]]))"
	+
	+thm "gauss_jordan_compute_inverse"
	+
	+primrec matr_option:: "nat \<Rightarrow> 'a::{one, zero} mat option \<Rightarrow> 'a mat"
	+ where "matr_option dimen None = 1\<^sub>m dimen"
	+ \| "matr_option dimen (Some c) = c"
	+
	+(* For smooth code export, we want to use a computable notion of matrix equality *)
	+definition mat_equal:: "'a:: field mat \<Rightarrow> 'a :: field mat \<Rightarrow> bool"
	+ where "mat_equal A B = (dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> (mat_to_list A) = (mat_to_list B))"
	+
	+definition mat_inverse_var :: "'a :: field mat \<Rightarrow> 'a mat option" where
	+ "mat_inverse_var A = (if dim_row A = dim_col A then
	+ let one = 1\<^sub>m (dim_row A) in
	+ (case gauss_jordan A one of
	+ (B, C) \<Rightarrow> if (mat_equal B one) then Some C else None) else None)"
	+
	+(* Now solve for LHS in general.
	+ Because mat_inverse returns an option type, we pattern match on this.
	+ Notice that when we call this function in the algorithm, the matrix we pass will always be invertible,
	+ given how the construction works. *)
	+definition solve_for_lhs:: "real poly \<Rightarrow> real poly list \<Rightarrow> nat list list \<Rightarrow> rat mat \<Rightarrow> rat vec"
	+ where "solve_for_lhs p qs subsets matr =
	+ mult_mat_vec (matr_option (dim_row matr) (mat_inverse_var matr)) (construct_rhs_vector p qs subsets)"
	+
	+section "Smashing"
	+
	+definition subsets_smash::"nat \<Rightarrow> nat list list \<Rightarrow> nat list list \<Rightarrow> nat list list"
	+ where "subsets_smash n s1 s2 = concat (map (\<lambda>l1. map (\<lambda> l2. l1 @ (map ((+) n) l2)) s2) s1)"
	+
	+definition signs_smash::"'a list list \<Rightarrow> 'a list list \<Rightarrow> 'a list list"
	+ where "signs_smash s1 s2 = concat (map (\<lambda>l1. map (\<lambda> l2. l1 @ l2) s2) s1)"
	+
	+definition smash_systems:: "real poly \<Rightarrow> real poly list \<Rightarrow> real poly list \<Rightarrow> nat list list \<Rightarrow> nat list list \<Rightarrow>
	+ rat list list \<Rightarrow> rat list list \<Rightarrow> rat mat \<Rightarrow> rat mat \<Rightarrow>
	+ real poly list \<times> (rat mat \<times> (nat list list \<times> rat list list))"
	+ where "smash_systems p qs1 qs2 subsets1 subsets2 signs1 signs2 mat1 mat2 =
	+ (qs1@qs2, (kronecker_product mat1 mat2, (subsets_smash (length qs1) subsets1 subsets2, signs_smash signs1 signs2)))"
	+
	+fun combine_systems:: "real poly \<Rightarrow> (real poly list \<times> (rat mat \<times> (nat list list \<times> rat list list))) \<Rightarrow> (real poly list \<times> (rat mat \<times> (nat list list \<times> rat list list)))
	+ \<Rightarrow> (real poly list \<times> (rat mat \<times> (nat list list \<times> rat list list)))"
	+ where "combine_systems p (qs1, m1, sub1, sgn1) (qs2, m2, sub2, sgn2) =
	+ (smash_systems p qs1 qs2 sub1 sub2 sgn1 sgn2 m1 m2)"
	+
	+(* Overall:
	+ Start with a matrix equation.
	+ Input a matrix, subsets, and signs.
	+ Drop columns of the matrix based on the 0's on the LHS---so extract a list of 0's. Reduce signs accordingly.
	+ Then find a list of rows to delete based on using rank (use the transpose result, pivot positions!),
	+ and delete those rows. Reduce subsets accordingly.
	+ End with a reduced system! *)
	+section "Reduction"
	+definition find_nonzeros_from_input_vec:: "rat vec \<Rightarrow> nat list"
	+ where "find_nonzeros_from_input_vec lhs_vec = filter (\<lambda>i. lhs_vec $ i \<noteq> 0) [0..< dim_vec lhs_vec]"
	+
	+definition take_indices:: "'a list \<Rightarrow> nat list \<Rightarrow> 'a list"
	+ where "take_indices subsets indices = map ((!) subsets) indices"
	+
	+definition take_cols_from_matrix:: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
	+ where "take_cols_from_matrix matr indices_to_keep =
	+ mat_of_cols (dim_row matr) ((take_indices (cols matr) indices_to_keep):: 'a vec list)"
	+
	+definition take_rows_from_matrix:: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
	+ where "take_rows_from_matrix matr indices_to_keep =
	+ mat_of_rows (dim_col matr) ((take_indices (rows matr) indices_to_keep):: 'a vec list)"
	+
	+fun reduce_mat_cols:: "'a mat \<Rightarrow> rat vec \<Rightarrow> 'a mat"
	+ where "reduce_mat_cols A lhs_vec = take_cols_from_matrix A (find_nonzeros_from_input_vec lhs_vec)"
	+
	+(* Find which rows to drop. *)
	+definition rows_to_keep:: "('a::field) mat \<Rightarrow> nat list" where
	+ "rows_to_keep A = map snd (pivot_positions (gauss_jordan_single (A\<^sup>T)))"
	+
	+fun reduction_step:: "rat mat \<Rightarrow> rat list list \<Rightarrow> nat list list \<Rightarrow> rat vec \<Rightarrow> rat mat \<times> (nat list list \<times> rat list list)"
	+ where "reduction_step A signs subsets lhs_vec =
	+ (let reduce_cols_A = (reduce_mat_cols A lhs_vec);
	+ rows_keep = rows_to_keep reduce_cols_A in
	+ (take_rows_from_matrix reduce_cols_A rows_keep,
	+ (take_indices subsets rows_keep,
	+ take_indices signs (find_nonzeros_from_input_vec lhs_vec))))"
	+
	+fun reduce_system:: "real poly \<Rightarrow> (real poly list \<times> (rat mat \<times> (nat list list \<times> rat list list))) \<Rightarrow> (rat mat \<times> (nat list list \<times> rat list list))"
	+ where "reduce_system p (qs,m,subs,signs) =
	+ reduction_step m signs subs (solve_for_lhs p qs subs m)"
	+
	+section "Overall algorithm "
	+ (*
	+ Find the matrix, subsets, signs for an input p and qs.
	+ The "rat mat" in the output is the matrix. The "nat list list" is the list of subsets.
	+ The "rat list list" is the list of signs.
	+
	+ We will want to call this when p is nonzero and when every q in qs is pairwise coprime to p.
	+ Properties of this algorithm are proved in BKR_Proofs.thy.
	+ *)
	+fun calculate_data:: "real poly \<Rightarrow> real poly list \<Rightarrow> (rat mat \<times> (nat list list \<times> rat list list))"
	+ where
	+ "calculate_data p qs =
	+ ( let len = length qs in
	+ if len = 0 then
	+ (\<lambda>(a,b,c).(a,b,map (drop 1) c)) (reduce_system p ([1],base_case_info))
	+ else if len \<le> 1 then reduce_system p (qs,base_case_info)
	+ else
	+ (let q1 = take (len div 2) qs; left = calculate_data p q1;
	+ q2 = drop (len div 2) qs; right = calculate_data p q2;
	+ comb = combine_systems p (q1,left) (q2,right) in
	+ reduce_system p comb
	+ )
	+ )"
	+
	+(* Extract the list of consistent sign assignments *)
	+definition find_consistent_signs_at_roots:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list"
	+ where [code]:
	+ "find_consistent_signs_at_roots p qs =
	+ ( let (M,S,\<Sigma>) = calculate_data p qs in \<Sigma> )"
	+
	+lemma find_consistent_signs_at_roots_thm:
	+ shows "find_consistent_signs_at_roots p qs = snd (snd (calculate_data p qs))"
	+ by (simp add: case_prod_beta find_consistent_signs_at_roots_def)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/BKR_Decision.thy b/thys/BenOr_Kozen_Reif/BKR_Decision.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/BKR_Decision.thy
	@@ -0,0 +1,2034 @@
	+theory BKR_Decision
	+ imports BKR_Algorithm
	+ "Berlekamp_Zassenhaus.Factorize_Rat_Poly"
	+ "Algebraic_Numbers.Real_Roots"
	+ "BKR_Proofs"
	+ "HOL.Deriv"
	+begin
	+
	+section "Algorithm"
	+
	+subsection "Parsing"
	+ (* Formula type *)
	+datatype 'a fml =
	+ And "'a fml" "'a fml"
	+ \| Or "'a fml" "'a fml"
	+ \| Gt 'a (* 'a > 0 *)
	+ \| Geq 'a (* 'a \<ge> 0 *)
	+ \| Lt 'a (* 'a < 0 *)
	+ \| Leq 'a (* 'a \<le> 0 *)
	+ \| Eq 'a (* 'a = 0 *)
	+ \| Neq 'a (* 'a \<noteq> 0 *)
	+
	+(* Evaluating a formula over a lookup semantics where 'a is nat *)
	+primrec lookup_sem :: "nat fml \<Rightarrow> ('a::linordered_field list) \<Rightarrow> bool"
	+ where
	+ "lookup_sem (And l r) ls = (lookup_sem l ls \<and> lookup_sem r ls)"
	+ \| "lookup_sem (Or l r) ls = (lookup_sem l ls \<or> lookup_sem r ls)"
	+ \| "lookup_sem (Gt p) ls = (ls ! p > 0)"
	+ \| "lookup_sem (Geq p) ls = (ls ! p \<ge> 0)"
	+ \| "lookup_sem (Lt p) ls = (ls ! p < 0)"
	+ \| "lookup_sem (Leq p) ls = (ls ! p \<le> 0)"
	+ \| "lookup_sem (Eq p) ls = (ls ! p = 0)"
	+ \| "lookup_sem (Neq p) ls = (ls ! p \<noteq> 0)"
	+
	+(* (compute) all polynomials mentioned in a formula *)
	+primrec poly_list :: "'a fml \<Rightarrow> 'a list"
	+ where
	+ "poly_list (And l r) = poly_list l @ poly_list r"
	+ \| "poly_list (Or l r) = poly_list l @ poly_list r"
	+ \| "poly_list (Gt p) = [p]"
	+ \| "poly_list (Geq p) = [p]"
	+ \| "poly_list (Lt p) = [p]"
	+ \| "poly_list (Leq p) = [p]"
	+ \| "poly_list (Eq p) = [p]"
	+ \| "poly_list (Neq p) = [p]"
	+
	+primrec index_of_aux :: "'a list \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> nat" where
	+ "index_of_aux [] y n = n"
	+\| "index_of_aux (x#xs) y n =
	+ (if x = y then n else index_of_aux xs y (n+1))"
	+
	+definition index_of :: "'a list \<Rightarrow> 'a \<Rightarrow> nat" where
	+ "index_of xs y = index_of_aux xs y 0"
	+
	+definition convert :: "'a fml \<Rightarrow> (nat fml \<times> 'a list)"
	+ where
	+ "convert fml = (
	+ let ps = remdups (poly_list fml)
	+ in
	+ (map_fml (index_of ps) fml, ps)
	+ )"
	+
	+
	+subsection "Factoring"
	+
	+(* Makes sure the result of factorize_rat_poly is monic *)
	+definition factorize_rat_poly_monic :: "rat poly \<Rightarrow> (rat \<times> (rat poly \<times> nat) list)"
	+ where
	+ "factorize_rat_poly_monic p = (
	+ let (c,fs) = factorize_rat_poly p ;
	+ lcs = prod_list (map (\<lambda>(f,i). (lead_coeff f) ^ Suc i) fs) ;
	+ fs = map (\<lambda>(f,i). (normalize f, i)) fs
	+ in
	+ (c * lcs,fs)
	+ )"
	+
	+(* Factoring an input list of polynomials *)
	+definition factorize_polys :: "rat poly list \<Rightarrow> (rat poly list \<times> (rat \<times> (nat \<times> nat) list) list)"
	+ where
	+ "factorize_polys ps = (
	+ let fact_ps = map factorize_rat_poly_monic ps;
	+ factors = remdups (map fst (concat (map snd fact_ps))) ;
	+ data = map (\<lambda>(c,fs). (c, map (\<lambda>(f,pow). (index_of factors f, pow) ) fs)) fact_ps
	+ in
	+ (factors,data)
	+ )"
	+
	+(* After turning a polynomial into factors,
	+ this turns a sign condition on the factors
	+ into a sign condition for the polynomial *)
	+definition undo_factorize :: "rat \<times> (nat \<times> nat) list \<Rightarrow> rat list \<Rightarrow> rat"
	+ where
	+ "undo_factorize cfs signs =
	+ squash
	+ (case cfs of (c,fs) \<Rightarrow>
	+ (c * prod_list (map (\<lambda>(f,pow). (signs ! f) ^ Suc pow) fs)))
	+ "
	+
	+definition undo_factorize_polys :: "(rat \<times> (nat \<times> nat) list) list \<Rightarrow> rat list \<Rightarrow> rat list"
	+ where
	+ "undo_factorize_polys ls signs = map (\<lambda>l. undo_factorize l signs) ls"
	+
	+subsection "Auxiliary Polynomial"
	+definition crb:: "real poly \<Rightarrow> int" where
	+ "crb p = ceiling (2 + max_list_non_empty (map (\<lambda> i. norm (coeff p i)) [0 ..< degree p])
	+ / norm (lead_coeff p))"
	+
	+(* Because we are using prod_list instead of lcm, it's important that this is called
	+ when ps is pairwise coprime. *)
	+definition coprime_r :: "real poly list \<Rightarrow> real poly"
	+ where
	+ "coprime_r ps = pderiv (prod_list ps) * ([:-(crb (prod_list ps)),1:]) * ([:(crb (prod_list ps)),1:])"
	+
	+
	+subsection "Setting Up the Procedure"
	+ (* 0 indexed *)
	+definition insertAt :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
	+ "insertAt n x ls = take n ls @ x # (drop n ls)"
	+
	+(* 0 indexed *)
	+definition removeAt :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
	+ "removeAt n ls = take n ls @ (drop (n+1) ls)"
	+
	+definition find_sgas_aux:: "real poly list \<Rightarrow> rat list list"
	+ where "find_sgas_aux in_list =
	+ concat (map (\<lambda>i.
	+ map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (in_list ! i) (removeAt i in_list))
	+ ) [0..<length in_list])"
	+
	+(* For an input list of real polynomials, apply BKR to all positions *)
	+definition find_sgas :: "real poly list \<Rightarrow> rat list list"
	+ where
	+ "find_sgas ps = (
	+ let r = coprime_r ps in
	+ find_consistent_signs_at_roots r ps @ find_sgas_aux ps
	+ )"
	+
	+(* Putting the sign condition preprocessing together with BKR *)
	+definition find_consistent_signs :: "rat poly list \<Rightarrow> rat list list"
	+ where
	+ "find_consistent_signs ps = (
	+ let (fs,data) = factorize_polys ps;
	+ sgas = find_sgas (map (map_poly of_rat) fs);
	+ rsgas = map (undo_factorize_polys data) sgas
	+ in
	+ (if fs = [] then [(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) ps)] else rsgas)
	+ )"
	+
	+
	+subsection "Deciding Univariate Problems"
	+definition decide_universal :: "rat poly fml \<Rightarrow> bool"
	+ where [code]:
	+ "decide_universal fml = (
	+ let (fml_struct,polys) = convert fml;
	+ conds = find_consistent_signs polys
	+ in
	+ list_all (lookup_sem fml_struct) conds
	+ )"
	+
	+definition decide_existential :: "rat poly fml \<Rightarrow> bool"
	+ where [code]:
	+ "decide_existential fml = (
	+ let (fml_struct,polys) = convert fml;
	+ conds = find_consistent_signs polys
	+ in
	+ find (lookup_sem fml_struct) conds \<noteq> None
	+ )"
	+
	+section "Proofs"
	+subsection "Parsing and Semantics"
	+ (* Evaluating a formula where 'a is a real poly *)
	+primrec real_sem :: "real poly fml \<Rightarrow> real \<Rightarrow> bool"
	+ where
	+ "real_sem (And l r) x = (real_sem l x \<and> real_sem r x)"
	+ \| "real_sem (Or l r) x = (real_sem l x \<or> real_sem r x)"
	+ \| "real_sem (Gt p) x = (poly p x > 0)"
	+ \| "real_sem (Geq p) x = (poly p x \<ge> 0)"
	+ \| "real_sem (Lt p) x = (poly p x < 0)"
	+ \| "real_sem (Leq p) x = (poly p x \<le> 0)"
	+ \| "real_sem (Eq p) x = (poly p x = 0)"
	+ \| "real_sem (Neq p) x = (poly p x \<noteq> 0)"
	+
	+(* Evaluating a formula where 'a is a rat poly *)
	+primrec fml_sem :: "rat poly fml \<Rightarrow> real \<Rightarrow> bool"
	+ where
	+ "fml_sem (And l r) x = (fml_sem l x \<and> fml_sem r x)"
	+ \| "fml_sem (Or l r) x = (fml_sem l x \<or> fml_sem r x)"
	+ \| "fml_sem (Gt p) x = (rpoly p x > 0)"
	+ \| "fml_sem (Geq p) x = (rpoly p x \<ge> 0)"
	+ \| "fml_sem (Lt p) x = (rpoly p x < 0)"
	+ \| "fml_sem (Leq p) x = (rpoly p x \<le> 0)"
	+ \| "fml_sem (Eq p) x = (rpoly p x = 0)"
	+ \| "fml_sem (Neq p) x = (rpoly p x \<noteq> 0)"
	+
	+lemma poly_list_set_fml:
	+ shows "set (poly_list fml) = set_fml fml"
	+ apply (induction) by auto
	+
	+lemma convert_semantics_lem:
	+ assumes "\<And>p. p \<in> set (poly_list fml) \<Longrightarrow>
	+ ls ! (index_of ps p) = rpoly p x"
	+ shows "fml_sem fml x = lookup_sem (map_fml (index_of ps) fml) ls"
	+ using assms apply (induct fml)
	+ by auto
	+
	+lemma index_of_aux_more:
	+ shows "index_of_aux ls p n \<ge> n"
	+ apply (induct ls arbitrary: n)
	+ apply auto
	+ using Suc_leD by blast
	+
	+lemma index_of_aux_lookup:
	+ assumes "p \<in> set ls"
	+ shows "(index_of_aux ls p n) - n < length ls"
	+ "ls ! ((index_of_aux ls p n) - n) = p"
	+ using assms apply (induct ls arbitrary: n)
	+ apply auto
	+ apply (metis Suc_diff_Suc index_of_aux_more lessI less_Suc_eq_0_disj less_le_trans)
	+ by (metis Suc_diff_Suc index_of_aux_more lessI less_le_trans nth_Cons_Suc)
	+
	+lemma index_of_lookup:
	+ assumes "p \<in> set ls"
	+ shows "index_of ls p < length ls"
	+ "ls ! (index_of ls p) = p"
	+ apply (metis assms index_of_aux_lookup(1) index_of_def minus_nat.diff_0)
	+ by (metis assms index_of_aux_lookup(2) index_of_def minus_nat.diff_0)
	+
	+lemma convert_semantics:
	+ shows "fml_sem fml x = lookup_sem (fst (convert fml)) (map (\<lambda>p. rpoly p x) (snd (convert fml)))"
	+ unfolding convert_def Let_def apply simp
	+ apply (intro convert_semantics_lem)
	+ by (simp add: index_of_lookup(1) index_of_lookup(2))
	+
	+lemma convert_closed:
	+ shows "\<And>i. i \<in> set_fml (fst (convert fml)) \<Longrightarrow> i < length (snd (convert fml))"
	+ unfolding convert_def Let_def
	+ apply (auto simp add: fml.set_map)
	+ by (simp add: index_of_lookup(1) poly_list_set_fml)
	+
	+(* Rational sign vector of polynomials qs with rational coefficients at x *)
	+definition sign_vec::"rat poly list \<Rightarrow> real \<Rightarrow> rat list"
	+ where "sign_vec qs x \<equiv>
	+ map (squash \<circ> (\<lambda>p. rpoly p x)) qs"
	+
	+(* The set of all rational sign vectors for qs wrt the set S
	+ When S = UNIV, then this quantifies over all reals *)
	+definition consistent_sign_vectors::"rat poly list \<Rightarrow> real set \<Rightarrow> rat list set"
	+ where "consistent_sign_vectors qs S = (sign_vec qs) ` S"
	+
	+lemma sign_vec_semantics:
	+ assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length ls"
	+ shows "lookup_sem fml (map (\<lambda>p. rpoly p x) ls) = lookup_sem fml (sign_vec ls x)"
	+ using assms apply (induction)
	+ by (auto simp add: sign_vec_def squash_def)
	+
	+(* The universal and existential decision procedure is easy if we know the consistent sign vectors *)
	+lemma universal_lookup_sem:
	+ assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length qs"
	+ assumes "set signs = consistent_sign_vectors qs UNIV"
	+ shows "(\<forall>x::real. lookup_sem fml (map (\<lambda>p. rpoly p x) qs)) \<longleftrightarrow>
	+ list_all (lookup_sem fml) signs"
	+ using assms(2) unfolding consistent_sign_vectors_def list_all_iff
	+ by (simp add: assms(1) sign_vec_semantics)
	+
	+lemma existential_lookup_sem:
	+ assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length qs"
	+ assumes "set signs = consistent_sign_vectors qs UNIV"
	+ shows "(\<exists>x::real. lookup_sem fml (map (\<lambda>p. rpoly p x) qs)) \<longleftrightarrow>
	+ find (lookup_sem fml) signs \<noteq> None"
	+ using assms(2) unfolding consistent_sign_vectors_def find_None_iff
	+ by (simp add: assms(1) sign_vec_semantics)
	+
	+subsection "Factoring Lemmas"
	+ (*definition real_factorize_list:: "rat poly list \<Rightarrow> real poly list"
	+where "real_factorize_list qs = map (map_poly of_rat) (fst(factorize_polys qs))"
	+*)
	+interpretation of_rat_poly_hom: map_poly_comm_semiring_hom of_rat..
	+interpretation of_rat_poly_hom: map_poly_comm_ring_hom of_rat..
	+interpretation of_rat_poly_hom: map_poly_idom_hom of_rat..
	+
	+lemma finite_prod_map_of_rat_poly_hom:
	+ shows "poly (real_of_rat_poly (\<Prod>(a,b)\<in>s. f a b)) y = (\<Prod>(a,b)\<in>s. poly (real_of_rat_poly (f a b)) y)"
	+ apply (simp add: of_rat_poly_hom.hom_prod poly_prod)
	+ by (simp add: case_prod_app prod.case_distrib)
	+
	+lemma sign_vec_index_of:
	+ assumes "f \<in> set ftrs"
	+ shows "sign_vec ftrs x ! (index_of ftrs f) = squash (rpoly f x)"
	+ by (simp add: assms index_of_lookup(1) index_of_lookup(2) sign_vec_def)
	+
	+lemma squash_idem:
	+ shows "squash (squash x) = squash x"
	+ unfolding squash_def by auto
	+
	+lemma squash_mult:
	+ shows "squash ((a::real) * b) = squash a * squash b"
	+ unfolding squash_def apply auto
	+ using less_not_sym mult_neg_neg apply blast
	+ using mult_less_0_iff by blast
	+
	+lemma squash_prod_list:
	+ shows "squash (prod_list (ls::real list)) = prod_list (map squash ls)"
	+ apply (induction ls)
	+ unfolding squash_def apply auto
	+ apply (simp add: mult_less_0_iff)
	+ by (simp add: zero_less_mult_iff)
	+
	+lemma squash_pow:
	+ shows "squash ((x::real) ^ (y::nat)) = (squash x) ^ y"
	+ unfolding squash_def apply auto
	+ by (auto simp add: zero_less_power_eq)
	+
	+lemma squash_real_of_rat[simp]:
	+ shows "squash (real_of_rat x) = squash x"
	+ unfolding squash_def by auto
	+
	+lemma factorize_rat_poly_monic_irreducible_monic:
	+ assumes "factorize_rat_poly_monic f = (c,fs)"
	+ assumes "(fi,i) \<in> set fs"
	+ shows "irreducible fi \<and> monic fi"
	+proof -
	+ obtain c' fs' where cfs: "factorize_rat_poly f = (c',fs')"
	+ by (meson surj_pair)
	+ then have fs: "fs = map (\<lambda>(f,i). (normalize f, i)) fs'"
	+ using factorize_rat_poly_monic_def assms by auto
	+ obtain "fi'" where "(fi',i) \<in> set fs'" "fi = normalize fi'"
	+ using assms(2) unfolding fs by auto
	+ thus ?thesis using factorize_rat_poly irreducible_normalize_iff
	+ by (metis cfs monic_normalize not_irreducible_zero)
	+qed
	+
	+lemma square_free_normalize:
	+ assumes "square_free p"
	+ shows "square_free (normalize p)"
	+ by (metis assms square_free_multD(3) unit_factor_mult_normalize)
	+
	+lemma coprime_normalize:
	+ assumes "coprime a b"
	+ shows "coprime (normalize a) b"
	+ using assms by auto
	+
	+lemma undo_normalize:
	+ shows "a = Polynomial.smult (unit_factor (lead_coeff a)) (normalize a)"
	+ by (metis add.right_neutral mult_pCons_right mult_zero_right normalize_mult_unit_factor pCons_0_hom.hom_zero unit_factor_poly_def)
	+
	+lemma finite_smult_distr:
	+ assumes "distinct fs"
	+ shows "(\<Prod>(x,y)\<in>set fs. Polynomial.smult ((f x y)::rat) (g x y)) =
	+ Polynomial.smult (\<Prod>(x,y)\<in>set fs. f x y) (\<Prod>(x,y)\<in>set fs. g x y)"
	+ using assms
	+proof (induction fs)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a fs)
	+ then show ?case apply auto
	+ using mult.commute mult_smult_right prod.case_distrib smult_smult split_cong split_conv
	+ by (simp add: Groups.mult_ac(2) split_beta)
	+qed
	+
	+lemma normalize_coprime_degree:
	+ assumes "normalize (f::rat poly) = normalize g"
	+ assumes "coprime f g"
	+ shows "degree f = 0"
	+proof -
	+ have "f dvd g" by (simp add: assms(1) associatedD2)
	+ then have "f dvd 1"
	+ using assms(2) associatedD1 by auto
	+ thus ?thesis
	+ using Missing_Polynomial_Factorial.is_unit_field_poly by blast
	+qed
	+
	+lemma factorize_rat_poly_monic_square_free_factorization:
	+ assumes res: "factorize_rat_poly_monic f = (c,fs)"
	+ shows "square_free_factorization f (c,fs)"
	+proof (unfold square_free_factorization_def split, intro conjI impI allI)
	+ obtain c' fs' where cfs: "factorize_rat_poly f = (c',fs')"
	+ by (meson surj_pair)
	+ then have fs: "fs = map (\<lambda>(f,i). (normalize f, i)) fs'"
	+ using factorize_rat_poly_monic_def assms by auto
	+ have sq: "square_free_factorization f (c',fs')"
	+ using cfs factorize_rat_poly(1) by blast
	+ obtain lcs where lcs: "lcs = prod_list (map (\<lambda>(f,i). lead_coeff f ^ Suc i) fs')" by force
	+ have c: "c = c' * lcs" using assms unfolding factorize_rat_poly_monic_def cfs Let_def lcs by auto
	+ show "f = 0 \<Longrightarrow> c = 0" using c cfs by auto
	+ show "f = 0 \<Longrightarrow> fs = []" using fs cfs by auto
	+ have dist: "distinct fs'" using sq square_free_factorizationD(5) by blast
	+ show dist2: "distinct fs" unfolding fs
	+ unfolding distinct_conv_nth apply auto
	+ proof -
	+ fix i j
	+ assume ij: "i < length fs'" "j < length fs'" "i \<noteq> j"
	+ assume eq: "(case fs' ! i of
	+ (f, x) \<Rightarrow> (normalize f, x)) =
	+ (case fs' ! j of
	+ (f, x) \<Rightarrow> (normalize f, x))"
	+ obtain f a where fa: "fs' ! i = (f,a)" by force
	+ obtain g where g: "fs' ! j = (g,a)" "normalize f = normalize g"
	+ using eq fa apply auto
	+ by (metis case_prod_conv prod.collapse prod.inject)
	+ have "f \<noteq> g" using dist ij fa g
	+ using nth_eq_iff_index_eq by fastforce
	+ then have "coprime f g"
	+ using square_free_factorizationD(3)[OF sq, of f a g a] fa g ij
	+ apply auto
	+ using nth_mem by force
	+ then have "degree f = 0"
	+ by (simp add: g(2) normalize_coprime_degree)
	+ thus False
	+ using fa ij(1) nth_mem sq square_free_factorizationD'(3) by fastforce
	+ qed
	+ have ceq: "c = c' * (\<Prod>(a, i)\<in>set fs'. (lead_coeff a) ^ Suc i)" using c lcs
	+ by (simp add: dist prod.distinct_set_conv_list)
	+ have fseq: " (\<Prod>(a, i)\<in>set fs. a ^ Suc i) = (\<Prod>(a, i)\<in>set fs'. (normalize a) ^ Suc i)"
	+ apply (subst prod.distinct_set_conv_list[OF dist])
	+ apply (subst prod.distinct_set_conv_list[OF dist2])
	+ unfolding fs apply (auto simp add: o_def )
	+ by (metis (no_types, lifting) case_prod_conv old.prod.exhaust)
	+
	+ have "f = Polynomial.smult c' (\<Prod>(a, i)\<in>set fs'. a ^ Suc i)" using sq square_free_factorizationD(1) by blast
	+ moreover have "... = Polynomial.smult c' (\<Prod>(a, i)\<in>set fs'. (Polynomial.smult ((unit_factor (lead_coeff a))) (normalize a)) ^ Suc i)"
	+ apply (subst undo_normalize[symmetric]) by auto
	+ moreover have "... = Polynomial.smult c'
	+ (\<Prod>(a, i)\<in>set fs'. (Polynomial.smult ((lead_coeff a) ^ Suc i) ((normalize a) ^ Suc i)))"
	+ apply (subst smult_power) by auto
	+ moreover have "... = Polynomial.smult c'
	+ (Polynomial.smult (\<Prod>(a, i)\<in>set fs'. ((lead_coeff a) ^ Suc i))
	+ (\<Prod>(a, i)\<in>set fs'. (normalize a) ^ Suc i))"
	+ apply (subst finite_smult_distr) by (auto simp add: dist)
	+ moreover have "... = Polynomial.smult (c' * (\<Prod>(a, i)\<in>set fs'. (lead_coeff a) ^ Suc i))
	+ (\<Prod>(a, i)\<in>set fs'. (normalize a) ^ Suc i)"
	+ using smult_smult by blast
	+ moreover have "... = Polynomial.smult c (\<Prod>(a, i)\<in>set fs. a ^ Suc i)"
	+ unfolding ceq fseq by auto
	+ ultimately show "f = Polynomial.smult c (\<Prod>(a, i)\<in>set fs. a ^ Suc i)" by auto
	+ fix a i
	+ assume ai: "(a,i) \<in> set fs"
	+ obtain a' where a': "(a',i) \<in> set fs'" "a = normalize a'" using ai unfolding fs by auto
	+ show "square_free a" using square_free_normalize a'
	+ using sq square_free_factorizationD(2) by blast
	+ show "0 < degree a" using degree_normalize a'
	+ using sq square_free_factorizationD'(3) by fastforce
	+ fix b j
	+ assume bj: "(b,j) \<in> set fs" "(a,i) \<noteq> (b,j)"
	+ obtain b' where b': "(b',j) \<in> set fs'" "b = normalize b'" using bj unfolding fs by auto
	+ show "algebraic_semidom_class.coprime a b" using a' b' apply auto
	+ using bj(2) sq square_free_factorizationD(3) by fastforce
	+qed
	+
	+lemma undo_factorize_correct:
	+ assumes "factorize_rat_poly_monic p = (c,fs)"
	+ assumes "\<And>f p. (f,p) \<in> set fs \<Longrightarrow> f \<in> set ftrs"
	+ shows "undo_factorize (c,map (\<lambda>(f,pow). (index_of ftrs f, pow)) fs) (sign_vec ftrs x) = squash (rpoly p x)"
	+proof -
	+ have p: "p = smult c (\<Prod>(a, i)\<in> set fs. a ^ Suc i)"
	+ using assms(1) factorize_rat_poly_monic_square_free_factorization square_free_factorizationD(1) by blast
	+ have fs: "distinct fs"
	+ using assms(1) factorize_rat_poly_monic_square_free_factorization square_free_factorizationD(5) by blast
	+ have "rpoly p x = ((real_of_rat c) * rpoly (\<Prod>(a, i)\<in> set fs. a ^ Suc i) x)"
	+ using p by (simp add: of_rat_hom.map_poly_hom_smult)
	+ moreover have "... = ((real_of_rat c) * rpoly (\<Prod>ai\<in> set fs. case ai of (a,i) \<Rightarrow> a ^ Suc i) x)"
	+ by blast
	+ moreover have "... = ((real_of_rat c) * (\<Prod>ai\<in> set fs. case ai of (a,i) \<Rightarrow> rpoly (a ^ Suc i) x))"
	+ by (simp add: finite_prod_map_of_rat_poly_hom)
	+ moreover have "... = ((real_of_rat c) * (\<Prod>ai\<in> set fs. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i))"
	+ by (metis (mono_tags, lifting) of_rat_poly_hom.hom_power poly_hom.hom_power split_cong)
	+ moreover have "... = ((real_of_rat c) * (prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i) fs)))"
	+ by (simp add: fs prod.distinct_set_conv_list)
	+ ultimately have "rpoly p x = ((real_of_rat c) * (prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i) fs)))" by auto
	+
	+ then have "squash (rpoly p x) = squash c * prod_list (map squash (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> (rpoly a x) ^ Suc i) fs))"
	+ by (auto simp add: squash_mult squash_prod_list o_def)
	+ moreover have "... = squash c * prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> squash ((rpoly a x) ^ Suc i)) fs)"
	+ apply (simp add: o_def)
	+ by (simp add: prod.case_distrib)
	+ ultimately have rp:"squash(rpoly p x) = squash c * prod_list (map (\<lambda>ai. case ai of (a,i) \<Rightarrow> squash (rpoly a x) ^ Suc i) fs)"
	+ using squash_pow
	+ by presburger
	+ have "undo_factorize
	+ (c, map (\<lambda>(f, pow).(index_of ftrs f, pow)) fs) (sign_vec ftrs x) =
	+ squash
	+ (c * (\<Prod>xa\<leftarrow>fs. case xa of (f, y) \<Rightarrow> sign_vec ftrs x ! index_of ftrs f ^ Suc y))"
	+ unfolding undo_factorize_def apply (auto simp add: o_def)
	+ by (metis (mono_tags, lifting) case_prod_conv old.prod.exhaust)
	+ moreover have "... = squash
	+ (c * (\<Prod>xa\<leftarrow>fs. case xa of (f, y) \<Rightarrow> (squash (rpoly f x)) ^ Suc y))"
	+ using assms(2) sign_vec_index_of
	+ map_eq_conv split_cong
	+ apply (auto)
	+ by (smt map_eq_conv split_cong)
	+ ultimately show ?thesis using rp
	+ by (metis (mono_tags, lifting) of_rat_hom.hom_mult squash_idem squash_mult squash_real_of_rat)
	+qed
	+
	+lemma length_sign_vec[simp]:
	+ shows "length (sign_vec ps x) = length ps" unfolding sign_vec_def by auto
	+
	+lemma factorize_polys_has_factors:
	+ assumes "factorize_polys ps = (ftrs,data)"
	+ assumes "p \<in> set ps"
	+ assumes "factorize_rat_poly_monic p = (c,fs)"
	+ shows "set (map fst fs) \<subseteq> set ftrs"
	+ using assms unfolding factorize_polys_def Let_def apply auto
	+ by (metis UN_iff fst_conv image_eqI snd_conv)
	+
	+lemma factorize_polys_undo_factorize_polys:
	+ assumes "factorize_polys ps = (ftrs,data)"
	+ shows "undo_factorize_polys data (sign_vec ftrs x) = sign_vec ps x"
	+ unfolding list_eq_iff_nth_eq undo_factorize_polys_def apply auto
	+proof -
	+ show leq:"length data = length ps"
	+ using assms unfolding factorize_polys_def by (auto simp add: Let_def)
	+ fix i
	+ assume il:"i < length data"
	+ obtain c fs where cfs: "factorize_rat_poly_monic (ps ! i) = (c,fs)"
	+ by (meson surj_pair)
	+ then have fsts:"set (map fst fs) \<subseteq> set ftrs"
	+ using assms factorize_polys_has_factors il leq nth_mem by fastforce
	+ have *:"data ! i = (c,map (\<lambda>(f,pow). (index_of ftrs f, pow)) fs)"
	+ using assms unfolding factorize_polys_def
	+ using cfs il by (auto simp add: Let_def cfs)
	+ have "undo_factorize (data ! i) (sign_vec ftrs x) = squash (rpoly (ps ! i) x)" unfolding *
	+ apply (subst undo_factorize_correct[of "ps ! i"])
	+ apply (auto simp add: cfs)
	+ using fsts by auto
	+ thus "undo_factorize (data ! i) (sign_vec ftrs x) = sign_vec ps x ! i"
	+ using leq il sign_vec_def by auto
	+qed
	+
	+lemma factorize_polys_irreducible_monic:
	+ assumes "factorize_polys ps = (fs,data)"
	+ shows "distinct fs" "\<And>f. f \<in> set fs \<Longrightarrow> irreducible f \<and> monic f"
	+ using assms unfolding factorize_polys_def Let_def apply auto
	+ using factorize_rat_poly_monic_irreducible_monic
	+ apply (metis prod.collapse)
	+ using factorize_rat_poly_monic_irreducible_monic
	+ by (metis prod.collapse)
	+
	+lemma factorize_polys_square_free:
	+ assumes "factorize_polys ps = (fs,data)"
	+ shows "\<And>f. f \<in> set fs \<Longrightarrow> square_free f"
	+ using assms factorize_polys_irreducible_monic(2) irreducible_imp_square_free by blast
	+
	+lemma irreducible_monic_coprime:
	+ assumes f: "monic f" "irreducible (f::rat poly)"
	+ assumes g: "monic g" "irreducible (g::rat poly)"
	+ assumes "f \<noteq> g"
	+ shows "coprime f g"
	+ by (metis (no_types, lifting) assms(5) coprime_0(2) coprime_def' f(1) f(2) g(1) g(2) irreducible_normalized_divisors normalize_dvd_iff normalize_idem normalize_monic)
	+
	+lemma factorize_polys_coprime:
	+ assumes "factorize_polys ps = (fs,data)"
	+ shows "\<And>f g. f \<in> set fs \<Longrightarrow> g \<in> set fs \<Longrightarrow> f \<noteq> g \<Longrightarrow> coprime f g"
	+ using assms factorize_polys_irreducible_monic(2) irreducible_monic_coprime by auto
	+
	+lemma coprime_rat_poly_real_poly:
	+ assumes "coprime p (q::rat poly)"
	+ shows "coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly)"
	+ by (metis assms gcd_dvd_1 of_rat_hom.map_poly_gcd of_rat_poly_hom.hom_dvd_1)
	+
	+lemma coprime_rat_poly_iff_coprimereal_poly:
	+ shows "coprime p (q::rat poly) \<longleftrightarrow> coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly)"
	+proof -
	+ have forward: "coprime p (q::rat poly) \<longrightarrow> coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly)"
	+ using coprime_rat_poly_real_poly by auto
	+ have backward: "coprime (real_of_rat_poly p) ((real_of_rat_poly q)::real poly) \<Longrightarrow> coprime p (q::rat poly)"
	+ proof -
	+ assume copr_real: "comm_monoid_mult_class.coprime (real_of_rat_poly p) (real_of_rat_poly q)"
	+ have "degree (gcd p (q::rat poly)) > 0 \<Longrightarrow> False"
	+ proof -
	+ assume deg: "degree (gcd p (q::rat poly)) > 0"
	+ then have "\<exists>y. y dvd p \<and> y dvd q \<and> degree y > 0"
	+ by blast
	+ then obtain y where yprop: "y dvd p \<and> y dvd q \<and> degree y > 0"
	+ by auto
	+ then have "(real_of_rat_poly y) dvd (real_of_rat_poly p) \<and>
	+ (real_of_rat_poly y ) dvd (real_of_rat_poly q) \<and> degree y > 0"
	+ by simp
	+ then show "False"
	+ using copr_real apply (auto)
	+ by fastforce
	+ qed
	+ then show "comm_monoid_mult_class.coprime p (q::rat poly)"
	+ using comm_monoid_gcd_class.gcd_dvd_1
	+ by (metis Missing_Polynomial_Factorial.is_unit_field_poly copr_real gcd_zero_iff' neq0_conv of_rat_poly_hom.hom_zero)
	+ qed
	+ show ?thesis
	+ using forward backward by auto
	+qed
	+
	+lemma factorize_polys_map_distinct:
	+ assumes "factorize_polys ps = (fs,data)"
	+ assumes "fss = map real_of_rat_poly fs"
	+ shows "distinct fss"
	+ using factorize_polys_irreducible_monic[OF assms(1)]
	+ unfolding assms(2)
	+ apply (simp add: distinct_conv_nth)
	+ by (metis of_rat_eq_iff of_rat_hom.coeff_map_poly_hom poly_eqI)
	+
	+lemma factorize_polys_map_square_free:
	+ assumes "factorize_polys ps = (fs,data)"
	+ assumes "fss = map real_of_rat_poly fs"
	+ shows "\<And>f. f \<in> set fss \<Longrightarrow> square_free f"
	+ using factorize_polys_square_free[OF assms(1)]
	+ using assms(2) field_hom_0'.square_free_map_poly of_rat_hom.field_hom_0'_axioms by auto
	+
	+lemma factorize_polys_map_coprime:
	+ assumes "factorize_polys ps = (fs,data)"
	+ assumes "fss = map real_of_rat_poly fs"
	+ shows "\<And>f g. f \<in> set fss \<Longrightarrow> g \<in> set fss \<Longrightarrow> f \<noteq> g \<Longrightarrow> coprime f g"
	+ using factorize_polys_coprime[OF assms(1)] coprime_rat_poly_real_poly unfolding assms(2)
	+ by auto
	+
	+lemma coprime_prod_list:
	+ assumes "\<And>p. p \<in> set ps \<Longrightarrow> p \<noteq> 0"
	+ assumes "coprime (prod_list ps) (q::real poly)"
	+ shows "\<And>p. p \<in> set ps \<Longrightarrow> coprime p q"
	+proof -
	+ fix p
	+ assume "p \<in> set ps"
	+ then obtain r where r: "prod_list ps = r * p"
	+ using remove1_retains_prod by blast
	+ show "coprime p q"
	+ apply (rule coprime_prod[of r 1])
	+ using assms r apply auto
	+ by blast
	+qed
	+
	+(* basically copied from square_free_factorizationD' *)
	+lemma factorize_polys_square_free_prod_list:
	+ assumes "factorize_polys ps = (fs,data)"
	+ shows "square_free (prod_list fs)"
	+proof (rule square_freeI)
	+ from factorize_polys_coprime[OF assms]
	+ have coprime: "\<And>p q. p \<in> set fs \<Longrightarrow> q \<in> set fs \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q" .
	+ from factorize_polys_square_free[OF assms]
	+ have sq: "\<And>p. p \<in> set fs \<Longrightarrow> square_free p" .
	+ thus "prod_list fs \<noteq> 0" unfolding prod_list_zero_iff
	+ using square_free_def by blast
	+ fix q
	+ assume "degree q > 0" "q * q dvd prod_list fs"
	+ from irreducible\<^sub>d_factor[OF this(1)] this(2) obtain q where
	+ irr: "irreducible q" and dvd: "q * q dvd prod_list fs" unfolding dvd_def by auto
	+ hence dvd': "q dvd prod_list fs" unfolding dvd_def by auto
	+ from irreducible_dvd_prod_list[OF irr dvd'] obtain b where
	+ mem: "b \<in> set fs" and dvd1: "q dvd b" by auto
	+ from dvd1 obtain k where b: "b = q * k" unfolding dvd_def by auto
	+ from split_list[OF mem] b obtain bs1 bs2 where bs: "fs = bs1 @ b # bs2" by auto
	+ from irr have q0: "q \<noteq> 0" and dq: "degree q > 0" unfolding irreducible\<^sub>d_def by auto
	+ have "square_free (q * k)" using sq b mem by auto
	+ from this[unfolded square_free_def, THEN conjunct2, rule_format, OF dq]
	+ have qk: "\<not> q dvd k" by simp
	+ from dvd[unfolded bs b] have "q * q dvd q * (k * prod_list (bs1 @ bs2))"
	+ by (auto simp: ac_simps)
	+ with q0 have "q dvd k * prod_list (bs1 @ bs2)" by auto
	+ with irr qk have "q dvd prod_list (bs1 @ bs2)" by auto
	+ from irreducible_dvd_prod_list[OF irr this] obtain b' where
	+ mem': "b' \<in> set (bs1 @ bs2)" and dvd2: "q dvd b'" by fastforce
	+ from dvd1 dvd2 have "q dvd gcd b b'" by auto
	+ with dq is_unit_iff_degree[OF q0] have cop: "\<not> coprime b b'" by force
	+ from mem' have "b' \<in> set fs" unfolding bs by auto
	+ have b': "b' = b" using coprime
	+ using \<open>b' \<in> set fs\<close> cop mem by blast
	+ with mem' bs factorize_polys_irreducible_monic(1)[OF assms] show False by auto
	+qed
	+
	+lemma factorize_polys_map_square_free_prod_list:
	+ assumes "factorize_polys ps = (fs,data)"
	+ assumes "fss = map real_of_rat_poly fs"
	+ shows "square_free (prod_list fss)"
	+ using factorize_polys_square_free_prod_list[OF assms(1)] unfolding assms(2)
	+ by (simp add: of_rat_hom.square_free_map_poly)
	+
	+lemma factorize_polys_map_coprime_pderiv:
	+ assumes "factorize_polys ps = (fs,data)"
	+ assumes "fss = map real_of_rat_poly fs"
	+ shows "\<And>f. f \<in> set fss \<Longrightarrow> coprime f (pderiv (prod_list fss))"
	+proof -
	+ fix f
	+ assume f: "f \<in> set fss"
	+ from factorize_polys_map_square_free[OF assms]
	+ have sq: "\<And>p. p \<in> set fss \<Longrightarrow> square_free p" .
	+ have z: "\<And>p. p \<in> set fss \<Longrightarrow> p \<noteq> 0" using sq square_free_def by blast
	+ have c: "coprime (prod_list fss) (pderiv (prod_list fss))"
	+ apply (simp add: separable_def[symmetric] square_free_iff_separable[symmetric])
	+ using factorize_polys_map_square_free_prod_list[OF assms] .
	+ from coprime_prod_list[OF z c f]
	+ show "coprime f (pderiv (prod_list fss))" by auto
	+qed
	+
	+definition pairwise_coprime_list:: "rat poly list \<Rightarrow> bool"
	+ where "pairwise_coprime_list qs =
	+ (\<forall>m < length qs. \<forall> n < length qs.
	+ m \<noteq> n \<longrightarrow> coprime (qs ! n) (qs ! m))"
	+
	+(* Restating factorize_polys_map_coprime to match later definitions *)
	+lemma coprime_factorize:
	+ fixes qs:: "rat poly list"
	+ shows "pairwise_coprime_list (fst(factorize_polys qs))"
	+proof -
	+ let ?fs = "fst(factorize_polys qs)"
	+ have "(\<forall>m < length ?fs. \<forall> n < length ?fs.
	+ m \<noteq> n \<longrightarrow> coprime (?fs ! n) (?fs ! m))"
	+ proof clarsimp
	+ fix m n
	+ assume "m < length (fst (factorize_polys qs))"
	+ assume "n < length (fst (factorize_polys qs))"
	+ assume "m \<noteq> n"
	+ show " algebraic_semidom_class.coprime (fst (factorize_polys qs) ! n)
	+ (fst (factorize_polys qs) ! m)"
	+ by (metis \<open>m < length (fst (factorize_polys qs))\<close> \<open>m \<noteq> n\<close> \<open>n < length (fst (factorize_polys qs))\<close> coprime_iff_coprime distinct_conv_nth factorize_polys_coprime factorize_polys_def factorize_polys_irreducible_monic(1) fstI nth_mem)
	+ qed
	+ then show ?thesis unfolding pairwise_coprime_list_def by auto
	+qed
	+
	+lemma squarefree_factorization_degree:
	+ assumes "square_free_factorization p (c,fs)"
	+ shows "degree p = sum_list (map (\<lambda>(f,c). (c+1) * degree f) fs)"
	+proof -
	+ have "p =
	+ Polynomial.smult c
	+ (\<Prod>(a, i)\<in>set fs. a ^ Suc i)" using assms unfolding square_free_factorization_def
	+ by blast
	+ then have "degree p = degree (\<Prod>(a, i)\<in>set fs. a ^ Suc i)"
	+ using assms square_free_factorizationD(4) by fastforce
	+ also have "... = degree (prod_list (map (\<lambda>(f,c). f ^ Suc c) fs))"
	+ by (metis assms prod.distinct_set_conv_list square_free_factorizationD(5))
	+ also have "... = (\<Sum>(a, i)\<leftarrow>fs. degree (a ^ Suc i))"
	+ apply (subst degree_prod_list_eq)
	+ apply (auto simp add: o_def)
	+ using assms degree_0 square_free_factorizationD(2) apply blast
	+ using assms degree_0 square_free_factorizationD(2) apply blast
	+ by (simp add: prod.case_distrib)
	+ ultimately show ?thesis
	+ by (smt Polynomial.degree_power_eq add.commute assms degree_0 map_eq_conv plus_1_eq_Suc split_cong square_free_factorizationD(2))
	+qed
	+
	+subsection "Auxiliary Polynomial Lemmas"
	+definition roots_of_coprime_r:: "real poly list \<Rightarrow> real set"
	+ where "roots_of_coprime_r qs = {x. poly (coprime_r qs) x = 0}"
	+
	+lemma crb_lem_pos:
	+ fixes x:: "real"
	+ fixes p:: "real poly"
	+ assumes x: "poly p x = 0"
	+ assumes p: "p \<noteq> 0"
	+ shows "x < crb p"
	+ using cauchy_root_bound[of p x] apply (auto)
	+ unfolding crb_def apply (auto)
	+ using p x
	+ by linarith
	+
	+lemma crb_lem_neg:
	+ fixes x:: "real"
	+ fixes p:: "real poly"
	+ assumes x: "poly p x = 0"
	+ assumes p: "p \<noteq> 0"
	+ shows "x > -crb p"
	+ using cauchy_root_bound[of p x] apply (auto)
	+ unfolding crb_def apply (auto)
	+ using p x by linarith
	+
	+(* Show that the product of the polynomial list is 0 at x iff there is a polynomial
	+ in the list that is 0 at x *)
	+lemma prod_zero:
	+ shows "\<forall>x . poly (prod_list (qs:: rat poly list)) x = 0 \<longleftrightarrow> (\<exists>q \<in> set (qs). poly q x = 0)"
	+ apply auto
	+ using poly_prod_list_zero_iff apply blast
	+ using poly_prod_list_zero_iff by blast
	+
	+lemma coprime_r_zero1: "poly (coprime_r qs) (crb (prod_list qs)) = 0"
	+ by (simp add: coprime_r_def)
	+
	+lemma coprime_r_zero2: "poly (coprime_r qs) (-crb (prod_list qs)) = 0"
	+ by (simp add: coprime_r_def)
	+
	+lemma coprime_mult:
	+ fixes a:: "real poly"
	+ fixes b:: "real poly"
	+ fixes c:: "real poly"
	+ assumes "algebraic_semidom_class.coprime a b"
	+ assumes "algebraic_semidom_class.coprime a c"
	+ shows "algebraic_semidom_class.coprime a (b*c)"
	+ using assms(1) assms(2) by auto
	+
	+(* Will be needed when we call the BKR roots on coprime_r *)
	+lemma coprime_r_coprime_prop:
	+ fixes ps:: "rat poly list"
	+ assumes "factorize_polys ps = (fs,data)"
	+ assumes "fss = map real_of_rat_poly fs"
	+ shows "\<And>f. f \<in> set fss \<Longrightarrow> coprime f (coprime_r fss)"
	+proof clarsimp
	+ fix f:: "real poly"
	+ assume f_in: "f \<in> set fss"
	+ have nonz_prod: "prod_list fss \<noteq> 0" using factorize_polys_map_square_free apply (auto)
	+ using assms(1) assms(2) square_free_def by fastforce
	+ have nonz_f: "f \<noteq> 0" using f_in factorize_polys_map_square_free apply (auto)
	+ using assms(1) assms(2) square_free_def by fastforce
	+ have copr_pderiv: "algebraic_semidom_class.coprime f (pderiv (prod_list fss))" using factorize_polys_map_coprime_pderiv
	+ apply (auto)
	+ using f_in assms(1) assms(2) by auto
	+ have z_iff: "\<forall>x. poly f x = 0 \<longrightarrow> poly (prod_list fss) x = 0"
	+ using f_in apply (auto)
	+ using poly_prod_list_zero_iff by blast
	+ let ?inf_p = "[:-(crb (prod_list fss)),1:]::real poly"
	+ have copr_inf: "algebraic_semidom_class.coprime f ([:-(crb (prod_list fss)),1:])"
	+ proof -
	+ have zero_prop: "\<forall>x. poly ?inf_p x = 0 \<longleftrightarrow> x = crb (prod_list fss)"
	+ by auto
	+ have "poly (prod_list fss) (crb (prod_list fss)) \<noteq> 0"
	+ proof -
	+ have h: "\<forall>x. poly (prod_list fss) x = 0 \<longrightarrow> x < (crb (prod_list fss))"
	+ using nonz_prod crb_lem_pos[where p = "prod_list fss"]
	+ by auto
	+ then show ?thesis by auto
	+ qed
	+ then have nonzero: "poly f (crb (prod_list fss)) \<noteq> 0"
	+ using z_iff by auto
	+ then have "\<not>(\<exists>x. poly f x = 0 \<and> poly ?inf_p x = 0)"
	+ by simp
	+ have is_unit_gcd: "is_unit (gcd ?inf_p f)"
	+ using prime_elem_imp_gcd_eq prime_elem_iff_irreducible linear_irreducible_field
	+ apply (auto) using nonzero
	+ proof -
	+ have f1: "\<forall>x0. - (x0::real) = - 1 * x0"
	+ by simp
	+ have "(1::real) \<noteq> 0"
	+ by auto
	+ then have "is_unit (gcd (pCons (- 1 * real_of_int (crb (prod_list fss))) 1) f)"
	+ using f1 by (metis (no_types) is_unit_gcd nonzero one_poly_eq_simps(1) poly_eq_0_iff_dvd prime_elem_imp_coprime prime_elem_linear_field_poly)
	+ then show "degree (gcd (pCons (- real_of_int (crb (prod_list fss))) 1) f) = 0"
	+ by simp
	+ qed
	+ then show ?thesis
	+ using is_unit_gcd
	+ by (metis gcd.commute gcd_eq_1_imp_coprime is_unit_gcd_iff)
	+ qed
	+ let ?ninf_p = "[:(crb (prod_list fss)),1:]::real poly"
	+ have copr_neg_inf: "algebraic_semidom_class.coprime f ([:(crb (prod_list fss)),1:])"
	+ proof -
	+ have h: "\<forall>x. poly f x = 0 \<longrightarrow> poly (prod_list fss) x = 0"
	+ using f_in apply (auto)
	+ using poly_prod_list_zero_iff by blast
	+ have zero_prop: "\<forall>x. poly ?ninf_p x = 0 \<longleftrightarrow> x = -crb (prod_list fss)"
	+ by auto
	+ have "poly (prod_list fss) (-crb (prod_list fss)) \<noteq> 0"
	+ proof -
	+ have h: "\<forall>x. poly (prod_list fss) x = 0 \<longrightarrow> x > (-crb (prod_list fss))"
	+ using nonz_prod crb_lem_neg[where p = "prod_list fss"]
	+ by auto
	+ then show ?thesis by auto
	+ qed
	+ then have nonzero: "poly f (-crb (prod_list fss)) \<noteq> 0"
	+ using z_iff by auto
	+ then have "\<not>(\<exists>x. poly f x = 0 \<and> poly ?ninf_p x = 0)"
	+ using zero_prop by auto
	+ have is_unit_gcd: "is_unit (gcd ?ninf_p f)"
	+ using prime_elem_imp_gcd_eq prime_elem_iff_irreducible linear_irreducible_field
	+ apply (auto) using nonzero
	+ proof -
	+ have f1: "(1::real) \<noteq> 0"
	+ by auto
	+ have "\<not> pCons (real_of_int (crb (prod_list fss))) 1 dvd f"
	+ using nonzero by auto
	+ then show "degree (gcd (pCons (real_of_int (crb (prod_list fss))) 1) f) = 0"
	+ using f1 by (metis (no_types) Missing_Polynomial_Factorial.is_unit_field_poly coprime_imp_gcd_eq_1 is_unit_gcd_iff one_poly_eq_simps(1) prime_elem_imp_coprime prime_elem_linear_field_poly)
	+ qed
	+ then show ?thesis
	+ using is_unit_gcd
	+ by (metis gcd.commute gcd_eq_1_imp_coprime is_unit_gcd_iff)
	+ qed
	+ show "algebraic_semidom_class.coprime f (coprime_r fss)"
	+ using copr_pderiv coprime_mult unfolding coprime_r_def
	+ using copr_inf copr_neg_inf by blast
	+qed
	+
	+lemma coprime_r_nonzero:
	+ fixes ps:: "rat poly list"
	+ assumes "factorize_polys ps = (fs,data)"
	+ assumes nonempty_fs: "fs \<noteq> []"
	+ assumes fss_is: "fss = map real_of_rat_poly fs"
	+ shows "(coprime_r fss) \<noteq> 0"
	+proof -
	+ have nonempty_fss: "fss \<noteq> []" using nonempty_fs fss_is by auto
	+ have deg_f: "\<forall>f \<in> set (fs). degree f > 0"
	+ using factorize_polys_irreducible_monic
	+ apply (auto)
	+ using assms(1) irreducible_degree_field by blast
	+ then have deg_fss: "\<forall>f \<in> set (fss). degree f > 0"
	+ using fss_is by simp
	+ then have fss_nonz: "\<forall>f \<in> set (fss). f \<noteq> 0"
	+ by auto
	+ have "fss \<noteq> [] \<longrightarrow> ((\<forall>f \<in> set (fss). (degree f > 0 \<and> f \<noteq> 0)) \<longrightarrow> degree (prod_list fss) > 0)"
	+ proof (induct fss)
	+ case Nil
	+ then show ?case
	+ by blast
	+ next
	+ case (Cons a fss)
	+ show ?case
	+ proof clarsimp
	+ assume z_lt: "0 < degree a"
	+ assume anonz: "a \<noteq> 0"
	+ assume fnonz: "\<forall>f\<in>set fss. 0 < degree f \<and> f \<noteq> 0"
	+ have h: "degree (a * prod_list fss) = degree a + degree (prod_list fss) "
	+ using degree_mult_eq[where p = "a", where q = "prod_list fss"] anonz fnonz
	+ by auto
	+ then show "0 < degree (a * prod_list fss)"
	+ using z_lt Cons.hyps by auto
	+ qed
	+ qed
	+ then have "degree (prod_list fss) > 0"
	+ using nonempty_fss deg_fss fss_nonz by auto
	+ then have pderiv_nonzero: "pderiv (prod_list fss) \<noteq> 0"
	+ by (simp add: pderiv_eq_0_iff)
	+ have "(([:-(crb (prod_list fss)),1:]) * ([:(crb (prod_list fss)),1:])) \<noteq> 0"
	+ by auto
	+ then show ?thesis using pderiv_nonzero
	+ unfolding coprime_r_def apply (auto)
	+ by (metis offset_poly_eq_0_lemma right_minus_eq synthetic_div_unique_lemma)
	+qed
	+
	+lemma Rolle_pderiv:
	+ fixes q:: "real poly"
	+ fixes x1 x2:: "real"
	+ shows "(x1 < x2 \<and> poly q x1 = 0 \<and> poly q x2 = 0) \<longrightarrow> (\<exists>w. x1 < w \<and> w < x2 \<and> poly (pderiv q) w = 0)"
	+ using Rolle_deriv apply (auto)
	+ by (metis DERIV_unique Rolle continuous_at_imp_continuous_on poly_DERIV poly_differentiable poly_isCont)
	+
	+lemma coprime_r_roots_prop:
	+ fixes qs:: "real poly list"
	+ assumes pairwise_rel_prime: "\<forall>q1 q2. (q1 \<noteq> q2 \<and> (List.member qs q1) \<and> (List.member qs q2))\<longrightarrow> coprime q1 q2"
	+ shows "\<forall>x1. \<forall>x2. ((x1 < x2 \<and> (\<exists>q1 \<in> set (qs). (poly q1 x1) = 0) \<and> (\<exists>q2\<in> set(qs). (poly q2 x2) = 0)) \<longrightarrow> (\<exists>q. x1 < q \<and> q < x2 \<and> poly (coprime_r qs) q = 0))"
	+proof clarsimp
	+ fix x1:: "real"
	+ fix x2:: "real"
	+ fix q1:: "real poly"
	+ fix q2:: "real poly"
	+ assume "x1 < x2"
	+ assume q1_in: "q1 \<in> set qs"
	+ assume q1_0: "poly q1 x1 = 0"
	+ assume q2_in: "q2 \<in> set qs"
	+ assume q2_0: "poly q2 x2 = 0"
	+ have prod_z_x1: "poly (prod_list qs) x1 = 0" using q1_in q1_0
	+ using poly_prod_list_zero_iff by blast
	+ have prod_z_x2: "poly (prod_list qs) x2 = 0" using q2_in q2_0
	+ using poly_prod_list_zero_iff by blast
	+ have "\<exists>w>x1. w < x2 \<and> poly (pderiv (prod_list qs)) w = 0"
	+ using Rolle_pderiv[where q = "prod_list qs"] prod_z_x1 prod_z_x2
	+ using \<open>x1 < x2\<close> by blast
	+ then obtain w where w_def: "w > x1 \<and>w < x2 \<and> poly (pderiv (prod_list qs)) w = 0"
	+ by auto
	+ then have "poly (coprime_r qs) w = 0"
	+ unfolding coprime_r_def
	+ by simp
	+ then show "\<exists>q>x1. q < x2 \<and> poly (coprime_r qs) q = 0"
	+ using w_def by blast
	+qed
	+
	+subsection "Setting Up the Procedure: Lemmas"
	+definition has_no_zeros::"rat list \<Rightarrow> bool"
	+ where "has_no_zeros l = (0 \<notin> set l)"
	+
	+lemma hnz_prop: "has_no_zeros l \<longleftrightarrow> \<not>(\<exists>k < length l. l ! k = 0)"
	+ unfolding has_no_zeros_def
	+ by (simp add: in_set_conv_nth)
	+
	+definition cast_rat_list:: "rat poly list \<Rightarrow> real poly list"
	+ where "cast_rat_list qs = map real_of_rat_poly qs"
	+
	+definition consistent_sign_vectors_r::"real poly list \<Rightarrow> real set \<Rightarrow> rat list set"
	+ where "consistent_sign_vectors_r qs S = (signs_at qs) ` S"
	+
	+lemma consistent_sign_vectors_consistent_sign_vectors_r:
	+ shows"consistent_sign_vectors_r (cast_rat_list qs) S = consistent_sign_vectors qs S"
	+ unfolding consistent_sign_vectors_r_def cast_rat_list_def consistent_sign_vectors_def
	+ sign_vec_def signs_at_def
	+ by auto
	+
	+(* Relies on coprime_rat_poly_real_poly *)
	+lemma coprime_over_reals_coprime_over_rats:
	+ fixes qs:: "rat poly list"
	+ assumes csa_in: "csa \<in> (consistent_sign_vectors qs UNIV)"
	+ assumes p1p2: "p1\<noteq>p2 \<and> p1 < length csa \<and> p2 < length csa \<and> csa ! p1 = 0 \<and> csa ! p2 = 0"
	+ shows "\<not> algebraic_semidom_class.coprime (nth qs p1) (nth qs p2) "
	+proof -
	+ have isx: "\<exists>(x::real). csa = (sign_vec qs x)"
	+ using csa_in unfolding consistent_sign_vectors_def by auto
	+ then obtain x where havex: "csa = (sign_vec qs x)" by auto
	+ then have expolys: "poly (real_of_rat_poly (nth qs p1)) x = 0 \<and> poly (real_of_rat_poly (nth qs p2)) x = 0"
	+ using havex unfolding sign_vec_def squash_def
	+ by (smt class_field.neg_1_not_0 length_map map_map nth_map one_neq_zero p1p2)
	+ then have "\<not> coprime (real_of_rat_poly (nth qs p1)) ((real_of_rat_poly (nth qs p2))::real poly)"
	+ apply (auto) using coprime_poly_0
	+ by blast
	+ then show ?thesis
	+ using coprime_rat_poly_real_poly by auto
	+qed
	+
	+(* This and the following lemma are designed to show that if you have two sgas that aren't the same,
	+ there's a 0 in between! The proof uses IVT. It hones in on the component that's changed sign
	+ (either from 1 to {0, -1} or from -1 to {0, 1}) *)
	+lemma zero_above:
	+ fixes qs:: "rat poly list"
	+ fixes x1:: "real"
	+ assumes hnz: "has_no_zeros (sign_vec qs x1)"
	+ shows "(\<forall> x2 > x1. ((sign_vec qs x1) \<noteq> (sign_vec qs x2)) \<longrightarrow>
	+ (\<exists>(r::real) > x1. (r \<le> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0))))"
	+proof clarsimp
	+ fix x2
	+ assume x1_lt: "x1 < x2"
	+ assume diff_sign_vec: "sign_vec qs x1 \<noteq> sign_vec qs x2"
	+ then have "\<exists>q \<in> set qs. squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
	+ unfolding sign_vec_def
	+ by simp
	+ then obtain q where q_prop: "q \<in> set qs \<and> squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
	+ by auto
	+ then have q_in: "q \<in> set qs" by auto
	+ have poss1: "squash (rpoly q x1) = -1 \<and> squash (rpoly q x2) = 1 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ using poly_IVT_pos[of x1 x2] using x1_lt unfolding squash_def apply (auto)
	+ using q_prop by fastforce
	+ have poss2: "squash (rpoly q x1) = 1 \<and> squash (rpoly q x2) = -1 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ using poly_IVT_neg[of x1 x2] using x1_lt unfolding squash_def apply (auto)
	+ using q_prop by fastforce
	+ have poss3: "squash (rpoly q x2) = 0 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ using x1_lt unfolding squash_def apply (auto)
	+ using q_prop by blast
	+ have "(q \<in> set qs \<and> rpoly q x1 = 0) \<longrightarrow> \<not>has_no_zeros (sign_vec qs x1)"
	+ unfolding has_no_zeros_def sign_vec_def apply auto
	+ by (smt image_iff squash_def)
	+ have not_poss4: "squash (rpoly q x1) \<noteq> 0"
	+ using hnz q_in unfolding squash_def
	+ using \<open>q \<in> set qs \<and> rpoly q x1 = 0 \<longrightarrow> \<not> has_no_zeros (sign_vec qs x1)\<close> by auto
	+ then show "\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0)"
	+ using q_prop poss1 poss2 poss3 not_poss4
	+ apply (auto)
	+ apply (meson squash_def)
	+ apply (metis squash_def)
	+ apply (metis squash_def) by (meson squash_def)
	+qed
	+
	+lemma zero_below:
	+ fixes qs:: "rat poly list"
	+ fixes x1:: "real"
	+ assumes hnz: "has_no_zeros (sign_vec qs x1)"
	+ shows "\<forall>x2 < x1. ((sign_vec qs x1) \<noteq> (sign_vec qs x2)) \<longrightarrow>
	+ (\<exists>(r::real) < x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
	+proof clarsimp
	+ fix x2
	+ assume x1_gt: "x2 < x1"
	+ assume diff_sign_vec: "sign_vec qs x1 \<noteq> sign_vec qs x2"
	+ then have "\<exists>q \<in> set qs. squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
	+ unfolding sign_vec_def
	+ by simp
	+ then obtain q where q_prop: "q \<in> set qs \<and> squash (rpoly q x1) \<noteq> squash (rpoly q x2)"
	+ by auto
	+ then have q_in: "q \<in> set qs" by auto
	+ have poss1: "squash (rpoly q x1) = -1 \<and> squash (rpoly q x2) = 1 \<longrightarrow> (\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
	+ using poly_IVT_neg[of x2 x1] using x1_gt unfolding squash_def apply (auto)
	+ using q_prop by fastforce
	+ have poss2: "squash (rpoly q x1) = 1 \<and> squash (rpoly q x2) = -1 \<longrightarrow> (\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
	+ using poly_IVT_pos[of x2 x1] using x1_gt unfolding squash_def apply (auto)
	+ using q_prop by fastforce
	+ have poss3: "squash (rpoly q x2) = 0 \<longrightarrow> (\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
	+ using x1_gt unfolding squash_def apply (auto)
	+ using q_prop by blast
	+ have "(q \<in> set qs \<and> rpoly q x1 = 0) \<longrightarrow> \<not>has_no_zeros (sign_vec qs x1)"
	+ unfolding has_no_zeros_def sign_vec_def apply auto
	+ using image_iff squash_def
	+ by (smt image_iff squash_def)
	+ have not_poss4: "squash (rpoly q x1) \<noteq> 0"
	+ using hnz q_in unfolding squash_def
	+ using \<open>q \<in> set qs \<and> rpoly q x1 = 0 \<longrightarrow> \<not> has_no_zeros (sign_vec qs x1)\<close> by auto
	+ then show "(\<exists>r<x1. (r \<ge> x2 \<and> (\<exists> q \<in> set(qs). rpoly q r = 0)))"
	+ using q_prop poss1 poss2 poss3 not_poss4 apply (auto)
	+ apply (meson squash_def)
	+ apply (metis squash_def)
	+ apply (metis squash_def)
	+ by (meson squash_def)
	+qed
	+
	+lemma sorted_list_lemma:
	+ fixes l:: "real list"
	+ fixes a b:: "real"
	+ fixes n:: "nat"
	+ assumes "a < b"
	+ assumes "(n + 1) < length l"
	+ assumes strict_sort: "strict_sorted l"
	+ assumes lt_a: "(l ! n) < a"
	+ assumes b_lt: "b < (l ! (n+1))"
	+ shows "\<not>(\<exists>(x::real). (List.member l x \<and> a \<le> x \<and> x \<le> b))"
	+proof -
	+ have sorted_hyp_var: "\<forall>q1 < length l. \<forall>q2 < length l. (q1 < q2 \<longrightarrow>
	+ (l ! q1) < (l ! q2))"
	+ apply (auto)
	+ by (metis (no_types, lifting) strict_sort sorted_wrt_iff_nth_less strict_sorted_sorted_wrt)
	+ then have sorted_hyp_var2: "\<forall>q1 < length l. \<forall>q2 < length l. ((l ! q1) < (l ! q2)) \<longrightarrow> q1 < q2"
	+ using linorder_neqE_nat
	+ by (metis Groups.add_ac(2) add_mono_thms_linordered_field(5) less_irrefl)
	+ have "(\<exists>(x::real). (List.member l x \<and> a \<le> x \<and> x \<le> b)) \<Longrightarrow> False"
	+ proof -
	+ assume "(\<exists>(x::real). (List.member l x \<and> a \<le> x \<and> x \<le> b))"
	+ then obtain x where x_prop: "List.member l x \<and> a \<le> x \<and> x \<le> b" by auto
	+ then have l_prop: "List.member l x \<and> (l ! n) < x \<and> x < (l ! (n+1))"
	+ using lt_a b_lt by auto
	+ have nth_l: "l ! n < x" using l_prop by auto
	+ have np1th_l: "x < l ! (n+1)" using l_prop by auto
	+ have "\<exists>k. k < length l \<and> nth l k = x" using l_prop
	+ by (meson in_set_member index_of_lookup(1) index_of_lookup(2))
	+ then obtain k where k_prop: "k < length l \<and> nth l k = x" by auto
	+ have n_lt: "n < k"
	+ using nth_l sorted_hyp_var k_prop add_lessD1 assms(2) linorder_neqE_nat nat_SN.gt_trans
	+ by (meson sorted_hyp_var2)
	+ have k_gt: "k < n + 1"
	+ using sorted_hyp_var np1th_l k_prop
	+ using assms(2) sorted_hyp_var2 by blast
	+ show False
	+ using n_lt k_gt by auto
	+ qed
	+ then show ?thesis by auto
	+qed
	+
	+(* This lemma shows that any zero of coprime_r is either between two roots or it's smaller than the
	+least root (neg inf) or it's greater than the biggest root (pos inf). *)
	+lemma roots_of_coprime_r_location_property:
	+ fixes qs:: "rat poly list"
	+ fixes sga:: "rat list"
	+ fixes zer_list
	+ assumes pairwise_rel_prime: "pairwise_coprime_list qs"
	+ assumes all_squarefree: "\<And>q. q \<in> set qs \<Longrightarrow> rsquarefree q"
	+ assumes x1_prop: "sga = sign_vec qs x1"
	+ assumes hnz: "has_no_zeros sga"
	+ assumes zer_list_prop: "zer_list = sorted_list_of_set {(x::real). (\<exists>q \<in> set(qs). (rpoly q x = 0))}"
	+ shows "zer_list \<noteq> [] \<longrightarrow> ((x1 < (zer_list ! 0)) \<or> (x1 > (zer_list ! (length zer_list - 1)) \<or>
	+ (\<exists> n < (length zer_list - 1). x1 > (zer_list ! n) \<and> x1 < (zer_list ! (n+1)))))"
	+proof -
	+ let ?zer_list = "sorted_list_of_set {(x::real). (\<exists>q \<in> set(qs). (rpoly q x = 0))} :: real list"
	+ show ?thesis
	+ proof -
	+ have "((\<forall>q. (List.member qs q) \<longrightarrow> q \<noteq> 0) \<and> has_no_zeros (sign_vec qs x1)) \<Longrightarrow> \<not> List.member ?zer_list x1"
	+ proof (induct qs)
	+ case Nil
	+ then show ?case apply (auto)
	+ by (simp add: member_rec(2))
	+ next
	+ case (Cons a qs)
	+ then show ?case
	+ proof clarsimp
	+ assume imp: "((\<forall>q. List.member qs q \<longrightarrow> q \<noteq> 0) \<and>
	+ has_no_zeros (sign_vec qs x1) \<Longrightarrow>
	+ \<not> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0})
	+ x1)"
	+ assume nonz: "\<forall>q. List.member (a # qs) q \<longrightarrow> q \<noteq> 0"
	+ assume hnz: " has_no_zeros (sign_vec (a # qs) x1)"
	+ assume mem_list: "List.member
	+ (sorted_list_of_set {x. rpoly a x = 0 \<or> (\<exists>q\<in>set qs. rpoly q x = 0)})
	+ x1"
	+ have "has_no_zeros (sign_vec (a # qs) x1) \<Longrightarrow> has_no_zeros (sign_vec qs x1)"
	+ proof -
	+ assume hnz: "has_no_zeros (sign_vec (a # qs) x1)"
	+ have same_vec: "sign_vec (a # qs) x1 = ((if rpoly a x1 > 0 then 1 else if rpoly a x1 = 0 then 0 else -1) # sign_vec (qs) x1)"
	+ unfolding sign_vec_def squash_def by auto
	+ have "has_no_zeros ((if rpoly a x1 > 0 then 1 else if rpoly a x1 = 0 then 0 else -1) # sign_vec (qs) x1)
	+ \<Longrightarrow> has_no_zeros (sign_vec (qs) x1)"
	+ by (simp add: has_no_zeros_def)
	+ then show "has_no_zeros (sign_vec qs x1)" using hnz same_vec by auto
	+ qed
	+ then have nmem: "\<not> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}) x1"
	+ using hnz nonz imp apply (auto)
	+ by (simp add: member_rec(1))
	+ have "\<forall>q \<in>set qs. q \<noteq> 0"
	+ using nonz using in_set_member apply (auto) by fastforce
	+ then have "\<forall>q \<in>set qs. finite {x. rpoly q x = 0}"
	+ by (simp add: poly_roots_finite)
	+ then have fin_set: "finite {x. \<exists>q\<in>set qs. rpoly q x = 0}"
	+ by auto
	+ have not_in: "x1 \<notin> {x. \<exists>q\<in>set qs. rpoly q x = 0}" using fin_set nmem set_sorted_list_of_set
	+ all_squarefree
	+ apply (auto)
	+ by (simp add: List.member_def \<open>finite {x. \<exists>q\<in>set qs. rpoly q x = 0}\<close>)
	+ have x1_in: "x1 \<in> {x. rpoly a x = 0 \<or> (\<exists>q\<in>set qs. rpoly q x = 0)}"
	+ using mem_list sorted_list_of_set
	+ proof -
	+ have f1: "\<forall>r R. ((r::real) \<in> R \<or> \<not> List.member (sorted_list_of_set R) r) \<or> infinite R"
	+ by (metis in_set_member set_sorted_list_of_set)
	+ have "finite {r. rpoly a (r::real) = 0}"
	+ by (metis (full_types) List.finite_set member_rec(1) nonz real_roots_of_rat_poly(1))
	+ then show ?thesis
	+ using f1 \<open>finite {x. \<exists>q\<in>set qs. rpoly q x = 0}\<close> mem_list by fastforce
	+ qed
	+ have "rpoly a x1 \<noteq> 0" using hnz
	+ unfolding has_no_zeros_def sign_vec_def squash_def by auto
	+ then show "False" using not_in x1_in
	+ by auto
	+ qed
	+ qed
	+ then have non_mem: "\<not> List.member ?zer_list x1"
	+ using all_squarefree unfolding rsquarefree_def hnz apply (auto)
	+ using hnz x1_prop
	+ by (simp add: in_set_member)
	+ have "?zer_list \<noteq> [] \<Longrightarrow> ((x1 \<ge> (?zer_list ! 0)) \<and> (x1 \<le> (?zer_list ! (length ?zer_list - 1))))
	+\<Longrightarrow> (\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1)))"
	+ proof -
	+ assume "?zer_list \<noteq> []"
	+ assume x1_asm: "(x1 \<ge> (?zer_list ! 0)) \<and> (x1 \<le> (?zer_list ! (length ?zer_list - 1)))"
	+ have nm1: "x1 \<noteq> ?zer_list ! 0" using non_mem
	+ using \<open>sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} \<noteq> []\<close> in_set_member
	+ by (metis (no_types, lifting) in_set_conv_nth length_greater_0_conv)
	+ have nm2: "x1 \<noteq> ?zer_list ! (length ?zer_list -1)" using non_mem
	+ by (metis (no_types, lifting) One_nat_def \<open>sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} \<noteq> []\<close> diff_Suc_less in_set_member length_greater_0_conv nth_mem)
	+ then have x_asm_var: "x1 > (?zer_list ! 0) \<and> x1 < ?zer_list ! (length ?zer_list -1)"
	+ using x1_asm nm1 nm2 by auto
	+ have "(\<forall>n. (n < (length ?zer_list - 1) \<and> x1 \<ge> (?zer_list ! n) \<longrightarrow> x1 \<ge> (?zer_list ! (n+1)))) \<Longrightarrow> False"
	+ proof -
	+ assume assump: "(\<forall>n. (n < (length ?zer_list - 1) \<and> x1 \<ge> (?zer_list ! n) \<longrightarrow> x1 \<ge> (?zer_list ! (n+1))))"
	+ have zer_case: "x1 \<ge> ?zer_list ! 0" using x_asm_var by auto
	+ have all_n: "\<And> n. (n < (length ?zer_list - 1) \<longrightarrow> x1 \<ge> ?zer_list ! n) "
	+ proof -
	+ fix n
	+ show n_lt: "(n < (length ?zer_list - 1) \<longrightarrow> x1 \<ge> ?zer_list ! n)"
	+ proof (induct n)
	+ case 0
	+ then show ?case using zer_case
	+ by blast
	+ next
	+ case (Suc n)
	+ then show ?case
	+ using assump
	+ using Suc_eq_plus1 Suc_lessD by presburger
	+ qed
	+ qed
	+ have "(length ?zer_list - 2) \<le> length ?zer_list -1"
	+ using diff_le_mono2 one_le_numeral by blast
	+ have "x1 \<ge> ?zer_list ! (length ?zer_list - 1)"
	+ proof -
	+ have h1: "length ?zer_list = 1 \<longrightarrow> x1 \<ge> ?zer_list ! (length ?zer_list - 1)"
	+ using assump zer_case by auto
	+ have h2: "length ?zer_list > 1 \<longrightarrow> x1 \<ge> ?zer_list ! (length ?zer_list - 1)"
	+ using all_n assump apply (auto)
	+ by (metis (mono_tags, lifting) Suc_diff_Suc lessI)
	+ then show ?thesis using h1 h2 apply (auto)
	+ using zer_case by blast
	+ qed
	+ then show False using all_n x_asm_var
	+ by linarith
	+ qed
	+ then show ?thesis
	+ using x1_asm
	+ by (smt One_nat_def Suc_pred \<open>sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} \<noteq> []\<close> in_set_member length_greater_0_conv less_SucI non_mem nth_mem)
	+ qed
	+ then have h1: "(?zer_list \<noteq> [] \<and> (x1 \<ge> (?zer_list ! 0)) \<and> (x1 \<le> (?zer_list ! (length ?zer_list - 1))) \<Longrightarrow>
	+ (\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1))))"
	+ by blast
	+ then show ?thesis apply (auto)
	+ using zer_list_prop not_less
	+ by auto
	+ qed
	+qed
	+
	+(* This lemma is essentially saying that the zeros of coprime_r capture all relevant sample points.
	+From roots_of_coprime_r_location_property, we know that any zero of coprime_r is either between two
	+ roots, or it's smaller than the least root (neg inf), or it's greater than the biggest root (pos inf).
	+Then, since the polynomials have constant signs within those intervals, the zeros of coprime_r
	+ capture all the relevant information.
	+*)
	+lemma roots_of_coprime_r_capture_sgas_without_zeros:
	+ fixes qs:: "rat poly list"
	+ fixes sga:: "rat list"
	+ assumes pairwise_rel_prime: "pairwise_coprime_list qs"
	+ assumes all_squarefree: "\<And>q. q \<in> set qs \<Longrightarrow> rsquarefree q"
	+ assumes ex_x1: "sga = sign_vec qs x1"
	+ assumes hnz: "has_no_zeros sga"
	+ shows "(\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). sga = (sign_vec qs w))"
	+proof -
	+ obtain x1 where x1_prop: "sga = (sign_vec qs x1)" using ex_x1 by auto
	+ let ?zer_list = "sorted_list_of_set {(x::real). (\<exists>q \<in> set(qs). (rpoly q x = 0))} :: real list"
	+ have strict_sorted_h: "strict_sorted ?zer_list" using sorted_sorted_list_of_set
	+ strict_sorted_iff by auto
	+ then have sorted_hyp: "\<forall>q < length ?zer_list. (q + 1 < length ?zer_list) \<longrightarrow>
	+ (?zer_list ! q) < (?zer_list ! (q +1))"
	+ apply (auto) using lessI sorted_wrt_iff_nth_less strict_sorted_sorted_wrt
	+ by (metis (no_types, lifting) length_sorted_list_of_set strict_sorted_h)
	+ then have sorted_hyp_var: "\<forall>q1 < length ?zer_list. \<forall>q2 < length ?zer_list. (q1 < q2 \<longrightarrow>
	+ (?zer_list ! q1) < (?zer_list ! q2))"
	+ by (metis (no_types, lifting) sorted_wrt_iff_nth_less strict_sorted_h strict_sorted_sorted_wrt)
	+ then have sorted_hyp_var2: "\<forall>q1 < length ?zer_list. ((?zer_list ! q1)::real) \<le> (?zer_list ! (length ?zer_list - 1))"
	+ apply (auto)
	+ by (smt (z3) Suc_pred diff_less gr_implies_not0 less_SucE zero_less_Suc)
	+ have nonz_q: "\<forall>q \<in>set qs. q \<noteq> 0"
	+ using all_squarefree unfolding rsquarefree_def using in_set_member by auto
	+ then have "\<forall>q \<in>set qs. finite {x. rpoly q x = 0}"
	+ by (simp add: poly_roots_finite)
	+ then have fin_set: "finite {x. \<exists>q\<in>set qs. rpoly q x = 0}"
	+ by auto
	+ have x1_and_roots: "?zer_list \<noteq> [] \<longrightarrow> ((x1 < (?zer_list ! 0)) \<or> (x1 > (?zer_list ! (length ?zer_list - 1)) \<or>
	+ (\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1)))))"
	+ using roots_of_coprime_r_location_property x1_prop assms by auto
	+ have x2gt: "\<forall>x2>x1. sign_vec qs x1 \<noteq> sign_vec qs x2 \<longrightarrow> (\<exists>r>x1. r \<le> x2 \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ using hnz x1_prop zero_above[of qs x1] by auto
	+ have x2lt: "\<forall>x2<x1. sign_vec qs x1 \<noteq> sign_vec qs x2 \<longrightarrow> (\<exists>r<x1. x2 \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ using hnz x1_prop zero_below[of qs x1] by (auto)
	+ have triv_neg_inf_h: "?zer_list = [] \<Longrightarrow> sga = (sign_vec qs (-crb (prod_list (cast_rat_list qs))))"
	+ proof -
	+ assume empty_zer: "(?zer_list:: real list) = []"
	+ let ?zer_set = "{x. \<exists>q\<in>set qs. rpoly q x = 0}:: real set"
	+ have fin_zer: "finite ?zer_set" using fin_set by auto
	+ have "finite ?zer_set \<Longrightarrow> (sorted_list_of_set ?zer_set = []) = (?zer_set = {})"
	+ using fin_zer sorted_list_of_set_eq_Nil_iff[where A = "?zer_set"] by auto
	+ then have "(sorted_list_of_set ?zer_set = []) = (?zer_set = {})"
	+ using fin_zer by auto
	+ then have nozers: "?zer_set = {}"
	+ using empty_zer by auto
	+ then have "\<not>(\<exists>(r::real). (\<exists>(q::rat poly)\<in>set qs. rpoly q r = 0))"
	+ using nozers by auto
	+ then have "\<forall>y. sign_vec qs x1 = sign_vec qs y"
	+ proof -
	+ fix y
	+ have gt_prop: "x1 > y \<longrightarrow> sign_vec qs x1 = sign_vec qs y"
	+ using hnz x1_prop zero_below[of qs x1] apply (auto)
	+ using \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> by blast
	+ have lt_prop: "x1 < y \<longrightarrow> sign_vec qs x1 = sign_vec qs y"
	+ using zero_above[of qs x1] apply (auto)
	+ using \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> x2gt by blast
	+ show ?thesis using gt_prop lt_prop apply (auto)
	+ apply (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom x2gt x2lt)
	+ using x2gt x2lt apply (auto)
	+ apply (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom)
	+ apply (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom)
	+ by (metis \<open>\<nexists>r. \<exists>q\<in>set qs. rpoly q r = 0\<close> linorder_neqE_linordered_idom)
	+ qed
	+ then show ?thesis
	+ by (simp add: x1_prop)
	+ qed
	+ have neg_inf_h: "?zer_list \<noteq>[] \<Longrightarrow> (x1 < (?zer_list ! 0) \<Longrightarrow> sga = (sign_vec qs (-crb (prod_list (cast_rat_list qs)))))"
	+ proof -
	+ let ?neg_crb = "-crb (prod_list (cast_rat_list qs))"
	+ assume len_nontriv: "?zer_list \<noteq>[]"
	+ assume x1_lt: "x1 < ?zer_list ! 0"
	+ have r_gt: "\<forall>r. (\<exists>q\<in>set qs. rpoly q r = 0) \<longrightarrow> r \<ge> (?zer_list ! 0)"
	+ proof clarsimp
	+ fix q::"rat poly"
	+ fix r:: "real"
	+ assume q_in: "q \<in> set qs"
	+ assume "rpoly q r = 0"
	+ then have "r \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}" using q_in by auto
	+ then have "List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}) r"
	+ using in_set_member set_sorted_list_of_set fin_set apply (auto)
	+ by (smt \<open>r \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}\<close> fin_set in_set_member set_sorted_list_of_set)
	+ then show "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! 0 \<le> r"
	+ using sorted_hyp_var
	+ by (metis (no_types, lifting) gr_implies_not0 in_set_conv_nth in_set_member not_less sorted_iff_nth_mono sorted_sorted_list_of_set)
	+ qed
	+ have prod_zer: "\<forall>x. (\<exists>q\<in>set qs. rpoly q x = 0) \<longrightarrow> (poly (prod_list (cast_rat_list qs)) x) = 0"
	+ using prod_list_zero_iff[where xs = "(cast_rat_list qs)"] unfolding cast_rat_list_def
	+ apply (auto)
	+ using nonz_q apply blast
	+ by (metis (no_types, hide_lams) image_eqI list.set_map of_rat_poly_hom.prod_list_map_hom poly_prod_list_zero_iff)
	+ have "?zer_list \<noteq>[] \<longrightarrow> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0})
	+ (?zer_list ! 0)"
	+ using nth_Cons_0 apply (auto)
	+ by (meson gr0I in_set_member length_0_conv nth_mem)
	+ then have "?zer_list \<noteq>[] \<longrightarrow> (?zer_list ! 0)
	+ \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}"
	+ using in_set_member[where x = "(sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! 0)",
	+ where xs = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}"]
	+ set_sorted_list_of_set fin_set
	+ by blast
	+ then have "?zer_list \<noteq>[] \<longrightarrow> (\<exists>q\<in>set qs. rpoly q (?zer_list ! 0) = 0)"
	+ by blast
	+ then have poly_zer: "?zer_list \<noteq>[] \<longrightarrow> (poly (prod_list (cast_rat_list qs)) (?zer_list ! 0)) = 0"
	+ using prod_zer by auto
	+ have "\<forall>q. List.member (cast_rat_list qs) q \<longrightarrow>q \<noteq> 0" using nonz_q
	+ unfolding cast_rat_list_def using in_set_member imageE image_set map_poly_zero of_rat_eq_0_iff
	+ by smt
	+ then have "(prod_list (cast_rat_list qs)) \<noteq> 0"
	+ using prod_list_zero_iff in_set_member apply (auto)
	+ by fastforce
	+ then have crb_lt: "?zer_list \<noteq>[] \<longrightarrow> ?neg_crb < ?zer_list ! 0"
	+ using crb_lem_neg[where p = "(prod_list (cast_rat_list qs))", where x = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! 0"] apply (auto)
	+ using poly_zer
	+ by blast
	+ have crb_gt_x1: "?zer_list \<noteq>[] \<longrightarrow> (?neg_crb > x1 \<longrightarrow> (sga \<noteq> (sign_vec qs ?neg_crb)) \<longrightarrow> (\<exists>r>x1. r \<le> ?neg_crb \<and> (\<exists>q\<in>set qs. rpoly q r = 0)))"
	+ using x2gt apply (auto)
	+ using crb_lt r_gt x1_prop by fastforce
	+ have crb_lt_x1: "?neg_crb < x1 \<longrightarrow> (sga \<noteq> (sign_vec qs ?neg_crb)) \<longrightarrow> (\<exists>r<x1. ?neg_crb \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ using x2lt apply (auto)
	+ using x1_lt r_gt x1_prop by fastforce
	+ show ?thesis using len_nontriv crb_gt_x1 crb_lt_x1 x1_lt crb_lt r_gt apply (auto)
	+ using x1_prop by blast
	+ qed
	+ have pos_inf_h: "?zer_list \<noteq> [] \<Longrightarrow> (x1 > (?zer_list ! (length ?zer_list - 1)) \<Longrightarrow> sga = (sign_vec qs (crb (prod_list (cast_rat_list qs)))))"
	+ proof -
	+ let ?pos_crb = "crb (prod_list (cast_rat_list qs))"
	+ assume len_nontriv: "?zer_list \<noteq>[]"
	+ assume x1_lt: "x1 > ?zer_list ! (length ?zer_list - 1)"
	+ have r_gt: "\<And>r. (\<exists>q\<in>set qs. rpoly q r = 0) \<Longrightarrow> r \<le> (?zer_list ! (length ?zer_list - 1))"
	+ proof -
	+ fix r:: "real"
	+ assume q_in: "(\<exists>q\<in>set qs. rpoly q r = 0)"
	+ then obtain q::"rat poly" where q_prop: "q \<in> set qs \<and> rpoly q r = 0" by auto
	+ then have "r \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}" using q_in by auto
	+ then have "List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}) r"
	+ using in_set_member set_sorted_list_of_set fin_set by smt
	+ then have "\<exists>n < (length ?zer_list). r = ?zer_list ! n"
	+ by (metis (no_types, lifting) in_set_conv_nth in_set_member)
	+ then obtain n where n_prop: "n < length ?zer_list \<and> r = ?zer_list ! n"
	+ by auto
	+ then show "r \<le> (?zer_list ! (length ?zer_list - 1))"
	+ proof -
	+ have "\<forall>q1. q1 < length ?zer_list \<longrightarrow> (?zer_list ! q1) \<le> (?zer_list ! (length ?zer_list - 1:: nat))"
	+ using sorted_hyp_var2 by auto
	+ then have "(?zer_list ! n) \<le> (?zer_list ! (length ?zer_list - 1))"
	+ using n_prop by auto
	+ then show ?thesis using n_prop by auto
	+ qed
	+ qed
	+ have prod_zer: "\<forall>x. (\<exists>q\<in>set qs. rpoly q x = 0) \<longrightarrow> (poly (prod_list (cast_rat_list qs)) x) = 0"
	+ using prod_list_zero_iff[where xs = "(cast_rat_list qs)"] unfolding cast_rat_list_def
	+ apply (auto)
	+ using nonz_q apply blast
	+ by (metis (no_types, hide_lams) image_eqI list.set_map of_rat_poly_hom.prod_list_map_hom poly_prod_list_zero_iff)
	+ have "?zer_list \<noteq>[] \<longrightarrow> List.member (sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0})
	+ (?zer_list ! (length ?zer_list -1))"
	+ using nth_Cons_0 apply (auto)
	+ by (metis (no_types, lifting) diff_less in_set_conv_nth in_set_member length_greater_0_conv length_sorted_list_of_set zero_less_Suc)
	+ then have "?zer_list \<noteq>[] \<longrightarrow> (?zer_list ! (length ?zer_list -1))
	+ \<in> {x. \<exists>q\<in>set qs. rpoly q x = 0}"
	+ using in_set_member[where x = "(sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! (length ?zer_list -1))",
	+ where xs = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0}"]
	+ set_sorted_list_of_set fin_set
	+ by blast
	+ then have "?zer_list \<noteq>[] \<longrightarrow> (\<exists>q\<in>set qs. rpoly q (?zer_list ! (length ?zer_list -1)) = 0)"
	+ by blast
	+ then have poly_zer: "?zer_list \<noteq>[] \<longrightarrow> (poly (prod_list (cast_rat_list qs)) (?zer_list ! (length ?zer_list -1))) = 0"
	+ using prod_zer by auto
	+ have "\<forall>q. List.member (cast_rat_list qs) q \<longrightarrow>q \<noteq> 0" using nonz_q
	+ unfolding cast_rat_list_def using in_set_member imageE image_set map_poly_zero of_rat_eq_0_iff
	+ by smt
	+ then have "(prod_list (cast_rat_list qs)) \<noteq> 0"
	+ using prod_list_zero_iff in_set_member apply (auto)
	+ by fastforce
	+ then have crb_lt: "?zer_list \<noteq>[] \<longrightarrow> ?pos_crb > ?zer_list ! (length ?zer_list -1)"
	+ using crb_lem_pos[where p = "(prod_list (cast_rat_list qs))", where x = "sorted_list_of_set {x. \<exists>q\<in>set qs. rpoly q x = 0} ! (length ?zer_list -1)"] apply (auto)
	+ using poly_zer
	+ by simp
	+ have crb_gt_x1: "?zer_list \<noteq>[] \<longrightarrow> ((?pos_crb::real) > (x1::real) \<longrightarrow> (sga \<noteq> (sign_vec (qs::rat poly list) (?pos_crb::real))) \<longrightarrow> (\<exists>(r::real)<x1. r \<ge> ?pos_crb \<and> (\<exists>(q::rat poly)\<in>set qs. rpoly q r = 0)))"
	+ using x2gt apply (auto)
	+ using crb_lt r_gt x1_prop
	+ using x1_lt by fastforce
	+ have crb_lt_x1: "?pos_crb < x1 \<longrightarrow> (sga \<noteq> (sign_vec qs ?pos_crb)) \<longrightarrow> (\<exists>r>x1. ?pos_crb \<ge> r \<and> (\<exists>q\<in>set qs. poly (real_of_rat_poly q) r = 0))"
	+ using x2lt apply (auto)
	+ using x1_lt r_gt x1_prop
	+ by (meson \<open>prod_list (cast_rat_list qs) \<noteq> 0\<close> crb_lem_pos not_less prod_zer)
	+ show ?thesis using len_nontriv crb_gt_x1 crb_lt_x1 x1_lt crb_lt r_gt apply (auto)
	+ using x1_prop
	+ by blast
	+ qed
	+ have between_h: "(\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1))) \<Longrightarrow> (\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). sga = (sign_vec qs w))"
	+ proof -
	+ assume "(\<exists> n < (length ?zer_list - 1). x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1)))"
	+ then obtain n where n_prop: "n < (length ?zer_list - 1) \<and> x1 > (?zer_list ! n) \<and> x1 < (?zer_list ! (n+1))"
	+ by auto
	+ have "\<forall>q1 q2. (q1 \<noteq> q2 \<and> (List.member (cast_rat_list qs) q1) \<and> (List.member (cast_rat_list qs) q2))\<longrightarrow> coprime q1 q2"
	+ using pairwise_rel_prime coprime_rat_poly_iff_coprimereal_poly
	+ unfolding pairwise_coprime_list_def
	+ by (smt cast_rat_list_def imageE image_set in_set_conv_nth in_set_member)
	+ then have all_prop: "\<forall>x1. \<forall>x2. ((x1 < x2 \<and> (\<exists>q1 \<in> set (cast_rat_list(qs)). (poly q1 x1) = 0) \<and> (\<exists>q2\<in> set((cast_rat_list(qs))). (poly q2 x2) = 0)) \<longrightarrow> (\<exists>q. x1 < q \<and> q < x2 \<and> poly (coprime_r (cast_rat_list qs)) q = 0))"
	+ using coprime_r_roots_prop
	+ by auto
	+ have exq1: "(\<exists>q1 \<in> set (cast_rat_list(qs)). (poly q1 (?zer_list ! n)) = 0)"
	+ unfolding cast_rat_list_def using n_prop apply (auto)
	+ by (smt (verit, ccfv_SIG) One_nat_def Suc_eq_plus1 Suc_lessD fin_set length_sorted_list_of_set less_diff_conv mem_Collect_eq nth_mem set_sorted_list_of_set)
	+ have exq2: "(\<exists>q2 \<in> set (cast_rat_list(qs)). (poly q2 (?zer_list ! (n+1))) = 0)"
	+ unfolding cast_rat_list_def using n_prop One_nat_def Suc_eq_plus1 fin_set less_diff_conv mem_Collect_eq nth_mem set_sorted_list_of_set
	+ by (smt (verit, ccfv_SIG) image_eqI set_map)
	+ have n_prop2: "(((?zer_list ! n) < (?zer_list ! (n+1)) \<and> (\<exists>q1 \<in> set (cast_rat_list(qs)). (poly q1 (?zer_list ! n)) = 0) \<and> (\<exists>q2\<in> set((cast_rat_list(qs))). (poly q2 (?zer_list ! (n+1))) = 0)))"
	+ using exq1 exq2 sorted_hyp n_prop by auto
	+ then have "(\<exists>q. (?zer_list ! n) < q \<and> q < (?zer_list ! (n+1)) \<and> poly (coprime_r (cast_rat_list qs)) q = 0)"
	+ using all_prop n_prop2 by auto
	+ then have "\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). (?zer_list ! n) < w \<and> w < (?zer_list ! (n+1))"
	+ apply (auto)
	+ using roots_of_coprime_r_def by auto
	+ then obtain w where w_prop: "w \<in> (roots_of_coprime_r (cast_rat_list qs)) \<and> (?zer_list ! n) < w \<and> w < (?zer_list ! (n+1))" by auto
	+ have n_lt1: "n < length ?zer_list" using n_prop
	+ using add_lessD1 less_diff_conv by blast
	+ have n_lt2: "n + 1 < length ?zer_list" using n_prop
	+ using less_diff_conv by blast
	+ have sorted_hyp_var3: "?zer_list ! n < ?zer_list ! (n + 1)" using sorted_hyp
	+ n_lt1 n_lt2 by auto
	+ then have helper: "w > x1 \<longrightarrow> \<not>(\<exists>(x::real). (List.member ?zer_list x \<and> x1 \<le> x \<and> x \<le> w))"
	+ using n_prop w_prop x1_prop strict_sorted_h sorted_list_lemma[where n = "n", where l = ?zer_list, where a = "x1", where b = "w"] sorted_hyp_var3
	+ by auto
	+ have no_root1: "w > x1 \<Longrightarrow> \<not>(\<exists>r>x1. r \<le> w \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ proof -
	+ assume "w > x1"
	+ then have nex: "\<not>(\<exists>(x::real). (List.member ?zer_list x \<and> x1 \<le> x \<and> x \<le> w))"
	+ using helper by auto
	+ have "(\<exists>r>x1. r \<le> w \<and> (\<exists>q\<in>set qs. rpoly q r = 0)) \<Longrightarrow> False"
	+ proof -
	+ assume "(\<exists>r>x1. r \<le> w \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ then obtain r where r_prop: "r > x1 \<and>r \<le> w \<and>(\<exists>q\<in>set qs. rpoly q r = 0)" by auto
	+ then have "List.member ?zer_list r \<and>x1 \<le> r \<and>x1 \<le> w "
	+ by (smt fin_set in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then show ?thesis using nex r_prop
	+ by blast
	+ qed
	+ then show ?thesis by auto
	+ qed
	+ have helper2: "w < x1 \<longrightarrow> \<not>(\<exists>(x::real). (List.member ?zer_list x \<and> w \<le> x \<and> x \<le> x1))"
	+ using n_prop w_prop x1_prop strict_sorted_h sorted_list_lemma[where n = "n", where l = ?zer_list, where a = "w", where b = "x1"] sorted_hyp_var3
	+ by auto
	+ have no_root2: "w < x1 \<Longrightarrow> \<not>(\<exists>r<x1. w \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ proof -
	+ assume "w < x1"
	+ then have nex: "\<not>(\<exists>(x::real). (List.member ?zer_list x \<and> w \<le> x \<and> x \<le> x1))"
	+ using helper2 by auto
	+ have "(\<exists>r<x1. w \<le> r \<and> (\<exists>q\<in>set qs. rpoly q r = 0)) \<Longrightarrow> False"
	+ proof -
	+ assume "(\<exists>r<x1. w \<le> r\<and> (\<exists>q\<in>set qs. rpoly q r = 0))"
	+ then obtain r where r_prop: "r < x1 \<and> w \<le> r \<and>(\<exists>q\<in>set qs. rpoly q r = 0)" by auto
	+ then have "List.member ?zer_list r \<and> w \<le> r \<and> r \<le> x1 "
	+ by (smt fin_set in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then show ?thesis using nex r_prop
	+ by blast
	+ qed
	+ then show ?thesis by auto
	+ qed
	+ then have w_gt: "w > x1 \<longrightarrow> (sign_vec qs x1) = (sign_vec qs w)"
	+ using no_root1 n_prop x2gt by auto
	+ have w_lt: "w < x1 \<longrightarrow> (sign_vec qs x1) = (sign_vec qs w)"
	+ using no_root2 n_prop x2lt by auto
	+ then have "sga = (sign_vec qs w)" using w_gt w_lt x1_prop by auto
	+ then show "(\<exists>w \<in> (roots_of_coprime_r (cast_rat_list qs)). sga = (sign_vec qs w))"
	+ using w_prop by auto
	+ qed
	+ show ?thesis using triv_neg_inf_h neg_inf_h pos_inf_h between_h x1_and_roots
	+ by (metis (mono_tags, lifting) coprime_r_zero1 coprime_r_zero2 mem_Collect_eq roots_of_coprime_r_def)
	+qed
	+
	+(* This lemma heavily relies on the main BKR_Proofs result and also the lemma named
	+ roots_of_coprime_r_capture_sgas_without_zeros *)
	+lemma find_csas_lemma_nozeros:
	+ fixes qs:: "rat poly list"
	+ assumes fs: "factorize_polys qs = (fs,data)"
	+ assumes "fs \<noteq> []"
	+ shows "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa) \<longleftrightarrow>
	+ csa \<in> set (find_consistent_signs_at_roots (coprime_r (cast_rat_list fs)) (cast_rat_list fs))"
	+proof -
	+ let ?new_l = "cast_rat_list fs"
	+ let ?copr = "coprime_r ?new_l"
	+ have copr_nonz: "?copr \<noteq> 0"
	+ using coprime_r_nonzero[OF assms(1-2)] unfolding cast_rat_list_def by auto
	+ have nontriv_list: "0 < length ?new_l"
	+ using assms cast_rat_list_def by (auto)
	+ have pairwise_cp: "(\<And>q. q \<in> set ?new_l \<Longrightarrow>
	+ algebraic_semidom_class.coprime ?copr q)" using coprime_r_coprime_prop[OF assms(1)]
	+ apply (auto)
	+ by (metis cast_rat_list_def comm_monoid_mult_class.coprime_commute coprime_iff_coprime list.set_map)
	+ have set_fsga: "set(find_consistent_signs_at_roots ?copr ?new_l) = set(characterize_consistent_signs_at_roots ?copr ?new_l)"
	+ using find_consistent_signs_at_roots[OF copr_nonz pairwise_cp] by auto
	+ then have csa_in_hyp: "csa \<in> set (find_consistent_signs_at_roots ?copr ?new_l)
	+ \<longleftrightarrow> csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)" by auto
	+ have forward: "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)
	+ \<Longrightarrow> csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)"
	+ proof -
	+ assume csa_in: "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)"
	+ have fin: "finite {x. poly (coprime_r (cast_rat_list fs)) x = 0}"
	+ using copr_nonz poly_roots_finite
	+ by (simp add: poly_roots_finite fs)
	+ have pcl: "pairwise_coprime_list fs"
	+ using coprime_factorize fs
	+ by (metis fst_conv)
	+ have sqf: "\<And>q. q \<in> set fs \<Longrightarrow> rsquarefree q"
	+ using factorize_polys_square_free[OF assms(1)]
	+ by (metis square_free_rsquarefree)
	+ obtain x1 where x1:"csa = sign_vec fs x1"
	+ using consistent_sign_vectors_def csa_in by auto
	+ have hnz: "has_no_zeros csa" using csa_in by auto
	+ obtain w where w_prop: "w\<in>roots_of_coprime_r (cast_rat_list fs)" "csa = sign_vec fs w"
	+ using roots_of_coprime_r_capture_sgas_without_zeros[OF pcl sqf x1 hnz]
	+ by auto
	+ have w_root: "poly (coprime_r (cast_rat_list fs)) w = 0"
	+ using w_prop
	+ by (simp add: roots_of_coprime_r_def)
	+ then have "w \<in> {x. poly (coprime_r (cast_rat_list fs)) x = 0}"
	+ by auto
	+ then have w_ins: "w \<in> set (characterize_root_list_p (coprime_r (cast_rat_list fs)))"
	+ using fin set_sorted_list_of_set[where A="{x. poly (coprime_r (cast_rat_list fs)) x = 0}"]
	+ unfolding characterize_root_list_p_def
	+ by auto
	+ have "map ((\<lambda>x. if 0 < x then 1 else if x < 0 then - 1 else 0) \<circ> (\<lambda>p. rpoly p w)) fs =
	+ map ((\<lambda>x. if 0 < x then 1 else - 1) \<circ> (\<lambda>p. rpoly p w)) fs"
	+ proof -
	+ have "\<not>(\<exists>x \<in> set fs. rpoly x w = 0)"
	+ proof clarsimp
	+ fix x
	+ assume x_in: "x \<in> set fs"
	+ assume x_zer: "rpoly x w = 0"
	+ then have "\<exists>k < length fs. nth fs k = x"
	+ using x_in
	+ by (simp add: in_set_conv_nth)
	+ then obtain k where k_prop: "k < length fs \<and> fs ! k = x"
	+ by auto
	+ then have "(sign_vec fs w) ! k = 0" using x_zer apply (auto)
	+ unfolding sign_vec_def squash_def by auto
	+ then have "\<not> (has_no_zeros (sign_vec fs w))"
	+ apply (auto)
	+ by (simp add: hnz_prop k_prop)
	+ then show False using hnz unfolding sign_vec_def squash_def
	+ using \<open>\<not> has_no_zeros (sign_vec fs w)\<close> w_prop(2) by blast
	+ qed
	+ then show ?thesis using hnz unfolding sign_vec_def squash_def by auto
	+ qed
	+ then have "map ((\<lambda>x. if 0 < x then 1 else if x < 0 then - 1 else 0) \<circ> (\<lambda>p. rpoly p w)) fs =
	+ map (\<lambda>q. if 0 < poly q w then 1 else - 1)
	+ (cast_rat_list fs)"
	+ unfolding cast_rat_list_def by auto
	+ then have "csa = map (\<lambda>q. if 0 < poly q w then 1 else - 1)
	+ (cast_rat_list fs)"
	+ by (simp add: comp_def sign_vec_def squash_def w_prop(2))
	+ then show ?thesis unfolding characterize_consistent_signs_at_roots_def
	+ apply (auto) unfolding signs_at_def using w_ins w_prop
	+ using consistent_sign_vectors_consistent_sign_vectors_r consistent_sign_vectors_def consistent_sign_vectors_r_def signs_at_def by force
	+ qed
	+ have backward: "csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l) \<Longrightarrow>
	+ (csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)"
	+ proof -
	+ assume csa_in: "csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)"
	+ have csa_in_old_set: "csa \<in> set (characterize_consistent_signs_at_roots_copr ?copr ?new_l)"
	+ using csa_list_copr_rel copr_nonz csa_in find_consistent_signs_at_roots_copr pairwise_cp set_fsga by auto
	+ have "\<forall>(x::real). \<forall> (l::real poly list). rec_list True (\<lambda>h T. If (h = 0) False)
	+ (map (\<lambda>q. if 0 < poly q x then (1::rat) else (-1::rat))
	+ l)"
	+ proof clarsimp
	+ fix x::"real"
	+ fix l::"real poly list"
	+ show " rec_list True (\<lambda>h T. If (h = 0) False)
	+ (map (\<lambda>q. if 0 < poly q x then (1::rat) else (-1::rat)) l) "
	+ proof (induct l)
	+ case Nil
	+ then show ?case
	+ by simp
	+ next
	+ case (Cons a l)
	+ then show ?case by auto
	+ qed
	+ qed
	+ then have "\<forall>x. rec_list True (\<lambda>h T. If (h = 0) False)
	+ (map (\<lambda>q. if 0 < poly q x then (1::rat) else - 1)
	+ (cast_rat_list fs))"
	+ by auto
	+ then have hnz: "has_no_zeros csa"
	+ using csa_in_old_set
	+ unfolding characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def
	+ apply (auto) unfolding has_no_zeros_def
	+ by auto
	+ have "\<exists>w \<in> set(characterize_root_list_p ?copr). csa = consistent_sign_vec_copr ?new_l w"
	+ using csa_in_old_set using characterize_consistent_signs_at_roots_copr_def by auto
	+ then obtain w where w_prop: "w \<in> set (characterize_root_list_p ?copr) \<and> csa = consistent_sign_vec_copr ?new_l w"
	+ by auto
	+ then have "poly ?copr w = 0" unfolding characterize_root_list_p_def
	+ by (simp add: copr_nonz poly_roots_finite)
	+ then have copr_prop: "\<forall>p \<in> set(?new_l). poly p w \<noteq> 0"
	+ using w_prop coprime_r_coprime_prop apply (auto)
	+ by (meson coprime_poly_0 in_set_member pairwise_cp)
	+ then have "consistent_sign_vec_copr ?new_l w = sign_vec fs w"
	+ unfolding sign_vec_def squash_def consistent_sign_vec_copr_def
	+ cast_rat_list_def by auto
	+ then show ?thesis using hnz w_prop apply (auto)
	+ using consistent_sign_vectors_def by blast
	+ qed
	+ have "(csa \<in> (consistent_sign_vectors fs UNIV) \<and> has_no_zeros csa)
	+ \<longleftrightarrow> csa \<in> set(characterize_consistent_signs_at_roots ?copr ?new_l)"
	+ using forward backward by blast
	+ then show ?thesis using csa_in_hyp by auto
	+qed
	+
	+lemma range_eq:
	+ fixes a
	+ fixes b
	+ shows "a = b \<longrightarrow> range a = range b"
	+ by simp
	+
	+lemma removeAt_distinct:
	+ shows "distinct fss \<Longrightarrow> distinct (removeAt i fss)"
	+ unfolding removeAt_def
	+ by (simp add: set_take_disj_set_drop_if_distinct)
	+
	+lemma consistent_signs_atw:
	+ assumes "\<And>p. p \<in> set fs \<Longrightarrow> poly p x \<noteq> 0"
	+ shows "consistent_sign_vec_copr fs x = signs_at fs x"
	+ unfolding consistent_sign_vec_copr_def signs_at_def squash_def o_def
	+ by (simp add: assms)
	+
	+(* This could be an alternate (equivalent) definition *)
	+lemma characterize_consistent_signs_at_roots_rw:
	+ assumes "p \<noteq> 0"
	+ assumes copr: "\<And>q. q \<in> set fs \<Longrightarrow> coprime p q"
	+ shows "set (characterize_consistent_signs_at_roots p fs) =
	+ consistent_sign_vectors_r fs ({x. poly p x = 0})"
	+ by (simp add: assms(1) characterize_consistent_signs_at_roots_def consistent_sign_vectors_r_def poly_roots_finite characterize_root_list_p_def)
	+
	+lemma signs_at_insert:
	+ assumes "i \<le> length qs"
	+ shows "insertAt i (squash (poly p x)) (signs_at qs x) =
	+ signs_at (insertAt i p qs) x"
	+ unfolding insertAt_def signs_at_def o_def using assms take_map apply auto
	+ apply (subst drop_map) by simp
	+
	+lemma length_removeAt:
	+ assumes "i < length ls"
	+ shows "length (removeAt i ls) = length ls - 1"
	+ unfolding removeAt_def using assms by auto
	+
	+lemma insertAt_removeAt:
	+ assumes "i < length ls"
	+ shows "insertAt i (ls!i) (removeAt i ls) = ls"
	+ unfolding insertAt_def removeAt_def using assms apply auto
	+ by (simp add: Cons_nth_drop_Suc)
	+
	+lemma insertAt_nth:
	+ assumes "i \<le> length ls"
	+ shows "insertAt i n ls ! i = n"
	+ unfolding insertAt_def using assms
	+ by (simp add: nth_append_take)
	+
	+lemma length_signs_at[simp]:
	+ shows "length (signs_at qs x) = length qs"
	+ unfolding signs_at_def by auto
	+
	+lemma find_csa_at_index:
	+ assumes "i < length fss"
	+ assumes "\<And>p q. p \<in> set fss \<Longrightarrow> q \<in> set fss \<Longrightarrow> p \<noteq> q \<Longrightarrow> coprime p q"
	+ assumes "\<And>p. p \<in> set fss \<Longrightarrow> p \<noteq> 0"
	+ assumes "distinct fss"
	+ shows "
	+ set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) =
	+ {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}"
	+proof -
	+ from removeAt_distinct[OF assms(4)]
	+ have neq: "fss ! i \<noteq> 0" using assms by simp
	+ have cop: "\<And>q. q \<in> set (removeAt i fss) \<Longrightarrow> coprime (fss ! i) q" using assms
	+ unfolding removeAt_def
	+ apply auto
	+ using dual_order.strict_trans find_first_unique image_iff less_imp_le_nat less_not_refl nth_image nth_mem
	+ apply (smt atLeastLessThan_iff dual_order.strict_trans find_first_unique image_iff less_imp_le_nat less_not_refl nth_image nth_mem)
	+ by (metis Cons_nth_drop_Suc distinct.simps(2) distinct_drop in_set_dropD nth_mem)
	+ from find_consistent_signs_at_roots[OF neq]
	+ have "set (find_consistent_signs_at_roots (fss ! i) (removeAt i fss)) =
	+ set (characterize_consistent_signs_at_roots (fss ! i) (removeAt i fss))"
	+ using cop by auto
	+ then have eq: "set (map (insertAt i 0)
	+ (find_consistent_signs_at_roots (fss ! i)
	+ (removeAt i fss))) = insertAt i 0 ` set (characterize_consistent_signs_at_roots (fss ! i) (removeAt i fss)) "
	+ by simp
	+ from characterize_consistent_signs_at_roots_rw[OF neq cop]
	+ have eq2: "set (characterize_consistent_signs_at_roots (fss ! i) (removeAt i fss)) = consistent_sign_vectors_r (removeAt i fss) {x. poly (fss ! i) x = 0}" .
	+ have ile: "i \<le> length (removeAt i fss)"
	+ using length_removeAt[OF assms(1)] assms(1) by linarith
	+ have 1: "\<And>xb. poly (fss ! i) xb = 0 \<Longrightarrow>
	+ insertAt i 0 (signs_at (removeAt i fss) xb) \<in> range (signs_at fss)"
	+ proof -
	+ fix x
	+ assume "poly (fss ! i) x = 0"
	+ then have "insertAt i 0 (signs_at (removeAt i fss) x) =
	+ insertAt i (squash (poly (fss ! i) x)) (signs_at (removeAt i fss) x)" by (auto simp add: squash_def)
	+ also have "... = signs_at (insertAt i (fss ! i) (removeAt i fss)) x"
	+ apply (intro signs_at_insert)
	+ using length_removeAt[OF assms(1)]
	+ using assms(1) by linarith
	+ also have "... = signs_at fss x" unfolding insertAt_removeAt[OF assms(1)] by auto
	+ ultimately have *:"insertAt i 0 (signs_at (removeAt i fss) x) = signs_at fss x" by auto
	+ thus "insertAt i 0 (signs_at (removeAt i fss) x) \<in> range (signs_at fss)" by auto
	+ qed
	+ have 2: "\<And>xa. signs_at fss xa ! i = 0 \<Longrightarrow>
	+ i \<le> length (removeAt i fss) \<Longrightarrow>
	+ signs_at fss xa
	+ \<in> insertAt i 0 `
	+ signs_at (removeAt i fss) `
	+ {x. poly (fss ! i) x = 0}"
	+ proof -
	+ fix x
	+ assume "signs_at fss x ! i = 0"
	+ then have z:"poly (fss ! i) x = 0" unfolding signs_at_def o_def squash_def
	+ by (smt assms(1) class_field.zero_not_one nth_map zero_neq_neg_one)
	+ then have "insertAt i 0 (signs_at (removeAt i fss) x) =
	+ insertAt i (squash (poly (fss ! i) x)) (signs_at (removeAt i fss) x)" by (auto simp add: squash_def)
	+ also have "... = signs_at (insertAt i (fss ! i) (removeAt i fss)) x"
	+ apply (intro signs_at_insert)
	+ using length_removeAt[OF assms(1)]
	+ using assms(1) by linarith
	+ also have "... = signs_at fss x" unfolding insertAt_removeAt[OF assms(1)] by auto
	+ ultimately have *:"insertAt i 0 (signs_at (removeAt i fss) x) = signs_at fss x" by auto
	+ thus "signs_at fss x \<in> insertAt i 0 ` signs_at (removeAt i fss) ` {x. poly (fss ! i) x = 0}"
	+ using z
	+ by (metis (mono_tags, lifting) mem_Collect_eq rev_image_eqI)
	+ qed
	+ have "insertAt i 0 ` consistent_sign_vectors_r (removeAt i fss) {x. poly (fss ! i) x = 0} =
	+ {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}"
	+ unfolding consistent_sign_vectors_r_def
	+ apply (auto simp add: 1)
	+ apply (subst insertAt_nth)
	+ using ile by (auto simp add: 2)
	+ thus ?thesis unfolding eq eq2 .
	+qed
	+
	+lemma in_set_concat_map:
	+ assumes "i < length ls"
	+ assumes "x \<in> set (f (ls ! i))"
	+ shows "x \<in> set (concat (map f ls))"
	+ using assms by auto
	+
	+lemma find_csas_lemma_onezero_gen:
	+ fixes qs:: "rat poly list"
	+ assumes fs: "factorize_polys qs = (fs,data)"
	+ assumes fss: "fss = cast_rat_list fs"
	+ shows "(csa \<in> (consistent_sign_vectors_r fss UNIV) \<and> \<not>(has_no_zeros csa))
	+ \<longleftrightarrow> csa \<in> set (find_sgas_aux fss)"
	+proof -
	+ have a:"(\<And>p q. p \<in> set fss \<Longrightarrow>
	+ q \<in> set fss \<Longrightarrow>
	+ p \<noteq> q \<Longrightarrow> coprime p
	+ q)"
	+ using cast_rat_list_def factorize_polys_map_coprime fs fss by blast
	+ have b:"(\<And>p. p \<in> set fss \<Longrightarrow> p \<noteq> 0)"
	+ using factorize_polys_map_square_free_prod_list semidom_class.prod_list_zero_iff square_free_def
	+ using cast_rat_list_def fs fss by blast
	+ have c:"distinct fss"
	+ using factorize_polys_map_distinct[OF assms(1)] assms(2) unfolding cast_rat_list_def
	+ by auto
	+ have forwards: "csa \<in> (consistent_sign_vectors_r fss UNIV) \<Longrightarrow>
	+ \<not> (has_no_zeros csa)
	+ \<Longrightarrow> csa \<in> set (find_sgas_aux fss)"
	+ unfolding find_sgas_aux_def
	+ proof -
	+ assume csa: "csa \<in> (consistent_sign_vectors_r fss UNIV)"
	+ assume hnz: "\<not>(has_no_zeros csa)"
	+ then obtain i where i: "i < length csa" "csa ! i = 0" unfolding hnz_prop by auto
	+ then have cin: "csa \<in> {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" using csa by auto
	+ have 1:"i < length fss" using i csa unfolding consistent_sign_vectors_r_def by auto
	+ from find_csa_at_index[OF 1 a b c]
	+ have eq: "set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) =
	+ {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" by auto
	+ show "csa \<in> set (concat (map (\<lambda>i. map (insertAt i 0) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) [0..<length fss]))"
	+ using cin i unfolding eq[symmetric]
	+ apply (intro in_set_concat_map[of i])
	+ using 1 by auto
	+ qed
	+ have backwards: "csa \<in> set (find_sgas_aux fss) \<Longrightarrow>
	+ \<not> (has_no_zeros csa) \<and> csa \<in> (consistent_sign_vectors_r fss UNIV)"
	+ proof -
	+ assume *: "csa \<in> set (find_sgas_aux fss)"
	+ then obtain i where i: "i < length fss"
	+ "csa \<in> set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss)))"
	+ unfolding find_sgas_aux_def
	+ by auto
	+ from find_csa_at_index[OF i(1) a b c]
	+ have eq: "set (map (\<lambda>v. insertAt i 0 v) (find_consistent_signs_at_roots (fss ! i) (removeAt i fss))) =
	+ {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" by auto
	+ have *: "csa \<in> {v \<in> consistent_sign_vectors_r fss UNIV. v ! i = 0}" using i eq by auto
	+ then have "length csa = length fss" unfolding consistent_sign_vectors_r_def by auto
	+ thus ?thesis unfolding has_no_zeros_def using * apply (auto simp add:in_set_conv_nth)
	+ using i(1) by auto
	+ qed
	+ show ?thesis
	+ using forwards backwards by blast
	+qed
	+
	+lemma mem_append: "List.member (l1@l2) m \<longleftrightarrow> (List.member l1 m \<or> List.member l2 m)"
	+ by (simp add: List.member_def)
	+
	+lemma same_sign_cond_rationals_reals:
	+ fixes qs:: "rat poly list"
	+ assumes lenh: "length (fst(factorize_polys qs)) > 0"
	+ shows "set(find_sgas (map (map_poly of_rat) (fst(factorize_polys qs)))) = consistent_sign_vectors (fst(factorize_polys qs)) UNIV"
	+proof -
	+ let ?ftrs = "(fst(factorize_polys qs))"
	+ have pairwise_rel_prime: "pairwise_coprime_list (fst(factorize_polys qs))"
	+ using factorize_polys_coprime
	+ by (simp add: coprime_factorize)
	+ have all_squarefree:"\<forall>q. (List.member (fst(factorize_polys qs)) q) \<longrightarrow> (rsquarefree q)"
	+ using factorize_polys_square_free
	+ by (metis in_set_member prod.collapse square_free_rsquarefree)
	+ have allnonzero: "\<forall>q. (List.member ?ftrs q) \<longrightarrow> q \<noteq> 0"
	+ using all_squarefree apply (auto)
	+ using rsquarefree_def by blast
	+ have h1: "\<forall> csa. (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> \<not> (has_no_zeros csa))
	+ \<longleftrightarrow> csa \<in> set (find_sgas_aux (cast_rat_list ?ftrs))"
	+ using lenh find_csas_lemma_onezero_gen pairwise_rel_prime allnonzero
	+ by (metis consistent_sign_vectors_consistent_sign_vectors_r eq_fst_iff)
	+ have h2: "\<forall>csa. (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> has_no_zeros csa) \<longleftrightarrow>
	+ List.member (find_consistent_signs_at_roots (coprime_r (cast_rat_list ?ftrs)) (cast_rat_list ?ftrs)) csa"
	+ using lenh find_csas_lemma_nozeros pairwise_rel_prime allnonzero
	+ by (metis in_set_member length_greater_0_conv prod.collapse)
	+ have h3: "\<forall> csa. List.member (find_sgas (map (map_poly of_rat) ?ftrs)) csa \<longleftrightarrow>
	+ ((List.member (find_sgas_aux (cast_rat_list ?ftrs)) csa) \<or> (List.member (find_consistent_signs_at_roots (coprime_r (cast_rat_list ?ftrs)) (cast_rat_list ?ftrs)) csa))"
	+ unfolding find_sgas_def cast_rat_list_def using mem_append
	+ by metis
	+ have h4: "\<forall> csa. List.member (find_sgas (map (map_poly of_rat) ?ftrs)) csa \<longleftrightarrow>
	+ ((csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> has_no_zeros csa) \<or> (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> \<not> (has_no_zeros csa)))"
	+ using h1 h2 h3 apply (auto) apply (simp add: in_set_member) by (simp add: in_set_member)
	+ have h5: "\<forall>csa. (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> has_no_zeros csa) \<or> (csa \<in> (consistent_sign_vectors ?ftrs UNIV) \<and> \<not> (has_no_zeros csa))
	+ \<longleftrightarrow> csa \<in> (consistent_sign_vectors ?ftrs UNIV)"
	+ by auto
	+ then have "\<forall> csa. List.member (find_sgas (map (map_poly of_rat) ?ftrs)) csa \<longleftrightarrow> csa \<in> (consistent_sign_vectors ?ftrs UNIV)"
	+ using h4
	+ by blast
	+ then show ?thesis using in_set_member apply (auto)
	+ apply (simp add: in_set_member)
	+ by (simp add: in_set_member)
	+qed
	+
	+lemma factorize_polys_undo_factorize_polys_set:
	+ assumes "factorize_polys ps = (ftrs,data)"
	+ assumes "sgas = find_sgas (map (map_poly of_rat) ftrs)"
	+ assumes sgas_set: "set (sgas) = consistent_sign_vectors ftrs UNIV"
	+ shows "set (map (undo_factorize_polys data) sgas) = consistent_sign_vectors ps UNIV"
	+proof -
	+ have h: "\<forall>x. undo_factorize_polys data (sign_vec ftrs x) = sign_vec ps x"
	+ using factorize_polys_undo_factorize_polys
	+ by (simp add: assms(1))
	+ have h1: "\<forall>x. sign_vec ps x \<in> set (map (undo_factorize_polys data) sgas)"
	+ using sgas_set
	+ by (metis UNIV_I consistent_sign_vectors_def h image_eqI image_set)
	+ then have subset_h: "consistent_sign_vectors ps UNIV \<subseteq> set (map (undo_factorize_polys data) sgas)"
	+ unfolding consistent_sign_vectors_def by auto
	+ have supset_h: "consistent_sign_vectors ps UNIV \<supseteq> set (map (undo_factorize_polys data) sgas)"
	+ proof -
	+ have "\<forall> ele. ele \<in> set (map (undo_factorize_polys data) sgas) \<longrightarrow>
	+ (\<exists>n < length sgas. ele = (undo_factorize_polys data (nth sgas n)))"
	+ using index_of_lookup(1) index_of_lookup(2) by fastforce
	+ then have "\<forall> ele. ele \<in> set (map (undo_factorize_polys data) sgas) \<longrightarrow>
	+ (\<exists>x. ele = (undo_factorize_polys data (sign_vec ftrs x)))"
	+ using sgas_set apply (auto) using consistent_sign_vectors_def by auto
	+ then show ?thesis using h
	+ using consistent_sign_vectors_def by auto
	+ qed
	+ show ?thesis using subset_h supset_h
	+ by blast
	+qed
	+
	+lemma main_step_aux1:
	+ fixes qs:: "rat poly list"
	+ assumes empty: "(fst(factorize_polys qs)) = []"
	+ shows "set (find_consistent_signs qs) = consistent_sign_vectors qs UNIV"
	+proof -
	+ have set_eq: "set (find_consistent_signs qs) = {(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)}"
	+ using empty unfolding find_consistent_signs_def apply (auto)
	+ apply (metis fst_conv)
	+ by (metis prod.collapse)
	+ have deg_q_prop: "fst(factorize_polys qs) = [] \<Longrightarrow> (\<forall>q \<in>set(qs). degree q = 0)"
	+ apply (rule ccontr)
	+ proof clarsimp
	+ fix q
	+ assume *:"fst(factorize_polys qs) = []"
	+ assume q: "q \<in> set qs" "0 < degree q"
	+ obtain arb where "factorize_rat_poly_monic q = (arb,[])"
	+ using * q unfolding factorize_polys_def apply (auto simp add:Let_def)
	+ by (metis prod.collapse)
	+ from squarefree_factorization_degree[OF factorize_rat_poly_monic_square_free_factorization[OF this]]
	+ have "degree q = 0" by auto
	+ thus False using q by auto
	+ qed
	+ have deg_q_cons: "(\<forall>q \<in>set(qs). degree q = 0) \<Longrightarrow> (consistent_sign_vectors qs UNIV = {(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)})"
	+ proof -
	+ assume deg_z: "(\<forall>q \<in>set(qs). degree q = 0)"
	+ then have "\<forall>q \<in>set(qs). \<forall>x y. poly q x = poly q y"
	+ apply (auto)
	+ by (meson constant_def constant_degree)
	+ then have csv: "consistent_sign_vectors qs UNIV = {sign_vec qs 0}"
	+ unfolding consistent_sign_vectors_def sign_vec_def apply (auto)
	+ apply (metis deg_z degree_0_id of_rat_hom.map_poly_hom_coeff_lift poly_0_coeff_0 poly_const_conv squash_real_of_rat)
	+ by (metis (mono_tags, lifting) class_semiring.add.one_closed comp_def image_iff list.map_cong0 of_rat_hom.poly_map_poly_0)
	+ have "sign_vec qs 0 = (map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)"
	+ unfolding sign_vec_def squash_def by auto
	+ then show "consistent_sign_vectors qs UNIV = {(map (\<lambda>x. if poly x 0 < 0 then -1 else if poly x 0 = 0 then 0 else 1) qs)}"
	+ using csv by auto
	+ qed
	+ then show ?thesis
	+ using deg_q_prop deg_q_cons set_eq
	+ by (simp add: empty)
	+qed
	+
	+lemma main_step_aux2:
	+ fixes qs:: "rat poly list"
	+ assumes lenh: "length (fst(factorize_polys qs)) > 0"
	+ shows "set (find_consistent_signs qs) = consistent_sign_vectors qs UNIV"
	+proof -
	+ let ?fs = "fst(factorize_polys qs)"
	+ let ?data = "snd(factorize_polys qs)"
	+ let ?sgas = "find_sgas (map (map_poly of_rat) ?fs)"
	+ have h0: "set (?sgas) = consistent_sign_vectors ?fs UNIV"
	+ using lenh same_sign_cond_rationals_reals coprime_factorize by auto
	+ then have h1: "set (map (undo_factorize_polys ?data) ?sgas) = consistent_sign_vectors qs UNIV"
	+ using factorize_polys_undo_factorize_polys_set
	+ by simp
	+ then show ?thesis using lenh apply (auto)
	+ apply (smt case_prod_unfold find_consistent_signs_def h1 main_step_aux1)
	+ by (simp add: find_consistent_signs_def prod.case_eq_if)
	+qed
	+
	+lemma main_step:
	+ fixes qs:: "rat poly list"
	+ shows "set (find_consistent_signs qs) = consistent_sign_vectors qs UNIV"
	+ using main_step_aux1 main_step_aux2 by auto
	+
	+subsection "Decision Procedure: Main Lemmas"
	+
	+lemma decide_univ_lem_helper:
	+ assumes "(fml_struct,polys) = convert fml"
	+ shows "(\<forall>x::real. lookup_sem fml_struct (map (\<lambda>p. rpoly p x) polys)) \<longleftrightarrow>
	+ (decide_universal fml)"
	+ using universal_lookup_sem main_step unfolding decide_universal_def apply (auto)
	+ apply (metis assms convert_closed fst_conv snd_conv)
	+ by (metis (full_types) assms convert_closed fst_conv snd_conv)
	+
	+lemma decide_exis_lem_helper:
	+ assumes "(fml_struct,polys) = convert fml"
	+ shows "(\<exists>x::real. lookup_sem fml_struct (map (\<lambda>p. rpoly p x) polys)) \<longleftrightarrow>
	+ (decide_existential fml)"
	+ using existential_lookup_sem main_step unfolding decide_existential_def apply (auto)
	+ apply (metis assms convert_closed fst_conv snd_conv)
	+ by (metis (full_types) assms convert_closed fst_conv snd_conv)
	+
	+theorem decision_procedure:
	+ shows "(\<forall>x::real. fml_sem fml x) \<longleftrightarrow> (decide_universal fml)"
	+ "\<exists>x::real. fml_sem fml x \<longleftrightarrow> (decide_existential fml)"
	+ using convert_semantics_lem decide_univ_lem_helper apply (auto)
	+ apply (simp add: convert_semantics)
	+ apply (metis convert_def convert_semantics fst_conv snd_conv)
	+ using convert_semantics_lem
	+ by (metis convert_def convert_semantics decide_exis_lem_helper fst_conv snd_conv)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/BKR_Proofs.thy b/thys/BenOr_Kozen_Reif/BKR_Proofs.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/BKR_Proofs.thy
	@@ -0,0 +1,2223 @@
	+theory BKR_Proofs
	+ imports "Matrix_Equation_Construction"
	+
	+begin
	+
	+definition well_def_signs:: "nat => rat list list \<Rightarrow> bool"
	+ where "well_def_signs num_polys sign_conds \<equiv> \<forall> signs \<in> set(sign_conds). (length signs = num_polys)"
	+
	+definition satisfies_properties:: "real poly \<Rightarrow> real poly list \<Rightarrow> nat list list \<Rightarrow> rat list list \<Rightarrow> rat mat \<Rightarrow> bool"
	+ where "satisfies_properties p qs subsets signs matrix =
	+ ( all_list_constr subsets (length qs) \<and> well_def_signs (length qs) signs \<and> distinct signs
	+ \<and> satisfy_equation p qs subsets signs \<and> invertible_mat matrix \<and> matrix = matrix_A signs subsets
	+ \<and> set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)
	+ )"
	+
	+section "Base Case"
	+
	+lemma mat_base_case:
	+ shows "matrix_A [[1],[-1]] [[],[0]] = (mat_of_rows_list 2 [[1, 1], [1, -1]])"
	+ unfolding matrix_A_def mtx_row_def z_def apply (auto)
	+ by (simp add: numeral_2_eq_2)
	+
	+lemma base_case_sgas:
	+ fixes q p:: "real poly"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes rel_prime: "coprime p q"
	+ shows "set (characterize_consistent_signs_at_roots_copr p [q]) \<subseteq> {[1], [- 1]}"
	+ unfolding characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def by auto
	+
	+lemma base_case_sgas_alt:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ assumes len1: "length qs = 1"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes rel_prime: "\<forall>q. (List.member qs q) \<longrightarrow> coprime p q"
	+ shows "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> {[1], [- 1]}"
	+proof -
	+ have ex_q: "\<exists>(q::real poly). qs = [q]"
	+ using len1
	+ using length_Suc_conv[of qs 0] by auto
	+ then show ?thesis using base_case_sgas nonzero rel_prime
	+ apply (auto)
	+ using characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def by auto
	+qed
	+
	+lemma base_case_satisfy_equation:
	+ fixes q p:: "real poly"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes rel_prime: "coprime p q"
	+ shows "satisfy_equation p [q] [[],[0]] [[1],[-1]]"
	+proof -
	+ have h1: "set (characterize_consistent_signs_at_roots_copr p [q]) \<subseteq> {[1], [- 1]}"
	+ using base_case_sgas assms by auto
	+ have h2: " \<forall>qa. List.member [q] qa \<longrightarrow> coprime p qa" using rel_prime
	+ by (simp add: member_rec(1) member_rec(2))
	+ have h3: "all_list_constr [[], [0]] (Suc 0)" unfolding all_list_constr_def
	+ by (simp add: list_constr_def member_def)
	+ then show ?thesis using matrix_equation[where p = "p", where qs = "[q]", where signs = "[[1],[-1]]", where subsets = "[[],[0]]"]
	+ nonzero h1 h2 h3 by auto
	+qed
	+
	+lemma base_case_satisfy_equation_alt:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ assumes len1: "length qs = 1"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes rel_prime: "\<forall>q. (List.member qs q) \<longrightarrow> coprime p q"
	+ shows "satisfy_equation p qs [[],[0]] [[1],[-1]]"
	+proof -
	+ have ex_q: "\<exists>(q::real poly). qs = [q]"
	+ using len1
	+ using length_Suc_conv[of qs 0] by auto
	+ then show ?thesis using base_case_satisfy_equation nonzero rel_prime
	+ apply (auto)
	+ by (simp add: member_rec(1))
	+qed
	+
	+lemma base_case_matrix_eq:
	+ fixes q p:: "real poly"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes rel_prime: "coprime p q"
	+ shows "(mult_mat_vec (mat_of_rows_list 2 [[1, 1], [1, -1]]) (construct_lhs_vector p [q] [[1],[-1]]) =
	+ (construct_rhs_vector p [q] [[],[0]]))"
	+ using mat_base_case base_case_satisfy_equation unfolding satisfy_equation_def
	+ by (simp add: nonzero rel_prime)
	+
	+lemma less_two:
	+ shows "j < Suc (Suc 0) \<longleftrightarrow> j = 0 \<or> j = 1" by auto
	+
	+lemma inverse_mat_base_case:
	+ shows "inverts_mat (mat_of_rows_list 2 [[1/2, 1/2], [1/2, -(1/2)]]::rat mat) (mat_of_rows_list 2 [[1, 1], [1, -1]]::rat mat)"
	+ unfolding inverts_mat_def mat_of_rows_list_def mat_eq_iff apply auto
	+ unfolding less_two by (auto simp add: scalar_prod_def)
	+
	+lemma inverse_mat_base_case_2:
	+ shows "inverts_mat (mat_of_rows_list 2 [[1, 1], [1, -1]]::rat mat) (mat_of_rows_list 2 [[1/2, 1/2], [1/2, -(1/2)]]::rat mat) "
	+ unfolding inverts_mat_def mat_of_rows_list_def mat_eq_iff apply auto
	+ unfolding less_two by (auto simp add: scalar_prod_def)
	+
	+lemma base_case_invertible_mat:
	+ shows "invertible_mat (matrix_A [[1], [- 1]] [[], [0]])"
	+ unfolding invertible_mat_def using inverse_mat_base_case inverse_mat_base_case_2
	+ apply (auto)
	+ apply (simp add: mat_base_case mat_of_rows_list_def)
	+ using mat_base_case by auto
	+
	+section "Inductive Step"
	+
	+subsection "Lemmas on smashing subsets and signs"
	+
	+lemma signs_smash_property:
	+ fixes signs1 signs2 :: "'a list list"
	+ fixes a b:: "nat"
	+ shows "\<forall> (elem :: 'a list). (elem \<in> (set (signs_smash signs1 signs2)) \<longrightarrow>
	+ (\<exists> n m :: nat.
	+ elem = ((nth signs1 n)@(nth signs2 m))))"
	+proof clarsimp
	+ fix elem
	+ assume assum: "elem \<in> set (signs_smash signs1 signs2)"
	+ show "\<exists>n m. elem = signs1 ! n @ signs2 ! m"
	+ using assum unfolding signs_smash_def apply (auto)
	+ by (metis in_set_conv_nth)
	+qed
	+
	+lemma signs_smash_property_set:
	+ fixes signs1 signs2 :: "'a list list"
	+ fixes a b:: "nat"
	+ shows "\<forall> (elem :: 'a list). (elem \<in> (set (signs_smash signs1 signs2)) \<longrightarrow>
	+ (\<exists> (elem1::'a list). \<exists> (elem2::'a list).
	+ (elem1 \<in> set(signs1) \<and> elem2 \<in> set(signs2) \<and> elem = (elem1@elem2))))"
	+proof clarsimp
	+ fix elem
	+ assume assum: "elem \<in> set (signs_smash signs1 signs2)"
	+ show "\<exists>elem1. elem1 \<in> set signs1 \<and> (\<exists>elem2. elem2 \<in> set signs2 \<and> elem = elem1 @ elem2)"
	+ using assum unfolding signs_smash_def by auto
	+qed
	+
	+lemma subsets_smash_property:
	+ fixes subsets1 subsets2 :: "nat list list"
	+ fixes n:: "nat"
	+ shows "\<forall> (elem :: nat list). (List.member (subsets_smash n subsets1 subsets2) elem) \<longrightarrow>
	+ (\<exists> (elem1::nat list). \<exists> (elem2::nat list).
	+ (elem1 \<in> set(subsets1) \<and> elem2 \<in> set(subsets2) \<and> elem = (elem1 @ ((map ((+) n) elem2)))))"
	+proof -
	+ let ?new_subsets = "(map (map ((+) n)) subsets2)"
	+ (* a slightly unorthodox use of signs_smash, but it closes the proof *)
	+ have "subsets_smash n subsets1 subsets2 = signs_smash subsets1 ?new_subsets"
	+ unfolding subsets_smash_def signs_smash_def apply (auto)
	+ by (simp add: comp_def)
	+ then show ?thesis
	+ by (smt imageE in_set_member set_map signs_smash_property_set)
	+qed
	+
	+ (* If subsets for smaller systems are well-defined, then subsets for combined systems
	+ are well-defined *)
	+subsection "Well-defined subsets preserved when smashing"
	+
	+lemma list_constr_append:
	+ "list_constr a n \<and> list_constr b n \<longrightarrow> list_constr (a@b) n"
	+ apply (auto) unfolding list_constr_def
	+ using list_all_append by blast
	+
	+lemma well_def_step:
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes subsets1 subsets2 :: "nat list list"
	+ assumes well_def_subsets1: "all_list_constr (subsets1) (length qs1)"
	+ assumes well_def_subsets2: "all_list_constr (subsets2) (length qs2)"
	+ shows "all_list_constr ((subsets_smash (length qs1) subsets1 subsets2))
	+ (length (qs1 @ qs2))"
	+proof -
	+ have h1: "\<forall>elem.
	+ List.member (subsets_smash (length qs1) subsets1 subsets2) elem \<longrightarrow>
	+ (\<exists>elem1 elem2. elem1 \<in> set subsets1 \<and> elem2 \<in> set subsets2 \<and> elem = elem1 @ map ((+) (length qs1)) elem2)"
	+ using subsets_smash_property by blast
	+ have h2: "\<forall>elem1 elem2. (elem1 \<in> set subsets1 \<and> elem2 \<in> set subsets2) \<longrightarrow> list_constr (elem1 @ map ((+) (length qs1)) elem2) (length (qs1 @ qs2))"
	+ proof clarsimp
	+ fix elem1
	+ fix elem2
	+ assume e1: "elem1 \<in> set subsets1"
	+ assume e2: "elem2 \<in> set subsets2"
	+ have h1: "list_constr elem1 (length qs1 + length qs2) "
	+ proof -
	+ have h1: "list_constr elem1 (length qs1)" using e1 well_def_subsets1
	+ unfolding all_list_constr_def
	+ by (simp add: in_set_member)
	+ then show ?thesis unfolding list_constr_def
	+ by (simp add: list.pred_mono_strong)
	+ qed
	+ have h2: "list_constr (map ((+) (length qs1)) elem2) (length qs1 + length qs2)"
	+ proof -
	+ have h1: "list_constr elem2 (length qs2)" using e2 well_def_subsets2
	+ unfolding all_list_constr_def
	+ by (simp add: in_set_member)
	+ then show ?thesis unfolding list_constr_def
	+ by (simp add: list_all_length)
	+ qed
	+ show "list_constr (elem1 @ map ((+) (length qs1)) elem2) (length qs1 + length qs2)"
	+ using h1 h2 list_constr_append
	+ by blast
	+ qed
	+ then show ?thesis using h1 unfolding all_list_constr_def by auto
	+qed
	+
	+subsection "Well def signs preserved when smashing"
	+lemma well_def_signs_step:
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes signs1 signs2 :: "rat list list"
	+ assumes "length qs1 > 0"
	+ assumes "length qs2 > 0"
	+ assumes well_def1: "well_def_signs (length qs1) signs1"
	+ assumes well_def2: "well_def_signs (length qs2) signs2"
	+ shows "well_def_signs (length (qs1@qs2)) (signs_smash signs1 signs2)"
	+ using well_def1 well_def2 unfolding well_def_signs_def using signs_smash_property_set[of signs1 signs2] length_append by auto
	+
	+subsection "Distinct signs preserved when smashing"
	+
	+lemma distinct_map_append:
	+ assumes "distinct ls"
	+ shows "distinct (map ((@) xs) ls)"
	+ unfolding distinct_map inj_on_def using assms by auto
	+
	+lemma length_eq_append:
	+ assumes "length y = length b"
	+ shows "(x @ y = a @ b) \<longleftrightarrow> x=a \<and> y = b"
	+ by (simp add: assms)
	+
	+lemma distinct_step:
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes signs1 signs2 :: "rat list list"
	+ assumes well_def1: "well_def_signs n1 signs1"
	+ assumes well_def2: "well_def_signs n2 signs2"
	+ assumes distinct1: "distinct signs1"
	+ assumes distinct2: "distinct signs2"
	+ shows "distinct (signs_smash signs1 signs2)"
	+ unfolding signs_smash_def
	+ using distinct1
	+proof(induction signs1)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a signs1)
	+ then show ?case apply (auto simp add: distinct2 distinct_map_append)
	+ using assms unfolding well_def_signs_def
	+ by (simp add: distinct1 distinct2 length_eq_append)
	+qed
	+
	+(* In this section we will show that if signs1 contains all consistent sign assignments and signs2
	+contains all consistent sign assignments, then their smash contains all consistent sign assignments.
	+Intuitively, this makes sense because signs1 and signs2 are carrying information about different
	+sets of polynomials, and their smash contains all possible combinations of that information.
	+*)
	+subsection "Consistent sign assignments preserved when smashing"
	+
	+lemma subset_smash_signs:
	+ fixes a1 b1 a2 b2:: "rat list list"
	+ assumes sub1: "set a1 \<subseteq> set a2"
	+ assumes sub2: "set b1 \<subseteq> set b2"
	+ shows "set (signs_smash a1 b1) \<subseteq> set (signs_smash a2 b2)"
	+proof -
	+ have h1: "\<forall>x\<in>set (signs_smash a1 b1). x\<in>set (signs_smash a2 b2)"
	+ proof clarsimp
	+ fix x
	+ assume x_in: "x \<in> set (signs_smash a1 b1)"
	+ have h1: "\<exists> n m :: nat. x = (nth a1 n)@(nth b1 m)"
	+ using signs_smash_property[of a1 b1] x_in
	+ by blast
	+ then have h2: "\<exists> p q::nat. x = (nth a2 p)@(nth b2 q)"
	+ using sub1 sub2 apply (auto)
	+ by (metis nth_find_first signs_smash_property_set subset_code(1) x_in)
	+ then show "x \<in> set (signs_smash a2 b2)"
	+ unfolding signs_smash_def apply (auto)
	+ using signs_smash_property_set sub1 sub2 x_in by fastforce
	+ qed
	+ then show ?thesis
	+ by blast
	+qed
	+
	+lemma subset_helper:
	+ fixes p:: "real poly"
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes signs1 signs2 :: "rat list list"
	+ shows "\<forall> x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2)).
	+ \<exists> x1 \<in> set (characterize_consistent_signs_at_roots_copr p qs1).
	+ \<exists> x2 \<in> set (characterize_consistent_signs_at_roots_copr p qs2).
	+ x = x1@x2"
	+proof clarsimp
	+ fix x
	+ assume x_in: "x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2))"
	+ have x_in_csv: "x \<in> set(map (consistent_sign_vec_copr (qs1 @ qs2)) (characterize_root_list_p p))"
	+ using x_in unfolding characterize_consistent_signs_at_roots_copr_def by simp
	+ have csv_hyp: "\<forall>r. consistent_sign_vec_copr (qs1 @ qs2) r = (consistent_sign_vec_copr qs1 r)@(consistent_sign_vec_copr qs2 r)"
	+ unfolding consistent_sign_vec_copr_def by auto
	+ have exr_iff: "(\<exists>r \<in> set (characterize_root_list_p p). x = consistent_sign_vec_copr (qs1 @ qs2) r) \<longleftrightarrow> (\<exists>r \<in> set (characterize_root_list_p p). x = (consistent_sign_vec_copr qs1 r)@(consistent_sign_vec_copr qs2 r))"
	+ using csv_hyp by auto
	+ have exr: "x \<in> set(map (consistent_sign_vec_copr (qs1 @ qs2)) (characterize_root_list_p p)) \<longrightarrow> (\<exists>r \<in> set (characterize_root_list_p p). x = consistent_sign_vec_copr (qs1 @ qs2) r)"
	+ by auto
	+ have mem_list1: "\<forall> r \<in> set (characterize_root_list_p p). (consistent_sign_vec_copr qs1 r) \<in> set(map (consistent_sign_vec_copr qs1) (characterize_root_list_p p))"
	+ by simp
	+ have mem_list2: "\<forall> r \<in> set (characterize_root_list_p p). (consistent_sign_vec_copr qs2 r) \<in> set(map (consistent_sign_vec_copr qs2) (characterize_root_list_p p))"
	+ by simp
	+ then show "\<exists>x1\<in>set (characterize_consistent_signs_at_roots_copr p qs1).
	+ \<exists>x2\<in>set (characterize_consistent_signs_at_roots_copr p qs2). x = x1 @ x2"
	+ using x_in_csv exr mem_list1 mem_list2 characterize_consistent_signs_at_roots_copr_def exr_iff by auto
	+qed
	+
	+lemma subset_step:
	+ fixes p:: "real poly"
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes signs1 signs2 :: "rat list list"
	+ assumes csa1: "set (characterize_consistent_signs_at_roots_copr p qs1) \<subseteq> set (signs1)"
	+ assumes csa2: "set (characterize_consistent_signs_at_roots_copr p qs2) \<subseteq> set (signs2)"
	+ shows "set (characterize_consistent_signs_at_roots_copr p
	+ (qs1 @ qs2))
	+ \<subseteq> set (signs_smash signs1 signs2)"
	+proof -
	+ have h0: "\<forall> x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2)). \<exists> x1 \<in> set (characterize_consistent_signs_at_roots_copr p qs1). \<exists> x2 \<in> set (characterize_consistent_signs_at_roots_copr p qs2).
	+ (x = x1@x2)" using subset_helper[of p qs1 qs2]
	+ by blast
	+ then have "\<forall>x \<in> set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2)).
	+ x \<in> set (signs_smash (characterize_consistent_signs_at_roots_copr p qs1)
	+ (characterize_consistent_signs_at_roots_copr p qs2))"
	+ unfolding signs_smash_def apply (auto)
	+ by fastforce
	+ then have "\<forall>x \<in> set (characterize_consistent_signs_at_roots_copr p
	+ (qs1 @ qs2)). x \<in> set (signs_smash signs1 signs2)"
	+ using csa1 csa2 subset_smash_signs[of _ signs1 _ signs2] apply (auto)
	+ by blast
	+ thus ?thesis
	+ by blast
	+qed
	+
	+subsection "Main Results"
	+
	+lemma dim_row_mat_of_rows_list[simp]:
	+ shows "dim_row (mat_of_rows_list nr ls) = length ls"
	+ unfolding mat_of_rows_list_def by auto
	+
	+lemma dim_col_mat_of_rows_list[simp]:
	+ shows "dim_col (mat_of_rows_list nr ls) = nr"
	+ unfolding mat_of_rows_list_def by auto
	+
	+lemma dim_row_matrix_A[simp]:
	+ shows "dim_row (matrix_A signs subsets) = length subsets"
	+ unfolding matrix_A_def by auto
	+
	+lemma dim_col_matrix_A[simp]:
	+ shows "dim_col (matrix_A signs subsets) = length signs"
	+ unfolding matrix_A_def by auto
	+
	+lemma length_signs_smash:
	+ shows
	+ "length (signs_smash signs1 signs2) = length signs1 * length signs2"
	+ unfolding signs_smash_def length_concat
	+ by (auto simp add: o_def sum_list_triv)
	+
	+lemma length_subsets_smash:
	+ shows
	+ "length (subsets_smash n subs1 subs2) = length subs1 * length subs2"
	+ unfolding subsets_smash_def length_concat
	+ by (auto simp add: o_def sum_list_triv)
	+
	+lemma length_eq_concat:
	+ assumes "\<And>x. x \<in> set ls \<Longrightarrow> length x = n"
	+ assumes "i < n * length ls"
	+ shows "concat ls ! i = ls ! (i div n) ! (i mod n)"
	+ using assms
	+proof (induct ls arbitrary: i)
	+ case Nil
	+ then show ?case
	+ by simp
	+next
	+ case (Cons a ls)
	+ then show ?case
	+ apply (auto simp add: nth_append)
	+ using div_if mod_geq by auto
	+qed
	+
	+lemma z_append:
	+ assumes "\<And>i. i \<in> set xs \<Longrightarrow> i < length as"
	+ shows "z (xs @ (map ((+) (length as)) ys)) (as @ bs) = z xs as * z ys bs"
	+proof -
	+ have 1: "map ((!) (as @ bs)) xs = map ((!) as) xs"
	+ unfolding list_eq_iff_nth_eq
	+ using assms by (auto simp add:nth_append)
	+ have 2: "map ((!) (as @ bs) \<circ> (+) (length as)) ys = map ((!) bs) ys"
	+ unfolding list_eq_iff_nth_eq
	+ using assms by auto
	+ show ?thesis
	+ unfolding z_def apply auto
	+ unfolding 1 2 by auto
	+qed
	+
	+(* Shows that the matrix of a smashed system is the Kronecker product of the matrices of the two
	+ systems being combined *)
	+lemma matrix_construction_is_kronecker_product:
	+ fixes qs1 :: "real poly list"
	+ fixes subs1 subs2 :: "nat list list"
	+ fixes signs1 signs2 :: "rat list list"
	+ (* n1 is the number of polynomials in the "1" sets *)
	+ assumes "\<And>l i. l \<in> set subs1 \<Longrightarrow> i \<in> set l \<Longrightarrow> i < n1"
	+ assumes "\<And>j. j \<in> set signs1 \<Longrightarrow> length j = n1"
	+ shows "
	+ (matrix_A (signs_smash signs1 signs2) (subsets_smash n1 subs1 subs2)) =
	+ kronecker_product (matrix_A signs1 subs1) (matrix_A signs2 subs2)"
	+ unfolding mat_eq_iff dim_row_matrix_A dim_col_matrix_A
	+ length_subsets_smash length_signs_smash dim_kronecker
	+proof safe
	+ fix i j
	+ assume i: "i < length subs1 * length subs2"
	+ and j: "j < length signs1 * length signs2"
	+ have ld: "i div length subs2 < length subs1"
	+ "j div length signs2 < length signs1"
	+ using i j less_mult_imp_div_less by auto
	+ have lm: "i mod length subs2 < length subs2"
	+ "j mod length signs2 < length signs2"
	+ using i j less_mult_imp_mod_less by auto
	+
	+ have n1: "n1 = length (signs1 ! (j div length signs2))"
	+ using assms(2) ld(2) nth_mem by blast
	+
	+ have 1: "matrix_A (signs_smash signs1 signs2) (subsets_smash n1 subs1 subs2) $$ (i, j) =
	+ z (subsets_smash n1 subs1 subs2 ! i) (signs_smash signs1 signs2 ! j)"
	+ unfolding mat_of_rows_list_def matrix_A_def mtx_row_def
	+ using i j
	+ by (simp add: length_signs_smash length_subsets_smash)
	+ have 2: " ... = z (subs1 ! (i div length subs2) @ map ((+) n1) (subs2 ! (i mod length subs2)))
	+ (signs1 ! (j div length signs2) @ signs2 ! (j mod length signs2))"
	+ unfolding signs_smash_def subsets_smash_def
	+ apply (subst length_eq_concat)
	+ using i apply (auto simp add: mult.commute)
	+ apply (subst length_eq_concat)
	+ using j apply (auto simp add: mult.commute)
	+ using ld lm by auto
	+ have 3: "... =
	+ z (subs1 ! (i div length subs2)) (signs1 ! (j div length signs2)) *
	+ z (subs2 ! (i mod length subs2)) (signs2 ! (j mod length signs2))"
	+ unfolding n1
	+ apply (subst z_append)
	+ apply (auto simp add: n1[symmetric])
	+ using assms(1) ld(1) nth_mem by blast
	+ have 4: "kronecker_product (matrix_A signs1 subs1) (matrix_A signs2 subs2) $$ (i,j) =
	+ z (subs1 ! (i div length subs2))
	+ (signs1 ! (j div length signs2)) *
	+ z (subs2 ! (i mod length subs2))
	+ (signs2 ! (j mod length signs2))"
	+ unfolding kronecker_product_def matrix_A_def mat_of_rows_list_def mtx_row_def
	+ using i j apply (auto simp add: Let_def)
	+ apply (subst index_mat(1)[OF ld])
	+ apply (subst index_mat(1)[OF lm])
	+ using ld lm by auto
	+ show "matrix_A (signs_smash signs1 signs2) (subsets_smash n1 subs1 subs2) $$ (i, j) =
	+ kronecker_product (matrix_A signs1 subs1) (matrix_A signs2 subs2) $$ (i, j)"
	+ using 1 2 3 4 by auto
	+qed
	+
	+(* Given that two smaller systems satisfy some mild constraints, show that their combined system
	+ (after smashing the signs and subsets) satisfies the matrix equation, and that the matrix of the
	+ combined system is invertible. *)
	+lemma inductive_step:
	+ fixes p:: "real poly"
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes subsets1 subsets2 :: "nat list list"
	+ fixes signs1 signs2 :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
	+ assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
	+ assumes welldefined_signs1: "well_def_signs (length qs1) signs1"
	+ assumes welldefined_signs2: "well_def_signs (length qs2) signs2"
	+ assumes distinct_signs1: "distinct signs1"
	+ assumes distinct_signs2: "distinct signs2"
	+ assumes all_info1: "set (characterize_consistent_signs_at_roots_copr p qs1) \<subseteq> set(signs1)"
	+ assumes all_info2: "set (characterize_consistent_signs_at_roots_copr p qs2) \<subseteq> set(signs2)"
	+ assumes welldefined_subsets1: "all_list_constr (subsets1) (length qs1)"
	+ assumes welldefined_subsets2: "all_list_constr (subsets2) (length qs2)"
	+ assumes invertibleMtx1: "invertible_mat (matrix_A signs1 subsets1)"
	+ assumes invertibleMtx2: "invertible_mat (matrix_A signs2 subsets2)"
	+ shows "satisfy_equation p (qs1@qs2) (subsets_smash (length qs1) subsets1 subsets2) (signs_smash signs1 signs2)
	+ \<and> invertible_mat (matrix_A (signs_smash signs1 signs2) (subsets_smash (length qs1) subsets1 subsets2))"
	+proof -
	+ have h1: "invertible_mat (matrix_A (signs_smash signs1 signs2) (subsets_smash (length qs1) subsets1 subsets2))"
	+ using matrix_construction_is_kronecker_product
	+ kronecker_invertible invertibleMtx1 invertibleMtx2
	+ welldefined_subsets1 welldefined_subsets2 unfolding all_list_constr_def list_constr_def
	+ by (smt in_set_conv_nth in_set_member list_all_length well_def_signs_def welldefined_signs1)
	+ have h2a: "distinct (signs_smash signs1 signs2)"
	+ using distinct_signs1 distinct_signs2 welldefined_signs1 welldefined_signs2 nontriv1 nontriv2
	+ distinct_step by auto
	+ have h2ba: "\<forall> q. List.member (qs1 @ qs2) q \<longrightarrow> (List.member qs1 q \<or> List.member qs2 q)"
	+ unfolding member_def
	+ by auto
	+ have h2b: "\<forall>q. ((List.member (qs1@qs2) q) \<longrightarrow> (coprime p q))"
	+ using h2ba pairwise_rel_prime1 pairwise_rel_prime2 by auto
	+ have h2c: "all_list_constr ((subsets_smash (length qs1) subsets1 subsets2)) (length (qs1@qs2))"
	+ using well_def_step
	+ welldefined_subsets1 welldefined_subsets2
	+ by blast
	+ have h2d: "set (characterize_consistent_signs_at_roots_copr p (qs1@qs2)) \<subseteq> set(signs_smash signs1 signs2)"
	+ using subset_step all_info1 all_info2
	+ by simp
	+ have h2: "satisfy_equation p (qs1@qs2) (subsets_smash (length qs1) subsets1 subsets2) (signs_smash signs1 signs2)"
	+ using matrix_equation[where p="p", where qs="qs1@qs2", where subsets = "subsets_smash (length qs1) subsets1 subsets2",
	+ where signs = "signs_smash signs1 signs2"]
	+ h2a h2b h2c h2d apply (auto) using nonzero by blast
	+ show ?thesis using h1 h2 by blast
	+qed
	+
	+section "Reduction Step Proofs"
	+
	+(* Some definitions *)
	+definition get_matrix:: "(rat mat \<times> (nat list list \<times> rat list list)) \<Rightarrow> rat mat"
	+ where "get_matrix data = fst(data)"
	+
	+definition get_subsets:: "(rat mat \<times> (nat list list \<times> rat list list)) \<Rightarrow> nat list list"
	+ where "get_subsets data = fst(snd(data))"
	+
	+definition get_signs:: "(rat mat \<times> (nat list list \<times> rat list list)) \<Rightarrow> rat list list"
	+ where "get_signs data = snd(snd(data))"
	+
	+definition reduction_signs:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> nat list list \<Rightarrow> rat mat \<Rightarrow> rat list list"
	+ where "reduction_signs p qs signs subsets matr =
	+ (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets matr)))"
	+
	+definition reduction_subsets:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> nat list list \<Rightarrow> rat mat \<Rightarrow> nat list list"
	+ where "reduction_subsets p qs signs subsets matr =
	+ (take_indices subsets (rows_to_keep (reduce_mat_cols matr (solve_for_lhs p qs subsets matr))))"
	+
	+(* Some basic lemmas *)
	+lemma reduction_signs_is_get_signs: "reduction_signs p qs signs subsets m = get_signs (reduce_system p (qs, (m, (subsets, signs))))"
	+ unfolding reduction_signs_def get_signs_def
	+ by (metis reduce_system.simps reduction_step.elims snd_conv)
	+
	+lemma reduction_subsets_is_get_subsets: "reduction_subsets p qs signs subsets m = get_subsets (reduce_system p (qs, (m, (subsets, signs))))"
	+ unfolding reduction_subsets_def get_subsets_def
	+ by (metis fst_conv reduce_system.simps reduction_step.elims snd_conv)
	+
	+lemma find_zeros_from_vec_prop:
	+ fixes input_vec :: "rat vec"
	+ shows "\<forall>n < (dim_vec input_vec). ((input_vec $ n \<noteq> 0) \<longleftrightarrow>
	+ List.member (find_nonzeros_from_input_vec input_vec) n)"
	+proof -
	+ have h1: "\<forall>n < (dim_vec input_vec). ((input_vec $ n \<noteq> 0) \<longrightarrow> List.member (find_nonzeros_from_input_vec input_vec) n)"
	+ unfolding find_nonzeros_from_input_vec_def List.member_def by auto
	+ have h2: "\<forall>n < (dim_vec input_vec). (List.member (find_nonzeros_from_input_vec input_vec) n \<longrightarrow> (input_vec $ n \<noteq> 0) )"
	+ unfolding find_nonzeros_from_input_vec_def List.member_def by auto
	+ show ?thesis using h1 h2 by auto
	+qed
	+
	+
	+subsection "Showing sign conditions preserved when reducing"
	+
	+lemma take_indices_lem:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes arb_list :: "'a list list"
	+ fixes index_list :: "nat list"
	+ fixes n:: "nat"
	+ assumes lest: "n < length (take_indices arb_list index_list)"
	+ assumes well_def: "\<forall>q.(List.member index_list q \<longrightarrow> q < length arb_list)"
	+ shows "\<exists>k<length arb_list.
	+ (take_indices arb_list index_list) ! n = arb_list ! k"
	+ using lest well_def unfolding take_indices_def apply (auto)
	+ by (metis in_set_member nth_mem)
	+
	+lemma invertible_means_mult_id:
	+ fixes A:: "'a::field mat"
	+ assumes assm: "invertible_mat A"
	+ shows "matr_option (dim_row A)
	+ (mat_inverse (A))*A = 1\<^sub>m (dim_row A)"
	+proof (cases "mat_inverse(A)")
	+ obtain n where n: "A \<in> carrier_mat n n"
	+ using assms invertible_mat_def square_mat.simps by blast
	+ case None
	+ then have "A \<notin> Units (ring_mat TYPE('a) n n)"
	+ by (simp add: mat_inverse(1) n)
	+ thus ?thesis
	+ by (meson assms det_non_zero_imp_unit invertible_Units n unit_imp_det_non_zero)
	+next
	+ case (Some a)
	+ then show ?thesis
	+ by (metis assms carrier_matI invertible_mat_def mat_inverse(2) matr_option.simps(2) square_mat.elims(2))
	+qed
	+
	+lemma dim_invertible:
	+ fixes A:: "'a::field mat"
	+ fixes n:: "nat"
	+ assumes assm: "invertible_mat A"
	+ assumes dim: "A \<in> carrier_mat n n"
	+ shows "matr_option (dim_row A)
	+ (mat_inverse (A)) \<in> carrier_mat n n"
	+proof (cases "mat_inverse(A)")
	+ obtain n where n: "A \<in> carrier_mat n n"
	+ using assms invertible_mat_def square_mat.simps by blast
	+ case None
	+ then have "A \<notin> Units (ring_mat TYPE('a) n n)"
	+ by (simp add: mat_inverse(1) n)
	+ thus ?thesis
	+ by (meson assms det_non_zero_imp_unit invertible_Units n unit_imp_det_non_zero)
	+next
	+ case (Some a)
	+ then show ?thesis
	+ using dim mat_inverse(2) by auto
	+qed
	+
	+lemma mult_assoc:
	+ fixes A B:: "rat mat"
	+ fixes v:: "rat vec"
	+ fixes n:: "nat"
	+ assumes "A \<in> carrier_mat n n"
	+ assumes "B \<in> carrier_mat n n"
	+ assumes "dim_vec v = n"
	+ shows "A \<^sub>v (mult_mat_vec B v) = (AB)*\<^sub>v v"
	+ using assms(1) assms(2) assms(3) by auto
	+
	+lemma size_of_mat:
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ shows "(matrix_A signs subsets) \<in> carrier_mat (length subsets) (length signs)"
	+ unfolding matrix_A_def carrier_mat_def by auto
	+
	+lemma size_of_lhs:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes signs :: "rat list list"
	+ shows "dim_vec (construct_lhs_vector p qs signs) = length signs"
	+ unfolding construct_lhs_vector_def
	+ by simp
	+
	+lemma size_of_rhs:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ shows "dim_vec (construct_rhs_vector p qs subsets) = length subsets"
	+ unfolding construct_rhs_vector_def
	+ by simp
	+
	+lemma same_size:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
	+ shows "length subsets = length signs"
	+ using invertible_mat unfolding invertible_mat_def
	+ using size_of_mat[of signs subsets] size_of_lhs[of p qs signs] size_of_rhs[of p qs subsets]
	+ by simp
	+
	+lemma mat_equal_list_lem:
	+ fixes A:: "'a::field mat"
	+ fixes B:: "'a::field mat"
	+ shows "(dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> mat_to_list A = mat_to_list B)
	+ \<Longrightarrow> A = B"
	+proof -
	+ assume hyp: "dim_row A = dim_row B \<and> dim_col A = dim_col B \<and> mat_to_list A = mat_to_list B"
	+ then have "\<And>i j. i < dim_row A \<Longrightarrow> j < dim_col A \<Longrightarrow> B $$ (i, j) = A $$ (i, j)"
	+ unfolding mat_to_list_def by auto
	+ then show ?thesis using hyp
	+ unfolding mat_to_list_def
	+ using eq_matI[of A B]
	+ by metis
	+qed
	+
	+lemma mat_inverse_same: "mat_inverse_var A = mat_inverse A"
	+ unfolding mat_inverse_var_def mat_inverse_def mat_equal_def
	+ using mat_equal_list_lem apply (simp)
	+ by (smt case_prod_beta index_one_mat(2) index_one_mat(3) mat_equal_list_lem)
	+
	+lemma construct_lhs_matches_solve_for_lhs:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
	+ shows "(construct_lhs_vector p qs signs) = solve_for_lhs p qs subsets (matrix_A signs subsets)"
	+proof -
	+ have matrix_equation_hyp: "(mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs) = (construct_rhs_vector p qs subsets))"
	+ using match unfolding satisfy_equation_def by blast
	+ then have eqn_hyp: " ((matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs)) =
	+ mult_mat_vec (matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) (construct_rhs_vector p qs subsets))"
	+ using invertible_mat
	+ by (simp add: matrix_equation_hyp)
	+ have match_hyp: "length subsets = length signs" using same_size invertible_mat by auto
	+ then have dim_hyp1: "matrix_A signs subsets \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ then have dim_hyp2: "matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets)) \<in> carrier_mat (length signs) (length signs)"
	+ using invertible_mat dim_invertible
	+ by blast
	+ have mult_assoc_hyp: "((matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs)))
	+ = (((matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) * (matrix_A signs subsets)) *\<^sub>v (construct_lhs_vector p qs signs))"
	+ using mult_assoc dim_hyp1 dim_hyp2 size_of_lhs by auto
	+ have cancel_helper: "(((matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) * (matrix_A signs subsets)) *\<^sub>v (construct_lhs_vector p qs signs))
	+ = (1\<^sub>m (length signs)) *\<^sub>v (construct_lhs_vector p qs signs)"
	+ using invertible_means_mult_id[where A= "matrix_A signs subsets"] dim_hyp1
	+ by (simp add: invertible_mat match_hyp)
	+ then have cancel_hyp: "(((matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) * (matrix_A signs subsets)) *\<^sub>v (construct_lhs_vector p qs signs))
	+ = (construct_lhs_vector p qs signs)"
	+ apply (auto)
	+ by (metis carrier_vec_dim_vec one_mult_mat_vec size_of_lhs)
	+ then have mult_hyp: "((matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A signs subsets) (construct_lhs_vector p qs signs)))
	+ = (construct_lhs_vector p qs signs)"
	+ using mult_assoc_hyp cancel_hyp
	+ by simp
	+ then have "(construct_lhs_vector p qs signs) = (mult_mat_vec (matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets))) (construct_rhs_vector p qs subsets)) "
	+ using eqn_hyp
	+ by simp
	+ then show ?thesis
	+ unfolding solve_for_lhs_def
	+ by (simp add: mat_inverse_same)
	+qed
	+
	+(* If set(A) is a subset of B then for all n, nth c n = 0 means nth a n not in B *)
	+lemma reduction_signs_set_helper_lemma:
	+ fixes A:: "rat list set"
	+ fixes C:: "rat vec"
	+ fixes B:: "rat list list"
	+ assumes "dim_vec C = length B"
	+ assumes sub: "A \<subseteq> set(B)"
	+ assumes not_in_hyp: "\<forall> n < dim_vec C. C $ n = 0 \<longrightarrow> (nth B n) \<notin> A"
	+ shows "A \<subseteq> set (take_indices B
	+ (find_nonzeros_from_input_vec C))"
	+proof -
	+ have unfold: "\<And> x. (x \<in> A \<Longrightarrow> x \<in> set (take_indices B
	+ (find_nonzeros_from_input_vec C)))"
	+ proof -
	+ fix x
	+ assume in_a: "x \<in> A"
	+ have "x \<in> set (B)"
	+ using sub in_a by blast
	+ then have "\<exists> n < length B. nth B n = x"
	+ by (simp add: in_set_conv_nth)
	+ then have "\<exists> n < length B. (nth B n = x \<and> (List.member (find_nonzeros_from_input_vec C) n) = True)"
	+ using not_in_hyp find_zeros_from_vec_prop[of C]
	+ using assms(1) in_a by auto
	+ thus "x \<in> set (take_indices B
	+ (find_nonzeros_from_input_vec C))"
	+ unfolding take_indices_def
	+ using member_def by fastforce
	+ qed
	+ then show ?thesis
	+ by blast
	+qed
	+
	+lemma reduction_signs_set_helper_lemma2:
	+ fixes A:: "rat list set"
	+ fixes C:: "rat vec"
	+ fixes B:: "rat list list"
	+ assumes dist: "distinct B"
	+ assumes eq_len: "dim_vec C = length B"
	+ assumes sub: "A \<subseteq> set(B)"
	+ assumes not_in_hyp: "\<forall> n < dim_vec C. C $ n \<noteq> 0 \<longrightarrow> (nth B n) \<in> A"
	+ shows "set (take_indices B
	+ (find_nonzeros_from_input_vec C)) \<subseteq> A"
	+proof -
	+ have unfold: "\<And> x. (x \<in> (set (take_indices B
	+ (find_nonzeros_from_input_vec C))) \<Longrightarrow> x \<in> A)"
	+ proof -
	+ fix x
	+ assume in_set: "x \<in> set (take_indices B (find_nonzeros_from_input_vec C))"
	+ have h: "\<exists>n< dim_vec C. (C $ n \<noteq> 0 \<and> (nth B n) = x)"
	+ proof -
	+ have h1: "\<exists>n < length B.(nth B n) = x"
	+ using in_set unfolding take_indices_def
	+ find_nonzeros_from_input_vec_def eq_len by auto
	+ have h2: "\<forall>n< length B. (nth B n = x \<longrightarrow> List.member (find_nonzeros_from_input_vec C) n)"
	+ proof clarsimp
	+ fix n
	+ assume leq_hyp: "n < length B"
	+ assume x_eq: "x = B ! n"
	+ have h: "(B !n) \<in> set (map ((!) B) (find_nonzeros_from_input_vec C))"
	+ using x_eq in_set
	+ by (simp add: take_indices_def)
	+ then have h2: "List.member (map ((!) B) (find_nonzeros_from_input_vec C)) (B ! n)"
	+ using in_set
	+ by (meson in_set_member)
	+ then have h3: "\<exists>k< length B. (List.member (find_nonzeros_from_input_vec C) k \<and> ((B ! k) = (B ! n)))"
	+ by (smt atLeastLessThan_iff eq_len find_nonzeros_from_input_vec_def imageE in_set_member mem_Collect_eq set_filter set_map set_upt)
	+ have h4: "\<forall>v< length B. ((B ! v) = (B ! n) \<longrightarrow> v = n)"
	+ using dist apply (auto)
	+ using leq_hyp nth_eq_iff_index_eq by blast
	+ then show "List.member (find_nonzeros_from_input_vec C) n"
	+ using h2 h3 h4 by auto
	+ qed
	+ then have "\<forall>n<length B. (nth B n = x \<longrightarrow> C $ n \<noteq> 0)"
	+ using find_zeros_from_vec_prop [of C]
	+ by (simp add: eq_len)
	+ then show ?thesis using h1 eq_len
	+ by auto
	+ qed
	+ thus "x \<in> A" using not_in_hyp
	+ by blast
	+ qed
	+ then show ?thesis
	+ by blast
	+qed
	+
	+(* Show that dropping columns doesn't affect the consistent sign assignments *)
	+lemma reduction_doesnt_break_things_signs:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
	+ shows "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(reduction_signs p qs signs subsets (matrix_A signs subsets))"
	+proof -
	+ have dim_hyp2: "matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets)) \<in> carrier_mat (length signs) (length signs)"
	+ using invertible_mat dim_invertible
	+ using same_size by fastforce
	+ have "(construct_lhs_vector p qs signs) = solve_for_lhs p qs subsets (matrix_A signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs assms by auto
	+ then have "(solve_for_lhs p qs subsets (matrix_A signs subsets)) =
	+ vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) signs))"
	+ using construct_lhs_vector_cleaner assms
	+ by (metis (mono_tags, lifting) list.map_cong map_map o_apply of_int_of_nat_eq)
	+ then have "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))).
	+ (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n = 0) \<longrightarrow>
	+ (nth signs n) \<notin> set (characterize_consistent_signs_at_roots_copr p qs))"
	+ proof -
	+ have h0: "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))).
	+ (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n = 0) \<longrightarrow>
	+ rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = (nth signs n)}) = 0)"
	+ by (metis (mono_tags, lifting) \<open>construct_lhs_vector p qs signs = solve_for_lhs p qs subsets (matrix_A signs subsets)\<close> construct_lhs_vector_clean nonzero of_nat_0_eq_iff of_rat_of_nat_eq size_of_lhs)
	+ have h1: "\<forall> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) = 0 \<longrightarrow>
	+ (\<nexists> x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w))"
	+ proof clarsimp
	+ fix x
	+ assume card_asm: "card {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = consistent_sign_vec_copr qs x} = 0"
	+ assume zero_asm: "poly p x = 0"
	+ have card_hyp: "{xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = consistent_sign_vec_copr qs x} = {}"
	+ using card_eq_0_iff
	+ using card_asm nonzero poly_roots_finite by fastforce
	+ have "x \<in> {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = consistent_sign_vec_copr qs x}"
	+ using zero_asm by auto
	+ thus "False" using card_hyp
	+ by blast
	+ qed
	+ have h2: "\<And> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) = 0 \<Longrightarrow>
	+ (\<not>List.member (characterize_consistent_signs_at_roots_copr p qs) w))"
	+ by (smt (verit, best) characterize_consistent_signs_at_roots_copr_def characterize_root_list_p_def h1 imageE in_set_member mem_Collect_eq nonzero poly_roots_finite set_map set_remdups sorted_list_of_set(1))
	+ then have h3: "\<forall> w. rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) = 0 \<longrightarrow>
	+ w \<notin> set (characterize_consistent_signs_at_roots_copr p qs)"
	+ by (simp add: in_set_member)
	+ show ?thesis using h0 h3
	+ by blast
	+ qed
	+ then have "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set (take_indices signs
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
	+ using all_info
	+ reduction_signs_set_helper_lemma[where A = "set (characterize_consistent_signs_at_roots_copr p qs)", where B = "signs",
	+ where C = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"]
	+ using dim_hyp2 solve_for_lhs_def by (simp add: mat_inverse_same)
	+ then show ?thesis unfolding reduction_signs_def by auto
	+qed
	+
	+lemma reduction_deletes_bad_sign_conds:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
	+ shows "set (characterize_consistent_signs_at_roots_copr p qs) = set(reduction_signs p qs signs subsets (matrix_A signs subsets))"
	+proof -
	+ have dim_hyp2: "matr_option (dim_row (matrix_A signs subsets))
	+ (mat_inverse (matrix_A signs subsets)) \<in> carrier_mat (length signs) (length signs)"
	+ using invertible_mat dim_invertible
	+ using same_size by fastforce
	+ have supset: "set (characterize_consistent_signs_at_roots_copr p qs) \<supseteq> set(reduction_signs p qs signs subsets (matrix_A signs subsets))"
	+ proof -
	+ have "(construct_lhs_vector p qs signs) = solve_for_lhs p qs subsets (matrix_A signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs assms by auto
	+ then have "(solve_for_lhs p qs subsets (matrix_A signs subsets)) =
	+ vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) signs))"
	+ using construct_lhs_vector_cleaner assms
	+ by (metis (mono_tags, lifting) list.map_cong map_map o_apply of_int_of_nat_eq)
	+ then have "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))).
	+ (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n \<noteq> 0) \<longrightarrow>
	+ (nth signs n) \<in> set (characterize_consistent_signs_at_roots_copr p qs))"
	+ proof -
	+ have h0: "\<forall> n < (dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))).
	+ (((solve_for_lhs p qs subsets (matrix_A signs subsets)) $ n = 0) \<longrightarrow>
	+ rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = (nth signs n)}) = 0)"
	+ by (metis (mono_tags, lifting) \<open>construct_lhs_vector p qs signs = solve_for_lhs p qs subsets (matrix_A signs subsets)\<close> construct_lhs_vector_clean nonzero of_nat_0_eq_iff of_rat_of_nat_eq size_of_lhs)
	+ have h1: "\<forall> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) \<noteq> 0 \<longrightarrow>
	+ (\<exists> x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w))"
	+ proof clarsimp
	+ fix w
	+ assume card_asm: "0 < card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}"
	+ show "\<exists>x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w"
	+ by (metis (mono_tags, lifting) Collect_empty_eq card_asm card_eq_0_iff gr_implies_not0)
	+ qed
	+ have h2: "\<And> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) \<noteq> 0 \<Longrightarrow>
	+ (List.member (characterize_consistent_signs_at_roots_copr p qs) w))"
	+ proof clarsimp
	+ fix w
	+ assume card_asm: " 0 < card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}"
	+ have h0: "\<exists>x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w"
	+ using card_asm
	+ by (simp add: h1)
	+ then show "List.member (characterize_consistent_signs_at_roots_copr p qs) w"
	+ unfolding characterize_consistent_signs_at_roots_copr_def
	+ using in_set_member nonzero poly_roots_finite characterize_root_list_p_def by fastforce
	+ qed
	+ then have h3: "\<forall> w. rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = w}) \<noteq> 0 \<longrightarrow>
	+ w \<in> set (characterize_consistent_signs_at_roots_copr p qs)"
	+ by (simp add: in_set_member)
	+ show ?thesis using h0 h3
	+ by (metis (no_types, lifting) \<open>solve_for_lhs p qs subsets (matrix_A signs subsets) = vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) signs))\<close> dim_vec_of_list length_map nth_map vec_of_list_index)
	+ qed
	+ then have "set (take_indices signs
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) \<subseteq>
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ using all_info
	+ reduction_signs_set_helper_lemma2[where A = "set (characterize_consistent_signs_at_roots_copr p qs)", where B = "signs",
	+ where C = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"]
	+ using distinct_signs dim_hyp2 solve_for_lhs_def
	+ by (simp add: mat_inverse_same)
	+ then show ?thesis unfolding reduction_signs_def by auto
	+ qed
	+ have subset: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(reduction_signs p qs signs subsets (matrix_A signs subsets))"
	+ using reduction_doesnt_break_things_signs[of p qs signs subsets] assms
	+ by blast
	+ then show ?thesis using supset subset by auto
	+qed
	+
	+theorem reduce_system_sign_conditions:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
	+ shows "set (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))) = set (characterize_consistent_signs_at_roots_copr p qs)"
	+ unfolding get_signs_def
	+ using reduction_deletes_bad_sign_conds[of p qs signs subsets] apply (auto)
	+ apply (simp add: all_info distinct_signs match nonzero reduction_signs_def welldefined_signs1)
	+ using nonzero invertible_mat apply (metis snd_conv)
	+ by (metis all_info distinct_signs invertible_mat match nonzero reduction_signs_def snd_conv welldefined_signs1)
	+
	+subsection "Showing matrix equation preserved when reducing"
	+lemma rows_to_keep_lem:
	+ fixes A:: "('a::field) mat"
	+ shows "\<And>ell. ell \<in> set (rows_to_keep A) \<Longrightarrow> ell < dim_row A"
	+ unfolding rows_to_keep_def
	+ apply auto
	+ using rref_pivot_positions
	+ by (metis carrier_mat_triv gauss_jordan_single(2) gauss_jordan_single(3) index_transpose_mat(3))
	+
	+lemma reduce_system_matrix_equation_preserved:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs: "well_def_signs (length qs) signs"
	+ assumes welldefined_subsets: "all_list_constr (subsets) (length qs)"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A signs subsets)"
	+ assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ shows "satisfy_equation p qs (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
	+ (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
	+proof -
	+ have poly_type_hyp: "p \<noteq> 0" using nonzero by auto
	+ have distinct_signs_hyp: "distinct (snd (snd (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))))"
	+ proof -
	+ let ?sym = "(find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ have h1: "\<forall> i < length (take_indices signs ?sym). \<forall>j < length(take_indices signs ?sym).
	+ i \<noteq> j \<longrightarrow> nth (take_indices signs ?sym) i \<noteq> nth (take_indices signs ?sym) j"
	+ using distinct_signs unfolding take_indices_def
	+ proof clarsimp
	+ fix i
	+ fix j
	+ assume "distinct signs"
	+ assume "i < length
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ assume "j < length
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ assume neq_hyp: "i \<noteq> j"
	+ assume "signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets
	+ (matrix_A signs subsets)) ! i) =
	+ signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets
	+ (matrix_A signs subsets)) ! j)"
	+ have h1: "find_nonzeros_from_input_vec (solve_for_lhs p qs subsets
	+ (matrix_A signs subsets)) ! i \<noteq> find_nonzeros_from_input_vec (solve_for_lhs p qs subsets
	+ (matrix_A signs subsets)) ! j"
	+ unfolding find_nonzeros_from_input_vec_def using neq_hyp
	+ by (metis \<open>i < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> \<open>j < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> distinct_conv_nth distinct_filter distinct_upt find_nonzeros_from_input_vec_def)
	+ then show "False" using distinct_signs
	+ proof -
	+ have f1: "\<forall>p ns n. ((n::nat) \<in> {n \<in> set ns. p n}) = (n \<in> set ns \<and> n \<in> Collect p)"
	+ by simp
	+ then have f2: "filter (\<lambda>n. solve_for_lhs p qs subsets (matrix_A signs subsets) $ n \<noteq> 0) [0..<dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))] ! i \<in> set [0..<length signs]"
	+ by (metis (full_types) \<open>i < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> construct_lhs_matches_solve_for_lhs find_nonzeros_from_input_vec_def invertible_mat match nth_mem set_filter size_of_lhs)
	+ have "filter (\<lambda>n. solve_for_lhs p qs subsets (matrix_A signs subsets) $ n \<noteq> 0) [0..<dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))] ! j \<in> set [0..<length signs]"
	+ using f1 by (metis (full_types) \<open>j < length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> construct_lhs_matches_solve_for_lhs find_nonzeros_from_input_vec_def invertible_mat match nth_mem set_filter size_of_lhs)
	+ then show ?thesis
	+ using f2 by (metis \<open>signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)) ! i) = signs ! (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)) ! j)\<close> atLeastLessThan_iff distinct_conv_nth distinct_signs find_nonzeros_from_input_vec_def h1 set_upt)
	+ qed
	+ qed
	+ then have "distinct (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
	+ using distinct_conv_nth by blast
	+ then show ?thesis
	+ using get_signs_def reduction_signs_def reduction_signs_is_get_signs by auto
	+ qed
	+ have all_info_hyp: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(snd (snd (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))))"
	+ using reduce_system_sign_conditions assms unfolding get_signs_def by auto
	+ have pairwise_rel_prime_hyp: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ using pairwise_rel_prime by auto
	+ have welldefined_hyp: "all_list_constr (fst (snd (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))) (length qs)"
	+ using welldefined_subsets rows_to_keep_lem
	+ unfolding all_list_constr_def List.member_def list_constr_def list_all_def
	+ apply (auto simp add: Let_def take_indices_def take_cols_from_matrix_def)
	+ using nth_mem by fastforce
	+ then show ?thesis using poly_type_hyp distinct_signs_hyp all_info_hyp pairwise_rel_prime_hyp welldefined_hyp
	+ using matrix_equation unfolding get_subsets_def get_signs_def
	+ by blast
	+qed
	+
	+(* Show that we are tracking the correct matrix in the algorithm *)
	+subsection "Showing matrix preserved"
	+lemma reduce_system_matrix_signs_helper_aux:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length signs"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "alt_matrix_A (take_indices signs S) subsets = take_cols_from_matrix (alt_matrix_A signs subsets) S"
	+proof -
	+ have h0a: "dim_col (take_cols_from_matrix (alt_matrix_A signs subsets) S) = length (take_indices signs S)"
	+ unfolding take_cols_from_matrix_def apply (auto) unfolding take_indices_def by auto
	+ have h0: "\<forall>i < length (take_indices signs S). (col (alt_matrix_A (take_indices signs S) subsets ) i =
	+col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i)"
	+ proof clarsimp
	+ fix i
	+ assume asm: "i < length (take_indices signs S)"
	+ have i_lt: "i < length (map ((!) (cols (alt_matrix_A signs subsets))) S)" using asm
	+ apply (auto) unfolding take_indices_def by auto
	+ have h0: " vec (length subsets) (\<lambda>j. z (subsets ! j) (map ((!) signs) S ! i)) =
	+ vec (length subsets) (\<lambda>j. z (subsets ! j) (signs ! (S ! i)))" using nth_map
	+ by (metis \<open>i < length (take_indices signs S)\<close> length_map take_indices_def)
	+ have dim: "(map ((!) (cols (alt_matrix_A signs subsets))) S) ! i \<in> carrier_vec (dim_row (alt_matrix_A signs subsets))"
	+ proof -
	+ have "dim_col (alt_matrix_A signs subsets) = length (signs)"
	+ by (simp add: alt_matrix_A_def)
	+ have well_d: "S ! i < length (signs)" using well_def_h
	+ using i_lt in_set_member by fastforce
	+ have
	+ map_eq: "(map ((!) (cols (alt_matrix_A signs subsets))) S) ! i = nth (cols (alt_matrix_A signs subsets)) (S ! i)"
	+ using i_lt by auto
	+ have "nth (cols (alt_matrix_A signs subsets)) (S ! i) \<in> carrier_vec (dim_row (alt_matrix_A signs subsets))"
	+ using col_dim unfolding cols_def using nth_map well_d
	+ by (simp add: \<open>dim_col (alt_matrix_A signs subsets) = length signs\<close>)
	+ then show ?thesis using map_eq unfolding alt_matrix_A_def by auto
	+ qed
	+ have h1: "col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i =
	+ col (mat_of_cols (dim_row (alt_matrix_A signs subsets)) (map ((!) (cols (alt_matrix_A signs subsets))) S)) i "
	+ by (simp add: take_cols_from_matrix_def take_indices_def)
	+ have h2: "col (mat_of_cols (dim_row (alt_matrix_A signs subsets)) (map ((!) (cols (alt_matrix_A signs subsets))) S)) i
	+ = nth (map ((!) (cols (alt_matrix_A signs subsets))) S) i "
	+ using dim i_lt asm col_mat_of_cols[where j = "i", where n = "(dim_row (alt_matrix_A signs subsets))",
	+ where vs = "(map ((!) (cols (alt_matrix_A signs subsets))) S)"]
	+ by blast
	+ have h3: "col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i = (col (alt_matrix_A signs subsets) (S !i))"
	+ using h1 h2 apply (auto)
	+ by (metis alt_matrix_char asm cols_nth dim_col_mat(1) in_set_member length_map mat_of_rows_list_def matrix_A_def nth_map nth_mem take_indices_def well_def_h)
	+ have "vec (length subsets) (\<lambda>j. z (subsets ! j) (signs ! (S ! i))) = (col (alt_matrix_A signs subsets) (S !i))"
	+ by (metis asm in_set_member length_map nth_mem signs_are_cols take_indices_def well_def_h)
	+ then have "vec (length subsets) (\<lambda>j. z (subsets ! j) (take_indices signs S ! i)) =
	+ col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i "
	+ using h0 h3
	+ by (simp add: take_indices_def)
	+ then show "col (alt_matrix_A (take_indices signs S) subsets) i =
	+ col (take_cols_from_matrix (alt_matrix_A signs subsets) S) i "
	+ using asm signs_are_cols[where signs = "(take_indices signs S)", where subsets = "subsets"]
	+ by auto
	+ qed
	+ then show ?thesis unfolding alt_matrix_A_def take_cols_from_matrix_def apply (auto)
	+ using h0a mat_col_eqI
	+ by (metis alt_matrix_A_def dim_col_mat(1) dim_row_mat(1) h0 mat_of_cols_def take_cols_from_matrix_def)
	+qed
	+
	+
	+lemma reduce_system_matrix_signs_helper:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length signs"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "matrix_A (take_indices signs S) subsets = take_cols_from_matrix (matrix_A signs subsets) S"
	+ using reduce_system_matrix_signs_helper_aux alt_matrix_char assms by auto
	+
	+lemma reduce_system_matrix_subsets_helper_aux:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes inv: "length subsets \<ge> length signs"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length subsets"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "alt_matrix_A signs (take_indices subsets S) = take_rows_from_matrix (alt_matrix_A signs subsets) S"
	+proof -
	+ have h0a: "dim_row (take_rows_from_matrix (alt_matrix_A signs subsets) S) = length (take_indices subsets S)"
	+ unfolding take_rows_from_matrix_def apply (auto) unfolding take_indices_def by auto
	+ have h0: "\<forall>i < length (take_indices subsets S). (row (alt_matrix_A signs (take_indices subsets S) ) i =
	+row (take_rows_from_matrix (alt_matrix_A signs subsets) S) i)"
	+ proof clarsimp
	+ fix i
	+ assume asm: "i < length (take_indices subsets S)"
	+ have i_lt: "i < length (map ((!) (rows (alt_matrix_A signs subsets))) S)" using asm
	+ apply (auto) unfolding take_indices_def by auto
	+ have h0: "row (take_rows_from_matrix (alt_matrix_A signs subsets) S) i =
	+ row (mat_of_rows (dim_col (alt_matrix_A signs subsets)) (map ((!) (rows (alt_matrix_A signs subsets))) S)) i "
	+ unfolding take_rows_from_matrix_def take_indices_def by auto
	+ have dim: "(map ((!) (rows (alt_matrix_A signs subsets))) S) ! i \<in> carrier_vec (dim_col (alt_matrix_A signs subsets))"
	+ proof -
	+ have "dim_col (alt_matrix_A signs subsets) = length (signs)"
	+ by (simp add: alt_matrix_A_def)
	+ then have lenh: "dim_col (alt_matrix_A signs subsets) \<le> length (subsets)"
	+ using assms
	+ by auto
	+ have well_d: "S ! i < length (subsets)" using well_def_h
	+ using i_lt in_set_member by fastforce
	+ have
	+ map_eq: "(map ((!) (rows (alt_matrix_A signs subsets))) S) ! i = nth (rows (alt_matrix_A signs subsets)) (S ! i)"
	+ using i_lt by auto
	+ have "nth (rows (alt_matrix_A signs subsets)) (S ! i) \<in> carrier_vec (dim_col (alt_matrix_A signs subsets))"
	+ using col_dim unfolding rows_def using nth_map well_d
	+ using lenh
	+ by (simp add: alt_matrix_A_def)
	+ then show ?thesis using map_eq unfolding alt_matrix_A_def by auto
	+ qed
	+ have h1: " row (mat_of_rows (dim_col (alt_matrix_A signs subsets)) (map ((!) (rows (alt_matrix_A signs subsets))) S)) i
	+ = (row (alt_matrix_A signs subsets) (S ! i)) "
	+ using dim i_lt mat_of_rows_row[where i = "i", where n = "(dim_col (alt_matrix_A signs subsets))",
	+ where vs = "(map ((!) (rows (alt_matrix_A signs subsets))) S)"]
	+ using alt_matrix_char in_set_member nth_mem well_def_h by fastforce
	+ have "row (alt_matrix_A signs (take_indices subsets S) ) i = (row (alt_matrix_A signs subsets) (S ! i))"
	+ using subsets_are_rows
	+ proof -
	+ have f1: "i < length S"
	+ by (metis (no_types) asm length_map take_indices_def)
	+ then have "List.member S (S ! i)"
	+ by (meson in_set_member nth_mem)
	+ then show ?thesis
	+ using f1 by (simp add: \<open>\<And>subsets signs. \<forall>i<length subsets. row (alt_matrix_A signs subsets) i = vec (length signs) (\<lambda>j. z (subsets ! i) (signs ! j))\<close> take_indices_def well_def_h)
	+ qed
	+ then show "(row (alt_matrix_A signs (take_indices subsets S) ) i =
	+ row (take_rows_from_matrix (alt_matrix_A signs subsets) S) i)"
	+ using h0 h1 unfolding take_indices_def by auto
	+ qed
	+ then show ?thesis unfolding alt_matrix_A_def take_rows_from_matrix_def apply (auto)
	+ using eq_rowI
	+ by (metis alt_matrix_A_def dim_col_mat(1) dim_row_mat(1) h0 length_map mat_of_rows_def take_indices_def take_rows_from_matrix_def)
	+qed
	+
	+
	+lemma reduce_system_matrix_subsets_helper:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes inv: "length subsets \<ge> length signs"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length subsets"
	+ shows "matrix_A signs (take_indices subsets S) = take_rows_from_matrix (matrix_A signs subsets) S"
	+ using assms reduce_system_matrix_subsets_helper_aux alt_matrix_char
	+ by auto
	+
	+lemma reduce_system_matrix_match:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ assumes inv: "invertible_mat (matrix_A signs subsets)"
	+ shows "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
	+ (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))) =
	+ (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
	+proof -
	+ let ?A = "(matrix_A signs subsets)"
	+ let ?lhs_vec = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"
	+ let ?red_mtx = "(take_rows_from_matrix (reduce_mat_cols (matrix_A signs subsets) ?lhs_vec) (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) ?lhs_vec)))"
	+ have h1: "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
	+ (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
	+ = matrix_A (reduction_signs p qs signs subsets (matrix_A signs subsets)) (reduction_subsets p qs signs subsets (matrix_A signs subsets))"
	+ using reduction_signs_is_get_signs reduction_subsets_is_get_subsets by auto
	+ have h1_var: "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
	+ (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
	+ = matrix_A (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec)) (take_indices subsets (rows_to_keep (reduce_mat_cols ?A ?lhs_vec)))"
	+ using h1 reduction_signs_def reduction_subsets_def by auto
	+ have h2: "?red_mtx = (take_rows_from_matrix (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec)) (rows_to_keep (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec))))"
	+ by simp
	+ have h30: "(construct_lhs_vector p qs signs) = ?lhs_vec"
	+ using assms construct_lhs_matches_solve_for_lhs
	+ by simp
	+ have h3a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (signs)"
	+ using h30 size_of_lhs unfolding find_nonzeros_from_input_vec_def apply (auto)
	+ by (metis atLeastLessThan_iff filter_is_subset member_def set_upt subset_eq)
	+ have h3b_a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (subsets)"
	+ using assms h30 size_of_lhs same_size unfolding find_nonzeros_from_input_vec_def apply (auto)
	+ by (simp add: find_nonzeros_from_input_vec_def h3a)
	+ have h3ba: "length
	+ (filter (\<lambda>i. solve_for_lhs p qs subsets (matrix_A signs subsets) $ i \<noteq> 0)
	+ [0..<length subsets])
	+ \<le> length subsets" using length_filter_le[where P = "(\<lambda>i. solve_for_lhs p qs subsets (matrix_A signs subsets) $ i \<noteq> 0)",
	+ where xs = "[0..<length subsets]"] length_upto by auto
	+ have " length subsets = dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))"
	+ using h30 inv size_of_lhs same_size[of signs subsets] apply (auto)
	+ by metis
	+ then have "length
	+ (filter (\<lambda>i. solve_for_lhs p qs subsets (matrix_A signs subsets) $ i \<noteq> 0)
	+ [0..<dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))])
	+ \<le> length subsets" using h3ba
	+ by auto
	+ then have h3b: "length subsets \<ge> length (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec))"
	+ unfolding take_indices_def find_nonzeros_from_input_vec_def by auto
	+ have h3c: "\<forall>x. List.member (rows_to_keep (reduce_mat_cols ?A ?lhs_vec)) x \<longrightarrow> x < length (subsets)"
	+ proof clarsimp
	+ fix x
	+ assume x_mem: "List.member (rows_to_keep
	+ (take_cols_from_matrix (matrix_A signs subsets)
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) x"
	+ obtain nn :: "rat list list \<Rightarrow> nat list \<Rightarrow> nat" where
	+ "\<forall>x2 x3. (\<exists>v4. v4 \<in> set x3 \<and> \<not> v4 < length x2) = (nn x2 x3 \<in> set x3 \<and> \<not> nn x2 x3 < length x2)"
	+ by moura
	+ then have f4: "nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> \<not> nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) < length signs \<or> matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ using h3a nonzero reduce_system_matrix_signs_helper by auto
	+ then have "matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> x \<in> set (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T)))"
	+ using f4
	+ by (metis h3a in_set_member rows_to_keep_def x_mem)
	+ thus "x < length (subsets)" using x_mem unfolding rows_to_keep_def
	+ by (metis (no_types) dim_row_matrix_A rows_to_keep_def rows_to_keep_lem)
	+ qed
	+ have h3: "matrix_A (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec)) (take_indices subsets (rows_to_keep (reduce_mat_cols ?A ?lhs_vec))) =
	+ (take_rows_from_matrix (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec)) (rows_to_keep (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec))))"
	+ using inv h3a h3b h3c reduce_system_matrix_subsets_helper reduce_system_matrix_signs_helper
	+ assms by auto
	+ show ?thesis using h1 h2 h3
	+ by (metis fst_conv get_matrix_def h1_var reduce_system.simps reduction_step.simps)
	+qed
	+
	+(* gauss_jordan_single_rank is crucial in this section *)
	+subsection "Showing invertibility preserved when reducing"
	+
	+(* Overall:
	+ Start with a matrix equation.
	+ Input a matrix, subsets, and signs.
	+ Drop columns of the matrix based on the 0's on the LHS---so extract a list of 0's. Reduce signs accordingly.
	+ Then find a list of rows to delete based on using rank (use the transpose result, pivot positions!),
	+ and delete those rows. Reduce subsets accordingly.
	+ End with a reduced system! *)
	+lemma well_def_find_zeros_from_lhs_vec:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ shows "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
	+ j < length (cols (matrix_A signs subsets)))"
	+proof -
	+ fix i
	+ fix j
	+ assume j_in: " j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs p qs subsets (matrix_A signs subsets))) "
	+ let ?og_mat = "(matrix_A signs subsets)"
	+ let ?lhs = "(solve_for_lhs p qs subsets ?og_mat)"
	+ let ?new_mat = "(take_rows_from_matrix (reduce_mat_cols ?og_mat ?lhs) (rows_to_keep (reduce_mat_cols ?og_mat ?lhs)))"
	+ have "square_mat (matrix_A signs subsets)" using inv
	+ using invertible_mat_def by blast
	+ then have mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ have "dim_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)) = (length signs)"
	+ using size_of_lhs construct_lhs_matches_solve_for_lhs assms
	+ by (metis (full_types))
	+ then have h: "j < (length signs)"
	+ using j_in unfolding find_nonzeros_from_input_vec_def
	+ by simp
	+ then show "j < length (cols (matrix_A signs subsets))"
	+ using mat_size by auto
	+qed
	+
	+lemma take_cols_subsets_og_cols:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ shows "set (take_indices (cols (matrix_A signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))
	+ \<subseteq> set (cols (matrix_A signs subsets))"
	+proof -
	+ have well_def: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
	+ j < length (cols (matrix_A signs subsets)))"
	+ using assms well_def_find_zeros_from_lhs_vec by auto
	+ have "\<forall>x. x \<in> set (take_indices (cols (matrix_A signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))
	+ \<longrightarrow> x \<in> set (cols (matrix_A signs subsets))"
	+ proof clarsimp
	+ fix x
	+ let ?og_list = "(cols (matrix_A signs subsets))"
	+ let ?ind_list = "(find_nonzeros_from_input_vec
	+ (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ assume x_in: "x \<in> set (take_indices ?og_list ?ind_list)"
	+ show "x \<in> set (cols (matrix_A signs subsets))"
	+ using x_in unfolding take_indices_def using in_set_member apply (auto)
	+ using in_set_conv_nth well_def by fastforce
	+ qed
	+ then show ?thesis
	+ by blast
	+qed
	+
	+lemma reduction_doesnt_break_things_invertibility_step1:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ shows "vec_space.rank (length signs) (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets))) =
	+ (length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
	+proof -
	+ let ?og_mat = "(matrix_A signs subsets)"
	+ let ?lhs = "(solve_for_lhs p qs subsets ?og_mat)"
	+ let ?new_mat = "(take_rows_from_matrix (reduce_mat_cols ?og_mat ?lhs) (rows_to_keep (reduce_mat_cols ?og_mat ?lhs)))"
	+ have "square_mat (matrix_A signs subsets)" using inv
	+ using invertible_mat_def by blast
	+ then have mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ then have mat_size_alt: "?og_mat \<in> carrier_mat (length subsets) (length subsets)"
	+ using size_of_mat same_size assms
	+ by auto
	+ have det_h: "det ?og_mat \<noteq> 0"
	+ using invertible_det[where A = "matrix_A signs subsets"] mat_size
	+ using inv by blast
	+ then have rank_h: "vec_space.rank (length signs) ?og_mat = (length signs)"
	+ using vec_space.det_rank_iff mat_size
	+ by auto
	+ then have dist_cols: "distinct (cols ?og_mat)" using mat_size vec_space.non_distinct_low_rank[where A = ?og_mat, where n = "length signs"]
	+ by auto
	+ have well_def: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
	+ j < length (cols (matrix_A signs subsets)))"
	+ using assms well_def_find_zeros_from_lhs_vec by auto
	+ have dist1: "distinct
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ unfolding find_nonzeros_from_input_vec_def by auto
	+ have clear: "set (take_indices (cols (matrix_A signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))
	+ \<subseteq> set (cols (matrix_A signs subsets))"
	+ using assms take_cols_subsets_og_cols by auto
	+ then have "distinct (take_indices (cols (matrix_A signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
	+ unfolding take_indices_def
	+ using dist1 dist_cols well_def conjugatable_vec_space.distinct_map_nth[where ls = "cols (matrix_A signs subsets)", where inds = "(find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"]
	+ by auto
	+ then have unfold_thesis: "vec_space.rank (length signs) (mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) (find_nonzeros_from_input_vec ?lhs)))
	+= (length (find_nonzeros_from_input_vec ?lhs))"
	+ using clear inv conjugatable_vec_space.rank_invertible_subset_cols[where A= "matrix_A signs subsets", where B = "(take_indices (cols (matrix_A signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"]
	+ by (simp add: len_eq mat_size take_indices_def)
	+ then show ?thesis apply (simp) unfolding take_cols_from_matrix_def by auto
	+qed
	+
	+lemma rechar_take_cols: "take_cols_var A B = take_cols_from_matrix A B"
	+ unfolding take_cols_var_def take_cols_from_matrix_def take_indices_def by auto
	+
	+lemma rows_and_cols_transpose: "rows M = cols M\<^sup>T"
	+ using row_transpose by simp
	+
	+lemma take_rows_and_take_cols: "(take_rows_from_matrix M r) = (take_cols_from_matrix M\<^sup>T r)\<^sup>T"
	+ unfolding take_rows_from_matrix_def take_cols_from_matrix_def
	+ using transpose_carrier_mat rows_and_cols_transpose apply (auto)
	+ by (simp add: transpose_mat_of_cols)
	+
	+lemma reduction_doesnt_break_things_invertibility:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation p qs subsets signs"
	+ shows "invertible_mat (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
	+proof -
	+ let ?og_mat = "(matrix_A signs subsets)"
	+ let ?lhs = "(solve_for_lhs p qs subsets ?og_mat)"
	+ let ?step1_mat = "(reduce_mat_cols ?og_mat ?lhs)"
	+ let ?new_mat = "take_rows_from_matrix ?step1_mat (rows_to_keep ?step1_mat)"
	+ let ?ind_list = "(find_nonzeros_from_input_vec ?lhs)"
	+ have "square_mat (matrix_A signs subsets)" using inv
	+ using invertible_mat_def by blast
	+ then have og_mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ have "dim_col (mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) ?ind_list))
	+ = (length (find_nonzeros_from_input_vec ?lhs))"
	+ by (simp add: take_indices_def)
	+ then have "mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) ?ind_list)
	+ \<in> carrier_mat (length signs) (length (find_nonzeros_from_input_vec ?lhs))"
	+ by (simp add: len_eq mat_of_cols_def)
	+ then have step1_mat_size: "?step1_mat \<in> carrier_mat (length signs) (length (find_nonzeros_from_input_vec ?lhs))"
	+ by (simp add: take_cols_from_matrix_def)
	+ then have "dim_row ?step1_mat \<ge> dim_col ?step1_mat"
	+ by (metis carrier_matD(1) carrier_matD(2) construct_lhs_matches_solve_for_lhs diff_zero find_nonzeros_from_input_vec_def inv length_filter_le length_upt match size_of_lhs)
	+ then have gt_eq_assm: "dim_col ?step1_mat\<^sup>T \<ge> dim_row ?step1_mat\<^sup>T"
	+ by simp
	+ have det_h: "det ?og_mat \<noteq> 0"
	+ using invertible_det[where A = "matrix_A signs subsets"] og_mat_size
	+ using inv by blast
	+ then have rank_h: "vec_space.rank (length signs) ?og_mat = (length signs)"
	+ using vec_space.det_rank_iff og_mat_size
	+ by auto
	+ have rank_drop_cols: "vec_space.rank (length signs) ?step1_mat = (dim_col ?step1_mat)"
	+ using assms reduction_doesnt_break_things_invertibility_step1 step1_mat_size
	+ by auto
	+ let ?step1_T = "?step1_mat\<^sup>T"
	+ have rank_transpose: "vec_space.rank (length signs) ?step1_mat = vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) ?step1_T"
	+ using transpose_rank[of ?step1_mat]
	+ using step1_mat_size by auto
	+ have obv: "?step1_T \<in> carrier_mat (dim_row ?step1_T) (dim_col ?step1_T)" by auto
	+ have should_have_this:"vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) ?step1_T"
	+ using obv gt_eq_assm conjugatable_vec_space.gauss_jordan_single_rank[where A = "?step1_T", where n = "dim_row ?step1_T", where nc = "dim_col ?step1_T"]
	+ by (simp add: take_cols_from_matrix_def take_indices_def)
	+ then have "vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = dim_col ?step1_mat"
	+ using rank_drop_cols rank_transpose by auto
	+ then have with_take_cols_from_matrix: "vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols_from_matrix ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = dim_col ?step1_mat"
	+ using rank_transpose rechar_take_cols conjugatable_vec_space.gjs_and_take_cols_var
	+ apply (auto)
	+ by (smt conjugatable_vec_space.gjs_and_take_cols_var gt_eq_assm obv rechar_take_cols reduce_mat_cols.simps)
	+ have "(take_rows_from_matrix ?step1_mat (rows_to_keep ?step1_mat)) = (take_cols_from_matrix ?step1_T (rows_to_keep ?step1_mat))\<^sup>T"
	+ using take_rows_and_take_cols
	+ by blast
	+ then have rank_new_mat: "vec_space.rank (dim_row ?new_mat) ?new_mat = dim_col ?step1_mat"
	+ using with_take_cols_from_matrix transpose_rank apply (auto)
	+ proof -
	+ assume a1: "vec_space.rank (length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) (take_cols_from_matrix (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T)))) = dim_col (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
	+ have f2: "\<forall>m. vec_space.rank (dim_row (m::rat mat)) m = vec_space.rank (dim_row m\<^sup>T) m\<^sup>T"
	+ by (simp add: transpose_rank)
	+ have f3: "dim_row (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ using \<open>dim_col (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> by force
	+ have "vec_space.rank (length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T))))) = dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T"
	+ using a1 by (simp add: take_cols_from_matrix_def)
	+ then have "vec_space.rank (dim_row (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T)))))\<^sup>T) (mat_of_cols (dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (take_indices (cols (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T) (map snd (pivot_positions (gauss_jordan_single (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T)))))\<^sup>T = dim_row (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))\<^sup>T"
	+ using f3 f2 by presburger
	+ then show "vec_space.rank (dim_col (take_cols_from_matrix (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T (rows_to_keep (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))))) (take_cols_from_matrix (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T (rows_to_keep (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))))\<^sup>T = dim_col (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))"
	+ by (simp add: rows_to_keep_def take_cols_from_matrix_def)
	+ qed
	+ have "length (pivot_positions (gauss_jordan_single (?step1_mat\<^sup>T))) \<le> (length (find_nonzeros_from_input_vec ?lhs))"
	+ using obv length_pivot_positions_dim_row[where A = "(gauss_jordan_single (?step1_mat\<^sup>T))"]
	+ by (metis carrier_matD(1) carrier_matD(2) gauss_jordan_single(2) gauss_jordan_single(3) index_transpose_mat(2) step1_mat_size)
	+ then have len_lt_eq: "length (pivot_positions (gauss_jordan_single (?step1_mat\<^sup>T))) \<le> dim_col ?step1_mat"
	+ using step1_mat_size
	+ by simp
	+ have len_gt_false: "length (rows_to_keep ?step1_mat) < (dim_col ?step1_mat) \<Longrightarrow> False"
	+ proof -
	+ assume length_lt: "length (rows_to_keep ?step1_mat) < (dim_col ?step1_mat)"
	+ have h: "dim_row ?new_mat < (dim_col ?step1_mat)"
	+ by (metis Matrix.transpose_transpose index_transpose_mat(3) length_lt length_map mat_of_cols_carrier(3) take_cols_from_matrix_def take_indices_def take_rows_and_take_cols)
	+ then show "False" using rank_new_mat
	+ by (metis Matrix.transpose_transpose carrier_matI index_transpose_mat(2) nat_less_le not_less_iff_gr_or_eq transpose_rank vec_space.rank_le_nc)
	+ qed
	+ then have len_gt_eq: "length (rows_to_keep ?step1_mat) \<ge> (dim_col ?step1_mat)"
	+ using not_less by blast
	+ have len_match: "length (rows_to_keep ?step1_mat) = (dim_col ?step1_mat)"
	+ using len_lt_eq len_gt_eq
	+ by (simp add: rows_to_keep_def)
	+ have mat_match: "matrix_A (get_signs (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))
	+ (get_subsets (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs))))) =
	+ (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
	+ using reduce_system_matrix_match[of p qs signs subsets] assms
	+ by blast
	+ have f2: "length (get_subsets (take_rows_from_matrix (mat_of_cols (dim_row (matrix_A signs subsets)) (map ((!) (cols (matrix_A signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) (rows_to_keep (mat_of_cols (dim_row (matrix_A signs subsets)) (map ((!) (cols (matrix_A signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))), map ((!) subsets) (rows_to_keep (mat_of_cols (dim_row (matrix_A signs subsets)) (map ((!) (cols (matrix_A signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))), map ((!) signs) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ by (metis (no_types) \<open>dim_col (mat_of_cols (dim_row (matrix_A signs subsets)) (take_indices (cols (matrix_A signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> \<open>length (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))) = dim_col (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> length_map reduce_mat_cols.simps reduce_system.simps reduction_step.simps reduction_subsets_def reduction_subsets_is_get_subsets take_cols_from_matrix_def take_indices_def)
	+ have f3: "\<forall>p ps rss nss m. map ((!) rss) (find_nonzeros_from_input_vec (solve_for_lhs p ps nss m)) = get_signs (reduce_system p (ps, m, nss, rss))"
	+ by (metis (no_types) reduction_signs_def reduction_signs_is_get_signs take_indices_def)
	+ have square_final_mat: "square_mat (get_matrix (reduce_system p (qs, ((matrix_A signs subsets), (subsets, signs)))))"
	+ using mat_match assms size_of_mat same_size
	+ apply (auto) using f2 f3
	+ by (metis (no_types, lifting) Matrix.transpose_transpose fst_conv get_matrix_def index_transpose_mat(2) len_match length_map mat_of_cols_carrier(2) mat_of_cols_carrier(3) reduce_mat_cols.simps take_cols_from_matrix_def take_indices_def take_rows_and_take_cols)
	+ have rank_match: "vec_space.rank (dim_row ?new_mat) ?new_mat = dim_row ?new_mat"
	+ using len_match rank_new_mat
	+ by (simp add: take_cols_from_matrix_def take_indices_def take_rows_and_take_cols)
	+ have "invertible_mat ?new_mat"
	+ using invertible_det og_mat_size
	+ using vec_space.det_rank_iff square_final_mat
	+ by (metis dim_col_matrix_A dim_row_matrix_A fst_conv get_matrix_def mat_match rank_match reduce_system.simps reduction_step.simps size_of_mat square_mat.elims(2))
	+ then show ?thesis apply (simp)
	+ by (metis fst_conv get_matrix_def)
	+qed
	+
	+subsection "Well def signs preserved when reducing"
	+
	+lemma reduction_doesnt_break_length_signs:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes length_init : "\<forall> x\<in> set(signs). length x = length qs"
	+ assumes sat_eq: "satisfy_equation p qs subsets signs"
	+ assumes inv_mat: "invertible_mat (matrix_A signs subsets)"
	+ shows "\<forall>x \<in> set(reduction_signs p qs signs subsets (matrix_A signs subsets)).
	+ length x = length qs"
	+proof clarsimp
	+ fix x
	+ assume x_in_set: "x \<in> set (reduction_signs p qs signs subsets (matrix_A signs subsets))"
	+ have "List.member (reduction_signs p qs signs subsets (matrix_A signs subsets)) x"
	+ using x_in_set by (simp add: in_set_member)
	+ then have take_ind: "List.member (take_indices signs
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) x"
	+ unfolding reduction_signs_def by auto
	+ have find_nz_len: "\<forall>y. List.member (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) y \<longrightarrow> y < length signs"
	+ using size_of_lhs sat_eq inv_mat construct_lhs_matches_solve_for_lhs[of p qs subsets signs] unfolding find_nonzeros_from_input_vec_def
	+ by (metis atLeastLessThan_iff filter_is_subset in_set_member set_upt subset_code(1))
	+ then have "\<exists> n < length signs. x = signs ! n"
	+ using take_ind
	+ by (metis in_set_conv_nth reduction_signs_def take_indices_lem x_in_set)
	+ then show "length x = length qs" using length_init take_indices_lem
	+ using nth_mem by blast
	+qed
	+
	+subsection "Distinct signs preserved when reducing"
	+
	+lemma reduction_signs_are_distinct:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes sat_eq: "satisfy_equation p qs subsets signs"
	+ assumes inv_mat: "invertible_mat (matrix_A signs subsets)"
	+ assumes distinct_init: "distinct signs"
	+ shows "distinct (reduction_signs p qs signs subsets (matrix_A signs subsets))"
	+proof -
	+ have solve_construct: "construct_lhs_vector p qs signs =
	+ solve_for_lhs p qs subsets (matrix_A signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs assms
	+ by simp
	+ have h1: "distinct (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ unfolding find_nonzeros_from_input_vec_def
	+ using distinct_filter
	+ using distinct_upt by blast
	+ have h2: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<Longrightarrow>
	+ j < length signs)"
	+ proof -
	+ fix j
	+ assume "j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ show "j < length signs" using solve_construct size_of_lhs
	+ by (metis \<open>j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))\<close> atLeastLessThan_iff filter_is_subset find_nonzeros_from_input_vec_def set_upt subset_iff)
	+ qed
	+ then show ?thesis unfolding reduction_signs_def unfolding take_indices_def
	+ using distinct_init h1 h2 conjugatable_vec_space.distinct_map_nth[where ls = "signs", where inds = "(find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"]
	+ by blast
	+qed
	+
	+subsection "Well def subsets preserved when reducing"
	+
	+lemma reduction_doesnt_break_subsets:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes length_init : "all_list_constr subsets (length qs)"
	+ assumes sat_eq: "satisfy_equation p qs subsets signs"
	+ assumes inv_mat: "invertible_mat (matrix_A signs subsets)"
	+ shows "all_list_constr (reduction_subsets p qs signs subsets (matrix_A signs subsets)) (length qs)"
	+ unfolding all_list_constr_def
	+proof clarsimp
	+ fix x
	+ assume in_red_subsets: "List.member (reduction_subsets p qs signs subsets (matrix_A signs subsets)) x "
	+ have solve_construct: "construct_lhs_vector p qs signs =
	+ solve_for_lhs p qs subsets (matrix_A signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs assms
	+ by simp
	+ have rows_to_keep_hyp: "\<forall>y. y \<in> set (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))) \<longrightarrow>
	+ y < length subsets"
	+ proof clarsimp
	+ fix y
	+ assume in_set: "y \<in> set (rows_to_keep
	+ (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))))"
	+ have in_set_2: "y \<in> set (rows_to_keep
	+ (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (construct_lhs_vector p qs signs))))"
	+ using in_set solve_construct by simp
	+ let ?lhs_vec = "(solve_for_lhs p qs subsets (matrix_A signs subsets))"
	+ have h30: "(construct_lhs_vector p qs signs) = ?lhs_vec"
	+ using assms construct_lhs_matches_solve_for_lhs
	+ by simp
	+ have h3a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (signs)"
	+ using h30 size_of_lhs unfolding find_nonzeros_from_input_vec_def apply (auto)
	+ by (metis atLeastLessThan_iff filter_is_subset member_def set_upt subset_eq)
	+ have h3c: "\<forall>x. List.member (rows_to_keep (reduce_mat_cols (matrix_A signs subsets) (solve_for_lhs p qs subsets (matrix_A signs subsets)))) x \<longrightarrow> x < length (subsets)"
	+ proof clarsimp
	+ fix x
	+ assume x_mem: "List.member (rows_to_keep
	+ (take_cols_from_matrix (matrix_A signs subsets)
	+ (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))) x"
	+ obtain nn :: "rat list list \<Rightarrow> nat list \<Rightarrow> nat" where
	+ "\<forall>x2 x3. (\<exists>v4. v4 \<in> set x3 \<and> \<not> v4 < length x2) = (nn x2 x3 \<in> set x3 \<and> \<not> nn x2 x3 < length x2)"
	+ by moura
	+ then have f4: "nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<in> set (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> \<not> nn signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) < length signs \<or> matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))"
	+ using h3a nonzero reduce_system_matrix_signs_helper by auto
	+ then have "matrix_A (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets)))) subsets = take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))) \<and> x \<in> set (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (matrix_A signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (matrix_A signs subsets))))\<^sup>T)))"
	+ by (metis h3a in_set_member rows_to_keep_def x_mem)
	+ thus "x < length (subsets)" using x_mem unfolding rows_to_keep_def using pivot_positions
	+ using dim_row_matrix_A h3a in_set_member nonzero reduce_system_matrix_signs_helper rows_to_keep_def rows_to_keep_lem
	+ apply (auto)
	+ by (smt (z3) \<open>M_mat (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (M_mat signs subsets)))) subsets = take_cols_from_matrix (M_mat signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (M_mat signs subsets))) \<and> x \<in> set (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (M_mat signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs p qs subsets (M_mat signs subsets))))\<^sup>T)))\<close> dim_row_matrix_A rows_to_keep_def rows_to_keep_lem)
	+ qed
	+ then show "y < length subsets" using in_set_member apply (auto)
	+ using in_set_2 solve_construct by fastforce
	+ qed
	+ show "list_constr x (length qs)" using in_red_subsets unfolding reduction_subsets_def
	+ using take_indices_lem[of _ subsets] rows_to_keep_hyp
	+ by (metis all_list_constr_def in_set_conv_nth in_set_member length_init)
	+qed
	+
	+section "Overall Lemmas"
	+
	+lemma combining_to_smash: "combine_systems p (qs1, m1, (sub1, sgn1)) (qs2, m2, (sub2, sgn2))
	+ = smash_systems p qs1 qs2 sub1 sub2 sgn1 sgn2 m1 m2"
	+ by simp
	+
	+lemma getter_functions: "calculate_data p qs = (get_matrix (calculate_data p qs), (get_subsets (calculate_data p qs), get_signs (calculate_data p qs))) "
	+ unfolding get_matrix_def get_subsets_def get_signs_def by auto
	+
	+subsection "Key properties preserved"
	+
	+subsubsection "Properties preserved when combining and reducing systems"
	+lemma combining_sys_satisfies_properties_helper:
	+ fixes p:: "real poly"
	+ fixes qs1 :: "real poly list"
	+ fixes qs2 :: "real poly list"
	+ fixes subsets1 subsets2 :: "nat list list"
	+ fixes signs1 signs2 :: "rat list list"
	+ fixes matrix1 matrix2:: "rat mat"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
	+ assumes satisfies_properties_sys1: "satisfies_properties p qs1 subsets1 signs1 matrix1"
	+ assumes satisfies_properties_sys2: "satisfies_properties p qs2 subsets2 signs2 matrix2"
	+ shows "satisfies_properties p (qs1@qs2) (get_subsets (snd ((combine_systems p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2)))))))
	+ (get_signs (snd ((combine_systems p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2)))))))
	+ (get_matrix (snd ((combine_systems p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2)))))))"
	+proof -
	+ let ?subsets = "(get_subsets (snd (combine_systems p (qs1, matrix1, subsets1, signs1)
	+ (qs2, matrix2, subsets2, signs2))))"
	+ let ?signs = "(get_signs (snd (combine_systems p (qs1, matrix1, subsets1, signs1) (qs2, matrix2, subsets2, signs2))))"
	+ let ?matrix = "(get_matrix (snd (combine_systems p (qs1, matrix1, subsets1, signs1) (qs2, matrix2, subsets2, signs2))))"
	+ have h1: "all_list_constr ?subsets (length (qs1 @ qs2))"
	+ using well_def_step[of subsets1 qs1 subsets2 qs2] assms
	+ by (simp add: nontriv2 get_subsets_def satisfies_properties_def smash_systems_def)
	+ have h2: "well_def_signs (length (qs1 @ qs2)) ?signs"
	+ using well_def_signs_step[of qs1 qs2 signs1 signs2]
	+ using get_signs_def nontriv1 nontriv2 satisfies_properties_def satisfies_properties_sys1 satisfies_properties_sys2 smash_systems_def by auto
	+ have h3: "distinct ?signs"
	+ using distinct_step[of _ signs1 _ signs2] assms
	+ using combine_systems.simps get_signs_def satisfies_properties_def smash_systems_def snd_conv by auto
	+ have h4: "satisfy_equation p (qs1 @ qs2) ?subsets ?signs"
	+ using assms inductive_step[of p qs1 qs2 signs1 signs2 subsets1 subsets2]
	+ using get_signs_def get_subsets_def satisfies_properties_def smash_systems_def
	+ by auto
	+ have h5: " invertible_mat ?matrix"
	+ using assms inductive_step[of p qs1 qs2 signs1 signs2 subsets1 subsets2]
	+ by (metis combining_to_smash fst_conv get_matrix_def kronecker_invertible satisfies_properties_def smash_systems_def snd_conv)
	+ have h6: "?matrix = matrix_A ?signs ?subsets"
	+ unfolding get_matrix_def combine_systems.simps smash_systems_def get_signs_def get_subsets_def
	+ apply simp
	+ apply (subst matrix_construction_is_kronecker_product[of subsets1 _ signs1 signs2 subsets2])
	+ apply (metis Ball_set all_list_constr_def in_set_member list_constr_def satisfies_properties_def satisfies_properties_sys1)
	+ using satisfies_properties_def satisfies_properties_sys1 well_def_signs_def apply blast
	+ using satisfies_properties_def satisfies_properties_sys1 satisfies_properties_sys2 by auto
	+ have h7: "set (characterize_consistent_signs_at_roots_copr p (qs1 @ qs2))
	+ \<subseteq> set (?signs)"
	+ using subset_step[of p qs1 signs1 qs2 signs2] assms
	+ by (simp add: nonzero get_signs_def satisfies_properties_def smash_systems_def)
	+ then show ?thesis unfolding satisfies_properties_def using h1 h2 h3 h4 h5 h6 h7 by blast
	+qed
	+
	+lemma combining_sys_satisfies_properties:
	+ fixes p:: "real poly"
	+ fixes qs1 :: "real poly list"
	+ fixes qs2 :: "real poly list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
	+ assumes satisfies_properties_sys1: "satisfies_properties p qs1 (get_subsets (calculate_data p qs1)) (get_signs (calculate_data p qs1)) (get_matrix (calculate_data p qs1))"
	+ assumes satisfies_properties_sys2: "satisfies_properties p qs2 (get_subsets (calculate_data p qs2)) (get_signs (calculate_data p qs2)) (get_matrix (calculate_data p qs2))"
	+ shows "satisfies_properties p (qs1@qs2) (get_subsets (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))
	+ (get_signs (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))
	+ (get_matrix (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
	+ using combining_sys_satisfies_properties_helper
	+ by (metis getter_functions nontriv1 nontriv2 nonzero pairwise_rel_prime1 pairwise_rel_prime2 nonzero satisfies_properties_sys1 satisfies_properties_sys2)
	+
	+lemma reducing_sys_satisfies_properties:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ fixes matrix:: "rat mat"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv: "length qs > 0"
	+ assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ assumes satisfies_properties_sys: "satisfies_properties p qs subsets signs matrix"
	+ shows "satisfies_properties p qs (get_subsets (reduce_system p (qs,matrix,subsets,signs)))
	+ (get_signs (reduce_system p (qs,matrix,subsets,signs)))
	+ (get_matrix (reduce_system p (qs,matrix,subsets,signs)))"
	+proof -
	+ have h1: " all_list_constr (get_subsets (reduce_system p (qs, matrix, subsets, signs))) (length qs)"
	+ using reduction_doesnt_break_subsets assms reduction_subsets_is_get_subsets satisfies_properties_def satisfies_properties_sys by auto
	+ have h2: "well_def_signs (length qs) (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
	+ using reduction_doesnt_break_length_signs[of signs qs p subsets] assms reduction_signs_is_get_signs satisfies_properties_def well_def_signs_def by auto
	+ have h3: "distinct (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
	+ using reduction_signs_are_distinct[of p qs subsets signs] assms reduction_signs_is_get_signs satisfies_properties_def by auto
	+ have h4: "satisfy_equation p qs (get_subsets (reduce_system p (qs, matrix, subsets, signs)))
	+ (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
	+ using reduce_system_matrix_equation_preserved[of p qs signs subsets] assms satisfies_properties_def by auto
	+ have h5: "invertible_mat (get_matrix (reduce_system p (qs, matrix, subsets, signs)))"
	+ using reduction_doesnt_break_things_invertibility assms same_size satisfies_properties_def by auto
	+ have h6: "get_matrix (reduce_system p (qs, matrix, subsets, signs)) =
	+ matrix_A (get_signs (reduce_system p (qs, matrix, subsets, signs)))
	+ (get_subsets (reduce_system p (qs, matrix, subsets, signs)))"
	+ using reduce_system_matrix_match[of p qs signs subsets] assms satisfies_properties_def by auto
	+ have h7: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set (get_signs (reduce_system p (qs, matrix, subsets, signs)))"
	+ using reduction_doesnt_break_things_signs[of p qs signs subsets] assms reduction_signs_is_get_signs satisfies_properties_def by auto
	+ then show ?thesis unfolding satisfies_properties_def using h1 h2 h3 h4 h5 h6 h7
	+ by blast
	+qed
	+
	+subsubsection "For length 1 qs"
	+
	+lemma length_1_calculate_data_satisfies_properties:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes len1: "length qs = 1"
	+ assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ shows "satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
	+proof -
	+ have h1: "all_list_constr [[],[0]] (length qs)"
	+ using len1 unfolding all_list_constr_def list_constr_def apply (auto)
	+ by (metis (full_types) length_Cons less_Suc0 list.size(3) list_all_length list_all_simps(2) member_rec(1) member_rec(2) nth_Cons_0)
	+ have h2: "well_def_signs (length qs) [[1],[-1]]"
	+ unfolding well_def_signs_def using len1 in_set_member
	+ by auto
	+ have h3: "distinct ([[1],[-1]]::rat list list)"
	+ unfolding distinct_def using in_set_member by auto
	+ have h4: "satisfy_equation p qs [[],[0]] [[1],[-1]]"
	+ using assms base_case_satisfy_equation_alt[of qs p] by auto
	+ have h6: "(mat_of_rows_list 2 [[1,1], [1,-1]]::rat mat) = (matrix_A ([[1],[-1]]) ([[],[0]]) :: rat mat)"
	+ using mat_base_case by auto
	+ then have h5: "invertible_mat (mat_of_rows_list 2 [[1,1], [1,-1]]:: rat mat)"
	+ using base_case_invertible_mat
	+ by simp
	+ have h7: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set ([[1],[-1]])"
	+ using assms base_case_sgas_alt[of qs p]
	+ by simp
	+ have base_case_hyp: "satisfies_properties p qs [[],[0]] [[1],[-1]] (mat_of_rows_list 2 [[1,1], [1,-1]])"
	+ using h1 h2 h3 h4 h5 h6 h7
	+ using satisfies_properties_def by blast
	+ then have key_hyp: "satisfies_properties p qs (get_subsets (reduce_system p (qs,base_case_info))) (get_signs (reduce_system p (qs,base_case_info))) (get_matrix (reduce_system p (qs,base_case_info)))"
	+ using reducing_sys_satisfies_properties
	+ by (metis base_case_info_def len1 nonzero pairwise_rel_prime nonzero zero_less_one_class.zero_less_one)
	+ show ?thesis
	+ by (simp add: key_hyp len1)
	+qed
	+
	+subsubsection "For arbitrary qs"
	+lemma append_not_distinct_helper: "(List.member l1 m \<and> List.member l2 m) \<longrightarrow> (distinct (l1@l2) = False)"
	+proof -
	+ have h1: "List.member l1 m \<longrightarrow> (\<exists> n. n < length l1 \<and> (nth l1 n) = m)"
	+ using member_def nth_find_first
	+ by (simp add: member_def in_set_conv_nth)
	+ have h2: "\<forall>n. n < length l1 \<and> (nth l1 n) = m \<longrightarrow> (nth (l1@l2) n) = m"
	+ proof clarsimp
	+ fix n
	+ assume lt: "n < length l1"
	+ assume nth_l1: "m = l1 ! n"
	+ show "(l1 @ l2) ! n = l1 ! n"
	+ proof (induct l2)
	+ case Nil
	+ then show ?case
	+ by simp
	+ next
	+ case (Cons a l2)
	+ then show ?case
	+ by (simp add: lt nth_append)
	+ qed
	+ qed
	+ have h3: "List.member l1 m \<longrightarrow> (\<exists>n. n < length l1 \<and> (nth (l1@l2) n) = m)"
	+ using h1 h2 by auto
	+ have h4: "List.member l2 m \<longrightarrow> (\<exists> n. (nth l2 n) = m)"
	+ by (meson member_def nth_find_first)
	+ have h5: "\<forall>n. (nth l2 n) = m \<longrightarrow> (nth (l1@l2) (n + length l1)) = m"
	+ proof clarsimp
	+ fix n
	+ assume nth_l2: "m = l2 ! n"
	+ show "(l1 @ l2) ! (n + length l1) = l2 ! n"
	+ proof (induct l2)
	+ case Nil
	+ then show ?case
	+ by (metis add.commute nth_append_length_plus)
	+ next
	+ case (Cons a l2)
	+ then show ?case
	+ by (simp add: nth_append)
	+ qed
	+ qed
	+ have h6: "List.member l2 m \<longrightarrow> (\<exists>n. (nth (l1@l2) (n + length l1)) = m)"
	+ using h4 h5
	+ by blast
	+ show ?thesis using h3 h6
	+ by (metis distinct_append equalityI insert_disjoint(1) insert_subset member_def order_refl)
	+qed
	+
	+lemma calculate_data_satisfies_properties:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ shows "(p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) )
	+ \<longrightarrow> satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
	+proof (induction "length qs" arbitrary: qs rule: less_induct)
	+ case less
	+ have len1_h: "length qs = 1 \<longrightarrow> ( p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
	+ using length_1_calculate_data_satisfies_properties
	+ by blast
	+ let ?len = "length qs"
	+ let ?q1 = "take (?len div 2) qs"
	+ let ?left = "calculate_data p ?q1"
	+ let ?q2 = "drop (?len div 2) qs"
	+ let ?right = "calculate_data p ?q2"
	+ let ?comb = "combine_systems p (?q1,?left) (?q2,?right)"
	+ let ?red = "reduce_system p ?comb"
	+ have h_q1_len: "length qs > 1 \<longrightarrow> (length ?q1 > 0)" by auto
	+ have h_q2_len: "length qs > 1 \<longrightarrow> (length ?q2 > 0)" by auto
	+ have h_q1_copr: "(\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) \<longrightarrow> (\<forall>q. ((List.member ?q1 q) \<longrightarrow> (coprime p q)))"
	+ proof -
	+ have mem_hyp: "(\<forall>q. ((List.member ?q1 q) \<longrightarrow> (List.member qs q)))"
	+ by (meson in_set_member in_set_takeD)
	+ then show ?thesis
	+ by blast
	+ qed
	+ have h_q2_copr: "(\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) \<longrightarrow> (\<forall>q. ((List.member ?q2 q) \<longrightarrow> (coprime p q)))"
	+ proof -
	+ have mem_hyp: "(\<forall>q. ((List.member ?q2 q) \<longrightarrow> (List.member qs q)))"
	+ by (meson in_set_dropD in_set_member)
	+ then show ?thesis
	+ by blast
	+ qed
	+ have q1_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p ?q1 (get_subsets (calculate_data p ?q1)) (get_signs (calculate_data p ?q1)) (get_matrix (calculate_data p ?q1))"
	+ using less.hyps[of ?q1] h_q1_len h_q1_copr by auto
	+ have q2_help: "length qs > 1 \<longrightarrow> length (drop (length qs div 2) qs) < length qs"
	+ using h_q1_len by auto
	+ then have q2_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p ?q2 (get_subsets (calculate_data p ?q2)) (get_signs (calculate_data p ?q2)) (get_matrix (calculate_data p ?q2))"
	+ using less.hyps[of ?q2] h_q2_len h_q2_copr
	+ by blast
	+ have put_tog: "?q1@?q2 = qs"
	+ using append_take_drop_id by blast
	+ then have comb_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> (satisfies_properties p (qs) (get_subsets (snd ((combine_systems p (?q1,calculate_data p ?q1) (?q2,calculate_data p ?q2)))))
	+ (get_signs (snd ((combine_systems p (?q1,calculate_data p ?q1) (?q2,calculate_data p ?q2)))))
	+ (get_matrix (snd ((combine_systems p (?q1,calculate_data p ?q1) (?q2,calculate_data p ?q2))))))"
	+ using q1_sat_props q2_sat_props combining_sys_satisfies_properties
	+ using h_q1_copr h_q1_len h_q2_copr h_q2_len put_tog
	+ by metis
	+ then have comb_sat: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow>
	+ (satisfies_properties p (qs) (get_subsets (snd ?comb)) (get_signs (snd ?comb)) (get_matrix (snd ?comb)))"
	+ by blast
	+ have red_char: "?red = (reduce_system p (qs,(get_matrix (snd ?comb)),(get_subsets (snd ?comb)),(get_signs (snd ?comb))))"
	+ using getter_functions
	+ by (smt Pair_inject combining_to_smash get_matrix_def get_signs_def get_subsets_def prod.collapse put_tog smash_systems_def)
	+ then have "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> (satisfies_properties p qs (get_subsets ?red) (get_signs ?red) (get_matrix ?red))"
	+ using reducing_sys_satisfies_properties comb_sat by presburger
	+ have len_gt1: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) \<and> (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))) ) \<longrightarrow> satisfies_properties p qs (get_subsets (calculate_data p qs)) (get_signs (calculate_data p qs)) (get_matrix (calculate_data p qs))"
	+ by (smt \<open>1 < length qs \<longrightarrow> p \<noteq> 0 \<and> 0 < length qs \<and> (\<forall>q. List.member qs q \<longrightarrow> coprime p q) \<longrightarrow> satisfies_properties p qs (get_subsets (reduce_system p (combine_systems p (take (length qs div 2) qs, calculate_data p (take (length qs div 2) qs)) (drop (length qs div 2) qs, calculate_data p (drop (length qs div 2) qs))))) (get_signs (reduce_system p (combine_systems p (take (length qs div 2) qs, calculate_data p (take (length qs div 2) qs)) (drop (length qs div 2) qs, calculate_data p (drop (length qs div 2) qs))))) (get_matrix (reduce_system p (combine_systems p (take (length qs div 2) qs, calculate_data p (take (length qs div 2) qs)) (drop (length qs div 2) qs, calculate_data p (drop (length qs div 2) qs)))))\<close> calculate_data.simps neq0_conv not_less)
	+ then show ?case using len1_h len_gt1
	+ by (metis One_nat_def Suc_lessI)
	+qed
	+
	+
	+subsection "Some key results on consistent sign assignments"
	+
	+lemma find_consistent_signs_at_roots_len1:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes len1: "length qs = 1"
	+ assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ shows "set (find_consistent_signs_at_roots p qs) = set (characterize_consistent_signs_at_roots_copr p qs)"
	+proof -
	+ let ?signs = "[[1],[-1]]::rat list list"
	+ let ?subsets = "[[],[0]]::nat list list"
	+ have mat_help: "matrix_A [[1],[-1]] [[],[0]] = (mat_of_rows_list 2 [[1,1], [1,-1]])"
	+ using mat_base_case by auto
	+ have well_def_signs: "well_def_signs (length qs) ?signs" unfolding well_def_signs_def
	+ using len1 by auto
	+ have distinct_signs: "distinct ?signs"
	+ unfolding distinct_def by auto
	+ have ex_q: "\<exists>(q::real poly). qs = [q]"
	+ using len1
	+ using length_Suc_conv[of qs 0] by auto
	+ then have all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(?signs)"
	+ using assms base_case_sgas apply (auto)
	+ by (meson in_mono insertE insert_absorb insert_not_empty member_rec(1))
	+ have match: "satisfy_equation p qs ?subsets ?signs"
	+ using ex_q base_case_satisfy_equation nonzero pairwise_rel_prime
	+ apply (auto)
	+ by (simp add: member_rec(1))
	+ have invertible_mat: "invertible_mat (matrix_A ?signs ?subsets)"
	+ using inverse_mat_base_case inverse_mat_base_case_2 unfolding invertible_mat_def using mat_base_case
	+ by auto
	+ have h: "set (get_signs (reduce_system p (qs, ((matrix_A ?signs ?subsets), (?subsets, ?signs))))) =
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ using nonzero nonzero well_def_signs distinct_signs all_info match invertible_mat
	+ reduce_system_sign_conditions[where p = "p", where qs = "qs", where signs = "[[1],[-1]]", where subsets = "[[],[0]]"]
	+ by blast
	+ then have "set (snd (snd (reduce_system p (qs, ((mat_of_rows_list 2 [[1,1], [1,-1]]), ([[],[0]], [[1],[-1]])))))) =
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ unfolding get_signs_def using mat_help by auto
	+ then have "set (snd (snd (reduce_system p (qs, base_case_info)))) = set (characterize_consistent_signs_at_roots_copr p qs)"
	+ unfolding base_case_info_def
	+ by auto
	+ then show ?thesis using len1
	+ by (simp add: find_consistent_signs_at_roots_thm)
	+qed
	+
	+
	+lemma smaller_sys_are_good:
	+ fixes p:: "real poly"
	+ fixes qs1 :: "real poly list"
	+ fixes qs2 :: "real poly list"
	+ fixes subsets :: "nat list list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes pairwise_rel_prime1: "\<forall>q. ((List.member qs1 q) \<longrightarrow> (coprime p q))"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes pairwise_rel_prime2: "\<forall>q. ((List.member qs2 q) \<longrightarrow> (coprime p q))"
	+ assumes "set(find_consistent_signs_at_roots p qs1) = set(characterize_consistent_signs_at_roots_copr p qs1)"
	+ assumes "set(find_consistent_signs_at_roots p qs2) = set(characterize_consistent_signs_at_roots_copr p qs2)"
	+ shows "set(snd(snd(reduce_system p (combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))
	+ = set(characterize_consistent_signs_at_roots_copr p (qs1@qs2))"
	+proof -
	+ let ?signs = "(get_signs (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2))))) "
	+ let ?subsets = "(get_subsets (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2))))) "
	+ have h0: "satisfies_properties p (qs1@qs2) ?subsets ?signs
	+ (get_matrix (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
	+ using calculate_data_satisfies_properties combining_sys_satisfies_properties
	+ using nontriv1 nontriv2 nonzero pairwise_rel_prime1 pairwise_rel_prime2 nonzero
	+ by simp
	+ then have h1: "set(characterize_consistent_signs_at_roots_copr p (qs1@qs2)) \<subseteq> set ?signs"
	+ unfolding satisfies_properties_def
	+ by linarith
	+ have h2: "well_def_signs (length (qs1@qs2)) ?signs"
	+ using calculate_data_satisfies_properties
	+ using h0 satisfies_properties_def by blast
	+ have h3: "distinct ?signs"
	+ using calculate_data_satisfies_properties
	+ using h0 satisfies_properties_def by blast
	+ have h4: "satisfy_equation p (qs1@qs2) ?subsets ?signs"
	+ using calculate_data_satisfies_properties
	+ using h0 satisfies_properties_def by blast
	+ have h5: "invertible_mat (matrix_A ?signs ?subsets) "
	+ using calculate_data_satisfies_properties
	+ using h0 satisfies_properties_def
	+ by auto
	+ have h: "set (take_indices ?signs
	+ (find_nonzeros_from_input_vec (solve_for_lhs p (qs1@qs2) ?subsets (matrix_A ?signs ?subsets))))
	+ = set(characterize_consistent_signs_at_roots_copr p (qs1@qs2))"
	+ using h1 h2 h3 h4 h5 reduction_deletes_bad_sign_conds
	+ using nonzero nonzero reduction_signs_def by auto
	+ then have h: "set (characterize_consistent_signs_at_roots_copr p (qs1@qs2)) =
	+ set (reduction_signs p (qs1@qs2) ?signs ?subsets (matrix_A ?signs ?subsets ))"
	+ unfolding reduction_signs_def get_signs_def
	+ by blast
	+ have help_h: "reduction_signs p (qs1@qs2) ?signs ?subsets (matrix_A ?signs ?subsets)
	+ = (take_indices ?signs (find_nonzeros_from_input_vec (solve_for_lhs p (qs1@qs2) ?subsets (matrix_A ?signs ?subsets))))"
	+ unfolding reduction_signs_def by auto
	+ have clear_signs: "(signs_smash (get_signs (calculate_data p qs1)) (get_signs (calculate_data p qs2))) = (get_signs (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
	+ by (smt combining_to_smash get_signs_def getter_functions smash_systems_def snd_conv)
	+ have clear_subsets: "(subsets_smash (length qs1) (get_subsets(calculate_data p qs1)) (get_subsets (calculate_data p qs2))) = (get_subsets (snd ((combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))"
	+ by (smt Pair_inject combining_to_smash get_subsets_def prod.collapse smash_systems_def)
	+ have "well_def_signs (length qs1) (get_signs (calculate_data p qs1))"
	+ using calculate_data_satisfies_properties
	+ using nontriv1 nonzero pairwise_rel_prime1 nonzero satisfies_properties_def
	+ by auto
	+ then have well_def_signs1: "(\<And>j. j \<in> set (get_signs (calculate_data p qs1)) \<Longrightarrow> length j = (length qs1))"
	+ using well_def_signs_def by blast
	+ have "all_list_constr (get_subsets(calculate_data p qs1)) (length qs1) "
	+ using calculate_data_satisfies_properties
	+ using nontriv1 nonzero pairwise_rel_prime1 nonzero satisfies_properties_def
	+ by auto
	+ then have well_def_subsets1: "(\<And>l i. l \<in> set (get_subsets(calculate_data p qs1)) \<Longrightarrow> i \<in> set l \<Longrightarrow> i < (length qs1))"
	+ unfolding all_list_constr_def list_constr_def using in_set_member
	+ by (metis in_set_conv_nth list_all_length)
	+ have extra_matrix_same: "matrix_A (signs_smash (get_signs (calculate_data p qs1)) (get_signs (calculate_data p qs2)))
	+ (subsets_smash (length qs1) (get_subsets(calculate_data p qs1)) (get_subsets (calculate_data p qs2)))
	+ = kronecker_product (get_matrix (calculate_data p qs1)) (get_matrix (calculate_data p qs2))"
	+ using well_def_signs1 well_def_subsets1
	+ using matrix_construction_is_kronecker_product
	+ using calculate_data_satisfies_properties nontriv1 nontriv2 nonzero pairwise_rel_prime1 pairwise_rel_prime2 nonzero satisfies_properties_def by auto
	+ then have matrix_same: "matrix_A ?signs ?subsets = kronecker_product (get_matrix (calculate_data p qs1)) (get_matrix (calculate_data p qs2))"
	+ using clear_signs clear_subsets
	+ by simp
	+ have comb_sys_h: "snd(snd(reduce_system p (combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))) =
	+ snd(snd(reduce_system p (qs1@qs2, (matrix_A ?signs ?subsets, (?subsets, ?signs)))))"
	+ unfolding get_signs_def get_subsets_def using matrix_same
	+ by (smt combining_to_smash get_signs_def get_subsets_def getter_functions prod.collapse prod.inject smash_systems_def)
	+ then have extra_h: " snd(snd(reduce_system p (qs1@qs2, (matrix_A ?signs ?subsets, (?subsets, ?signs))))) =
	+ snd(snd(reduction_step (matrix_A ?signs ?subsets) ?signs ?subsets (solve_for_lhs p (qs1@qs2) ?subsets (matrix_A ?signs ?subsets)))) "
	+ by simp
	+ then have same_h: "set(snd(snd(reduce_system p (combine_systems p (qs1,calculate_data p qs1) (qs2,calculate_data p qs2)))))
	+ = set (reduction_signs p (qs1@qs2) ?signs ?subsets (matrix_A ?signs ?subsets ))"
	+ using comb_sys_h unfolding reduction_signs_def
	+ by (metis get_signs_def help_h reduction_signs_is_get_signs)
	+ then show ?thesis using h
	+ by blast
	+qed
	+
	+lemma find_consistent_signs_at_roots_1:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ shows "(p \<noteq> 0 \<and> length qs > 0 \<and>
	+ (\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q)))) \<longrightarrow>
	+ set(find_consistent_signs_at_roots p qs) = set(characterize_consistent_signs_at_roots_copr p qs)"
	+proof (induction "length qs" arbitrary: qs rule: less_induct)
	+ case less
	+ then show ?case
	+ proof clarsimp
	+ assume ind_hyp: "(\<And>qsa.
	+ length qsa < length qs \<Longrightarrow> qsa \<noteq> [] \<and> (\<forall>q. List.member qsa q \<longrightarrow> coprime p q) \<longrightarrow>
	+ set (find_consistent_signs_at_roots p qsa) =
	+ set (characterize_consistent_signs_at_roots_copr p qsa))"
	+ assume nonzero: "p \<noteq> 0"
	+ assume nontriv: "qs \<noteq> []"
	+ assume copr:" \<forall>q. List.member qs q \<longrightarrow> coprime p q"
	+ let ?len = "length qs"
	+ let ?q1 = "take ((?len) div 2) qs"
	+ let ?left = "calculate_data p ?q1"
	+ let ?q2 = "drop ((?len) div 2) qs"
	+ let ?right = "calculate_data p ?q2"
	+ have nontriv_q1: "length qs>1 \<longrightarrow> length ?q1 > 0"
	+ by auto
	+ have qs_more_q1: "length qs>1 \<longrightarrow> length qs > length ?q1"
	+ by auto
	+ have pairwise_rel_prime_q1: "\<forall>q. ((List.member ?q1 q) \<longrightarrow> (coprime p q))"
	+ proof clarsimp
	+ fix q
	+ assume mem: "List.member (take (length qs div 2) qs) q"
	+ have "List.member qs q" using mem set_take_subset[where n = "length qs div 2"]
	+ proof -
	+ show ?thesis
	+ by (meson \<open>List.member (take (length qs div 2) qs) q\<close> in_set_member in_set_takeD)
	+ qed
	+ then show "coprime p q"
	+ using copr by blast
	+ qed
	+ have nontriv_q2: "length qs>1 \<longrightarrow>length ?q2 > 0"
	+ by auto
	+ have qs_more_q2: "length qs>1 \<longrightarrow> length qs > length ?q2"
	+ by auto
	+ have pairwise_rel_prime_q2: "\<forall>q. ((List.member ?q2 q) \<longrightarrow> (coprime p q))"
	+ proof clarsimp
	+ fix q
	+ assume mem: "List.member (drop (length qs div 2) qs) q"
	+ have "List.member qs q" using mem set_take_subset[where n = "length qs div 2"]
	+ proof -
	+ show ?thesis
	+ by (meson \<open>List.member (drop (length qs div 2) qs) q\<close> in_set_dropD in_set_member)
	+ qed
	+ then show "coprime p q"
	+ using copr by blast
	+ qed
	+ have key_h: "set (snd (snd (if ?len \<le> Suc 0 then reduce_system p (qs, base_case_info)
	+ else Let (combine_systems p (?q1, ?left) (?q2, ?right))
	+ (reduce_system p)))) =
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ proof -
	+ have h_len1 : "?len = 1 \<longrightarrow> set (snd (snd (if ?len \<le> Suc 0 then reduce_system p (qs, base_case_info)
	+ else Let (combine_systems p (?q1, ?left) (?q2, ?right))
	+ (reduce_system p)))) =
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ using find_consistent_signs_at_roots_len1[of p qs] copr nonzero nontriv
	+ by (simp add: find_consistent_signs_at_roots_thm)
	+ have h_len_gt1 : "?len > 1 \<longrightarrow> set (snd (snd (if ?len \<le> Suc 0 then reduce_system p (qs, base_case_info)
	+ else Let (combine_systems p (?q1, ?left) (?q2, ?right))
	+ (reduce_system p)))) =
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ proof -
	+ have h_imp_a: "?len > 1 \<longrightarrow> set (snd (snd (reduce_system p (combine_systems p (?q1, ?left) (?q2, ?right))))) =
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ proof -
	+ have h1: "?len > 1 \<longrightarrow> set(snd(snd(?left))) = set (characterize_consistent_signs_at_roots_copr p ?q1)"
	+ using nontriv_q1 pairwise_rel_prime_q1 ind_hyp[of ?q1] qs_more_q1 by (metis find_consistent_signs_at_roots_thm less_numeral_extra(3) list.size(3))
	+ have h2: "?len > 1 \<longrightarrow> set(snd(snd(?right))) = set (characterize_consistent_signs_at_roots_copr p ?q2)"
	+ using nontriv_q2 pairwise_rel_prime_q2 ind_hyp[of ?q2] qs_more_q2
	+ by (metis (full_types) find_consistent_signs_at_roots_thm list.size(3) not_less_zero)
	+ show ?thesis using nonzero nontriv_q1 pairwise_rel_prime_q1 nontriv_q2 pairwise_rel_prime_q2 h1 h2
	+ smaller_sys_are_good
	+ by (metis append_take_drop_id find_consistent_signs_at_roots_thm)
	+ qed
	+ then have h_imp: "?len > 1 \<longrightarrow> set (snd (snd (Let (combine_systems p (?q1, ?left) (?q2, ?right))
	+ (reduce_system p)))) =
	+ set (characterize_consistent_signs_at_roots_copr p qs)"
	+ by auto
	+ then show ?thesis by auto
	+ qed
	+ show ?thesis using h_len1 h_len_gt1
	+ by (meson \<open>qs \<noteq> []\<close> length_0_conv less_one nat_neq_iff)
	+ qed
	+ then show "set (find_consistent_signs_at_roots p qs) = set (characterize_consistent_signs_at_roots_copr p qs)"
	+ by (smt One_nat_def calculate_data.simps find_consistent_signs_at_roots_thm length_0_conv nontriv)
	+ qed
	+qed
	+
	+lemma find_consistent_signs_at_roots_0:
	+ fixes p:: "real poly"
	+ assumes "p \<noteq> 0"
	+ shows "set(find_consistent_signs_at_roots p []) =
	+ set(characterize_consistent_signs_at_roots_copr p [])"
	+proof -
	+ obtain a b c where abc: "reduce_system p ([1], base_case_info) = (a,b,c)"
	+ using prod_cases3 by blast
	+ have "find_consistent_signs_at_roots p [1] = c" using abc
	+ by (simp add: find_consistent_signs_at_roots_thm)
	+ have *: "set (find_consistent_signs_at_roots p [1]) = set (characterize_consistent_signs_at_roots_copr p [1])"
	+ apply (subst find_consistent_signs_at_roots_1)
	+ using assms apply auto
	+ by (simp add: member_rec(1) member_rec(2))
	+ have "set(characterize_consistent_signs_at_roots_copr p []) = drop 1 ` set(characterize_consistent_signs_at_roots_copr p [1])"
	+ unfolding characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def apply simp
	+ by (smt drop0 drop_Suc_Cons image_cong image_image)
	+ thus ?thesis using abc *
	+ apply (auto) apply (simp add: find_consistent_signs_at_roots_thm)
	+ by (simp add: find_consistent_signs_at_roots_thm)
	+qed
	+
	+lemma find_consistent_signs_at_roots_copr:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ assumes "p \<noteq> 0"
	+ assumes "\<And>q. q \<in> set qs \<Longrightarrow> coprime p q"
	+ shows "set(find_consistent_signs_at_roots p qs) = set(characterize_consistent_signs_at_roots_copr p qs)"
	+ by (metis assms find_consistent_signs_at_roots_0 find_consistent_signs_at_roots_1 in_set_member length_greater_0_conv)
	+
	+lemma find_consistent_signs_at_roots:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ assumes "p \<noteq> 0"
	+ assumes "\<And>q. q \<in> set qs \<Longrightarrow> coprime p q"
	+ shows "set(find_consistent_signs_at_roots p qs) = set(characterize_consistent_signs_at_roots p qs)"
	+ using assms find_consistent_signs_at_roots_copr csa_list_copr_rel
	+ by (simp add: in_set_member)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/Matrix_Equation_Construction.thy b/thys/BenOr_Kozen_Reif/Matrix_Equation_Construction.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/Matrix_Equation_Construction.thy
	@@ -0,0 +1,881 @@
	+theory Matrix_Equation_Construction
	+
	+imports "BKR_Algorithm"
	+begin
	+
	+section "Results with Sturm's Theorem"
	+
	+lemma relprime:
	+ fixes q::"real poly"
	+ assumes "coprime p q"
	+ assumes "p \<noteq> 0"
	+ assumes "q \<noteq> 0"
	+ shows "changes_R_smods p (pderiv p) = card {x. poly p x = 0 \<and> poly q x > 0} + card {x. poly p x = 0 \<and> poly q x < 0}"
	+proof -
	+ have 1: "{x. poly p x = 0 \<and> poly q x = 0} = {}"
	+ using assms(1) coprime_poly_0 by auto
	+ have 2: "changes_R_smods p (pderiv p) = int (card {x . poly p x = 0})" using sturm_R by auto
	+ have 3: "{x. poly p x = 0 \<and> poly q x > 0} \<inter> {x. poly p x = 0 \<and> poly q x < 0} = {}" by auto
	+ have "{x . poly p x = 0} = {x. poly p x = 0 \<and> poly q x > 0} \<union>{x. poly p x = 0 \<and> poly q x < 0} \<union> {x. poly p x = 0 \<and> poly q x = 0}" by force
	+ then have "{x . poly p x = 0} = {x. poly p x = 0 \<and> poly q x > 0} \<union>{x. poly p x = 0 \<and> poly q x < 0}" using 1 by auto
	+ then have "(card {x . poly p x = 0}) = (card ({x. poly p x = 0 \<and> poly q x > 0} \<union>{x. poly p x = 0 \<and> poly q x < 0}))" by presburger
	+ then have 4: "(card {x . poly p x = 0}) = card {x. poly p x = 0 \<and> poly q x > 0} + card {x. poly p x = 0 \<and> poly q x < 0}" using 3 by (simp add: card_Un_disjoint assms(2) poly_roots_finite)
	+ show ?thesis by (simp add: "2" "4")
	+qed
	+
	+(* This is the same proof as card_eq_sum *)
	+lemma card_eq_const_sum:
	+ fixes k:: real
	+ assumes "finite A"
	+ shows "k*card A = sum (\<lambda>x. k) A"
	+proof -
	+ have "plus \<circ> (\<lambda>_. Suc 0) = (\<lambda>_. Suc)"
	+ by (simp add: fun_eq_iff)
	+ then have "Finite_Set.fold (plus \<circ> (\<lambda>_. Suc 0)) = Finite_Set.fold (\<lambda>_. Suc)"
	+ by (rule arg_cong)
	+ then have "Finite_Set.fold (plus \<circ> (\<lambda>_. Suc 0)) 0 A = Finite_Set.fold (\<lambda>_. Suc) 0 A"
	+ by (blast intro: fun_cong)
	+ then show ?thesis
	+ by (simp add: card.eq_fold sum.eq_fold)
	+qed
	+
	+lemma restate_tarski:
	+ fixes q::"real poly"
	+ assumes "coprime p q"
	+ assumes "p \<noteq> 0"
	+ assumes "q \<noteq> 0"
	+ shows "changes_R_smods p ((pderiv p) * q) = card {x. poly p x = 0 \<and> poly q x > 0} - int(card {x. poly p x = 0 \<and> poly q x < 0})"
	+proof -
	+ have 3: "taq {x. poly p x=0} q \<equiv> \<Sum>y\<in>{x. poly p x=0}. sign (poly q y)" by (simp add: taq_def)
	+ have 4: "{x. poly p x=0} = {x. poly p x = 0 \<and> poly q x > 0} \<union> {x. poly p x = 0 \<and> poly q x < 0} \<union> {x. poly p x = 0 \<and> poly q x = 0}" by force
	+ then have 5: "{x. poly p x=0} = {x. poly p x = 0 \<and> poly q x > 0} \<union> {x. poly p x = 0 \<and> poly q x < 0}" using assms(1) coprime_poly_0 by auto
	+ then have 6: "\<Sum>y\<in>{x. poly p x=0}. sign (poly q y) \<equiv> \<Sum>y\<in>{x. poly p x = 0 \<and> poly q x > 0} \<union> {x. poly p x = 0 \<and> poly q x < 0}. sign (poly q y)" by presburger
	+ then have 12: "taq {x. poly p x=0} q \<equiv> \<Sum>y\<in>{x. poly p x = 0 \<and> poly q x > 0} \<union> {x. poly p x = 0 \<and> poly q x < 0}. sign (poly q y)" using 3 by linarith
	+ have 7: "{x. poly p x = 0 \<and> poly q x > 0} \<inter> {x. poly p x = 0 \<and> poly q x < 0} = {}" by auto
	+ then have 8: "\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x > 0} \<union> {x. poly p x = 0 \<and> poly q x < 0}. sign (poly q y) \<equiv> (\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x > 0}.sign (poly q y)) + (\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x < 0}.sign(poly q y))" by (simp add: assms(2) poly_roots_finite sum.union_disjoint)
	+ then have 13: "taq {x. poly p x=0} q \<equiv> (\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x > 0}.sign (poly q y)) + (\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x < 0}.sign(poly q y))" using 12 by linarith
	+ then have 9: "taq {x. poly p x = 0} q \<equiv> (\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x > 0}.1) + (\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x < 0}.(-1))" by simp
	+ have 10: "(\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x > 0}.1) = card {x. poly p x = 0 \<and> poly q x > 0}" using card_eq_sum by auto
	+ have 11: " (\<Sum>y\<in>{x. poly p x = 0 \<and> poly q x < 0}.(-1)) = -1*card {x. poly p x = 0 \<and> poly q x < 0}" using card_eq_const_sum by simp
	+ have 14: "taq {x. poly p x = 0} q \<equiv> card {x. poly p x = 0 \<and> poly q x > 0} + -1*card {x. poly p x = 0 \<and> poly q x < 0}" using 9 10 11 by simp
	+ have 1: "changes_R_smods p (pderiv p * q) = taq {x. poly p x=0} q" using sturm_tarski_R by simp
	+ then have 15: "changes_R_smods p (pderiv p * q) = card {x. poly p x = 0 \<and> poly q x > 0} + (-1*card {x. poly p x = 0 \<and> poly q x < 0})" using 14 by linarith
	+ have 16: "(-1*card {x. poly p x = 0 \<and> poly q x < 0}) = - card {x. poly p x = 0 \<and> poly q x < 0}" by auto
	+ then show ?thesis using 15 by linarith
	+qed
	+
	+lemma restate_tarski2:
	+ fixes q::"real poly"
	+ assumes "p \<noteq> 0"
	+ shows "changes_R_smods p ((pderiv p) * q) =
	+ int(card {x. poly p x = 0 \<and> poly q x > 0}) -
	+ int(card {x. poly p x = 0 \<and> poly q x < 0})"
	+ unfolding sturm_tarski_R[symmetric] taq_def
	+proof -
	+ let ?all = "{x. poly p x=0}"
	+ let ?lt = "{x. poly p x=0 \<and> poly q x < 0}"
	+ let ?gt = "{x. poly p x=0 \<and> poly q x > 0}"
	+ let ?eq = "{x. poly p x=0 \<and> poly q x = 0}"
	+ have eq: "?all = ?lt \<union> ?gt \<union> ?eq" by force
	+ from poly_roots_finite[OF assms] have fin: "finite ?all" .
	+ show "(\<Sum>x \| poly p x = 0. sign (poly q x)) = int (card ?gt) - int (card ?lt)"
	+ unfolding eq
	+ apply (subst sum_Un)
	+ apply (auto simp add:fin)
	+ apply (subst sum_Un)
	+ by (auto simp add:fin)
	+qed
	+
	+lemma coprime_set_prod:
	+ fixes I:: "real poly set"
	+ shows "finite I \<Longrightarrow> ((\<forall> q \<in> I. (coprime p q)) \<longrightarrow> (coprime p (\<Prod> I)))"
	+proof (induct rule: finite_induct)
	+ case empty
	+ then show ?case
	+ by simp
	+next
	+ case (insert x F)
	+ then show ?case using coprime_mult_right_iff
	+ by simp
	+qed
	+
	+lemma finite_nonzero_set_prod:
	+ fixes I:: "real poly set"
	+ shows nonzero_hyp: "finite I \<Longrightarrow> ((\<forall> q \<in> I. q \<noteq> 0) \<longrightarrow> \<Prod> I \<noteq> 0)"
	+proof (induct rule: finite_induct)
	+ case empty
	+ then show ?case
	+ by simp
	+next
	+ case (insert x F)
	+ have h: "\<Prod> (insert x F) = x * (\<Prod> F)"
	+ by (simp add: insert.hyps(1) insert.hyps(2))
	+ have h_xin: "x \<in> insert x F"
	+ by simp
	+ have hq: "(\<forall> q \<in> (insert x F). q \<noteq> 0) \<longrightarrow> x \<noteq> 0" using h_xin
	+ by blast
	+ show ?case using h hq
	+ using insert.hyps(3) by auto
	+qed
	+
	+section "Setting up the construction: Definitions"
	+
	+definition characterize_root_list_p:: "real poly \<Rightarrow> real list"
	+ where "characterize_root_list_p p \<equiv> sorted_list_of_set({x. poly p x = 0}::real set)"
	+
	+(************ Renegar's N(I); towards defining the RHS of the matrix equation ************)
	+
	+lemma construct_NofI_prop:
	+ fixes p:: "real poly"
	+ fixes I:: "real poly list"
	+ assumes nonzero: "p\<noteq>0"
	+ shows "construct_NofI p I =
	+ rat_of_int (int (card {x. poly p x = 0 \<and> poly (prod_list I) x > 0}) -
	+ int (card {x. poly p x = 0 \<and> poly (prod_list I) x < 0}))"
	+ unfolding construct_NofI_def
	+ using assms restate_tarski2 nonzero rsquarefree_def
	+ by (simp add: rsquarefree_def)
	+
	+definition construct_s_vector:: "real poly \<Rightarrow> real poly list list \<Rightarrow> rat vec"
	+ where "construct_s_vector p Is = vec_of_list (map (\<lambda> I.(construct_NofI p I)) Is)"
	+
	+(* Consistent sign assignments *)
	+definition squash::"'a::linordered_field \<Rightarrow> rat"
	+ where "squash x = (if x > 0 then 1
	+ else if x < 0 then -1
	+ else 0)"
	+
	+definition signs_at::"real poly list \<Rightarrow> real \<Rightarrow> rat list"
	+ where "signs_at qs x \<equiv>
	+ map (squash \<circ> (\<lambda>q. poly q x)) qs"
	+
	+definition characterize_consistent_signs_at_roots:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list"
	+ where "characterize_consistent_signs_at_roots p qs =
	+ (remdups (map (signs_at qs) (characterize_root_list_p p)))"
	+
	+(* An alternate version designed to be used when every polynomial in qs is relatively prime to p*)
	+definition consistent_sign_vec_copr::"real poly list \<Rightarrow> real \<Rightarrow> rat list"
	+ where "consistent_sign_vec_copr qs x \<equiv>
	+ map (\<lambda> q. if (poly q x > 0) then (1::rat) else (-1::rat)) qs"
	+
	+definition characterize_consistent_signs_at_roots_copr:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list"
	+ where "characterize_consistent_signs_at_roots_copr p qss =
	+ (remdups (map (consistent_sign_vec_copr qss) (characterize_root_list_p p)))"
	+
	+lemma csa_list_copr_rel:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ shows "characterize_consistent_signs_at_roots p qs = characterize_consistent_signs_at_roots_copr p qs"
	+proof -
	+ have "\<forall>q \<in> set(qs). \<forall> x \<in> set (characterize_root_list_p p). poly q x \<noteq> 0"
	+ using pairwise_rel_prime
	+ using coprime_poly_0 in_set_member nonzero poly_roots_finite characterize_root_list_p_def by fastforce
	+ then have h: "\<forall>q \<in> set(qs). \<forall> x \<in> set (characterize_root_list_p p). squash (poly q x) = (if (poly q x > 0) then (1::rat) else (-1::rat))"
	+ by (simp add: squash_def)
	+ have "map (\<lambda>r. map (\<lambda>p. if 0 < poly p r then 1 else - 1) qs) (characterize_root_list_p p) = map (\<lambda>r. map (squash \<circ> (\<lambda>p. poly p r)) qs) (characterize_root_list_p p)"
	+ by (simp add: h)
	+ thus ?thesis unfolding characterize_consistent_signs_at_roots_def characterize_consistent_signs_at_roots_copr_def
	+ signs_at_def consistent_sign_vec_copr_def
	+ by presburger
	+qed
	+
	+(************ Towards defining Renegar's polynomial function and the LHS of the matrix equation ************)
	+
	+definition list_constr:: "nat list \<Rightarrow> nat \<Rightarrow> bool"
	+ where "list_constr L n \<equiv> list_all (\<lambda>x. x < n) L"
	+
	+definition all_list_constr:: "nat list list \<Rightarrow> nat \<Rightarrow> bool"
	+ where "all_list_constr L n \<equiv> (\<forall>x. List.member L x \<longrightarrow> list_constr x n)"
	+
	+(* The first input is the subset; the second input is the consistent sign assignment.
	+ We want to map over the first list and pull out all of the elements in the second list with
	+ corresponding positions, and then multiply those together.
	+*)
	+definition z:: "nat list \<Rightarrow> rat list \<Rightarrow> rat"
	+ where "z index_list sign_asg \<equiv> (prod_list (map (nth sign_asg) index_list))"
	+
	+definition mtx_row:: "rat list list \<Rightarrow> nat list \<Rightarrow> rat list"
	+ where "mtx_row sign_list index_list \<equiv> (map ( (z index_list)) sign_list)"
	+
	+definition matrix_A:: "rat list list \<Rightarrow> nat list list \<Rightarrow> rat mat"
	+ where "matrix_A sign_list subset_list =
	+ (mat_of_rows_list (length sign_list) (map (\<lambda>i .(mtx_row sign_list i)) subset_list))"
	+
	+definition alt_matrix_A:: "rat list list \<Rightarrow> nat list list \<Rightarrow> rat mat"
	+ where "alt_matrix_A signs subsets = (mat (length subsets) (length signs)
	+ (\<lambda>(i, j). z (subsets ! i) (signs ! j)))"
	+
	+lemma alt_matrix_char: "alt_matrix_A signs subsets = matrix_A signs subsets"
	+proof -
	+ have h0: "(\<And>i j. i < length subsets \<Longrightarrow>
	+ j < length signs \<Longrightarrow>
	+ map (\<lambda>index_list. map (z index_list) signs) subsets ! i ! j = z (subsets ! i) (signs ! j))"
	+ proof -
	+ fix i
	+ fix j
	+ assume i_lt: "i < length subsets"
	+ assume j_lt: "j < length signs"
	+ show "((map (\<lambda>index_list. map (z index_list) signs) subsets) ! i) ! j = z (subsets ! i) (signs ! j)"
	+ proof -
	+ have h0: "(map (\<lambda>index_list. map (z index_list) signs) subsets) ! i = map (z (subsets ! i)) signs"
	+ using nth_map i_lt
	+ by blast
	+ then show ?thesis using nth_map j_lt
	+ by simp
	+ qed
	+ qed
	+ have h: " mat (length subsets) (length signs) (\<lambda>(i, j). z (subsets ! i) (signs ! j)) =
	+ mat (length subsets) (length signs) (\<lambda>(i, y). map (\<lambda>index_list. map (z index_list) signs) subsets ! i ! y)"
	+ using h0 eq_matI[where A = "mat (length subsets) (length signs) (\<lambda>(i, j). z (subsets ! i) (signs ! j))",
	+ where B = "mat (length subsets) (length signs) (\<lambda>(i, y). map (\<lambda>index_list. map (z index_list) signs) subsets ! i ! y)"]
	+ by auto
	+ show ?thesis unfolding alt_matrix_A_def matrix_A_def mat_of_rows_list_def apply (auto) unfolding mtx_row_def
	+ using h by blast
	+qed
	+
	+lemma subsets_are_rows: "\<forall>i < (length subsets). row (alt_matrix_A signs subsets) i = vec (length signs) (\<lambda>j. z (subsets ! i) (signs ! j))"
	+ unfolding row_def unfolding alt_matrix_A_def by auto
	+
	+lemma signs_are_cols: "\<forall>i < (length signs). col (alt_matrix_A signs subsets) i = vec (length subsets) (\<lambda>j. z (subsets ! j) (signs ! i))"
	+ unfolding col_def unfolding alt_matrix_A_def by auto
	+
	+(* ith entry of LHS vector is the number of (distinct) real zeros of p where the sign vector of the qs is the ith entry of signs.*)
	+definition construct_lhs_vector:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> rat vec"
	+ where "construct_lhs_vector p qs signs \<equiv>
	+ vec_of_list (map (\<lambda>w. rat_of_int (int (length (filter (\<lambda>v. v = w) (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)))))) signs)"
	+
	+(* Putting all of the pieces of the construction together *)
	+definition satisfy_equation:: "real poly \<Rightarrow> real poly list \<Rightarrow> nat list list \<Rightarrow> rat list list \<Rightarrow> bool"
	+ where "satisfy_equation p qs subset_list sign_list =
	+ (mult_mat_vec (matrix_A sign_list subset_list) (construct_lhs_vector p qs sign_list) = (construct_rhs_vector p qs subset_list))"
	+
	+section "Setting up the construction: Proofs"
	+
	+(* Some matrix lemmas *)
	+lemma row_mat_of_rows_list:
	+ assumes "list_all (\<lambda>r. length r = nc) rs"
	+ assumes "i < length rs"
	+ shows "row (mat_of_rows_list nc rs) i = vec_of_list (nth rs i)"
	+ by (smt assms(1) assms(2) dim_col_mat(1) dim_vec_of_list eq_vecI index_row(2) index_vec list_all_length mat_of_rows_list_def row_mat split_conv vec_of_list_index)
	+
	+
	+lemma mult_mat_vec_of_list:
	+ assumes "length ls = nc"
	+ assumes "list_all (\<lambda>r. length r = nc) rs"
	+ shows "mat_of_rows_list nc rs *\<^sub>v vec_of_list ls =
	+ vec_of_list (map (\<lambda>r. vec_of_list r \<bullet> vec_of_list ls) rs)"
	+ unfolding mult_mat_vec_def
	+ using row_mat_of_rows_list assms
	+ apply auto
	+ by (smt dim_row_mat(1) dim_vec dim_vec_of_list eq_vecI index_map_vec(1) index_map_vec(2) index_vec list_all_length mat_of_rows_list_def row_mat_of_rows_list vec_of_list_index)
	+
	+lemma mtx_row_length:
	+ "list_all (\<lambda>r. length r = length signs) (map (mtx_row signs) ls)"
	+ apply (induction ls)
	+ by (auto simp add: mtx_row_def)
	+
	+thm construct_lhs_vector_def
	+thm poly_roots_finite
	+
	+(* Recharacterize the LHS vector *)
	+lemma construct_lhs_vector_clean:
	+ assumes "p \<noteq> 0"
	+ assumes "i < length signs"
	+ shows "(construct_lhs_vector p qs signs) $ i =
	+ card {x. poly p x = 0 \<and> ((consistent_sign_vec_copr qs x) = (nth signs i))}"
	+proof -
	+ from poly_roots_finite[OF assms(1)] have "finite {x. poly p x = 0}" .
	+ then have eq: "(Collect
	+ ((\<lambda>v. v = signs ! i) \<circ>
	+ consistent_sign_vec_copr qs) \<inter>
	+ set (sorted_list_of_set
	+ {x. poly p x = 0})) =
	+ {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = signs ! i}"
	+ by auto
	+ show ?thesis
	+ unfolding construct_lhs_vector_def vec_of_list_index characterize_root_list_p_def
	+ apply auto
	+ apply (subst nth_map[OF assms(2)])
	+ apply auto
	+ apply (subst distinct_length_filter)
	+ using eq by auto
	+qed
	+
	+lemma construct_lhs_vector_cleaner:
	+ assumes "p \<noteq> 0"
	+ shows "(construct_lhs_vector p qs signs) =
	+ vec_of_list (map (\<lambda>s. rat_of_int (card {x. poly p x = 0 \<and> ((consistent_sign_vec_copr qs x) = s)})) signs)"
	+ apply (rule eq_vecI)
	+ apply (auto simp add: construct_lhs_vector_clean[OF assms] )
	+ apply (simp add: vec_of_list_index)
	+ unfolding construct_lhs_vector_def
	+ using assms construct_lhs_vector_clean construct_lhs_vector_def apply auto[1]
	+ by simp
	+
	+(* Show that because our consistent sign vectors consist of 1 and -1's, z returns 1 or -1
	+ when applied to a consistent sign vector *)
	+lemma z_signs:
	+ assumes "list_all (\<lambda>i. i < length signs) I"
	+ assumes "list_all (\<lambda>s. s = 1 \<or> s = -1) signs"
	+ shows "(z I signs = 1) \<or> (z I signs = -1)" using assms
	+proof (induction I)
	+ case Nil
	+ then show ?case
	+ by (auto simp add:z_def)
	+next
	+ case (Cons a I)
	+ moreover have "signs ! a = 1 \<or> signs ! a = -1"
	+ by (metis (mono_tags, lifting) add_Suc_right calculation(2) calculation(3) gr0_conv_Suc list.size(4) list_all_length nth_Cons_0)
	+ ultimately show ?case
	+ by (auto simp add:z_def)
	+qed
	+
	+lemma z_lemma:
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ assumes consistent: "sign \<in> set (characterize_consistent_signs_at_roots_copr p qs)"
	+ assumes welldefined: "list_constr I (length qs)"
	+ shows "(z I sign = 1) \<or> (z I sign = -1)"
	+proof (rule z_signs)
	+ have "length sign = length qs" using consistent
	+ by (auto simp add: characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def)
	+ thus "list_all (\<lambda>i. i < length sign) I"
	+ using welldefined
	+ by (auto simp add: list_constr_def characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def)
	+ show "list_all (\<lambda>s. s = 1 \<or> s = - 1) sign" using consistent
	+ apply (auto simp add: list.pred_map characterize_consistent_signs_at_roots_copr_def consistent_sign_vec_copr_def)
	+ using Ball_set
	+ by force
	+qed
	+
	+(* Show that all consistent sign vectors on roots of polynomials are in characterize_consistent_signs_at_roots_copr *)
	+lemma in_set:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec_copr qs x"
	+ assumes welldefined: "list_constr I (length qs)"
	+ shows "sign \<in> set (characterize_consistent_signs_at_roots_copr p qs)"
	+proof -
	+ have h1: "consistent_sign_vec_copr qs x \<in>
	+ set (remdups (map (consistent_sign_vec_copr qs) (sorted_list_of_set {x. poly p x = 0})))"
	+ using root_p apply auto apply (subst set_sorted_list_of_set)
	+ using nonzero poly_roots_finite rsquarefree_def apply blast by auto
	+ thus ?thesis unfolding characterize_consistent_signs_at_roots_copr_def characterize_root_list_p_def using sign_fix
	+ by blast
	+qed
	+
	+(* Since all of the polynomials in qs are relatively prime to p, products of subsets of these
	+ polynomials are also relatively prime to p *)
	+lemma nonzero_product:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ assumes pairwise_rel_prime_1: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ fixes I:: "nat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes welldefined: "list_constr I (length qs)"
	+ shows "(poly (prod_list (retrieve_polys qs I)) x > 0) \<or> (poly (prod_list (retrieve_polys qs I)) x < 0)"
	+proof -
	+ have "\<And>x. x \<in> set (retrieve_polys qs I) \<Longrightarrow> coprime p x"
	+ unfolding retrieve_polys_def
	+ by (smt in_set_conv_nth in_set_member length_map list_all_length list_constr_def nth_map pairwise_rel_prime_1 welldefined)
	+ then have coprimeh: "coprime p (prod_list (retrieve_polys qs I))"
	+ using prod_list_coprime_right by auto
	+ thus ?thesis using root_p
	+ using coprime_poly_0 linorder_neqE_linordered_idom by blast
	+qed
	+
	+(* The next few lemmas relate z to the signs of the product of subsets of polynomials of qs *)
	+lemma horiz_vector_helper_pos_ind:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ assumes pairwise_rel_prime_1: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec_copr qs x"
	+ shows "(list_constr I (length qs)) \<longrightarrow> (poly (prod_list (retrieve_polys qs I)) x > 0) \<longleftrightarrow> (z I sign = 1)"
	+proof (induct I)
	+ case Nil
	+ then show ?case
	+ by (simp add: retrieve_polys_def z_def)
	+next
	+ case (Cons a I)
	+ have welldef: "list_constr (a#I) (length qs) \<longrightarrow> (list_constr I (length qs))"
	+ unfolding list_constr_def list_all_def by auto
	+ have set_hyp: "list_constr I (length qs) \<longrightarrow> sign \<in> set (characterize_consistent_signs_at_roots_copr p qs)"
	+ using in_set using nonzero root_p sign_fix by blast
	+ have z_hyp: "list_constr I (length qs) \<longrightarrow> ((z I sign = 1) \<or> (z I sign = -1))"
	+ using set_hyp z_lemma[where sign="sign", where I = "I", where p="p", where qs="qs"] by blast
	+ have sign_hyp: "sign = map (\<lambda> q. if (poly q x > 0) then 1 else -1) qs"
	+ using sign_fix unfolding consistent_sign_vec_copr_def by blast
	+ have ind_hyp_1: "list_constr (a#I) (length qs) \<longrightarrow>
	+ ((0 < poly (prod_list (retrieve_polys qs I)) x) = (z I sign = 1))"
	+ using welldef Cons.hyps by auto
	+ have ind_hyp_2: "list_constr (a#I) (length qs) \<longrightarrow>
	+ ((0 > poly (prod_list (retrieve_polys qs I)) x) = (z I sign = -1))"
	+ using welldef z_hyp Cons.hyps nonzero_product
	+ using pairwise_rel_prime_1 nonzero root_p by auto
	+ have h1: "prod_list (retrieve_polys qs (a # I)) = (nth qs a)*(prod_list (retrieve_polys qs I))"
	+ by (simp add: retrieve_polys_def)
	+ have h2: "(z (a # I) sign) = (nth sign a)*(z I sign)"
	+ by (metis (mono_tags, hide_lams) list.simps(9) prod_list.Cons z_def)
	+ have h3help: "list_constr (a#I) (length qs) \<longrightarrow> a < length qs" unfolding list_constr_def
	+ by simp
	+ then have h3: "list_constr (a#I) (length qs) \<longrightarrow>
	+ ((nth sign a) = (if (poly (nth qs a) x > 0) then 1 else -1))"
	+ using nth_map sign_hyp by auto
	+ have h2: "(0 < poly ((nth qs a)*(prod_list (retrieve_polys qs I))) x) \<longleftrightarrow>
	+ ((0 < poly (nth qs a) x \<and> (0 < poly (prod_list (retrieve_polys qs I)) x)) \<or>
	+ (0 > poly (nth qs a) x \<and> (0 > poly (prod_list (retrieve_polys qs I)) x)))"
	+ by (simp add: zero_less_mult_iff)
	+ have final_hyp_a: "list_constr (a#I) (length qs) \<longrightarrow> (((0 < poly (nth qs a) x \<and> (0 < poly (prod_list (retrieve_polys qs I)) x))
	+ \<or> (0 > poly (nth qs a) x \<and> (0 > poly (prod_list (retrieve_polys qs I)) x))) =
	+ ((nth sign a)*(z I sign) = 1))"
	+ proof -
	+ have extra_hyp_a: "list_constr (a#I) (length qs) \<longrightarrow> (0 < poly (nth qs a) x = ((nth sign a) = 1))" using h3
	+ by simp
	+ have extra_hyp_b: "list_constr (a#I) (length qs) \<longrightarrow> (0 > poly (nth qs a) x = ((nth sign a) = -1))"
	+ using h3 apply (auto) using coprime_poly_0 h3help in_set_member nth_mem pairwise_rel_prime_1 root_p by fastforce
	+ have ind_hyp_1: "list_constr (a#I) (length qs) \<longrightarrow> (((0 < poly (nth qs a) x \<and> (z I sign = 1)) \<or>
	+ (0 > poly (nth qs a) x \<and> (z I sign = -1)))
	+ = ((nth sign a)*(z I sign) = 1))" using extra_hyp_a extra_hyp_b
	+ using zmult_eq_1_iff
	+ by (simp add: h3)
	+ then show ?thesis
	+ using ind_hyp_1 ind_hyp_2 by (simp add: Cons.hyps welldef)
	+ qed
	+ then show ?case
	+ using h1 z_def by (simp add: zero_less_mult_iff)
	+qed
	+
	+lemma horiz_vector_helper_pos:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ assumes pairwise_rel_prime_1: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec_copr qs x"
	+ assumes welldefined: "list_constr I (length qs)"
	+ shows "(poly (prod_list (retrieve_polys qs I)) x > 0) \<longleftrightarrow> (z I sign = 1)"
	+ using horiz_vector_helper_pos_ind
	+ using pairwise_rel_prime_1 nonzero root_p sign_fix welldefined by blast
	+
	+lemma horiz_vector_helper_neg:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ assumes pairwise_rel_prime_1: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec_copr qs x"
	+ assumes welldefined: "list_constr I (length qs)"
	+ shows "(poly (prod_list (retrieve_polys qs I)) x < 0) \<longleftrightarrow> (z I sign = -1)"
	+proof -
	+ have set_hyp: "list_constr I (length qs) \<longrightarrow> sign \<in> set (characterize_consistent_signs_at_roots_copr p qs)"
	+ using in_set using nonzero root_p sign_fix by blast
	+ have z_hyp: "list_constr I (length qs) \<longrightarrow> ((z I sign = 1) \<or> (z I sign = -1))"
	+ using set_hyp z_lemma[where sign="sign", where I = "I", where p="p", where qs="qs"] by blast
	+ have poly_hyp: "(poly (prod_list (retrieve_polys qs I)) x > 0) \<or> (poly (prod_list (retrieve_polys qs I)) x < 0)"
	+ using nonzero_product
	+ using pairwise_rel_prime_1 nonzero root_p
	+ using welldefined by blast
	+ have pos_hyp: "(poly (prod_list (retrieve_polys qs I)) x > 0) \<longleftrightarrow> (z I sign = 1)" using horiz_vector_helper_pos
	+ using pairwise_rel_prime_1 nonzero root_p sign_fix welldefined by blast
	+ show ?thesis using z_hyp poly_hyp pos_hyp apply (auto)
	+ using welldefined by blast
	+qed
	+
	+(* Recharacterize the dot product *)
	+lemma vec_of_list_dot_rewrite:
	+ assumes "length xs = length ys"
	+ shows "vec_of_list xs \<bullet> vec_of_list ys =
	+ sum_list (map2 (*) xs ys)"
	+ using assms
	+proof (induction xs arbitrary:ys)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a xs)
	+ then show ?case apply auto
	+ by (smt (verit, best) Suc_length_conv list.simps(9) old.prod.case scalar_prod_vCons sum_list.Cons vec_of_list_Cons zip_Cons_Cons)
	+qed
	+
	+lemma lhs_dot_rewrite:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ shows
	+ "(vec_of_list (mtx_row signs I) \<bullet> (construct_lhs_vector p qs signs)) =
	+ sum_list (map (\<lambda>s. (z I s) * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) signs)"
	+proof -
	+ have "p \<noteq> 0" using nonzero by auto
	+ from construct_lhs_vector_cleaner[OF this]
	+ have rhseq: "construct_lhs_vector p qs signs =
	+ vec_of_list
	+ (map (\<lambda>s. rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) signs)" by auto
	+ have "(vec_of_list (mtx_row signs I) \<bullet> (construct_lhs_vector p qs signs)) =
	+ sum_list (map2 (*) (mtx_row signs I) (map (\<lambda>s. rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) signs))"
	+ unfolding rhseq
	+ apply (intro vec_of_list_dot_rewrite)
	+ by (auto simp add: mtx_row_def)
	+ thus ?thesis unfolding mtx_row_def
	+ using map2_map_map
	+ by (auto simp add: map2_map_map)
	+qed
	+
	+lemma sum_list_distinct_filter:
	+ fixes f:: "'a \<Rightarrow> int"
	+ assumes "distinct xs" "distinct ys"
	+ assumes "set ys \<subseteq> set xs"
	+ assumes "\<And>x. x \<in> set xs - set ys \<Longrightarrow> f x = 0"
	+ shows "sum_list (map f xs) = sum_list (map f ys)"
	+ by (metis List.finite_set assms(1) assms(2) assms(3) assms(4) sum.mono_neutral_cong_left sum_list_distinct_conv_sum_set)
	+
	+(* If we have a superset of the signs, we can drop to just the consistent ones *)
	+lemma construct_lhs_vector_drop_consistent:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes welldefined: "list_constr I (length qs)"
	+ shows
	+ "(vec_of_list (mtx_row signs I) \<bullet> (construct_lhs_vector p qs signs)) =
	+ (vec_of_list (mtx_row (characterize_consistent_signs_at_roots_copr p qs) I) \<bullet>
	+ (construct_lhs_vector p qs (characterize_consistent_signs_at_roots_copr p qs)))"
	+proof -
	+ have h0: "\<forall> sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec_copr qs ` set (characterize_root_list_p p) \<and> 0 < rat_of_nat (card
	+ {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = sgn}) \<longrightarrow> z I sgn = 0"
	+ proof -
	+ have "\<forall> sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec_copr qs ` set (characterize_root_list_p p) \<and> 0 < rat_of_int (card
	+ {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = sgn}) \<longrightarrow> {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = sgn} \<noteq> {}"
	+ by fastforce
	+ then show ?thesis
	+ proof -
	+ { fix iis :: "rat list"
	+ have ff1: "0 \<noteq> p"
	+ using nonzero rsquarefree_def by blast
	+ obtain rr :: "(real \<Rightarrow> bool) \<Rightarrow> real" where
	+ ff2: "\<And>p. p (rr p) \<or> Collect p = {}"
	+ by moura
	+ { assume "\<exists>is. is = iis \<and> {r. poly p r = 0 \<and> consistent_sign_vec_copr qs r = is} \<noteq> {}"
	+ then have "\<exists>is. consistent_sign_vec_copr qs (rr (\<lambda>r. poly p r = 0 \<and> consistent_sign_vec_copr qs r = is)) = iis \<and> {r. poly p r = 0 \<and> consistent_sign_vec_copr qs r = is} \<noteq> {}"
	+ using ff2
	+ by (metis (mono_tags, lifting))
	+ then have "\<exists>r. poly p r = 0 \<and> consistent_sign_vec_copr qs r = iis"
	+ using ff2 by smt
	+ then have "iis \<in> consistent_sign_vec_copr qs ` set (sorted_list_of_set {r. poly p r = 0})"
	+ using ff1 poly_roots_finite by fastforce }
	+ then have "iis \<notin> set signs \<or> iis \<in> consistent_sign_vec_copr qs ` set (characterize_root_list_p p) \<or> \<not> 0 < rat_of_int (int (card {r. poly p r = 0 \<and> consistent_sign_vec_copr qs r = iis}))"
	+ by (metis (no_types) \<open>\<forall>sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec_copr qs ` set (characterize_root_list_p p) \<and> 0 < rat_of_int (int (card {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = sgn})) \<longrightarrow> {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = sgn} \<noteq> {}\<close> characterize_root_list_p_def) }
	+ then show ?thesis
	+ by fastforce
	+ qed
	+ qed
	+ then have "\<forall> sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec_copr qs ` set (characterize_root_list_p p) \<longrightarrow> ((0 = rat_of_nat (card
	+ {xa. poly p xa = 0 \<and> consistent_sign_vec_copr qs xa = sgn}) \<or> z I sgn = 0))"
	+ by auto
	+ then have hyp: "\<forall> s. s \<in> set signs \<and> s \<notin> consistent_sign_vec_copr qs ` set (characterize_root_list_p p) \<longrightarrow> (z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) = 0)"
	+ by auto
	+ then have "(\<Sum>s\<in> set(signs). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ (\<Sum>s\<in>(set (signs) \<inter> (consistent_sign_vec_copr qs ` set (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ proof -
	+ have "set(signs) =(set (signs) \<inter> (consistent_sign_vec_copr qs ` set (characterize_root_list_p p))) \<union>
	+ (set(signs)-(consistent_sign_vec_copr qs ` set (characterize_root_list_p p)))"
	+ by blast
	+ then have sum_rewrite: "(\<Sum>s\<in> set(signs). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ (\<Sum>s\<in> (set (signs) \<inter> (consistent_sign_vec_copr qs ` set (characterize_root_list_p p))) \<union>
	+ (set(signs)-(consistent_sign_vec_copr qs ` set (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ by auto
	+ then have sum_split: "(\<Sum>s\<in> (set (signs) \<inter> (consistent_sign_vec_copr qs ` set (characterize_root_list_p p))) \<union>
	+ (set(signs)-(consistent_sign_vec_copr qs ` set (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))
	+ =
	+(\<Sum>s\<in> (set (signs) \<inter> (consistent_sign_vec_copr qs ` set (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))
	++ (\<Sum>s\<in> (set(signs)-(consistent_sign_vec_copr qs ` set (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ by (metis (no_types, lifting) List.finite_set sum.Int_Diff)
	+ have sum_zero: "(\<Sum>s\<in> (set(signs)-(consistent_sign_vec_copr qs ` set (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) = 0"
	+ using hyp
	+ by (simp add: hyp)
	+ show ?thesis using sum_rewrite sum_split sum_zero by linarith
	+ qed
	+ then have set_eq: "set (remdups
	+ (map (consistent_sign_vec_copr qs)
	+ (characterize_root_list_p p))) = set (signs) \<inter> (consistent_sign_vec_copr qs ` set (characterize_root_list_p p))"
	+ using all_info
	+ by (simp add: characterize_consistent_signs_at_roots_copr_def subset_antisym)
	+ have hyp1: "(\<Sum>s\<leftarrow>signs. z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ (\<Sum>s\<in>set (signs). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ using distinct_signs sum_list_distinct_conv_sum_set by blast
	+ have hyp2: "(\<Sum>s\<leftarrow>remdups
	+ (map (consistent_sign_vec_copr qs)
	+ (characterize_root_list_p p)). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))
	+ = (\<Sum>s\<in> set (remdups
	+ (map (consistent_sign_vec_copr qs)
	+ (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ using sum_list_distinct_conv_sum_set by blast
	+ have set_sum_eq: "(\<Sum>s\<in>(set (signs) \<inter> (consistent_sign_vec_copr qs ` set (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ (\<Sum>s\<in> set (remdups
	+ (map (consistent_sign_vec_copr qs)
	+ (characterize_root_list_p p))). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ using set_eq by auto
	+ then have "(\<Sum>s\<leftarrow>signs. z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ (\<Sum>s\<leftarrow>remdups
	+ (map (consistent_sign_vec_copr qs)
	+ (characterize_root_list_p p)). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ using set_sum_eq hyp1 hyp2
	+ using \<open>(\<Sum>s\<in>set signs. z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) = (\<Sum>s\<in>set signs \<inter> consistent_sign_vec_copr qs ` set (characterize_root_list_p p). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))\<close> by linarith
	+ then have "consistent_sign_vec_copr qs ` set (characterize_root_list_p p) \<subseteq> set signs \<Longrightarrow>
	+ (\<And>p qss.
	+ characterize_consistent_signs_at_roots_copr p qss =
	+ remdups (map (consistent_sign_vec_copr qss) (characterize_root_list_p p))) \<Longrightarrow>
	+ (\<Sum>s\<leftarrow>signs. z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ (\<Sum>s\<leftarrow>remdups
	+ (map (consistent_sign_vec_copr qs)
	+ (characterize_root_list_p p)). z I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ by linarith
	+ then show ?thesis unfolding lhs_dot_rewrite[OF nonzero]
	+ apply (auto intro!: sum_list_distinct_filter simp add: distinct_signs characterize_consistent_signs_at_roots_copr_def)
	+ using all_info characterize_consistent_signs_at_roots_copr_def by auto[1]
	+qed
	+
	+(* Both matrix_equation_helper_step and matrix_equation_main_step relate the matrix construction
	+ to the Tarski queries, i.e. relate the product of a row of the matrix and the LHS vector to a
	+ Tarski query on the RHS *)
	+lemma matrix_equation_helper_step:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes welldefined: "list_constr I (length qs)"
	+ assumes pairwise_rel_prime_1: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ shows "(vec_of_list (mtx_row signs I) \<bullet> (construct_lhs_vector p qs signs)) =
	+ rat_of_int (card {x. poly p x = 0 \<and> poly (prod_list (retrieve_polys qs I)) x > 0}) -
	+ rat_of_int (card {x. poly p x = 0 \<and> poly (prod_list (retrieve_polys qs I)) x < 0})"
	+proof -
	+ have "finite (set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)))" by auto
	+ let ?gt = "(set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)) \<inter> {s. z I s = 1})"
	+ let ?lt = " (set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)) \<inter> {s. z I s = -1})"
	+ have eq: "set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)) = ?gt \<union> ?lt"
	+ apply auto
	+ by (metis characterize_root_list_p_def horiz_vector_helper_neg horiz_vector_helper_pos_ind nonzero nonzero_product pairwise_rel_prime_1 poly_roots_finite sorted_list_of_set(1) welldefined)
	+ (* First, drop the signs that are irrelevant *)
	+ from construct_lhs_vector_drop_consistent[OF assms(1-4)] have
	+ "vec_of_list (mtx_row signs I) \<bullet> construct_lhs_vector p qs signs =
	+ vec_of_list (mtx_row (characterize_consistent_signs_at_roots_copr p qs) I) \<bullet>
	+ construct_lhs_vector p qs (characterize_consistent_signs_at_roots_copr p qs)" .
	+ (* Now we split the sum *)
	+ from lhs_dot_rewrite[OF assms(1)]
	+ moreover have "... =
	+ (\<Sum>s\<leftarrow>characterize_consistent_signs_at_roots_copr p qs.
	+ z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))" .
	+ moreover have "... =
	+ (\<Sum>s\<in>set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)).
	+ z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))" unfolding characterize_consistent_signs_at_roots_copr_def sum_code[symmetric]
	+ by (auto)
	+ ultimately have "... =
	+ (\<Sum>s\<in>?gt. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) +
	+ (\<Sum>s\<in>?lt. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))"
	+ apply (subst eq)
	+ apply (rule sum.union_disjoint)
	+ by auto
	+ (* Now recharacterize lt, gt*)
	+ have setroots: "set (characterize_root_list_p p) = {x. poly p x = 0}" unfolding characterize_root_list_p_def
	+ using poly_roots_finite nonzero rsquarefree_def set_sorted_list_of_set by blast
	+ have *: "\<And>s. {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s} =
	+ {x \<in>{x. poly p x = 0}. consistent_sign_vec_copr qs x = s}"
	+ by auto
	+ have lem_e1: "\<And>x. x \<in> {x. poly p x = 0} \<Longrightarrow>
	+ card
	+ {s \<in> consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = 1}.
	+ consistent_sign_vec_copr qs x = s} =
	+ (if 0 < poly (prod_list (retrieve_polys qs I)) x then 1 else 0)"
	+ proof -
	+ fix x
	+ assume rt: "x \<in> {x. poly p x = 0}"
	+ then have 1: "{s \<in> consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = 1}. consistent_sign_vec_copr qs x = s} =
	+ {s. z I s = 1 \<and> consistent_sign_vec_copr qs x = s}"
	+ by auto
	+ from horiz_vector_helper_pos[OF assms(1) assms(5) rt]
	+ have 2: "... = {s. (0 < poly (prod_list (retrieve_polys qs I)) x) \<and> consistent_sign_vec_copr qs x = s}"
	+ using welldefined by blast
	+ have 3: "... = (if (0 < poly (prod_list (retrieve_polys qs I)) x) then {consistent_sign_vec_copr qs x} else {})"
	+ by auto
	+ thus "card {s \<in> consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = 1}. consistent_sign_vec_copr qs x = s} =
	+ (if 0 < poly (prod_list (retrieve_polys qs I)) x then 1 else 0) " using 1 2 3 by auto
	+ qed
	+ have e1: "(\<Sum>s\<in>consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = 1}.
	+ card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) =
	+ (sum (\<lambda>x. if (poly (prod_list (retrieve_polys qs I)) x) > 0 then 1 else 0) {x. poly p x = 0})"
	+ unfolding * apply (rule sum_multicount_gen)
	+ using \<open>finite (set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)))\<close> setroots apply auto[1]
	+ apply (metis List.finite_set setroots)
	+ using lem_e1 by auto
	+ have gtchr: "(\<Sum>s\<in>?gt. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ rat_of_int (card {x. poly p x = 0 \<and> 0 < poly (prod_list (retrieve_polys qs I)) x})"
	+ apply (auto simp add: setroots)
	+ apply (subst of_nat_sum[symmetric])
	+ apply (subst of_nat_eq_iff)
	+ apply (subst e1)
	+ apply (subst card_eq_sum)
	+ apply (rule sum.mono_neutral_cong_right)
	+ apply (metis List.finite_set setroots)
	+ by auto
	+ have lem_e2: "\<And>x. x \<in> {x. poly p x = 0} \<Longrightarrow>
	+ card
	+ {s \<in> consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = -1}.
	+ consistent_sign_vec_copr qs x = s} =
	+ (if poly (prod_list (retrieve_polys qs I)) x < 0 then 1 else 0)"
	+ proof -
	+ fix x
	+ assume rt: "x \<in> {x. poly p x = 0}"
	+ then have 1: "{s \<in> consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = -1}. consistent_sign_vec_copr qs x = s} =
	+ {s. z I s = -1 \<and> consistent_sign_vec_copr qs x = s}"
	+ by auto
	+ from horiz_vector_helper_neg[OF assms(1) assms(5) rt]
	+ have 2: "... = {s. (0 > poly (prod_list (retrieve_polys qs I)) x) \<and> consistent_sign_vec_copr qs x = s}"
	+ using welldefined by blast
	+ have 3: "... = (if (0 > poly (prod_list (retrieve_polys qs I)) x) then {consistent_sign_vec_copr qs x} else {})"
	+ by auto
	+ thus "card {s \<in> consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = -1}. consistent_sign_vec_copr qs x = s} =
	+ (if poly (prod_list (retrieve_polys qs I)) x < 0 then 1 else 0)" using 1 2 3 by auto
	+ qed
	+ have e2: " (\<Sum>s\<in>consistent_sign_vec_copr qs ` {x. poly p x = 0} \<inter> {s. z I s = - 1}.
	+ card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}) =
	+ (sum (\<lambda>x. if (poly (prod_list (retrieve_polys qs I)) x) < 0 then 1 else 0) {x. poly p x = 0})"
	+ unfolding * apply (rule sum_multicount_gen)
	+ using \<open>finite (set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)))\<close> setroots apply auto[1]
	+ apply (metis List.finite_set setroots)
	+ using lem_e2 by auto
	+ have ltchr: "(\<Sum>s\<in>?lt. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) =
	+ - rat_of_int (card {x. poly p x = 0 \<and> 0 > poly (prod_list (retrieve_polys qs I)) x})"
	+ apply (auto simp add: setroots sum_negf)
	+ apply (subst of_nat_sum[symmetric])
	+ apply (subst of_nat_eq_iff)
	+ apply (subst e2)
	+ apply (subst card_eq_sum)
	+ apply (rule sum.mono_neutral_cong_right)
	+ apply (metis List.finite_set setroots)
	+ by auto
	+ show ?thesis using gtchr ltchr
	+ using \<open>(\<Sum>s\<in>set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)). z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) = (\<Sum>s\<in>set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)) \<inter> {s. z I s = 1}. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) + (\<Sum>s\<in>set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)) \<inter> {s. z I s = - 1}. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))\<close> \<open>(\<Sum>s\<leftarrow>characterize_consistent_signs_at_roots_copr p qs. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s})) = (\<Sum>s\<in>set (map (consistent_sign_vec_copr qs) (characterize_root_list_p p)). z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))\<close> \<open>vec_of_list (mtx_row (characterize_consistent_signs_at_roots_copr p qs) I) \<bullet> construct_lhs_vector p qs (characterize_consistent_signs_at_roots_copr p qs) = (\<Sum>s\<leftarrow>characterize_consistent_signs_at_roots_copr p qs. z I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec_copr qs x = s}))\<close> \<open>vec_of_list (mtx_row signs I) \<bullet> construct_lhs_vector p qs signs = vec_of_list (mtx_row (characterize_consistent_signs_at_roots_copr p qs) I) \<bullet> construct_lhs_vector p qs (characterize_consistent_signs_at_roots_copr p qs)\<close>
	+ by linarith
	+qed
	+
	+(* A clean restatement of the helper lemma *)
	+lemma matrix_equation_main_step:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes welldefined: "list_constr I (length qs)"
	+ assumes pairwise_rel_prime_1: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ shows "(vec_of_list (mtx_row signs I) \<bullet> (construct_lhs_vector p qs signs)) =
	+ construct_NofI p (retrieve_polys qs I)"
	+ unfolding construct_NofI_prop[OF nonzero]
	+ using matrix_equation_helper_step[OF assms]
	+ by linarith
	+
	+lemma map_vec_vec_of_list_eq_intro:
	+ assumes "map f xs = map g ys"
	+ shows "map_vec f (vec_of_list xs) = map_vec g (vec_of_list ys)"
	+ by (metis assms vec_of_list_map)
	+
	+(* Shows that as long as we have a "basis" of sign assignments (see assumptions all_info, welldefined),
	+ and some other mild assumptions on our inputs (given in nonzero, distinct_signs, pairwise_rel_prime),
	+ the construction will be satisfied *)
	+theorem matrix_equation:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes subsets:: "nat list list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots_copr p qs) \<subseteq> set(signs)"
	+ assumes pairwise_rel_prime: "\<forall>q. ((List.member qs q) \<longrightarrow> (coprime p q))"
	+ assumes welldefined: "all_list_constr (subsets) (length qs)"
	+ shows "satisfy_equation p qs subsets signs"
	+ unfolding satisfy_equation_def matrix_A_def
	+ construct_lhs_vector_def construct_rhs_vector_def all_list_constr_def
	+ apply (subst mult_mat_vec_of_list)
	+ apply (auto simp add: mtx_row_length intro!: map_vec_vec_of_list_eq_intro)
	+ using matrix_equation_main_step[OF assms(1-3) _ assms(4), unfolded construct_lhs_vector_def]
	+ using all_list_constr_def in_set_member welldefined by fastforce
	+
	+(* Prettifying some theorems*)
	+definition roots:: "real poly \<Rightarrow> real set"
	+ where "roots p = {x. poly p x = 0}"
	+
	+definition sgn::"'a::linordered_field \<Rightarrow> rat"
	+ where "sgn x = (if x > 0 then 1
	+ else if x < 0 then -1
	+ else 0)"
	+
	+definition sgn_vec::"real poly list \<Rightarrow> real \<Rightarrow> rat list"
	+ where "sgn_vec qs x \<equiv> map (sgn \<circ> (\<lambda>q. poly q x)) qs"
	+
	+definition consistent_signs_at_roots:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list set"
	+ where "consistent_signs_at_roots p qs =
	+ (sgn_vec qs) ` (roots p)"
	+
	+lemma consistent_signs_at_roots_eq:
	+ assumes "p \<noteq> 0"
	+ shows "consistent_signs_at_roots p qs =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ unfolding consistent_signs_at_roots_def characterize_consistent_signs_at_roots_def
	+ characterize_root_list_p_def
	+ apply auto
	+ apply (subst set_sorted_list_of_set)
	+ using assms poly_roots_finite apply blast
	+ unfolding sgn_vec_def sgn_def signs_at_def squash_def o_def
	+ using roots_def apply auto[1]
	+ by (smt Collect_cong assms image_iff poly_roots_finite roots_def sorted_list_of_set(1))
	+
	+abbreviation w_vec:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> rat vec"
	+ where "w_vec \<equiv> construct_lhs_vector"
	+
	+abbreviation v_vec:: "real poly \<Rightarrow> real poly list \<Rightarrow> nat list list \<Rightarrow> rat vec"
	+ where "v_vec \<equiv> construct_rhs_vector"
	+
	+abbreviation M_mat:: "rat list list \<Rightarrow> nat list list \<Rightarrow> rat mat"
	+ where "M_mat \<equiv> matrix_A"
	+
	+theorem matrix_equation_pretty:
	+ assumes "p\<noteq>0"
	+ assumes "\<And>q. q \<in> set qs \<Longrightarrow> coprime p q"
	+ assumes "distinct signs"
	+ assumes "consistent_signs_at_roots p qs \<subseteq> set signs"
	+ assumes "\<And>l i. l \<in> set subsets \<Longrightarrow> i \<in> set l \<Longrightarrow> i < length qs"
	+ shows "M_mat signs subsets *\<^sub>v w_vec p qs signs = v_vec p qs subsets"
	+ unfolding satisfy_equation_def[symmetric]
	+ apply (rule matrix_equation[OF assms(1) assms(3)])
	+ apply (metis assms(1) assms(2) assms(4) consistent_signs_at_roots_eq csa_list_copr_rel member_def)
	+ apply (simp add: assms(2) in_set_member)
	+ using Ball_set all_list_constr_def assms(5) list_constr_def member_def by fastforce
	+
	+end
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/More_Matrix.thy b/thys/BenOr_Kozen_Reif/More_Matrix.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/More_Matrix.thy
	@@ -0,0 +1,2014 @@
	+theory More_Matrix
	+ imports "Jordan_Normal_Form.Matrix"
	+ "Jordan_Normal_Form.DL_Rank"
	+ "Jordan_Normal_Form.VS_Connect"
	+ "Jordan_Normal_Form.Gauss_Jordan_Elimination"
	+begin
	+
	+section "Kronecker Product"
	+
	+definition kronecker_product :: "'a :: ring mat \<Rightarrow> 'a mat \<Rightarrow> 'a mat" where
	+ "kronecker_product A B =
	+ (let ra = dim_row A; ca = dim_col A;
	+ rb = dim_row B; cb = dim_col B
	+ in
	+ mat (rarb) (cacb)
	+ (\<lambda>(i,j).
	+ A $$ (i div rb, j div cb) *
	+ B $$ (i mod rb, j mod cb)
	+ ))"
	+
	+lemma arith:
	+ assumes "d < a"
	+ assumes "c < b"
	+ shows "bd+c < a(b::nat)"
	+proof -
	+ have "bd+c < b(d+1)"
	+ by (simp add: assms(2))
	+ thus ?thesis
	+ by (metis One_nat_def Suc_leI add.right_neutral add_Suc_right assms(1) less_le_trans mult.commute mult_le_cancel2)
	+qed
	+
	+lemma dim_kronecker[simp]:
	+ "dim_row (kronecker_product A B) = dim_row A * dim_row B"
	+ "dim_col (kronecker_product A B) = dim_col A * dim_col B"
	+ unfolding kronecker_product_def Let_def by auto
	+
	+lemma kronecker_inverse_index:
	+ assumes "r < dim_row A" "s < dim_col A"
	+ assumes "v < dim_row B" "w < dim_col B"
	+ shows "kronecker_product A B $$ (dim_row Br+v, dim_col Bs+w) = A $$ (r,s) * B $$ (v,w)"
	+proof -
	+ from arith[OF assms(1) assms(3)]
	+ have "dim_row Br+v < dim_row A dim_row B" .
	+ moreover from arith[OF assms(2) assms(4)]
	+ have "dim_col B * s + w < dim_col A * dim_col B" .
	+ ultimately show ?thesis
	+ unfolding kronecker_product_def Let_def
	+ using assms by auto
	+qed
	+
	+lemma kronecker_distr_left:
	+ assumes "dim_row B = dim_row C" "dim_col B = dim_col C"
	+ shows "kronecker_product A (B+C) = kronecker_product A B + kronecker_product A C"
	+ unfolding kronecker_product_def Let_def
	+ using assms apply (auto simp add: mat_eq_iff)
	+ by (metis (no_types, lifting) distrib_left index_add_mat(1) mod_less_divisor mult_eq_0_iff neq0_conv not_less_zero)
	+
	+lemma kronecker_distr_right:
	+ assumes "dim_row B = dim_row C" "dim_col B = dim_col C"
	+ shows "kronecker_product (B+C) A = kronecker_product B A + kronecker_product C A"
	+ unfolding kronecker_product_def Let_def
	+ using assms by (auto simp add: mat_eq_iff less_mult_imp_div_less distrib_right)
	+
	+lemma index_mat_mod[simp]: "nr > 0 & nc > 0 \<Longrightarrow> mat nr nc f $$ (i mod nr,j mod nc) = f (i mod nr,j mod nc)"
	+ by auto
	+
	+lemma kronecker_assoc:
	+ shows "kronecker_product A (kronecker_product B C) = kronecker_product (kronecker_product A B) C"
	+ unfolding kronecker_product_def Let_def
	+ apply (case_tac "dim_row B * dim_row C > 0 & dim_col B * dim_col C > 0")
	+ apply (auto simp add: mat_eq_iff less_mult_imp_div_less)
	+ by (smt div_mult2_eq div_mult_mod_eq kronecker_inverse_index less_mult_imp_div_less linordered_semiring_strict_class.mult_pos_pos mod_less_divisor mod_mult2_eq mult.assoc mult.commute)
	+
	+lemma sum_sum_mod_div:
	+ "(\<Sum>ia = 0::nat..<x. \<Sum>ja = 0..<y. f ia ja) =
	+ (\<Sum>ia = 0..<x*y. f (ia div y) (ia mod y))"
	+proof -
	+ have 1: "inj_on (\<lambda>ia. (ia div y, ia mod y)) {0..<x * y}"
	+ by (smt (verit, best) Pair_inject div_mod_decomp inj_onI)
	+ have 21: "{0..<x} \<times> {0..<y} \<subseteq> (\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y}"
	+ proof clarsimp
	+ fix a b
	+ assume *:"a < x" "b < y"
	+ have "a * y + b \<in> {0..<x*y}"
	+ by (metis arith * atLeastLessThan_iff le0 mult.commute)
	+ thus "(a, b) \<in> (\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y}"
	+ by (metis (no_types, lifting) "*"(2) Euclidean_Division.div_eq_0_iff add_cancel_right_right div_mult_self3 gr_implies_not0 image_iff mod_less mod_mult_self3)
	+ qed
	+ have 22:"(\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y} \<subseteq> {0..<x} \<times> {0..<y}"
	+ using less_mult_imp_div_less apply auto
	+ by (metis mod_less_divisor mult.commute neq0_conv not_less_zero)
	+ have 2: "{0..<x} \<times> {0..<y} = (\<lambda>ia. (ia div y, ia mod y)) ` {0..<x * y}"
	+ using 21 22 by auto
	+ have *: "(\<Sum>ia = 0::nat..<x. \<Sum>ja = 0..<y. f ia ja) =
	+ (\<Sum>(x, y)\<in>{0..<x} \<times> {0..<y}. f x y)"
	+ by (auto simp add: sum.cartesian_product)
	+ show ?thesis unfolding *
	+ apply (intro sum.reindex_cong[of "\<lambda>ia. (ia div y, ia mod y)"])
	+ using 1 2 by auto
	+qed
	+
	+(* Kronecker product distributes over matrix multiplication *)
	+lemma kronecker_of_mult:
	+ assumes "dim_col (A :: 'a :: comm_ring mat) = dim_row C"
	+ assumes "dim_col B = dim_row D"
	+ shows "kronecker_product A B * kronecker_product C D = kronecker_product (A * C) (B * D)"
	+ unfolding kronecker_product_def Let_def mat_eq_iff
	+proof clarsimp
	+ fix i j
	+ assume ij: "i < dim_row A * dim_row B" "j < dim_col C * dim_col D"
	+ have 1: "(A * C) $$ (i div dim_row B, j div dim_col D) =
	+ row A (i div dim_row B) \<bullet> col C (j div dim_col D)"
	+ using ij less_mult_imp_div_less by (auto intro!: index_mult_mat)
	+ have 2: "(B * D) $$ (i mod dim_row B, j mod dim_col D) =
	+ row B (i mod dim_row B) \<bullet> col D (j mod dim_col D)"
	+ using ij apply (auto intro!: index_mult_mat)
	+ using gr_implies_not0 apply fastforce
	+ using gr_implies_not0 by fastforce
	+ have 3: "\<And>x. x < dim_row C * dim_row D \<Longrightarrow>
	+ A $$ (i div dim_row B, x div dim_row D) *
	+ B $$ (i mod dim_row B, x mod dim_row D) *
	+ (C $$ (x div dim_row D, j div dim_col D) *
	+ D $$ (x mod dim_row D, j mod dim_col D)) =
	+ row A (i div dim_row B) $ (x div dim_row D) *
	+ col C (j div dim_col D) $ (x div dim_row D) *
	+ (row B (i mod dim_row B) $ (x mod dim_row D) *
	+ col D (j mod dim_col D) $ (x mod dim_row D))"
	+ proof -
	+ fix x
	+ assume :"x < dim_row C dim_row D"
	+ have 1: "row A (i div dim_row B) $ (x div dim_row D) = A $$ (i div dim_row B, x div dim_row D)"
	+ by (simp add: * assms(1) less_mult_imp_div_less row_def)
	+ have 2: "row B (i mod dim_row B) $ (x mod dim_row D) = B $$ (i mod dim_row B, x mod dim_row D)"
	+ by (metis "*" assms(2) ij(1) index_row(1) mod_less_divisor nat_0_less_mult_iff neq0_conv not_less_zero)
	+ have 3: "col C (j div dim_col D) $ (x div dim_row D) = C $$ (x div dim_row D, j div dim_col D)"
	+ by (simp add: "*" ij(2) less_mult_imp_div_less)
	+ have 4: "col D (j mod dim_col D) $ (x mod dim_row D) = D $$ (x mod dim_row D, j mod dim_col D)"
	+ by (metis "*" Euclidean_Division.div_eq_0_iff gr_implies_not0 ij(2) index_col mod_div_trivial mult_not_zero)
	+ show "A $$ (i div dim_row B, x div dim_row D) *
	+ B $$ (i mod dim_row B, x mod dim_row D) *
	+ (C $$ (x div dim_row D, j div dim_col D) *
	+ D $$ (x mod dim_row D, j mod dim_col D)) =
	+ row A (i div dim_row B) $ (x div dim_row D) *
	+ col C (j div dim_col D) $ (x div dim_row D) *
	+ (row B (i mod dim_row B) $ (x mod dim_row D) *
	+ col D (j mod dim_col D) $ (x mod dim_row D))" unfolding 1 2 3 4
	+ by (simp add: mult.assoc mult.left_commute)
	+ qed
	+ have : "(A C) $$ (i div dim_row B, j div dim_col D) *
	+ (B * D) $$ (i mod dim_row B, j mod dim_col D) =
	+ (\<Sum>ia = 0..<dim_row C * dim_row D.
	+ A $$ (i div dim_row B, ia div dim_row D) *
	+ B $$ (i mod dim_row B, ia mod dim_row D) *
	+ (C $$ (ia div dim_row D, j div dim_col D) *
	+ D $$ (ia mod dim_row D, j mod dim_col D)))"
	+ unfolding 1 2 scalar_prod_def sum_product sum_sum_mod_div
	+ apply (auto simp add: sum_product sum_sum_mod_div intro!: sum.cong)
	+ using 3 by presburger
	+ show "vec (dim_col A * dim_col B)
	+ (\<lambda>j. A $$ (i div dim_row B, j div dim_col B) *
	+ B $$ (i mod dim_row B, j mod dim_col B)) \<bullet>
	+ vec (dim_row C * dim_row D)
	+ (\<lambda>i. C $$ (i div dim_row D, j div dim_col D) *
	+ D $$ (i mod dim_row D, j mod dim_col D)) =
	+ (A * C) $$ (i div dim_row B, j div dim_col D) *
	+ (B * D) $$ (i mod dim_row B, j mod dim_col D)"
	+ unfolding * scalar_prod_def
	+ by (auto simp add: assms sum_product sum_sum_mod_div intro!: sum.cong)
	+qed
	+
	+lemma inverts_mat_length:
	+ assumes "square_mat A" "inverts_mat A B" "inverts_mat B A"
	+ shows "dim_row B = dim_row A" "dim_col B = dim_col A"
	+ apply (metis assms(1) assms(3) index_mult_mat(3) index_one_mat(3) inverts_mat_def square_mat.simps)
	+ by (metis assms(1) assms(2) index_mult_mat(3) index_one_mat(3) inverts_mat_def square_mat.simps)
	+
	+lemma less_mult_imp_mod_less:
	+ "m mod i < i" if "m < n * i" for m n i :: nat
	+ using gr_implies_not_zero that by fastforce
	+
	+lemma kronecker_one:
	+ shows "kronecker_product ((1\<^sub>m x)::'a :: ring_1 mat) (1\<^sub>m y) = 1\<^sub>m (x*y)"
	+ unfolding kronecker_product_def Let_def
	+ apply (auto simp add:mat_eq_iff less_mult_imp_div_less less_mult_imp_mod_less)
	+ by (metis div_mult_mod_eq)
	+
	+lemma kronecker_invertible:
	+ assumes "invertible_mat (A :: 'a :: comm_ring_1 mat)" "invertible_mat B"
	+ shows "invertible_mat (kronecker_product A B)"
	+proof -
	+ obtain Ai where Ai: "inverts_mat A Ai" "inverts_mat Ai A" using assms invertible_mat_def by blast
	+ obtain Bi where Bi: "inverts_mat B Bi" "inverts_mat Bi B" using assms invertible_mat_def by blast
	+ have "square_mat (kronecker_product A B)"
	+ by (metis (no_types, lifting) assms(1) assms(2) dim_col_mat(1) dim_row_mat(1) invertible_mat_def kronecker_product_def square_mat.simps)
	+ moreover have "inverts_mat (kronecker_product A B) (kronecker_product Ai Bi)"
	+ using Ai Bi unfolding inverts_mat_def
	+ by (metis (no_types, lifting) dim_kronecker(1) index_mult_mat(3) index_one_mat(3) kronecker_of_mult kronecker_one)
	+ moreover have "inverts_mat (kronecker_product Ai Bi) (kronecker_product A B)"
	+ using Ai Bi unfolding inverts_mat_def
	+ by (metis (no_types, lifting) dim_kronecker(1) index_mult_mat(3) index_one_mat(3) kronecker_of_mult kronecker_one)
	+ ultimately show ?thesis unfolding invertible_mat_def by blast
	+qed
	+
	+section "More DL Rank"
	+
	+(* conjugate matrices *)
	+instantiation mat :: (conjugate) conjugate
	+begin
	+
	+definition conjugate_mat :: "'a :: conjugate mat \<Rightarrow> 'a mat"
	+ where "conjugate m = mat (dim_row m) (dim_col m) (\<lambda>(i,j). conjugate (m $$ (i,j)))"
	+
	+lemma dim_row_conjugate[simp]: "dim_row (conjugate m) = dim_row m"
	+ unfolding conjugate_mat_def by auto
	+
	+lemma dim_col_conjugate[simp]: "dim_col (conjugate m) = dim_col m"
	+ unfolding conjugate_mat_def by auto
	+
	+lemma carrier_vec_conjugate[simp]: "m \<in> carrier_mat nr nc \<Longrightarrow> conjugate m \<in> carrier_mat nr nc"
	+ by (auto)
	+
	+lemma mat_index_conjugate[simp]:
	+ shows "i < dim_row m \<Longrightarrow> j < dim_col m \<Longrightarrow> conjugate m $$ (i,j) = conjugate (m $$ (i,j))"
	+ unfolding conjugate_mat_def by auto
	+
	+lemma row_conjugate[simp]: "i < dim_row m \<Longrightarrow> row (conjugate m) i = conjugate (row m i)"
	+ by (auto)
	+
	+lemma col_conjugate[simp]: "i < dim_col m \<Longrightarrow> col (conjugate m) i = conjugate (col m i)"
	+ by (auto)
	+
	+lemma rows_conjugate: "rows (conjugate m) = map conjugate (rows m)"
	+ by (simp add: list_eq_iff_nth_eq)
	+
	+lemma cols_conjugate: "cols (conjugate m) = map conjugate (cols m)"
	+ by (simp add: list_eq_iff_nth_eq)
	+
	+instance
	+proof
	+ fix a b :: "'a mat"
	+ show "conjugate (conjugate a) = a"
	+ unfolding mat_eq_iff by auto
	+ let ?a = "conjugate a"
	+ let ?b = "conjugate b"
	+ show "conjugate a = conjugate b \<longleftrightarrow> a = b"
	+ by (metis dim_col_conjugate dim_row_conjugate mat_index_conjugate conjugate_cancel_iff mat_eq_iff)
	+qed
	+
	+end
	+
	+abbreviation conjugate_transpose :: "'a::conjugate mat \<Rightarrow> 'a mat"
	+ where "conjugate_transpose A \<equiv> conjugate (A\<^sup>T)"
	+
	+notation conjugate_transpose ("(_\<^sup>H)" [1000])
	+
	+lemma transpose_conjugate:
	+ shows "(conjugate A)\<^sup>T = A\<^sup>H"
	+ unfolding conjugate_mat_def
	+ by auto
	+
	+lemma vec_module_col_helper:
	+ fixes A:: "('a :: field) mat"
	+ shows "(0\<^sub>v (dim_row A) \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A)))"
	+proof -
	+ have "\<forall>v. (0::'a) \<cdot>\<^sub>v v + v = v"
	+ by auto
	+ then show "0\<^sub>v (dim_row A) \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A))"
	+ by (metis cols_dim module_vec_def right_zero_vec smult_carrier_vec vec_space.prod_in_span zero_carrier_vec)
	+qed
	+
	+lemma vec_module_col_helper2:
	+ fixes A:: "('a :: field) mat"
	+ shows "\<And>a x. x \<in> LinearCombinations.module.span class_ring
	+ \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined,
	+ zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr>
	+ (set (cols A)) \<Longrightarrow>
	+ (\<And>a b v. (a + b) \<cdot>\<^sub>v v = a \<cdot>\<^sub>v v + b \<cdot>\<^sub>v v) \<Longrightarrow>
	+ a \<cdot>\<^sub>v x
	+ \<in> LinearCombinations.module.span class_ring
	+ \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined,
	+ zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr>
	+ (set (cols A))"
	+proof -
	+ fix a :: 'a and x :: "'a vec"
	+ assume "x \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A))"
	+ then show "a \<cdot>\<^sub>v x \<in> LinearCombinations.module.span class_ring \<lparr>carrier = carrier_vec (dim_row A), mult = undefined, one = undefined, zero = 0\<^sub>v (dim_row A), add = (+), smult = (\<cdot>\<^sub>v)\<rparr> (set (cols A))"
	+ by (metis (full_types) cols_dim idom_vec.smult_in_span module_vec_def)
	+qed
	+
	+lemma vec_module_col: "module (class_ring :: 'a :: field ring)
	+ (module_vec TYPE('a)
	+ (dim_row A)
	+ \<lparr>carrier :=
	+ LinearCombinations.module.span
	+ class_ring (module_vec TYPE('a) (dim_row A)) (set (cols A))\<rparr>)"
	+proof -
	+ interpret abelian_group "module_vec TYPE('a) (dim_row A)
	+ \<lparr>carrier :=
	+ LinearCombinations.module.span
	+ class_ring (module_vec TYPE('a) (dim_row A)) (set (cols A))\<rparr>"
	+ apply (unfold_locales)
	+ apply (auto simp add:module_vec_def)
	+ apply (metis cols_dim module_vec_def partial_object.select_convs(1) ring.simps(2) vec_vs vectorspace.span_add1)
	+ apply (metis assoc_add_vec cols_dim module_vec_def vec_space.cV vec_vs vectorspace.span_closed)
	+ using vec_module_col_helper[of A] apply (auto)
	+ apply (metis cols_dim left_zero_vec module_vec_def partial_object.select_convs(1) vec_vs vectorspace.span_closed)
	+ apply (metis cols_dim module_vec_def partial_object.select_convs(1) right_zero_vec vec_vs vectorspace.span_closed)
	+ apply (metis cols_dim comm_add_vec module_vec_def vec_space.cV vec_vs vectorspace.span_closed)
	+ unfolding Units_def apply auto
	+ by (smt cols_dim module_vec_def partial_object.select_convs(1) uminus_l_inv_vec uminus_r_inv_vec vec_space.vec_neg vec_vs vectorspace.span_closed vectorspace.span_neg)
	+ show ?thesis
	+ apply (unfold_locales)
	+ unfolding class_ring_simps apply auto
	+ unfolding module_vec_simps using add_smult_distrib_vec apply auto
	+ apply (auto simp add:module_vec_def)
	+ using vec_module_col_helper2
	+ apply blast
	+ using cols_dim module_vec_def partial_object.select_convs(1) smult_add_distrib_vec vec_vs vectorspace.span_closed
	+ by (smt (z3))
	+qed
	+
	+(* The columns of a matrix form a vectorspace *)
	+lemma vec_vs_col: "vectorspace (class_ring :: 'a :: field ring)
	+ (module_vec TYPE('a) (dim_row A)
	+ \<lparr>carrier :=
	+ LinearCombinations.module.span
	+ class_ring
	+ (module_vec TYPE('a)
	+ (dim_row A))
	+ (set (cols A))\<rparr>)"
	+ unfolding vectorspace_def
	+ using vec_module_col class_field
	+ by (auto simp: class_field_def)
	+
	+lemma cols_mat_mul_map:
	+ shows "cols (A * B) = map ((*\<^sub>v) A) (cols B)"
	+ unfolding list_eq_iff_nth_eq
	+ by auto
	+
	+lemma cols_mat_mul:
	+ shows "set (cols (A * B)) = (*\<^sub>v) A ` set (cols B)"
	+ by (simp add: cols_mat_mul_map)
	+
	+lemma set_obtain_sublist:
	+ assumes "S \<subseteq> set ls"
	+ obtains ss where "distinct ss" "S = set ss"
	+ using assms finite_distinct_list infinite_super by blast
	+
	+lemma mul_mat_of_cols:
	+ assumes "A \<in> carrier_mat nr n"
	+ assumes "\<And>j. j < length cs \<Longrightarrow> cs ! j \<in> carrier_vec n"
	+ shows "A * (mat_of_cols n cs) = mat_of_cols nr (map ((*\<^sub>v) A) cs)"
	+ unfolding mat_eq_iff
	+ using assms apply auto
	+ apply (subst mat_of_cols_index)
	+ by auto
	+
	+lemma helper:
	+ fixes x y z ::"'a :: {conjugatable_ring, comm_ring}"
	+ shows "x * (y * z) = y * x * z"
	+ by (simp add: mult.assoc mult.left_commute)
	+
	+lemma cscalar_prod_conjugate_transpose:
	+ fixes x y ::"'a :: {conjugatable_ring, comm_ring} vec"
	+ assumes "A \<in> carrier_mat nr nc"
	+ assumes "x \<in> carrier_vec nr"
	+ assumes "y \<in> carrier_vec nc"
	+ shows "x \<bullet>c (A \<^sub>v y) = (A\<^sup>H \<^sub>v x) \<bullet>c y"
	+ unfolding mult_mat_vec_def scalar_prod_def
	+ using assms apply (auto simp add: sum_distrib_left sum_distrib_right sum_conjugate conjugate_dist_mul)
	+ apply (subst sum.swap)
	+ by (meson helper mult.assoc mult.left_commute sum.cong)
	+
	+lemma mat_mul_conjugate_transpose_vec_eq_0:
	+ fixes v ::"'a :: {conjugatable_ordered_ring,semiring_no_zero_divisors,comm_ring} vec"
	+ assumes "A \<in> carrier_mat nr nc"
	+ assumes "v \<in> carrier_vec nr"
	+ assumes "A \<^sub>v (A\<^sup>H \<^sub>v v) = 0\<^sub>v nr"
	+ shows "A\<^sup>H *\<^sub>v v = 0\<^sub>v nc"
	+proof -
	+ have "(A\<^sup>H \<^sub>v v) \<bullet>c (A\<^sup>H \<^sub>v v) = (A \<^sub>v (A\<^sup>H \<^sub>v v)) \<bullet>c v"
	+ by (metis (mono_tags, lifting) Matrix.carrier_vec_conjugate assms(1) assms(2) assms(3) carrier_matD(2) conjugate_zero_vec cscalar_prod_conjugate_transpose dim_row_conjugate index_transpose_mat(2) mult_mat_vec_def scalar_prod_left_zero scalar_prod_right_zero vec_carrier)
	+ also have "... = 0"
	+ by (simp add: assms(2) assms(3))
	+ (* this step requires real entries *)
	+ ultimately have "(A\<^sup>H \<^sub>v v) \<bullet>c (A\<^sup>H \<^sub>v v) = 0" by auto
	+ thus ?thesis
	+ apply (subst conjugate_square_eq_0_vec[symmetric])
	+ using assms(1) carrier_dim_vec apply fastforce
	+ by auto
	+qed
	+
	+lemma row_mat_of_cols:
	+ assumes "i < nr"
	+ shows "row (mat_of_cols nr ls) i = vec (length ls) (\<lambda>j. (ls ! j) $i)"
	+ by (smt assms dim_vec eq_vecI index_row(1) index_row(2) index_vec mat_of_cols_carrier(2) mat_of_cols_carrier(3) mat_of_cols_index)
	+
	+lemma mat_of_cols_cons_mat_vec:
	+ fixes v ::"'a::comm_ring vec"
	+ assumes "v \<in> carrier_vec (length ls)"
	+ assumes "dim_vec a = nr"
	+ shows
	+ "mat_of_cols nr (a # ls) *\<^sub>v (vCons m v) =
	+ m \<cdot>\<^sub>v a + mat_of_cols nr ls *\<^sub>v v"
	+ unfolding mult_mat_vec_def vec_eq_iff
	+ using assms by
	+ (auto simp add: row_mat_of_cols vec_Suc o_def mult.commute)
	+
	+lemma smult_vec_zero:
	+ fixes v ::"'a::ring vec"
	+ shows "0 \<cdot>\<^sub>v v = 0\<^sub>v (dim_vec v)"
	+ unfolding smult_vec_def vec_eq_iff
	+ by (auto)
	+
	+lemma helper2:
	+ fixes A ::"'a::comm_ring mat"
	+ fixes v ::"'a vec"
	+ assumes "v \<in> carrier_vec (length ss)"
	+ assumes "\<And>x. x \<in> set ls \<Longrightarrow> dim_vec x = nr"
	+ shows
	+ "mat_of_cols nr ss *\<^sub>v v =
	+ mat_of_cols nr (ls @ ss) *\<^sub>v (0\<^sub>v (length ls) @\<^sub>v v)"
	+ using assms(2)
	+proof (induction ls)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a ls)
	+ then show ?case apply (auto simp add:zero_vec_Suc)
	+ apply (subst mat_of_cols_cons_mat_vec)
	+ by (auto simp add:assms smult_vec_zero)
	+qed
	+
	+lemma mat_of_cols_mult_mat_vec_permute_list:
	+ fixes v ::"'a::comm_ring list"
	+ assumes "f permutes {..<length ss}"
	+ assumes "length ss = length v"
	+ shows
	+ "mat_of_cols nr (permute_list f ss) *\<^sub>v vec_of_list (permute_list f v) =
	+ mat_of_cols nr ss *\<^sub>v vec_of_list v"
	+ unfolding mat_of_cols_def mult_mat_vec_def vec_eq_iff scalar_prod_def
	+proof clarsimp
	+ fix i
	+ assume "i < nr"
	+ from sum.permute[OF assms(1)]
	+ have "(\<Sum>ia<length ss. ss ! f ia $ i * v ! f ia) =
	+ sum ((\<lambda>ia. ss ! f ia $ i * v ! f ia) \<circ> f) {..<length ss}" .
	+ also have "... = (\<Sum>ia = 0..<length v. ss ! f ia $ i * v ! f ia)"
	+ using assms(2) calculation lessThan_atLeast0 by auto
	+ ultimately have *: "(\<Sum>ia = 0..<length v.
	+ ss ! f ia $ i * v ! f ia) =
	+ (\<Sum>ia = 0..<length v.
	+ ss ! ia $ i * v ! ia)"
	+ by (metis (mono_tags, lifting) \<open>\<And>g. sum g {..<length ss} = sum (g \<circ> f) {..<length ss}\<close> assms(2) comp_apply lessThan_atLeast0 sum.cong)
	+ show "(\<Sum>ia = 0..<length v.
	+ vec (length ss) (\<lambda>j. permute_list f ss ! j $ i) $ ia *
	+ vec_of_list (permute_list f v) $ ia) =
	+ (\<Sum>ia = 0..<length v. vec (length ss) (\<lambda>j. ss ! j $ i) $ ia * vec_of_list v $ ia)"
	+ using assms * by (auto simp add: permute_list_nth vec_of_list_index)
	+qed
	+
	+(* permute everything in a subset of the indices to the back *)
	+lemma subindex_permutation:
	+ assumes "distinct ss" "set ss \<subseteq> {..<length ls}"
	+ obtains f where "f permutes {..<length ls}"
	+ "permute_list f ls = map ((!) ls) (filter (\<lambda>i. i \<notin> set ss) [0..<length ls]) @ map ((!) ls) ss"
	+proof -
	+ have "set [0..<length ls] = set (filter (\<lambda>i. i \<notin> set ss) [0..<length ls] @ ss)"
	+ using assms unfolding multiset_eq_iff by auto
	+ then have "mset [0..<length ls] = mset (filter (\<lambda>i. i \<notin> set ss) [0..<length ls] @ ss)"
	+ apply (subst set_eq_iff_mset_eq_distinct[symmetric])
	+ using assms by auto
	+ then have "mset ls = mset (map ((!) ls)
	+ (filter (\<lambda>i. i \<notin> set ss)
	+ [0..<length ls]) @ map ((!) ls) ss)"
	+ by (smt length_map map_append map_nth mset_eq_permutation mset_permute_list permute_list_map)
	+ thus ?thesis
	+ by (metis mset_eq_permutation that)
	+qed
	+
	+lemma subindex_permutation2:
	+ assumes "distinct ss" "set ss \<subseteq> {..<length ls}"
	+ obtains f where "f permutes {..<length ls}"
	+ "ls = permute_list f (map ((!) ls) (filter (\<lambda>i. i \<notin> set ss) [0..<length ls]) @ map ((!) ls) ss)"
	+ using subindex_permutation
	+ by (metis assms(1) assms(2) length_permute_list mset_eq_permutation mset_permute_list)
	+
	+lemma distinct_list_subset_nths:
	+ assumes "distinct ss" "set ss \<subseteq> set ls"
	+ obtains ids where "distinct ids" "set ids \<subseteq> {..<length ls}" "ss = map ((!) ls) ids"
	+proof -
	+ let ?ids = "map (\<lambda>i. @j. j < length ls \<and> ls!j = i ) ss"
	+ have 1: "distinct ?ids" unfolding distinct_map
	+ using assms apply (auto simp add: inj_on_def)
	+ by (smt in_mono in_set_conv_nth tfl_some)
	+ have 2: "set ?ids \<subseteq> {..<length ls}"
	+ using assms apply (auto)
	+ by (metis (mono_tags, lifting) in_mono in_set_conv_nth tfl_some)
	+ have 3: "ss = map ((!) ls) ?ids"
	+ using assms apply (auto simp add: list_eq_iff_nth_eq)
	+ by (smt imageI in_set_conv_nth subset_iff tfl_some)
	+ show "(\<And>ids. distinct ids \<Longrightarrow>
	+ set ids \<subseteq> {..<length ls} \<Longrightarrow>
	+ ss = map ((!) ls) ids \<Longrightarrow> thesis) \<Longrightarrow>
	+ thesis" using 1 2 3 by blast
	+qed
	+
	+lemma helper3:
	+ fixes A ::"'a::comm_ring mat"
	+ assumes A: "A \<in> carrier_mat nr nc"
	+ assumes ss:"distinct ss" "set ss \<subseteq> set (cols A)"
	+ assumes "v \<in> carrier_vec (length ss)"
	+ obtains c where "mat_of_cols nr ss \<^sub>v v = A \<^sub>v c" "dim_vec c = nc"
	+proof -
	+ from distinct_list_subset_nths[OF ss]
	+ obtain ids where ids: "distinct ids" "set ids \<subseteq> {..<length (cols A)}"
	+ and ss: "ss = map ((!) (cols A)) ids" by blast
	+ let ?ls = " map ((!) (cols A)) (filter (\<lambda>i. i \<notin> set ids) [0..<length (cols A)])"
	+ from subindex_permutation2[OF ids] obtain f where
	+ f: "f permutes {..<length (cols A)}"
	+ "cols A = permute_list f (?ls @ ss)" using ss by blast
	+ have *: "\<And>x. x \<in> set ?ls \<Longrightarrow> dim_vec x = nr"
	+ using A by auto
	+ let ?cs1 = "(list_of_vec (0\<^sub>v (length ?ls) @\<^sub>v v))"
	+ from helper2[OF assms(4) ]
	+ have "mat_of_cols nr ss \<^sub>v v = mat_of_cols nr (?ls @ ss) \<^sub>v vec_of_list (?cs1)"
	+ using *
	+ by (metis vec_list)
	+ also have "... = mat_of_cols nr (permute_list f (?ls @ ss)) *\<^sub>v vec_of_list (permute_list f ?cs1)"
	+ apply (auto intro!: mat_of_cols_mult_mat_vec_permute_list[symmetric])
	+ apply (metis cols_length f(1) f(2) length_append length_map length_permute_list)
	+ using assms(4) by auto
	+ also have "... = A *\<^sub>v vec_of_list (permute_list f ?cs1)" using f(2) assms by auto
	+ ultimately show
	+ "(\<And>c. mat_of_cols nr ss \<^sub>v v = A \<^sub>v c \<Longrightarrow> dim_vec c = nc \<Longrightarrow> thesis) \<Longrightarrow> thesis"
	+ by (metis A assms(4) carrier_matD(2) carrier_vecD cols_length dim_vec_of_list f(2) index_append_vec(2) index_zero_vec(2) length_append length_list_of_vec length_permute_list)
	+qed
	+
	+lemma mat_mul_conjugate_transpose_sub_vec_eq_0:
	+ fixes A ::"'a :: {conjugatable_ordered_ring,semiring_no_zero_divisors,comm_ring} mat"
	+ assumes "A \<in> carrier_mat nr nc"
	+ assumes "distinct ss" "set ss \<subseteq> set (cols (A\<^sup>H))"
	+ assumes "v \<in> carrier_vec (length ss)"
	+ assumes "A \<^sub>v (mat_of_cols nc ss \<^sub>v v) = 0\<^sub>v nr"
	+ shows "(mat_of_cols nc ss *\<^sub>v v) = 0\<^sub>v nc"
	+proof -
	+ have "A\<^sup>H \<in> carrier_mat nc nr" using assms(1) by auto
	+ from helper3[OF this assms(2-4)]
	+ obtain c where c: "mat_of_cols nc ss \<^sub>v v = A\<^sup>H \<^sub>v c" "dim_vec c = nr" by blast
	+ have 1: "c \<in> carrier_vec nr"
	+ using c carrier_vec_dim_vec by blast
	+ have 2: "A \<^sub>v (A\<^sup>H \<^sub>v c) = 0\<^sub>v nr" using c assms(5) by auto
	+ from mat_mul_conjugate_transpose_vec_eq_0[OF assms(1) 1 2]
	+ have "A\<^sup>H *\<^sub>v c = 0\<^sub>v nc" .
	+ thus ?thesis unfolding c(1)[symmetric] .
	+qed
	+
	+lemma Units_invertible:
	+ fixes A:: "'a::semiring_1 mat"
	+ assumes "A \<in> Units (ring_mat TYPE('a) n b)"
	+ shows "invertible_mat A"
	+ using assms unfolding Units_def invertible_mat_def
	+ apply (auto simp add: ring_mat_def)
	+ using inverts_mat_def by blast
	+
	+lemma invertible_Units:
	+ fixes A:: "'a::semiring_1 mat"
	+ assumes "invertible_mat A"
	+ shows "A \<in> Units (ring_mat TYPE('a) (dim_row A) b)"
	+ using assms unfolding Units_def invertible_mat_def
	+ apply (auto simp add: ring_mat_def)
	+ by (metis assms carrier_mat_triv invertible_mat_def inverts_mat_def inverts_mat_length(1) inverts_mat_length(2))
	+
	+lemma invertible_det:
	+ fixes A:: "'a::field mat"
	+ assumes "A \<in> carrier_mat n n"
	+ shows "invertible_mat A \<longleftrightarrow> det A \<noteq> 0"
	+ apply auto
	+ using invertible_Units unit_imp_det_non_zero apply fastforce
	+ using assms by (auto intro!: Units_invertible det_non_zero_imp_unit)
	+
	+context vec_space begin
	+
	+lemma find_indices_distinct:
	+ assumes "distinct ss"
	+ assumes "i < length ss"
	+ shows "find_indices (ss ! i) ss = [i]"
	+proof -
	+ have "set (find_indices (ss ! i) ss) = {i}"
	+ using assms apply auto by (simp add: assms(1) assms(2) nth_eq_iff_index_eq)
	+ thus ?thesis
	+ by (metis distinct.simps(2) distinct_find_indices empty_iff empty_set insert_iff list.exhaust list.simps(15))
	+qed
	+
	+lemma lin_indpt_lin_comb_list:
	+ assumes "distinct ss"
	+ assumes "lin_indpt (set ss)"
	+ assumes "set ss \<subseteq> carrier_vec n"
	+ assumes "lincomb_list f ss = 0\<^sub>v n"
	+ assumes "i < length ss"
	+ shows "f i = 0"
	+proof -
	+ from lincomb_list_as_lincomb[OF assms(3)]
	+ have "lincomb_list f ss = lincomb (mk_coeff ss f) (set ss)" .
	+ also have "... = lincomb (\<lambda>v. sum f (set (find_indices v ss))) (set ss)"
	+ unfolding mk_coeff_def
	+ apply (subst R.sumlist_map_as_finsum)
	+ by (auto simp add: distinct_find_indices)
	+ ultimately have "lincomb_list f ss = lincomb (\<lambda>v. sum f (set (find_indices v ss))) (set ss)" by auto
	+ then have *:"lincomb (\<lambda>v. sum f (set (find_indices v ss))) (set ss) = 0\<^sub>v n"
	+ using assms(4) by auto
	+ have "finite (set ss)" by simp
	+ from not_lindepD[OF assms(2) this _ _ *]
	+ have "(\<lambda>v. sum f (set (find_indices v ss))) \<in> set ss \<rightarrow> {0}"
	+ by auto
	+ from funcset_mem[OF this]
	+ have "sum f (set (find_indices (nth ss i) ss)) \<in> {0}"
	+ using assms(5) by auto
	+ thus ?thesis unfolding find_indices_distinct[OF assms(1) assms(5)]
	+ by auto
	+qed
	+
	+(* Note: in this locale dim_row A = n, e.g.:
	+lemma foo:
	+ assumes "dim_row A = n"
	+ shows "rank A = vec_space.rank (dim_row A) A"
	+ by (simp add: assms) *)
	+
	+lemma span_mat_mul_subset:
	+ assumes "A \<in> carrier_mat n d"
	+ assumes "B \<in> carrier_mat d nc"
	+ shows "span (set (cols (A * B))) \<subseteq> span (set (cols A))"
	+proof -
	+ have : "\<And>v. \<exists>ca. lincomb_list v (cols (A B)) =
	+ lincomb_list ca (cols A)"
	+ proof -
	+ fix v
	+ have "lincomb_list v (cols (A * B)) = (A * B) *\<^sub>v vec nc v"
	+ apply (subst lincomb_list_as_mat_mult)
	+ apply (metis assms(1) carrier_dim_vec carrier_matD(1) cols_dim index_mult_mat(2) subset_code(1))
	+ by (metis assms(1) assms(2) carrier_matD(1) carrier_matD(2) cols_length index_mult_mat(2) index_mult_mat(3) mat_of_cols_cols)
	+ also have "... = A \<^sub>v (B \<^sub>v vec nc v)"
	+ using assms(1) assms(2) by auto
	+ also have "... = lincomb_list (\<lambda>i. (B *\<^sub>v vec nc v) $ i) (cols A)"
	+ apply (subst lincomb_list_as_mat_mult)
	+ using assms(1) carrier_dim_vec cols_dim apply blast
	+ by (metis assms(1) assms(2) carrier_matD(1) carrier_matD(2) cols_length dim_mult_mat_vec dim_vec eq_vecI index_vec mat_of_cols_cols)
	+ ultimately have "lincomb_list v (cols (A * B)) =
	+ lincomb_list (\<lambda>i. (B *\<^sub>v vec nc v) $ i) (cols A)" by auto
	+ thus "\<exists>ca. lincomb_list v (cols (A * B)) = lincomb_list ca (cols A)" by auto
	+ qed
	+ show ?thesis
	+ apply (subst span_list_as_span[symmetric])
	+ apply (metis assms(1) carrier_matD(1) cols_dim index_mult_mat(2))
	+ apply (subst span_list_as_span[symmetric])
	+ using assms(1) cols_dim apply blast
	+ by (auto simp add:span_list_def *)
	+qed
	+
	+lemma rank_mat_mul_right:
	+ assumes "A \<in> carrier_mat n d"
	+ assumes "B \<in> carrier_mat d nc"
	+ shows "rank (A * B) \<le> rank A"
	+proof -
	+ have "subspace class_ring (local.span (set (cols (A*B))))
	+ (vs (local.span (set (cols A))))"
	+ unfolding subspace_def
	+ by (metis assms(1) assms(2) carrier_matD(1) cols_dim index_mult_mat(2) nested_submodules span_is_submodule vec_space.span_mat_mul_subset vec_vs_col)
	+ from vectorspace.subspace_dim[OF _ this]
	+ have "vectorspace.dim class_ring
	+ (vs (local.span (set (cols A)))
	+ \<lparr>carrier := local.span (set (cols (A * B)))\<rparr>) \<le>
	+ vectorspace.dim class_ring
	+ (vs (local.span (set (cols A))))"
	+ apply auto
	+ by (metis (no_types) assms(1) carrier_matD(1) fin_dim_span_cols index_mult_mat(2) mat_of_cols_carrier(1) mat_of_cols_cols vec_vs_col)
	+ thus ?thesis unfolding rank_def
	+ by auto
	+qed
	+
	+lemma sumlist_drop:
	+ assumes "\<And>v. v \<in> set ls \<Longrightarrow> dim_vec v = n"
	+ shows "sumlist ls = sumlist (filter (\<lambda>v. v \<noteq> 0\<^sub>v n) ls)"
	+ using assms
	+proof (induction ls)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a ls)
	+ then show ?case using dim_sumlist by auto
	+qed
	+
	+lemma lincomb_list_alt:
	+ shows "lincomb_list c s =
	+ sumlist (map2 (\<lambda>i j. i \<cdot>\<^sub>v s ! j) (map (\<lambda>i. c i) [0..<length s]) [0..<length s])"
	+ unfolding lincomb_list_def
	+ by (smt length_map map2_map_map map_nth nth_equalityI nth_map)
	+
	+lemma lincomb_list_alt2:
	+ assumes "\<And>v. v \<in> set s \<Longrightarrow> dim_vec v = n"
	+ assumes "\<And>i. i \<in> set ls \<Longrightarrow> i < length s"
	+ shows "
	+ sumlist (map2 (\<lambda>i j. i \<cdot>\<^sub>v s ! j) (map (\<lambda>i. c i) ls) ls) =
	+ sumlist (map2 (\<lambda>i j. i \<cdot>\<^sub>v s ! j) (map (\<lambda>i. c i) (filter (\<lambda>i. c i \<noteq> 0) ls)) (filter (\<lambda>i. c i \<noteq> 0) ls))"
	+ using assms(2)
	+proof (induction ls)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a s)
	+ then show ?case
	+ apply auto
	+ apply (subst smult_l_null)
	+ apply (simp add: assms(1) carrier_vecI)
	+ apply (subst left_zero_vec)
	+ apply (subst sumlist_carrier)
	+ apply auto
	+ by (metis (no_types, lifting) assms(1) carrier_dim_vec mem_Collect_eq nth_mem set_filter set_zip_rightD)
	+qed
	+
	+lemma two_set:
	+ assumes "distinct ls"
	+ assumes "set ls = set [a,b]"
	+ assumes "a \<noteq> b"
	+ shows "ls = [a,b] \<or> ls = [b,a]"
	+ apply (cases ls)
	+ using assms(2) apply auto[1]
	+proof -
	+ fix x xs
	+ assume ls:"ls = x # xs"
	+ obtain y ys where xs:"xs = y # ys"
	+ by (metis (no_types) \<open>ls = x # xs\<close> assms(2) assms(3) list.set_cases list.set_intros(1) list.set_intros(2) set_ConsD)
	+ have 1:"x = a \<or> x = b"
	+ using \<open>ls = x # xs\<close> assms(2) by auto
	+ have 2:"y = a \<or> y = b"
	+ using \<open>ls = x # xs\<close> \<open>xs = y # ys\<close> assms(2) by auto
	+ have 3:"ys = []"
	+ by (metis (no_types) \<open>ls = x # xs\<close> \<open>xs = y # ys\<close> assms(1) assms(2) distinct.simps(2) distinct_length_2_or_more in_set_member member_rec(2) neq_Nil_conv set_ConsD)
	+ show "ls = [a, b] \<or> ls = [b, a]" using ls xs 1 2 3 assms
	+ by auto
	+qed
	+
	+lemma filter_disj_inds:
	+ assumes "i < length ls" "j < length ls" "i \<noteq> j"
	+ shows "filter (\<lambda>ia. ia \<noteq> j \<longrightarrow> ia = i) [0..<length ls] = [i, j] \<or>
	+ filter (\<lambda>ia. ia \<noteq> j \<longrightarrow> ia = i) [0..<length ls] = [j,i]"
	+proof -
	+ have 1: "distinct (filter (\<lambda>ia. ia = i \<or> ia = j) [0..<length ls])"
	+ using distinct_filter distinct_upt by blast
	+ have 2:"set (filter (\<lambda>ia. ia = i \<or> ia = j) [0..<length ls]) = {i, j}"
	+ using assms by auto
	+ show ?thesis using two_set[OF 1]
	+ using assms(3) empty_set filter_cong list.simps(15)
	+ by (smt "2" assms(3) empty_set filter_cong list.simps(15))
	+qed
	+
	+lemma lincomb_list_indpt_distinct:
	+ assumes "\<And>v. v \<in> set ls \<Longrightarrow> dim_vec v = n"
	+ assumes
	+ "\<And>c. lincomb_list c ls = 0\<^sub>v n \<Longrightarrow> (\<forall>i. i < (length ls) \<longrightarrow> c i = 0)"
	+ shows "distinct ls"
	+ unfolding distinct_conv_nth
	+proof clarsimp
	+ fix i j
	+ assume ij: "i < length ls" "j < length ls" "i \<noteq> j"
	+ assume lsij: "ls ! i = ls ! j"
	+ have "lincomb_list (\<lambda>k. if k = i then 1 else if k = j then -1 else 0) ls =
	+ (ls ! i) - (ls ! j)"
	+ unfolding lincomb_list_alt
	+ apply (subst lincomb_list_alt2[OF assms(1)])
	+ apply auto
	+ using filter_disj_inds[OF ij]
	+ apply auto
	+ using ij(3) apply force
	+ using assms(1) ij(2) apply auto[1]
	+ using ij(3) apply blast
	+ using assms(1) ij(2) by auto
	+ also have "... = 0\<^sub>v n" unfolding lsij
	+ apply (rule minus_cancel_vec)
	+ using \<open>j < length ls\<close> assms(1)
	+ using carrier_vec_dim_vec nth_mem by blast
	+ ultimately have "lincomb_list (\<lambda>k. if k = i then 1 else if k = j then -1 else 0) ls = 0\<^sub>v n" by auto
	+ from assms(2)[OF this]
	+ show False
	+ using \<open>i < length ls\<close> by auto
	+qed
	+
	+end
	+
	+locale conjugatable_vec_space = vec_space f_ty n for
	+ f_ty::"'a::conjugatable_ordered_field itself"
	+ and n
	+begin
	+
	+lemma transpose_rank_mul_conjugate_transpose:
	+ fixes A :: "'a mat"
	+ assumes "A \<in> carrier_mat n nc"
	+ shows "vec_space.rank nc A\<^sup>H \<le> rank (A * A\<^sup>H)"
	+proof -
	+ have 1: "A\<^sup>H \<in> carrier_mat nc n" using assms by auto
	+ have 2: "A * A\<^sup>H \<in> carrier_mat n n" using assms by auto
	+ (* S is a maximal linearly independent set of rows A (or cols A\<^sup>T) *)
	+ let ?P = "(\<lambda>T. T \<subseteq> set (cols A\<^sup>H) \<and> module.lin_indpt class_ring (module_vec TYPE('a) nc) T)"
	+ have *:"\<And>A. ?P A \<Longrightarrow> finite A \<and> card A \<le> n"
	+ proof clarsimp
	+ fix S
	+ assume S: "S \<subseteq> set (cols A\<^sup>H)"
	+ have "card S \<le> card (set (cols A\<^sup>H))" using S
	+ using card_mono by blast
	+ also have "... \<le> length (cols A\<^sup>H)" using card_length by blast
	+ also have "... \<le> n" using assms by auto
	+ ultimately show "finite S \<and> card S \<le> n"
	+ by (meson List.finite_set S dual_order.trans finite_subset)
	+ qed
	+ have **:"?P {}"
	+ apply (subst module.lin_dep_def)
	+ by (auto simp add: vec_module)
	+ from maximal_exists[OF *]
	+ obtain S where S: "maximal S ?P" using **
	+ by (metis (no_types, lifting))
	+ (* Some properties of S *)
	+ from vec_space.rank_card_indpt[OF 1 S]
	+ have rankeq: "vec_space.rank nc A\<^sup>H = card S" .
	+
	+ have s_hyp: "S \<subseteq> set (cols A\<^sup>H)"
	+ using S unfolding maximal_def by simp
	+ have modhyp: "module.lin_indpt class_ring (module_vec TYPE('a) nc) S"
	+ using S unfolding maximal_def by simp
	+
	+(* switch to a list representation *)
	+ obtain ss where ss: "set ss = S" "distinct ss"
	+ by (metis (mono_tags) S maximal_def set_obtain_sublist)
	+ have ss2: "set (map ((\<^sub>v) A) ss) = (\<^sub>v) A ` S"
	+ by (simp add: ss(1))
	+ have rw_hyp: "cols (mat_of_cols n (map ((\<^sub>v) A) ss)) = cols (A mat_of_cols nc ss)"
	+ unfolding cols_def apply (auto)
	+ using mat_vec_as_mat_mat_mult[of A n nc]
	+ by (metis (no_types, lifting) "1" assms carrier_matD(1) cols_dim mul_mat_of_cols nth_mem s_hyp ss(1) subset_code(1))
	+ then have rw: "mat_of_cols n (map ((\<^sub>v) A) ss) = A mat_of_cols nc ss"
	+ by (metis assms carrier_matD(1) index_mult_mat(2) mat_of_cols_carrier(2) mat_of_cols_cols)
	+ have indpt: "\<And>c. lincomb_list c (map ((*\<^sub>v) A) ss) = 0\<^sub>v n \<Longrightarrow>
	+ \<forall>i. (i < (length ss) \<longrightarrow> c i = 0)"
	+ proof clarsimp
	+ fix c i
	+ assume : "lincomb_list c (map ((\<^sub>v) A) ss) = 0\<^sub>v n"
	+ assume i: "i < length ss"
	+ have "\<forall>w\<in>set (map ((*\<^sub>v) A) ss). dim_vec w = n"
	+ using assms by auto
	+ from lincomb_list_as_mat_mult[OF this]
	+ have "A * mat_of_cols nc ss *\<^sub>v vec (length ss) c = 0\<^sub>v n"
	+ using * rw by auto
	+ then have hq: "A \<^sub>v (mat_of_cols nc ss \<^sub>v vec (length ss) c) = 0\<^sub>v n"
	+ by (metis assms assoc_mult_mat_vec mat_of_cols_carrier(1) vec_carrier)
	+
	+ then have eq1: "(mat_of_cols nc ss *\<^sub>v vec (length ss) c) = 0\<^sub>v nc"
	+ apply (intro mat_mul_conjugate_transpose_sub_vec_eq_0)
	+ using assms ss s_hyp by auto
	+
	+(* Rewrite the inner vector back to a lincomb_list *)
	+ have dim_hyp2: "\<forall>w\<in>set ss. dim_vec w = nc"
	+ using ss(1) s_hyp
	+ by (metis "1" carrier_matD(1) carrier_vecD cols_dim subsetD)
	+ from vec_module.lincomb_list_as_mat_mult[OF this, symmetric]
	+ have "mat_of_cols nc ss *\<^sub>v vec (length ss) c = module.lincomb_list (module_vec TYPE('a) nc) c ss" .
	+ then have "module.lincomb_list (module_vec TYPE('a) nc) c ss = 0\<^sub>v nc" using eq1 by auto
	+ from vec_space.lin_indpt_lin_comb_list[OF ss(2) _ _ this i]
	+ show "c i = 0" using modhyp ss s_hyp
	+ using "1" cols_dim by blast
	+ qed
	+ have distinct: "distinct (map ((*\<^sub>v) A) ss)"
	+ by (metis (no_types, lifting) assms carrier_matD(1) dim_mult_mat_vec imageE indpt length_map lincomb_list_indpt_distinct ss2)
	+ then have 3: "card S = card ((*\<^sub>v) A ` S)"
	+ by (metis ss distinct_card image_set length_map)
	+ then have 4: "(\<^sub>v) A ` S \<subseteq> set (cols (A A\<^sup>H))"
	+ using cols_mat_mul \<open>S \<subseteq> set (cols A\<^sup>H)\<close> by blast
	+ have 5: "lin_indpt ((*\<^sub>v) A ` S)"
	+ proof clarsimp
	+ assume ld:"lin_dep ((*\<^sub>v) A ` S)"
	+ have : "finite ((\<^sub>v) A ` S)"
	+ by (metis List.finite_set ss2)
	+ have *: "(\<^sub>v) A ` S \<subseteq> carrier_vec n"
	+ using "2" "4" cols_dim by blast
	+ from finite_lin_dep[OF * ld **]
	+ obtain a v where
	+ a: "lincomb a ((*\<^sub>v) A ` S) = 0\<^sub>v n" and
	+ v: "v \<in> (*\<^sub>v) A ` S" "a v \<noteq> 0" by blast
	+ obtain i where i:"v = map ((*\<^sub>v) A) ss ! i" "i < length ss"
	+ using v unfolding ss2[symmetric]
	+ using find_first_le nth_find_first by force
	+ from ss2[symmetric]
	+ have "set (map ((\<^sub>v) A) ss)\<subseteq> carrier_vec n" using * ss2 by auto
	+ from lincomb_as_lincomb_list_distinct[OF this distinct] have
	+ "lincomb_list
	+ (\<lambda>i. a (map ((\<^sub>v) A) ss ! i)) (map ((\<^sub>v) A) ss) = 0\<^sub>v n"
	+ using a ss2 by auto
	+ from indpt[OF this]
	+ show False using v i by simp
	+ qed
	+ from rank_ge_card_indpt[OF 2 4 5]
	+ have "card ((\<^sub>v) A ` S) \<le> rank (A A\<^sup>H)" .
	+ thus ?thesis using rankeq 3 by linarith
	+qed
	+
	+lemma conjugate_transpose_rank_le:
	+ assumes "A \<in> carrier_mat n nc"
	+ shows "vec_space.rank nc (A\<^sup>H) \<le> rank A"
	+ by (metis assms carrier_matD(2) carrier_mat_triv dim_row_conjugate dual_order.trans index_transpose_mat(2) rank_mat_mul_right transpose_rank_mul_conjugate_transpose)
	+
	+lemma conjugate_finsum:
	+ assumes f: "f : U \<rightarrow> carrier_vec n"
	+ shows "conjugate (finsum V f U) = finsum V (conjugate \<circ> f) U"
	+ using f
	+proof (induct U rule: infinite_finite_induct)
	+ case (infinite A)
	+ then show ?case by auto
	+next
	+ case empty
	+ then show ?case by auto
	+next
	+ case (insert u U)
	+ hence f: "f : U \<rightarrow> carrier_vec n" "f u : carrier_vec n" by auto
	+ then have cf: "conjugate \<circ> f : U \<rightarrow> carrier_vec n"
	+ "(conjugate \<circ> f) u : carrier_vec n"
	+ apply (simp add: Pi_iff)
	+ by (simp add: f(2))
	+ then show ?case
	+ unfolding finsum_insert[OF insert(1) insert(2) f]
	+ unfolding finsum_insert[OF insert(1) insert(2) cf ]
	+ apply (subst conjugate_add_vec[of _ n])
	+ using f(2) apply blast
	+ using M.finsum_closed f(1) apply blast
	+ by (simp add: comp_def f(1) insert.hyps(3))
	+qed
	+
	+lemma rank_conjugate_le:
	+ assumes A:"A \<in> carrier_mat n d"
	+ shows "rank (conjugate (A)) \<le> rank A"
	+proof -
	+ (* S is a maximal linearly independent set of (conjugate A) *)
	+ let ?P = "(\<lambda>T. T \<subseteq> set (cols (conjugate A)) \<and> lin_indpt T)"
	+ have *:"\<And>A. ?P A \<Longrightarrow> finite A \<and> card A \<le> d"
	+ by (metis List.finite_set assms card_length card_mono carrier_matD(2) cols_length dim_col_conjugate dual_order.trans rev_finite_subset)
	+ have **:"?P {}"
	+ by (simp add: finite_lin_indpt2)
	+ from maximal_exists[OF *]
	+ obtain S where S: "maximal S ?P" using **
	+ by (metis (no_types, lifting))
	+ have s_hyp: "S \<subseteq> set (cols (conjugate A))" "lin_indpt S"
	+ using S unfolding maximal_def
	+ apply blast
	+ by (metis (no_types, lifting) S maximal_def)
	+ from rank_card_indpt[OF _ S, of d]
	+ have rankeq: "rank (conjugate A) = card S" using assms by auto
	+ have 1:"conjugate ` S \<subseteq> set (cols A)"
	+ using S apply auto
	+ by (metis (no_types, lifting) cols_conjugate conjugate_id image_eqI in_mono list.set_map s_hyp(1))
	+ have 2: "lin_indpt (conjugate ` S)"
	+ apply (rule ccontr)
	+ apply (auto simp add: lin_dep_def)
	+ proof -
	+ fix T c v
	+ assume T: "T \<subseteq> conjugate ` S" "finite T" and
	+ lc:"lincomb c T = 0\<^sub>v n" and "v \<in> T" "c v \<noteq> 0"
	+ let ?T = "conjugate ` T"
	+ let ?c = "conjugate \<circ> c \<circ> conjugate"
	+ have 1: "finite ?T" using T by auto
	+ have 2: "?T \<subseteq> S" using T by auto
	+ have 3: "?c \<in> ?T \<rightarrow> UNIV" by auto
	+ have "lincomb ?c ?T = (\<Oplus>\<^bsub>V\<^esub>x\<in>T. conjugate (c x) \<cdot>\<^sub>v conjugate x)"
	+ unfolding lincomb_def
	+ apply (subst finsum_reindex)
	+ apply auto
	+ apply (metis "2" carrier_vec_conjugate assms carrier_matD(1) cols_dim image_eqI s_hyp(1) subsetD)
	+ by (meson conjugate_cancel_iff inj_onI)
	+ also have "... = (\<Oplus>\<^bsub>V\<^esub>x\<in>T. conjugate (c x \<cdot>\<^sub>v x)) "
	+ by (simp add: conjugate_smult_vec)
	+ also have "... = conjugate (\<Oplus>\<^bsub>V\<^esub>x\<in>T. (c x \<cdot>\<^sub>v x))"
	+ apply(subst conjugate_finsum[of "\<lambda>x.(c x \<cdot>\<^sub>v x)" T])
	+ apply (auto simp add:o_def)
	+ by (smt Matrix.carrier_vec_conjugate Pi_I' T(1) assms carrier_matD(1) cols_dim dim_row_conjugate imageE s_hyp(1) smult_carrier_vec subset_eq)
	+ also have "... = conjugate (lincomb c T)"
	+ using lincomb_def by presburger
	+ ultimately have "lincomb ?c ?T = conjugate (lincomb c T)" by auto
	+ then have 4:"lincomb ?c ?T = 0\<^sub>v n" using lc by auto
	+ from not_lindepD[OF s_hyp(2) 1 2 3 4]
	+ have "conjugate \<circ> c \<circ> conjugate \<in> conjugate ` T \<rightarrow> {0}" .
	+ then have "c v = 0"
	+ by (simp add: Pi_iff \<open>v \<in> T\<close>)
	+ thus False using \<open>c v \<noteq> 0\<close> by auto
	+ qed
	+ from rank_ge_card_indpt[OF A 1 2]
	+ have 3:"card (conjugate ` S) \<le> rank A" .
	+ have 4: "card (conjugate ` S) = card S"
	+ apply (auto intro!: card_image)
	+ by (meson conjugate_cancel_iff inj_onI)
	+ show ?thesis using rankeq 3 4 by auto
	+qed
	+
	+lemma rank_conjugate:
	+ assumes "A \<in> carrier_mat n d"
	+ shows "rank (conjugate A) = rank A"
	+ using rank_conjugate_le
	+ by (metis carrier_vec_conjugate assms conjugate_id dual_order.antisym)
	+
	+end (* exit the context *)
	+
	+lemma conjugate_transpose_rank:
	+ fixes A::"'a::{conjugatable_ordered_field} mat"
	+ shows "vec_space.rank (dim_row A) A = vec_space.rank (dim_col A) (A\<^sup>H)"
	+ using conjugatable_vec_space.conjugate_transpose_rank_le
	+ by (metis (no_types, lifting) Matrix.transpose_transpose carrier_matI conjugate_id dim_col_conjugate dual_order.antisym index_transpose_mat(2) transpose_conjugate)
	+
	+lemma transpose_rank:
	+ fixes A::"'a::{conjugatable_ordered_field} mat"
	+ shows "vec_space.rank (dim_row A) A = vec_space.rank (dim_col A) (A\<^sup>T)"
	+ by (metis carrier_mat_triv conjugatable_vec_space.rank_conjugate conjugate_transpose_rank index_transpose_mat(2))
	+
	+lemma rank_mat_mul_left:
	+ fixes A::"'a::{conjugatable_ordered_field} mat"
	+ assumes "A \<in> carrier_mat n d"
	+ assumes "B \<in> carrier_mat d nc"
	+ shows "vec_space.rank n (A * B) \<le> vec_space.rank d B"
	+ by (metis (no_types, lifting) Matrix.transpose_transpose assms(1) assms(2) carrier_matD(1) carrier_matD(2) carrier_mat_triv conjugatable_vec_space.rank_conjugate conjugate_transpose_rank index_mult_mat(3) index_transpose_mat(3) transpose_mult vec_space.rank_mat_mul_right)
	+
	+section "Results on Invertibility"
	+
	+(* Extract specific columns of a matrix *)
	+definition take_cols :: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
	+ where "take_cols A inds = mat_of_cols (dim_row A) (map ((!) (cols A)) (filter ((>) (dim_col A)) inds))"
	+
	+definition take_cols_var :: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
	+ where "take_cols_var A inds = mat_of_cols (dim_row A) (map ((!) (cols A)) (inds))"
	+
	+definition take_rows :: "'a mat \<Rightarrow> nat list \<Rightarrow> 'a mat"
	+ where "take_rows A inds = mat_of_rows (dim_col A) (map ((!) (rows A)) (filter ((>) (dim_row A)) inds))"
	+
	+lemma cong1:
	+ "x = y \<Longrightarrow> mat_of_cols n x = mat_of_cols n y"
	+ by auto
	+
	+lemma nth_filter:
	+ assumes "j < length (filter P ls)"
	+ shows "P ((filter P ls) ! j)"
	+ by (simp add: assms list_ball_nth)
	+
	+lemma take_cols_mat_mul:
	+ assumes "A \<in> carrier_mat nr n"
	+ assumes "B \<in> carrier_mat n nc"
	+ shows "A * take_cols B inds = take_cols (A * B) inds"
	+proof -
	+ have "\<And>j. j < length (map ((!) (cols B)) (filter ((>) nc) inds)) \<Longrightarrow>
	+ (map ((!) (cols B)) (filter ((>) nc) inds)) ! j \<in> carrier_vec n"
	+ using assms apply auto
	+ apply (subst cols_nth)
	+ using nth_filter by auto
	+ from mul_mat_of_cols[OF assms(1) this]
	+ have "A * take_cols B inds = mat_of_cols nr (map (\<lambda>x. A *\<^sub>v cols B ! x) (filter ((>) (dim_col B)) inds))"
	+ unfolding take_cols_def using assms by (auto simp add: o_def)
	+ also have "... = take_cols (A * B) inds"
	+ unfolding take_cols_def using assms apply (auto intro!: cong1)
	+ by (simp add: mult_mat_vec_def)
	+ ultimately show ?thesis by auto
	+qed
	+
	+lemma take_cols_carrier_mat:
	+ assumes "A \<in> carrier_mat nr nc"
	+ obtains n where "take_cols A inds \<in> carrier_mat nr n"
	+ unfolding take_cols_def
	+ using assms
	+ by fastforce
	+
	+lemma take_cols_carrier_mat_strict:
	+ assumes "A \<in> carrier_mat nr nc"
	+ assumes "\<And>i. i \<in> set inds \<Longrightarrow> i < nc"
	+ shows "take_cols A inds \<in> carrier_mat nr (length inds)"
	+ unfolding take_cols_def
	+ using assms by auto
	+
	+lemma gauss_jordan_take_cols:
	+ assumes "gauss_jordan A (take_cols A inds) = (C,D)"
	+ shows "D = take_cols C inds"
	+proof -
	+ obtain nr nc where A: "A \<in> carrier_mat nr nc" by auto
	+ from take_cols_carrier_mat[OF this]
	+ obtain n where B: "take_cols A inds \<in> carrier_mat nr n" by auto
	+ from gauss_jordan_transform[OF A B assms, of undefined]
	+ obtain P where PP:"P\<in>Units (ring_mat TYPE('a) nr undefined)" and
	+ CD: "C = P * A" "D = P * take_cols A inds" by blast
	+ have P: "P \<in> carrier_mat nr nr"
	+ by (metis (no_types, lifting) Units_def PP mem_Collect_eq partial_object.select_convs(1) ring_mat_def)
	+ from take_cols_mat_mul[OF P A]
	+ have "P * take_cols A inds = take_cols (P * A) inds" .
	+ thus ?thesis using CD by blast
	+qed
	+
	+lemma dim_col_take_cols:
	+ assumes "\<And>j. j \<in> set inds \<Longrightarrow> j < dim_col A"
	+ shows "dim_col (take_cols A inds) = length inds"
	+ unfolding take_cols_def
	+ using assms by auto
	+
	+lemma dim_col_take_rows[simp]:
	+ shows "dim_col (take_rows A inds) = dim_col A"
	+ unfolding take_rows_def by auto
	+
	+lemma cols_take_cols_subset:
	+ shows "set (cols (take_cols A inds)) \<subseteq> set (cols A)"
	+ unfolding take_cols_def
	+ apply (subst cols_mat_of_cols)
	+ apply auto
	+ using in_set_conv_nth by fastforce
	+
	+lemma dim_row_take_cols[simp]:
	+ shows "dim_row (take_cols A ls) = dim_row A"
	+ by (simp add: take_cols_def)
	+
	+lemma dim_row_append_rows[simp]:
	+ shows "dim_row (A @\<^sub>r B) = dim_row A + dim_row B"
	+ by (simp add: append_rows_def)
	+
	+lemma rows_inj:
	+ assumes "dim_col A = dim_col B"
	+ assumes "rows A = rows B"
	+ shows "A = B"
	+ unfolding mat_eq_iff
	+ apply auto
	+ apply (metis assms(2) length_rows)
	+ using assms(1) apply blast
	+ by (metis assms(1) assms(2) mat_of_rows_rows)
	+
	+lemma append_rows_index:
	+ assumes "dim_col A = dim_col B"
	+ assumes "i < dim_row A + dim_row B"
	+ assumes "j < dim_col A"
	+ shows "(A @\<^sub>r B) $$ (i,j) = (if i < dim_row A then A $$ (i,j) else B $$ (i-dim_row A,j))"
	+ unfolding append_rows_def
	+ apply (subst index_mat_four_block)
	+ using assms by auto
	+
	+lemma row_append_rows:
	+ assumes "dim_col A = dim_col B"
	+ assumes "i < dim_row A + dim_row B"
	+ shows "row (A @\<^sub>r B) i = (if i < dim_row A then row A i else row B (i-dim_row A))"
	+ unfolding vec_eq_iff
	+ using assms by (auto simp add: append_rows_def)
	+
	+lemma append_rows_mat_mul:
	+ assumes "dim_col A = dim_col B"
	+ shows "(A @\<^sub>r B) * C = A * C @\<^sub>r B * C"
	+ unfolding mat_eq_iff
	+ apply auto
	+ apply (simp add: append_rows_def)
	+ apply (subst index_mult_mat)
	+ apply auto
	+ apply (simp add: append_rows_def)
	+ apply (subst append_rows_index)
	+ apply auto
	+ apply (simp add: append_rows_def)
	+ apply (metis add.right_neutral append_rows_def assms index_mat_four_block(3) index_mult_mat(1) index_mult_mat(3) index_zero_mat(3) row_append_rows trans_less_add1)
	+ by (metis add_cancel_right_right add_diff_inverse_nat append_rows_def assms index_mat_four_block(3) index_mult_mat(1) index_mult_mat(3) index_zero_mat(3) nat_add_left_cancel_less row_append_rows)
	+
	+lemma cardlt:
	+ shows "card {i. i < (n::nat)} \<le> n"
	+ by simp
	+
	+lemma row_echelon_form_zero_rows:
	+ assumes row_ech: "row_echelon_form A"
	+ assumes dim_asm: "dim_col A \<ge> dim_row A"
	+ shows "take_rows A [0..<length (pivot_positions A)] @\<^sub>r 0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) = A"
	+proof -
	+ have ex_pivot_fun: "\<exists> f. pivot_fun A f (dim_col A)" using row_ech unfolding row_echelon_form_def by auto
	+ have len_help: "length (pivot_positions A) = card {i. i < dim_row A \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}"
	+ using ex_pivot_fun pivot_positions[where A = "A",where nr = "dim_row A", where nc = "dim_col A"]
	+ by auto
	+ then have len_help2: "length (pivot_positions A) \<le> dim_row A"
	+ by (metis (no_types, lifting) card_mono cardlt finite_Collect_less_nat le_trans mem_Collect_eq subsetI)
	+ have fileq: "filter (\<lambda>y. y < dim_row A) [0..< length (pivot_positions A)] = [0..<length (pivot_positions A)]"
	+ apply (rule filter_True)
	+ using len_help2 by auto
	+ have "\<forall>n. card {i. i < n \<and> row A i \<noteq> 0\<^sub>v (dim_col A)} \<le> n"
	+ proof clarsimp
	+ fix n
	+ have h: "\<forall>x. x \<in> {i. i < n \<and> row A i \<noteq> 0\<^sub>v (dim_col A)} \<longrightarrow> x\<in>{..<n}"
	+ by simp
	+ then have h1: "{i. i < n \<and> row A i \<noteq> 0\<^sub>v (dim_col A)} \<subseteq> {..<n}"
	+ by blast
	+ then have h2: "(card {i. i < n \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}::nat) \<le> (card {..<n}::nat)"
	+ using card_mono by blast
	+ then show "(card {i. i < n \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}::nat) \<le> (n::nat)" using h2 card_lessThan[of n]
	+ by auto
	+ qed
	+ then have pivot_len: "length (pivot_positions A) \<le> dim_row A " using len_help
	+ by simp
	+ have alt_char: "mat_of_rows (dim_col A)
	+ (map ((!) (rows A)) (filter (\<lambda>y. y < dim_col A) [0..<length (pivot_positions A)])) =
	+ mat_of_rows (dim_col A) (map ((!) (rows A)) [0..<length (pivot_positions A)])"
	+ using pivot_len dim_asm
	+ by auto
	+ have h1: "\<And>i j. i < dim_row A \<Longrightarrow>
	+ j < dim_col A \<Longrightarrow>
	+ i < dim_row (take_rows A [0..<length (pivot_positions A)]) \<Longrightarrow>
	+ take_rows A [0..<length (pivot_positions A)] $$ (i, j) = A $$ (i, j)"
	+ proof -
	+ fix i
	+ fix j
	+ assume "i < dim_row A"
	+ assume j_lt: "j < dim_col A"
	+ assume i_lt: "i < dim_row (take_rows A [0..<length (pivot_positions A)])"
	+ have lt: "length (pivot_positions A) \<le> dim_row A" using pivot_len by auto
	+ have h1: "take_rows A [0..<length (pivot_positions A)] $$ (i, j) = (row (take_rows A [0..<length (pivot_positions A)]) i)$j"
	+ by (simp add: i_lt j_lt)
	+ then have h2: "(row (take_rows A [0..<length (pivot_positions A)]) i)$j = (row A i)$j"
	+ using lt alt_char i_lt unfolding take_rows_def by auto
	+ show "take_rows A [0..<length (pivot_positions A)] $$ (i, j) = A $$ (i, j)"
	+ using h1 h2
	+ by (simp add: \<open>i < dim_row A\<close> j_lt)
	+ qed
	+ let ?nc = "dim_col A"
	+ let ?nr = "dim_row A"
	+ have h2: "\<And>i j. i < dim_row A \<Longrightarrow>
	+ j < dim_col A \<Longrightarrow>
	+ \<not> i < dim_row (take_rows A [0..<length (pivot_positions A)]) \<Longrightarrow>
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) $$
	+ (i - dim_row (take_rows A [0..<length (pivot_positions A)]), j) =
	+ A $$ (i, j)"
	+ proof -
	+ fix i
	+ fix j
	+ assume lt_i: "i < dim_row A"
	+ assume lt_j: "j < dim_col A"
	+ assume not_lt: "\<not> i < dim_row (take_rows A [0..<length (pivot_positions A)])"
	+ let ?ip = "i+1"
	+ have h0: "\<exists>f. pivot_fun A f (dim_col A) \<and> f i = ?nc"
	+ proof -
	+ have half1: "\<exists>f. pivot_fun A f (dim_col A)" using assms unfolding row_echelon_form_def
	+ by blast
	+ have half2: "\<forall>f. pivot_fun A f (dim_col A) \<longrightarrow> f i = ?nc "
	+ proof clarsimp
	+ fix f
	+ assume is_piv: "pivot_fun A f (dim_col A)"
	+ have len_pp: "length (pivot_positions A) = card {i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}" using is_piv pivot_positions[of A ?nr ?nc f]
	+ by auto
	+ have "\<forall>i. (i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc) \<longleftrightarrow> (i < ?nr \<and> f i \<noteq> ?nc)"
	+ using is_piv pivot_fun_zero_row_iff[of A f ?nc ?nr]
	+ by blast
	+ then have len_pp_var: "length (pivot_positions A) = card {i. i < ?nr \<and> f i \<noteq> ?nc}"
	+ using len_pp by auto
	+ have allj_hyp: "\<forall>j < ?nr. f j = ?nc \<longrightarrow> ((Suc j) < ?nr \<longrightarrow> f (Suc j) = ?nc)"
	+ using is_piv unfolding pivot_fun_def
	+ using lt_i
	+ by (metis le_antisym le_less)
	+ have if_then_bad: "f i \<noteq> ?nc \<longrightarrow> (\<forall>j. j \<le> i \<longrightarrow> f j \<noteq> ?nc)"
	+ proof clarsimp
	+ fix j
	+ assume not_i: "f i \<noteq> ?nc"
	+ assume j_leq: "j \<le> i"
	+ assume bad_asm: "f j = ?nc"
	+ have "\<And>k. k \<ge> j \<Longrightarrow> k < ?nr \<Longrightarrow> f k = ?nc"
	+ proof -
	+ fix k :: nat
	+ assume a1: "j \<le> k"
	+ assume a2: "k < dim_row A"
	+ have f3: "\<And>n. \<not> n < dim_row A \<or> f n \<noteq> f j \<or> \<not> Suc n < dim_row A \<or> f (Suc n) = f j"
	+ using allj_hyp bad_asm by presburger
	+ obtain nn :: "nat \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow> nat" where
	+ f4: "\<And>n na p nb nc. (\<not> n \<le> na \<or> Suc n \<le> Suc na) \<and> (\<not> p nb \<or> \<not> nc \<le> nb \<or> \<not> p (nn nc nb p) \<or> p nc) \<and> (\<not> p nb \<or> \<not> nc \<le> nb \<or> p nc \<or> p (Suc (nn nc nb p)))"
	+ using inc_induct order_refl by moura
	+ then have f5: "\<And>p. \<not> p k \<or> p j \<or> p (Suc (nn j k p))"
	+ using a1 by presburger
	+ have f6: "\<And>p. \<not> p k \<or> \<not> p (nn j k p) \<or> p j"
	+ using f4 a1 by meson
	+ { assume "nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A) < dim_row A \<and> f (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) \<noteq> dim_col A"
	+ moreover
	+ { assume "(nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A) < dim_row A \<and> f (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) \<noteq> dim_col A) \<and> (\<not> j < dim_row A \<or> f j = dim_col A)"
	+ then have "\<not> k < dim_row A \<or> f k = dim_col A"
	+ using f6
	+ by (metis (mono_tags, lifting)) }
	+ ultimately have "(\<not> j < dim_row A \<or> f j = dim_col A) \<and> (\<not> Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<or> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) = dim_col A) \<or> \<not> k < dim_row A \<or> f k = dim_col A"
	+ using bad_asm
	+ by blast }
	+ moreover
	+ { assume "(\<not> j < dim_row A \<or> f j = dim_col A) \<and> (\<not> Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<or> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) = dim_col A)"
	+ then have "\<not> k < dim_row A \<or> f k = dim_col A"
	+ using f5
	+ proof -
	+ have "\<not> (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<and> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) \<noteq> dim_col A) \<and> \<not> (j < dim_row A \<and> f j \<noteq> dim_col A)"
	+ using \<open>(\<not> j < dim_row A \<or> f j = dim_col A) \<and> (\<not> Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A)) < dim_row A \<or> f (Suc (nn j k (\<lambda>n. n < dim_row A \<and> f n \<noteq> dim_col A))) = dim_col A)\<close> by linarith
	+ then have "\<not> (k < dim_row A \<and> f k \<noteq> dim_col A)"
	+ by (metis (mono_tags, lifting) a2 bad_asm f5 le_less)
	+ then show ?thesis
	+ by meson
	+ qed }
	+ ultimately show "f k = dim_col A"
	+ using f3 a2 by (metis (lifting) Suc_lessD bad_asm)
	+ qed
	+ then show "False" using lt_i not_i
	+ using j_leq by blast
	+ qed
	+ have "f i \<noteq> ?nc \<longrightarrow> ({0..<?ip} \<subseteq> {y. y < ?nr \<and> f y \<noteq> dim_col A})"
	+ proof -
	+ have h1: "f i \<noteq> dim_col A \<longrightarrow> (\<forall>j\<le>i. j < ?nr \<and> f j \<noteq> dim_col A)"
	+ using if_then_bad lt_i by auto
	+ then show ?thesis by auto
	+ qed
	+ then have gteq: "f i \<noteq> ?nc \<longrightarrow> (card {i. i < ?nr \<and> f i \<noteq> dim_col A} \<ge> (i+1))"
	+ using card_lessThan[of ?ip] card_mono[where B = "{i. i < ?nr \<and> f i \<noteq> dim_col A} ", where A = "{0..<?ip}"]
	+ by auto
	+ then have clear: "dim_row (take_rows A [0..<length (pivot_positions A)]) = length (pivot_positions A)"
	+ unfolding take_rows_def using dim_asm fileq by (auto)
	+ have "i + 1 > length (pivot_positions A)" using not_lt clear by auto
	+ then show "f i = ?nc" using gteq len_pp_var by auto
	+ qed
	+ show ?thesis using half1 half2
	+ by blast
	+ qed
	+ then have h1a: "row A i = 0\<^sub>v (dim_col A)"
	+ using pivot_fun_zero_row_iff[of A _ ?nc ?nr]
	+ using lt_i by blast
	+ then have h1: "A $$ (i, j) = 0"
	+ using index_row(1) lt_i lt_j by fastforce
	+ have h2a: "i - dim_row (take_rows A [0..<length (pivot_positions A)]) < dim_row A - length (pivot_positions A)"
	+ using pivot_len lt_i not_lt
	+ by (simp add: take_rows_def)
	+ then have h2: "0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) $$
	+ (i - dim_row (take_rows A [0..<length (pivot_positions A)]), j) = 0 "
	+ unfolding zero_mat_def using pivot_len lt_i lt_j
	+ using index_mat(1) by blast
	+ then show "0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) $$
	+ (i - dim_row (take_rows A [0..<length (pivot_positions A)]), j) =
	+ A $$ (i, j)" using h1 h2
	+ by simp
	+ qed
	+ have h3: "(dim_row (take_rows A [0..<length (pivot_positions A)])::nat) + ((dim_row A::nat) - (length (pivot_positions A)::nat)) =
	+ dim_row A"
	+ proof -
	+ have h0: "dim_row (take_rows A [0..<length (pivot_positions A)]) = (length (pivot_positions A)::nat)"
	+ by (simp add: take_rows_def fileq)
	+ then show ?thesis using add_diff_inverse_nat pivot_len
	+ by linarith
	+ qed
	+ have h4: " \<And>i j. i < dim_row A \<Longrightarrow>
	+ j < dim_col A \<Longrightarrow>
	+ i < dim_row (take_rows A [0..<length (pivot_positions A)]) +
	+ (dim_row A - length (pivot_positions A))"
	+ using pivot_len
	+ by (simp add: h3)
	+ then show ?thesis apply (subst mat_eq_iff)
	+ using h1 h2 h3 h4 by (auto simp add: append_rows_def)
	+qed
	+
	+lemma length_pivot_positions_dim_row:
	+ assumes "row_echelon_form A"
	+ shows "length (pivot_positions A) \<le> dim_row A"
	+proof -
	+ have 1: "A \<in> carrier_mat (dim_row A) (dim_col A)" by auto
	+ obtain f where 2: "pivot_fun A f (dim_col A)"
	+ using assms row_echelon_form_def by blast
	+ from pivot_positions(4)[OF 1 2] have
	+ "length (pivot_positions A) = card {i. i < dim_row A \<and> row A i \<noteq> 0\<^sub>v (dim_col A)}" .
	+ also have "... \<le> card {i. i < dim_row A}"
	+ apply (rule card_mono)
	+ by auto
	+ ultimately show ?thesis by auto
	+qed
	+
	+lemma rref_pivot_positions:
	+ assumes "row_echelon_form R"
	+ assumes R: "R \<in> carrier_mat nr nc"
	+ shows "\<And>i j. (i,j) \<in> set (pivot_positions R) \<Longrightarrow> i < nr \<and> j < nc"
	+proof -
	+ obtain f where f: "pivot_fun R f nc"
	+ using assms(1) assms(2) row_echelon_form_def by blast
	+ have *: "\<And>i. i < nr \<Longrightarrow> f i \<le> nc" using f
	+ using R pivot_funD(1) by blast
	+ from pivot_positions[OF R f]
	+ have "set (pivot_positions R) = {(i, f i) \|i. i < nr \<and> f i \<noteq> nc}" by auto
	+ then have **: "set (pivot_positions R) = {(i, f i) \|i. i < nr \<and> f i < nc}"
	+ using *
	+ by fastforce
	+ fix i j
	+ assume "(i, j) \<in> set (pivot_positions R)"
	+ thus "i < nr \<and> j < nc" using **
	+ by simp
	+qed
	+
	+lemma pivot_fun_monoton:
	+ assumes pf: "pivot_fun A f (dim_col A)"
	+ assumes dr: "dim_row A = nr"
	+ shows "\<And> i. i < nr \<Longrightarrow> (\<And> k. ((k < nr \<and> i < k) \<longrightarrow> f i \<le> f k))"
	+proof -
	+ fix i
	+ assume "i < nr"
	+ show "(\<And> k. ((k < nr \<and> i < k) \<longrightarrow> f i \<le> f k))"
	+ proof -
	+ fix k
	+ show "((k < nr \<and> i < k) \<longrightarrow> f i \<le> f k)"
	+ proof (induct k)
	+ case 0
	+ then show ?case
	+ by blast
	+ next
	+ case (Suc k)
	+ then show ?case
	+ by (smt dr le_less_trans less_Suc_eq less_imp_le_nat pf pivot_funD(1) pivot_funD(3))
	+ qed
	+ qed
	+qed
	+
	+lemma pivot_positions_contains:
	+ assumes row_ech: "row_echelon_form A"
	+ assumes dim_h: "dim_col A \<ge> dim_row A"
	+ assumes "pivot_fun A f (dim_col A)"
	+ shows "\<forall>i < (length (pivot_positions A)). (i, f i) \<in> set (pivot_positions A)"
	+proof -
	+ let ?nr = "dim_row A"
	+ let ?nc = "dim_col A"
	+ let ?pp = "pivot_positions A"
	+ have i_nr: "\<forall>i < (length ?pp). i < ?nr" using rref_pivot_positions assms
	+ using length_pivot_positions_dim_row less_le_trans by blast
	+ have i_nc: "\<forall>i < (length ?pp). f i < ?nc"
	+ proof clarsimp
	+ fix i
	+ assume i_lt: "i < length ?pp"
	+ have fis_nc: "f i = ?nc \<Longrightarrow> (\<forall> k > i. k < ?nr \<longrightarrow> f k = ?nc)"
	+ proof -
	+ assume is_nc: "f i = ?nc"
	+ show "(\<forall> k > i. k < ?nr \<longrightarrow> f k = ?nc)"
	+ proof clarsimp
	+ fix k
	+ assume k_gt: "k > i"
	+ assume k_lt: "k < ?nr"
	+ have fk_lt: "f k \<le> ?nc" using pivot_funD(1)[of A ?nr f ?nc k] k_lt apply (auto)
	+ using \<open>pivot_fun A f (dim_col A)\<close> by blast
	+ show "f k = ?nc"
	+ using fk_lt is_nc k_gt k_lt assms pivot_fun_monoton[of A f ?nr i k]
	+ using \<open>pivot_fun A f (dim_col A)\<close> by auto
	+ qed
	+ qed
	+ have ncimp: "f i = ?nc \<Longrightarrow> (\<forall> k \<ge>i. k \<notin> { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc})"
	+ proof -
	+ assume nchyp: "f i = ?nc"
	+ show "(\<forall> k \<ge>i. k \<notin> { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc})"
	+ proof clarsimp
	+ fix k
	+ assume i_lt: "i \<le> k"
	+ assume k_lt: "k < dim_row A"
	+ show "row A k = 0\<^sub>v (dim_col A) "
	+ using i_lt k_lt fis_nc
	+ using pivot_fun_zero_row_iff[of A f ?nc ?nr]
	+ using \<open>pivot_fun A f (dim_col A)\<close> le_neq_implies_less nchyp by blast
	+ qed
	+ qed
	+ then have "f i = ?nc \<Longrightarrow> card { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc} \<le> i"
	+ proof -
	+ assume nchyp: "f i = ?nc"
	+ have h: "{ i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc} \<subseteq> {0..<i}"
	+ using atLeast0LessThan le_less_linear nchyp ncimp by blast
	+ then show " card { i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc} \<le> i"
	+ using card_lessThan
	+ using subset_eq_atLeast0_lessThan_card by blast
	+ qed
	+ then show "f i < ?nc" using i_lt pivot_positions(4)[of A ?nr ?nc f]
	+ apply (auto)
	+ by (metis \<open>pivot_fun A f (dim_col A)\<close> i_nr le_neq_implies_less not_less pivot_funD(1))
	+ qed
	+ then show ?thesis
	+ using pivot_positions(1)
	+ by (smt \<open>pivot_fun A f (dim_col A)\<close> carrier_matI i_nr less_not_refl mem_Collect_eq)
	+qed
	+
	+lemma pivot_positions_form_helper_1:
	+ shows "(a, b) \<in> set (pivot_positions_main_gen z A nr nc i j) \<Longrightarrow> i \<le> a"
	+proof (induct i j rule: pivot_positions_main_gen.induct[of nr nc A z])
	+ case (1 i j)
	+ then show ?case using pivot_positions_main_gen.simps[of z A nr nc i j]
	+ apply (auto)
	+ by (smt Suc_leD le_refl old.prod.inject set_ConsD)
	+qed
	+
	+lemma pivot_positions_form_helper_2:
	+ shows "strict_sorted (map fst (pivot_positions_main_gen z A nr nc i j))"
	+proof (induct i j rule: pivot_positions_main_gen.induct[of nr nc A z])
	+ case (1 i j)
	+ then show ?case using pivot_positions_main_gen.simps[of z A nr nc i j]
	+ apply (auto) using pivot_positions_form_helper_1
	+ by (simp add: pivot_positions_form_helper_1 Suc_le_lessD)
	+qed
	+
	+lemma sorted_pivot_positions:
	+ shows "strict_sorted (map fst (pivot_positions A))"
	+ using pivot_positions_form_helper_2
	+ by (simp add: pivot_positions_form_helper_2 pivot_positions_gen_def)
	+
	+lemma pivot_positions_form:
	+ assumes row_ech: "row_echelon_form A"
	+ assumes dim_h: "dim_col A \<ge> dim_row A"
	+ shows "\<forall> i < (length (pivot_positions A)). fst ((pivot_positions A) ! i) = i"
	+proof clarsimp
	+ let ?nr = "dim_row A"
	+ let ?nc = "dim_col A"
	+ let ?pp = "pivot_positions A :: (nat \<times> nat) list"
	+ fix i
	+ assume i_lt: "i < length (pivot_positions A)"
	+ have "\<exists>f. pivot_fun A f ?nc" using row_ech unfolding row_echelon_form_def
	+ by blast
	+ then obtain f where pf:"pivot_fun A f ?nc"
	+ by blast
	+ have all_f_in: "\<forall>i < (length ?pp). (i, f i) \<in> set ?pp"
	+ using pivot_positions_contains pf
	+ assms
	+ by blast
	+ have sorted_hyp: "\<And> (p::nat) (q::nat). p < (length ?pp) \<Longrightarrow> q < (length ?pp) \<Longrightarrow> p < q \<Longrightarrow> (fst (?pp ! p) < fst (?pp ! q))"
	+ proof -
	+ fix p::nat
	+ fix q::nat
	+ assume p_lt: "p < q"
	+ assume p_welldef: "p < (length ?pp)"
	+ assume q_welldef: "q < (length ?pp)"
	+ show "fst (?pp ! p) < fst (?pp ! q)"
	+ using sorted_pivot_positions p_lt p_welldef q_welldef apply (auto)
	+ by (smt find_first_unique length_map nat_less_le nth_map p_welldef sorted_nth_mono sorted_pivot_positions strict_sorted_iff)
	+ qed
	+ have h: "i < (length ?pp) \<longrightarrow> fst (pivot_positions A ! i) = i"
	+ proof (induct i)
	+ case 0
	+ have "\<exists>j. fst (pivot_positions A ! j) = 0"
	+ by (metis all_f_in fst_conv i_lt in_set_conv_nth length_greater_0_conv list.size(3) not_less0)
	+ then obtain j where jth:" fst (pivot_positions A ! j) = 0"
	+ by blast
	+ have "j \<noteq> 0 \<longrightarrow> (fst (pivot_positions A ! 0) > 0 \<longrightarrow> j \<le> 0)"
	+ using sorted_hyp apply (auto)
	+ by (metis all_f_in fst_conv i_lt in_set_conv_nth length_greater_0_conv list.size(3) neq0_conv not_less0)
	+ then show ?case
	+ using jth neq0_conv by blast
	+ next
	+ case (Suc i)
	+ have ind_h: "i < length (pivot_positions A) \<longrightarrow> fst (pivot_positions A ! i) = i"
	+ using Suc.hyps by blast
	+ have thesis_h: "(Suc i) < length (pivot_positions A) \<Longrightarrow> fst (pivot_positions A ! (Suc i)) = (Suc i)"
	+ proof -
	+ assume suc_i_lt: "(Suc i) < length (pivot_positions A)"
	+ have fst_i_is: "fst (pivot_positions A ! i) = i" using suc_i_lt ind_h
	+ using Suc_lessD by blast
	+ have "(\<exists>j < (length ?pp). fst (pivot_positions A ! j) = (Suc i))"
	+ by (metis suc_i_lt all_f_in fst_conv in_set_conv_nth)
	+ then obtain j where jth: "j < (length ?pp) \<and> fst (pivot_positions A ! j) = (Suc i)"
	+ by blast
	+ have "j > i"
	+ using sorted_hyp apply (auto)
	+ by (metis Suc_lessD \<open>fst (pivot_positions A ! i) = i\<close> jth less_not_refl linorder_neqE_nat n_not_Suc_n suc_i_lt)
	+ have "j > (Suc i) \<Longrightarrow> False"
	+ proof -
	+ assume j_gt: "j > (Suc i)"
	+ then have h1: "fst (pivot_positions A ! (Suc i)) > i"
	+ using fst_i_is sorted_pivot_positions
	+ using sorted_hyp suc_i_lt by force
	+ have "fst (pivot_positions A ! j) > fst (pivot_positions A ! (Suc i))"
	+ using jth j_gt sorted_hyp apply (auto)
	+ by fastforce
	+ then have h2: "fst (pivot_positions A ! (Suc i)) < (Suc i)"
	+ using jth
	+ by simp
	+ show "False" using h1 h2
	+ using not_less_eq by blast
	+ qed
	+ show "fst (pivot_positions A ! (Suc i)) = (Suc i)"
	+ using Suc_lessI \<open>Suc i < j \<Longrightarrow> False\<close> \<open>i < j\<close> jth by blast
	+ qed
	+ then show ?case
	+ by blast
	+ qed
	+ then show "fst (pivot_positions A ! i) = i"
	+ using i_lt by auto
	+qed
	+
	+lemma take_cols_pivot_eq:
	+ assumes row_ech: "row_echelon_form A"
	+ assumes dim_h: "dim_col A \<ge> dim_row A"
	+ shows "take_cols A (map snd (pivot_positions A)) =
	+ 1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))"
	+proof -
	+ let ?nr = "dim_row A"
	+ let ?nc = "dim_col A"
	+ have h1: " dim_col
	+ (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) = (length (pivot_positions A))"
	+ by (simp add: append_rows_def)
	+ have len_pivot: "length (pivot_positions A) = card {i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}"
	+ using row_ech pivot_positions(4) row_echelon_form_def by blast
	+ have pp_leq_nc: "\<forall>f. pivot_fun A f ?nc \<longrightarrow> (\<forall>i < ?nr. f i \<le> ?nc)" unfolding pivot_fun_def
	+ by meson
	+ have pivot_set: "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) \| i. i < ?nr \<and> f i \<noteq> ?nc}"
	+ using row_ech row_echelon_form_def pivot_positions(1)
	+ by (smt (verit) Collect_cong carrier_matI)
	+ then have pivot_set_alt: "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) \| i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}"
	+ using pivot_positions pivot_fun_zero_row_iff Collect_cong carrier_mat_triv
	+ by (smt (verit, best))
	+ have "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) \| i. f i \<le> ?nc \<and> i < ?nr \<and> f i \<noteq> ?nc}"
	+ using pivot_set pp_leq_nc by auto
	+ then have pivot_set_var: "\<exists>f. pivot_fun A f ?nc \<and> set (pivot_positions A) = {(i, f i) \| i. i < ?nr \<and> f i < ?nc}"
	+ by auto
	+ have "length (map snd (pivot_positions A)) = card (set (map snd (pivot_positions A)))"
	+ using row_ech row_echelon_form_def pivot_positions(3) distinct_card[where xs = "map snd (pivot_positions A)"]
	+ by (metis carrier_mat_triv)
	+ then have "length (map snd (pivot_positions A)) = card (set (pivot_positions A))"
	+ by (metis card_distinct distinct_card distinct_map length_map)
	+ then have "length (map snd (pivot_positions A)) = card {i. i < ?nr \<and> row A i \<noteq> 0\<^sub>v ?nc}"
	+ using pivot_set_alt
	+ by (simp add: len_pivot)
	+ then have length_asm: "length (map snd (pivot_positions A)) = length (pivot_positions A)"
	+ using len_pivot by linarith
	+ then have "\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A"
	+ proof clarsimp
	+ fix a
	+ assume a_in: "List.member (map snd (pivot_positions A)) a"
	+ have "\<exists>v \<in> set (pivot_positions A). a = snd v"
	+ using a_in in_set_member[where xs = "(pivot_positions A)"] apply (auto)
	+ by (metis in_set_impl_in_set_zip2 in_set_member length_map snd_conv zip_map_fst_snd)
	+ then show "a < dim_col A"
	+ using pivot_set_var in_set_member by auto
	+ qed
	+ then have h2b: "(filter (\<lambda>y. y < dim_col A) (map snd (pivot_positions A))) = (map snd (pivot_positions A))"
	+ by (meson filter_True in_set_member)
	+ then have h2a: "length (map ((!) (cols A)) (filter (\<lambda>y. y < dim_col A) (map snd (pivot_positions A)))) = length (pivot_positions A)"
	+ using length_asm
	+ by (simp add: h2b)
	+ then have h2: "length (pivot_positions A) \<le> dim_row A \<Longrightarrow>
	+ dim_col (take_cols A (map snd (pivot_positions A))) = (length (pivot_positions A))"
	+ unfolding take_cols_def using mat_of_cols_carrier by auto
	+ have h_len: "length (pivot_positions A) \<le> dim_row A \<Longrightarrow>
	+ dim_col (take_cols A (map snd (pivot_positions A))) =
	+ dim_col
	+ (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A)))"
	+ using h1 h2
	+ by (simp add: h1 assms length_pivot_positions_dim_row)
	+ have h2: "\<And>i j. length (pivot_positions A) \<le> dim_row A \<Longrightarrow>
	+ i < dim_row A \<Longrightarrow>
	+ j < dim_col
	+ (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) \<Longrightarrow>
	+ take_cols A (map snd (pivot_positions A)) $$ (i, j) =
	+ (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) $$
	+ (i, j)"
	+ proof -
	+ fix i
	+ fix j
	+ let ?pp = "(pivot_positions A)"
	+ assume len_lt: "length (pivot_positions A) \<le> dim_row A"
	+ assume i_lt: " i < dim_row A"
	+ assume j_lt: "j < dim_col
	+ (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A)))"
	+ let ?w = "((map snd (pivot_positions A)) ! j)"
	+ have breaking_it_down: "mat_of_cols (dim_row A)
	+ (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j)
	+ = ((cols A) ! ?w) $ i"
	+ apply (auto)
	+ by (metis comp_apply h1 i_lt j_lt length_map mat_of_cols_index nth_map)
	+ have h1a: "i < (length ?pp) \<Longrightarrow> (mat_of_cols (dim_row A) (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j)
	+ = (1\<^sub>m (length (pivot_positions A))) $$ (i, j))"
	+ proof -
	+ (* need to, using row_ech, rely heavily on pivot_fun_def, that num_cols \<ge> num_rows, and row_echelon form*)
	+ assume "i < (length ?pp)"
	+ have "\<exists>f. pivot_fun A f ?nc" using row_ech unfolding row_echelon_form_def
	+ by blast
	+ then obtain f where "pivot_fun A f ?nc"
	+ by blast
	+ have j_nc: "j < (length ?pp)" using j_lt
	+ by (simp add: h1)
	+ then have j_lt_nr: "j < ?nr" using dim_h
	+ using len_lt by linarith
	+ then have is_this_true: "(pivot_positions A) ! j = (j, f j)"
	+ using pivot_positions_form pivot_positions(1)[of A ?nr ?nc f]
	+ proof -
	+ have "pivot_positions A ! j \<in> set (pivot_positions A)"
	+ using j_nc nth_mem by blast
	+ then have "\<exists>n. pivot_positions A ! j = (n, f n) \<and> n < dim_row A \<and> f n \<noteq> dim_col A"
	+ using \<open>\<lbrakk>A \<in> carrier_mat (dim_row A) (dim_col A); pivot_fun A f (dim_col A)\<rbrakk> \<Longrightarrow> set (pivot_positions A) = {(i, f i) \|i. i < dim_row A \<and> f i \<noteq> dim_col A}\<close> \<open>pivot_fun A f (dim_col A)\<close> by blast
	+ then show ?thesis
	+ by (metis (no_types) \<open>\<And>A. \<lbrakk>row_echelon_form A; dim_row A \<le> dim_col A\<rbrakk> \<Longrightarrow> \<forall>i<length (pivot_positions A). fst (pivot_positions A ! i) = i\<close> dim_h fst_conv j_nc row_ech)
	+ qed
	+ then have w_is: "?w = f j"
	+ by (metis h1 j_lt nth_map snd_conv)
	+ have h0: "i = j \<longrightarrow> ((cols A) ! ?w) $ i = 1" using w_is pivot_funD(4)[of A ?nr f ?nc i]
	+ by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> \<open>i < length (pivot_positions A)\<close> \<open>pivot_fun A f (dim_col A)\<close> cols_length i_lt in_set_member length_asm mat_of_cols_cols mat_of_cols_index nth_mem)
	+ have h1: "i \<noteq> j \<longrightarrow> ((cols A) ! ?w) $ i = 0" using w_is pivot_funD(5)
	+ by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> \<open>pivot_fun A f (dim_col A)\<close> cols_length h1 i_lt in_set_member j_lt len_lt length_asm less_le_trans mat_of_cols_cols mat_of_cols_index nth_mem)
	+ show "(mat_of_cols (dim_row A) (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j)
	+ = (1\<^sub>m (length (pivot_positions A))) $$ (i, j))" using h0 h1 breaking_it_down
	+ by (metis \<open>i < length (pivot_positions A)\<close> h2 h_len index_one_mat(1) j_lt len_lt)
	+ qed
	+ have h1b: "i \<ge> (length ?pp) \<Longrightarrow> (mat_of_cols (dim_row A) (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j) = 0)"
	+ proof -
	+ assume i_gt: "i \<ge> (length ?pp)"
	+ have h0a: "((cols A) ! ((map snd (pivot_positions A)) ! j)) $ i = (row A i) $ ?w"
	+ by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> cols_length h1 i_lt in_set_member index_row(1) j_lt length_asm mat_of_cols_cols mat_of_cols_index nth_mem)
	+ have h0b:
	+ "take_rows A [0..<length (pivot_positions A)] @\<^sub>r 0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A) = A"
	+ using assms row_echelon_form_zero_rows[of A]
	+ by blast
	+ then have h0c: "(row A i) = 0\<^sub>v (dim_col A)" using i_gt
	+ using add_diff_cancel_right' add_less_cancel_left diff_is_0_eq' dim_col_take_rows dim_row_append_rows i_lt index_zero_mat(2) index_zero_mat(3) le_add_diff_inverse len_lt less_not_refl3 row_append_rows row_zero zero_less_diff
	+ by (smt add_diff_cancel_right' add_less_cancel_left diff_is_0_eq' dim_col_take_rows dim_row_append_rows i_lt index_zero_mat(2) index_zero_mat(3) le_add_diff_inverse len_lt less_not_refl3 row_append_rows row_zero zero_less_diff)
	+ then show ?thesis using h0a breaking_it_down apply (auto)
	+ by (metis \<open>\<forall>a. List.member (map snd (pivot_positions A)) a \<longrightarrow> a < dim_col A\<close> h1 in_set_member index_zero_vec(1) j_lt length_asm nth_mem)
	+ qed
	+ have h1: " mat_of_cols (dim_row A)
	+ (map ((!) (cols A)) (map snd (pivot_positions A))) $$ (i, j) =
	+ (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) $$
	+ (i, j) " using h1a h1b
	+ apply (auto)
	+ by (smt add_diff_inverse_nat add_less_cancel_left append_rows_index h1 i_lt index_one_mat(2) index_one_mat(3) index_zero_mat(1) index_zero_mat(2) index_zero_mat(3) j_lt len_lt not_less)
	+ then show "take_cols A (map snd (pivot_positions A)) $$ (i, j) =
	+ (1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))) $$
	+ (i, j)"
	+ unfolding take_cols_def
	+ by (simp add: h2b)
	+ qed
	+ show ?thesis
	+ unfolding mat_eq_iff
	+ using length_pivot_positions_dim_row[OF assms(1)] h_len h2 by auto
	+qed
	+
	+lemma rref_right_mul:
	+ assumes "row_echelon_form A"
	+ assumes "dim_col A \<ge> dim_row A"
	+ shows
	+ "take_cols A (map snd (pivot_positions A)) * take_rows A [0..<length (pivot_positions A)] = A"
	+proof -
	+ from take_cols_pivot_eq[OF assms] have
	+ 1: "take_cols A (map snd (pivot_positions A)) =
	+ 1\<^sub>m (length (pivot_positions A)) @\<^sub>r
	+ 0\<^sub>m (dim_row A - length (pivot_positions A)) (length (pivot_positions A))" .
	+ have 2: "take_cols A (map snd (pivot_positions A)) * take_rows A [0..<length (pivot_positions A)] =
	+ take_rows A [0..<length (pivot_positions A)] @\<^sub>r 0\<^sub>m (dim_row A - length (pivot_positions A)) (dim_col A)"
	+ unfolding 1
	+ apply (auto simp add: append_rows_mat_mul)
	+ by (smt add_diff_cancel_right' assms diff_diff_cancel dim_col_take_rows dim_row_append_rows index_zero_mat(2) left_mult_one_mat' left_mult_zero_mat' length_pivot_positions_dim_row row_echelon_form_zero_rows)
	+ from row_echelon_form_zero_rows[OF assms] have
	+ "... = A" .
	+ thus ?thesis
	+ by (simp add: "2")
	+qed
	+
	+context conjugatable_vec_space begin
	+
	+lemma lin_indpt_id:
	+ shows "lin_indpt (set (cols (1\<^sub>m n)::'a vec list))"
	+proof -
	+ have *: "set (cols (1\<^sub>m n)) = set (rows (1\<^sub>m n))"
	+ by (metis cols_transpose transpose_one)
	+ have "det (1\<^sub>m n) \<noteq> 0" using det_one by auto
	+ from det_not_0_imp_lin_indpt_rows[OF _ this]
	+ have "lin_indpt (set (rows (1\<^sub>m n)))"
	+ using one_carrier_mat by blast
	+ thus ?thesis
	+ by (simp add: *)
	+qed
	+
	+lemma lin_indpt_take_cols_id:
	+ shows "lin_indpt (set (cols (take_cols (1\<^sub>m n) inds)))"
	+proof -
	+ have subset_h: "set (cols (take_cols (1\<^sub>m n) inds)) \<subseteq> set (cols (1\<^sub>m n)::'a vec list)"
	+ using cols_take_cols_subset by blast
	+ then show ?thesis using lin_indpt_id subset_li_is_li by auto
	+qed
	+
	+lemma cols_id_unit_vecs:
	+ shows "cols (1\<^sub>m d) = unit_vecs d"
	+ unfolding unit_vecs_def list_eq_iff_nth_eq
	+ by auto
	+
	+lemma distinct_cols_id:
	+ shows "distinct (cols (1\<^sub>m d)::'a vec list)"
	+ by (simp add: conjugatable_vec_space.cols_id_unit_vecs vec_space.unit_vecs_distinct)
	+
	+lemma distinct_map_nth:
	+ assumes "distinct ls"
	+ assumes "distinct inds"
	+ assumes "\<And>j. j \<in> set inds \<Longrightarrow> j < length ls"
	+ shows "distinct (map ((!) ls) inds)"
	+ by (simp add: assms(1) assms(2) assms(3) distinct_map inj_on_nth)
	+
	+lemma distinct_take_cols_id:
	+ assumes "distinct inds"
	+ shows "distinct (cols (take_cols (1\<^sub>m n) inds) :: 'a vec list)"
	+ unfolding take_cols_def
	+ apply (subst cols_mat_of_cols)
	+ apply (auto intro!: distinct_map_nth simp add: distinct_cols_id)
	+ using assms distinct_filter by blast
	+
	+lemma rank_take_cols:
	+ assumes "distinct inds"
	+ shows "rank (take_cols (1\<^sub>m n) inds) = length (filter ((>) n) inds)"
	+ apply (subst lin_indpt_full_rank[of _ "length (filter ((>) n) inds)"])
	+ apply (auto simp add: lin_indpt_take_cols_id)
	+ apply (metis (full_types) index_one_mat(2) index_one_mat(3) length_map mat_of_cols_carrier(1) take_cols_def)
	+ by (simp add: assms distinct_take_cols_id)
	+
	+lemma rank_mul_left_invertible_mat:
	+ fixes A::"'a mat"
	+ assumes "invertible_mat A"
	+ assumes "A \<in> carrier_mat n n"
	+ assumes "B \<in> carrier_mat n nc"
	+ shows "rank (A * B) = rank B"
	+proof -
	+ obtain C where C: "inverts_mat A C" "inverts_mat C A"
	+ using assms invertible_mat_def by blast
	+ from C have ceq: "C * A = 1\<^sub>m n"
	+ by (metis assms(2) carrier_matD(2) index_mult_mat(3) index_one_mat(3) inverts_mat_def)
	+ then have :"B = CA*B"
	+ using assms(3) by auto
	+ from rank_mat_mul_left[OF assms(2-3)]
	+ have *: "rank (AB) \<le> rank B" .
	+ have 1: "C \<in> carrier_mat n n" using C ceq
	+ by (metis assms(2) carrier_matD(1) carrier_matI index_mult_mat(3) index_one_mat(3) inverts_mat_def)
	+ have 2: "A * B \<in> carrier_mat n nc" using assms by auto
	+ have "rank B = rank (C* A * B)" using * by auto
	+ also have "... \<le> rank (A*B)" using rank_mat_mul_left[OF 1 2]
	+ using "1" assms(2) assms(3) by auto
	+ ultimately show ?thesis using ** by auto
	+qed
	+
	+lemma invertible_take_cols_rank:
	+ fixes A::"'a mat"
	+ assumes "invertible_mat A"
	+ assumes "A \<in> carrier_mat n n"
	+ assumes "distinct inds"
	+ shows "rank (take_cols A inds) = length (filter ((>) n) inds)"
	+proof -
	+ have " A = A * 1\<^sub>m n" using assms(2) by auto
	+ then have "take_cols A inds = A * take_cols (1\<^sub>m n) inds"
	+ by (metis assms(2) one_carrier_mat take_cols_mat_mul)
	+ then have "rank (take_cols A inds) = rank (take_cols (1\<^sub>m n) inds)"
	+ by (metis assms(1) assms(2) conjugatable_vec_space.rank_mul_left_invertible_mat one_carrier_mat take_cols_carrier_mat)
	+ thus ?thesis
	+ by (simp add: assms(3) conjugatable_vec_space.rank_take_cols)
	+qed
	+
	+lemma rank_take_cols_leq:
	+ assumes R:"R \<in> carrier_mat n nc"
	+ shows "rank (take_cols R ls) \<le> rank R"
	+proof -
	+ from take_cols_mat_mul[OF R]
	+ have "take_cols R ls = R * take_cols (1\<^sub>m nc) ls"
	+ by (metis assms one_carrier_mat right_mult_one_mat)
	+ thus ?thesis
	+ by (metis assms one_carrier_mat take_cols_carrier_mat vec_space.rank_mat_mul_right)
	+qed
	+
	+lemma rank_take_cols_geq:
	+ assumes R:"R \<in> carrier_mat n nc"
	+ assumes t:"take_cols R ls \<in> carrier_mat n r"
	+ assumes B:"B \<in> carrier_mat r nc"
	+ assumes "R = (take_cols R ls) * B"
	+ shows "rank (take_cols R ls) \<ge> rank R"
	+ by (metis B assms(4) t vec_space.rank_mat_mul_right)
	+
	+lemma rref_drop_pivots:
	+ assumes row_ech: "row_echelon_form R"
	+ assumes dims: "R \<in> carrier_mat n nc"
	+ assumes order: "nc \<ge> n"
	+ shows "rank (take_cols R (map snd (pivot_positions R))) = rank R"
	+proof -
	+ let ?B = "take_rows R [0..<length (pivot_positions R)]"
	+ have equa: "R = take_cols R (map snd (pivot_positions R)) * ?B" using assms rref_right_mul
	+ by (metis carrier_matD(1) carrier_matD(2))
	+ have ex_r: "\<exists>r. take_cols R (map snd (pivot_positions R)) \<in> carrier_mat n r \<and> ?B \<in> carrier_mat r nc"
	+ proof -
	+ have h1:
	+ "take_cols R (map snd (pivot_positions R)) \<in> carrier_mat n (length (pivot_positions R))"
	+ using assms
	+ by (metis in_set_impl_in_set_zip2 length_map rref_pivot_positions take_cols_carrier_mat_strict zip_map_fst_snd)
	+ have "\<exists> f. pivot_fun R f nc" using row_ech unfolding row_echelon_form_def using dims
	+ by blast
	+ then have "length (pivot_positions R) = card {i. i < n \<and> row R i \<noteq> 0\<^sub>v nc}"
	+ using pivot_positions[of R n nc]
	+ using dims by auto
	+ then have "nc \<ge> length (pivot_positions R)" using order
	+ using carrier_matD(1) dims dual_order.trans length_pivot_positions_dim_row row_ech by blast
	+ then have "dim_col R \<ge> length (pivot_positions R)" using dims by auto
	+ then have h2: "?B \<in> carrier_mat (length (pivot_positions R)) nc" unfolding take_rows_def
	+ using dims
	+ by (smt atLeastLessThan_iff carrier_matD(2) filter_True le_eq_less_or_eq length_map length_pivot_positions_dim_row less_trans map_nth mat_of_cols_carrier(1) row_ech set_upt transpose_carrier_mat transpose_mat_of_rows)
	+ show ?thesis using h1 h2
	+ by blast
	+ qed
	+ (* prove the other two dimensionality assumptions *)
	+ have "rank R \<le> rank (take_cols R (map snd (pivot_positions R)))"
	+ using dims ex_r rank_take_cols_geq[where R = "R", where B = "?B", where ls = "(map snd (pivot_positions R))", where nc = "nc"]
	+ using equa by blast
	+ thus ?thesis
	+ using assms(2) conjugatable_vec_space.rank_take_cols_leq le_antisym by blast
	+qed
	+
	+lemma gjs_and_take_cols_var:
	+ fixes A::"'a mat"
	+ assumes A:"A \<in> carrier_mat n nc"
	+ assumes order: "nc \<ge> n"
	+ shows "(take_cols A (map snd (pivot_positions (gauss_jordan_single A)))) =
	+ (take_cols_var A (map snd (pivot_positions (gauss_jordan_single A))))"
	+proof -
	+ let ?gjs = "(gauss_jordan_single A)"
	+ have "\<forall>x. List.member (map snd (pivot_positions (gauss_jordan_single A))) x \<longrightarrow> x \<le> dim_col A"
	+ using rref_pivot_positions gauss_jordan_single(3) carrier_matD(2) gauss_jordan_single(2) in_set_impl_in_set_zip2 in_set_member length_map less_irrefl less_trans not_le_imp_less zip_map_fst_snd
	+ by (smt A carrier_matD(2) gauss_jordan_single(2) in_set_impl_in_set_zip2 in_set_member length_map less_irrefl less_trans not_le_imp_less zip_map_fst_snd)
	+ then have "(filter (\<lambda>y. y < dim_col A) (map snd (pivot_positions (gauss_jordan_single A)))) =
	+ (map snd (pivot_positions (gauss_jordan_single A)))"
	+ by (metis (no_types, lifting) A carrier_matD(2) filter_True gauss_jordan_single(2) gauss_jordan_single(3) in_set_impl_in_set_zip2 length_map rref_pivot_positions zip_map_fst_snd)
	+ then show ?thesis unfolding take_cols_def take_cols_var_def
	+ by simp
	+qed
	+
	+lemma gauss_jordan_single_rank:
	+ fixes A::"'a mat"
	+ assumes A:"A \<in> carrier_mat n nc"
	+ assumes order: "nc \<ge> n"
	+ shows "rank (take_cols A (map snd (pivot_positions (gauss_jordan_single A)))) = rank A"
	+proof -
	+ let ?R = "gauss_jordan_single A"
	+ obtain P where P:"P\<in>Units (ring_mat TYPE('a) n undefined)" and
	+ i: "?R = P * A" using gauss_jordan_transform[OF A]
	+ using A assms det_mult det_non_zero_imp_unit det_one gauss_jordan_single(4) mult_not_zero one_neq_zero
	+ by (smt A assms det_mult det_non_zero_imp_unit det_one gauss_jordan_single(4) mult_not_zero one_neq_zero)
	+ have pcarrier: "P \<in> carrier_mat n n" using P unfolding Units_def
	+ by (auto simp add: ring_mat_def)
	+ have "invertible_mat P" using P unfolding invertible_mat_def Units_def inverts_mat_def
	+ apply auto
	+ apply (simp add: ring_mat_simps(5))
	+ by (metis index_mult_mat(2) index_one_mat(2) ring_mat_simps(1) ring_mat_simps(3))
	+ then
	+ obtain Pi where Pi: "invertible_mat Pi" "Pi * P = 1\<^sub>m n"
	+ proof -
	+ assume a1: "\<And>Pi. \<lbrakk>invertible_mat Pi; Pi * P = 1\<^sub>m n\<rbrakk> \<Longrightarrow> thesis"
	+ have "dim_row P = n"
	+ by (metis (no_types) A assms(1) carrier_matD(1) gauss_jordan_single(2) i index_mult_mat(2))
	+ then show ?thesis
	+ using a1 by (metis (no_types) \<open>invertible_mat P\<close> index_mult_mat(3) index_one_mat(3) invertible_mat_def inverts_mat_def square_mat.simps)
	+ qed
	+ then have pi_carrier:"Pi \<in> carrier_mat n n"
	+ by (metis carrier_mat_triv index_mult_mat(2) index_one_mat(2) invertible_mat_def square_mat.simps)
	+ have R1:"row_echelon_form ?R"
	+ using assms(2) gauss_jordan_single(3) by blast
	+ have R2: "?R \<in> carrier_mat n nc"
	+ using A assms(2) gauss_jordan_single(2) by auto
	+ have Rcm: "take_cols ?R (map snd (pivot_positions ?R))
	+ \<in> carrier_mat n (length (map snd (pivot_positions ?R)))"
	+ apply (rule take_cols_carrier_mat_strict[OF R2])
	+ using rref_pivot_positions[OF R1 R2] by auto
	+ have "Pi * ?R = A" using i Pi
	+ by (smt A \<open>invertible_mat P\<close> assoc_mult_mat carrier_mat_triv index_mult_mat(2) index_mult_mat(3) index_one_mat(3) invertible_mat_def left_mult_one_mat square_mat.simps)
	+ then have "rank (take_cols A (map snd (pivot_positions ?R))) = rank (take_cols (Pi * ?R) (map snd (pivot_positions ?R)))"
	+ by auto
	+ also have "... = rank ( Pi * take_cols ?R (map snd (pivot_positions ?R)))"
	+ by (metis A gauss_jordan_single(2) pi_carrier take_cols_mat_mul)
	+ also have "... = rank (take_cols ?R (map snd (pivot_positions ?R)))"
	+ by (intro rank_mul_left_invertible_mat[OF Pi(1) pi_carrier Rcm])
	+ also have "... = rank ?R"
	+ using assms(2) conjugatable_vec_space.rref_drop_pivots gauss_jordan_single(3)
	+ using R1 R2 by blast
	+ ultimately show ?thesis
	+ using A \<open>P \<in> carrier_mat n n\<close> \<open>invertible_mat P\<close> conjugatable_vec_space.rank_mul_left_invertible_mat i
	+ by auto
	+qed
	+
	+lemma lin_indpt_subset_cols:
	+ fixes A:: "'a mat"
	+ fixes B:: "'a vec set"
	+ assumes "A \<in> carrier_mat n n"
	+ assumes inv: "invertible_mat A"
	+ assumes "B \<subseteq> set (cols A)"
	+ shows "lin_indpt B"
	+proof -
	+ have "det A \<noteq> 0"
	+ using assms(1) inv invertible_det by blast
	+ then have "lin_indpt (set (rows A\<^sup>T))"
	+ using assms(1) idom_vec.lin_dep_cols_imp_det_0 by auto
	+ thus ?thesis using subset_li_is_li assms(3)
	+ by auto
	+qed
	+
	+lemma rank_invertible_subset_cols:
	+ fixes A:: "'a mat"
	+ fixes B:: "'a vec list"
	+ assumes inv: "invertible_mat A"
	+ assumes A_square: "A \<in> carrier_mat n n"
	+ assumes set_sub: "set (B) \<subseteq> set (cols A)"
	+ assumes dist_B: "distinct B"
	+ shows "rank (mat_of_cols n B) = length B"
	+proof -
	+ let ?B_mat = "(mat_of_cols n B)"
	+ have h1: "lin_indpt (set(B))"
	+ using assms lin_indpt_subset_cols[of A] by auto
	+ have "set B \<subseteq> carrier_vec n"
	+ using set_sub A_square cols_dim[of A] by auto
	+ then have cols_B: "cols (mat_of_cols n B) = B" using cols_mat_of_cols by auto
	+ then have "maximal (set B) (\<lambda>T. T \<subseteq> set (B) \<and> lin_indpt T)" using h1
	+ by (simp add: maximal_def subset_antisym)
	+ then have h2: "maximal (set B) (\<lambda>T. T \<subseteq> set (cols (mat_of_cols n B)) \<and> lin_indpt T)"
	+ using cols_B by auto
	+ have h3: "rank (mat_of_cols n B) = card (set B)"
	+ using h1 h2 rank_card_indpt[of ?B_mat]
	+ using mat_of_cols_carrier(1) by blast
	+ then show ?thesis using assms distinct_card by auto
	+qed
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/ROOT b/thys/BenOr_Kozen_Reif/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/ROOT
	@@ -0,0 +1,12 @@
	+chapter AFP
	+
	+session BenOr_Kozen_Reif (AFP) = Algebraic_Numbers +
	+ options [timeout = 600]
	+ sessions
	+ Sturm_Tarski
	+ theories
	+ BKR_Decision
	+ Renegar_Decision
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/BenOr_Kozen_Reif/Renegar_Algorithm.thy b/thys/BenOr_Kozen_Reif/Renegar_Algorithm.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/Renegar_Algorithm.thy
	@@ -0,0 +1,108 @@
	+theory Renegar_Algorithm
	+ imports BKR_Algorithm
	+begin
	+
	+(* There is significant overlap between Renegar's algorithm and BKR's.
	+ However, the RHS vector is constructed differently in Renegar. The base case is also different.
	+ In general, the _R's on definition and lemma names in this file are to emphasize that we are
	+ working with Renegar style.
	+*)
	+
	+definition construct_NofI_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> real poly list \<Rightarrow> rat"
	+ where "construct_NofI_R p I1 I2 = (
	+ let new_p = sum_list (map (\<lambda>x. x^2) (p # I1)) in
	+ rat_of_int (changes_R_smods new_p ((pderiv new_p)*(prod_list I2))))"
	+
	+(* Renegar's RHS vector will have type (nat list * nat list) list.
	+ Note the change from BKR, where the RHS vector had type nat list list*)
	+definition construct_rhs_vector_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> (nat list * nat list) list \<Rightarrow> rat vec"
	+ where "construct_rhs_vector_R p qs Is =
	+ vec_of_list (map (\<lambda>(I1,I2).
	+ (construct_NofI_R p (retrieve_polys qs I1) (retrieve_polys qs I2))) Is)"
	+
	+section "Base Case"
	+
	+(* Renegar's matrix is 3x3 instead of 2x2 *)
	+definition base_case_info_R:: "(rat mat \<times> ((nat list * nat list) list \<times> rat list list))"
	+ where "base_case_info_R =
	+ ((mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]]),([([], []),([0], []),([], [0])], [[1],[0],[-1]]))"
	+
	+(* When p, q are coprime, this will actually be an int vec, which is why taking the floor is okay *)
	+definition base_case_solve_for_lhs:: "real poly \<Rightarrow> real poly \<Rightarrow> rat vec"
	+ where "base_case_solve_for_lhs p q = (mult_mat_vec (mat_of_rows_list 3 [[1/2, -1/2, 1/2], [0, 1, 0], [1/2, -1/2, -1/2]]) (construct_rhs_vector_R p [q] [([], []),([0], []),([], [0])]))"
	+
	+(* Solve for LHS in general: mat_inverse returns an option type, and we pattern match on this.
	+ Notice that when we call this function in the algorithm, the matrix we pass will always be invertible,
	+ given how the construction works. *)
	+definition solve_for_lhs_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> (nat list * nat list) list \<Rightarrow> rat mat \<Rightarrow> rat vec"
	+ where "solve_for_lhs_R p qs subsets matr =
	+ mult_mat_vec (matr_option (dim_row matr) (mat_inverse_var matr)) (construct_rhs_vector_R p qs subsets)"
	+
	+section "Smashing"
	+
	+definition subsets_smash_R::"nat \<Rightarrow> (nat listnat list) list \<Rightarrow> (nat listnat list) list \<Rightarrow> (nat list*nat list) list"
	+ where "subsets_smash_R n s1 s2 = concat (map (\<lambda>l1. map (\<lambda> l2. (((fst l1) @ (map ((+) n) (fst l2))), (snd l1) @ (map ((+) n) (snd l2)))) s2) s1)"
	+
	+definition smash_systems_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> real poly list \<Rightarrow> (nat list * nat list) list \<Rightarrow> (nat list * nat list) list \<Rightarrow>
	+ rat list list \<Rightarrow> rat list list \<Rightarrow> rat mat \<Rightarrow> rat mat \<Rightarrow>
	+ real poly list \<times> (rat mat \<times> ((nat list * nat list) list \<times> rat list list))"
	+ where "smash_systems_R p qs1 qs2 subsets1 subsets2 signs1 signs2 mat1 mat2 =
	+ (qs1@qs2, (kronecker_product mat1 mat2, (subsets_smash_R (length qs1) subsets1 subsets2, signs_smash signs1 signs2)))"
	+
	+fun combine_systems_R:: "real poly \<Rightarrow> (real poly list \<times> (rat mat \<times> ((nat list * nat list) list \<times> rat list list))) \<Rightarrow> (real poly list \<times> (rat mat \<times> ((nat list * nat list) list \<times> rat list list)))
	+ \<Rightarrow> (real poly list \<times> (rat mat \<times> ((nat list * nat list) list \<times> rat list list)))"
	+ where "combine_systems_R p (qs1, m1, sub1, sgn1) (qs2, m2, sub2, sgn2) =
	+ (smash_systems_R p qs1 qs2 sub1 sub2 sgn1 sgn2 m1 m2)"
	+
	+(* Overall:
	+ Start with a matrix equation.
	+ Input a matrix, subsets, and signs.
	+ Drop columns of the matrix based on the 0's on the LHS---so extract a list of 0's. Reduce signs accordingly.
	+ Then find a list of rows to delete based on using rank (use the transpose result, pivot positions!),
	+ and delete those rows. Reduce subsets accordingly.
	+ End with a reduced system! *)
	+section "Reduction"
	+
	+fun reduction_step_R:: "rat mat \<Rightarrow> rat list list \<Rightarrow> (nat listnat list) list \<Rightarrow> rat vec \<Rightarrow> rat mat \<times> ((nat listnat list) list \<times> rat list list)"
	+ where "reduction_step_R A signs subsets lhs_vec =
	+ (let reduce_cols_A = (reduce_mat_cols A lhs_vec);
	+ rows_keep = rows_to_keep reduce_cols_A in
	+ (take_rows_from_matrix reduce_cols_A rows_keep,
	+ (take_indices subsets rows_keep,
	+ take_indices signs (find_nonzeros_from_input_vec lhs_vec))))"
	+
	+fun reduce_system_R:: "real poly \<Rightarrow> (real poly list \<times> (rat mat \<times> ((nat listnat list) list \<times> rat list list))) \<Rightarrow> (rat mat \<times> ((nat listnat list) list \<times> rat list list))"
	+ where "reduce_system_R p (qs,m,subs,signs) =
	+ reduction_step_R m signs subs (solve_for_lhs_R p qs subs m)"
	+
	+section "Overall algorithm "
	+(* Find matrix, subsets, signs.
	+ The "rat mat" in the output is the matrix. The "(nat list*nat list) list" is the list of subsets.
	+ The "rat list list" is the list of signs.
	+*)
	+fun calculate_data_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> (rat mat \<times> ((nat list*nat list) list \<times> rat list list))"
	+ where
	+ "calculate_data_R p qs =
	+ ( let len = length qs in
	+ if len = 0 then
	+ (\<lambda>(a,b,c).(a,b,map (drop 1) c)) (reduce_system_R p ([1],base_case_info_R))
	+ else if len \<le> 1 then reduce_system_R p (qs,base_case_info_R)
	+ else
	+ (let q1 = take (len div 2) qs; left = calculate_data_R p q1;
	+ q2 = drop (len div 2) qs; right = calculate_data_R p q2;
	+ comb = combine_systems_R p (q1,left) (q2,right) in
	+ reduce_system_R p comb
	+ )
	+ )"
	+
	+(* Extract the list of consistent sign assignments *)
	+definition find_consistent_signs_at_roots_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list"
	+ where [code]:
	+ "find_consistent_signs_at_roots_R p qs =
	+ ( let (M,S,\<Sigma>) = calculate_data_R p qs in \<Sigma> )"
	+
	+lemma find_consistent_signs_at_roots_thm_R:
	+ shows "find_consistent_signs_at_roots_R p qs = snd (snd (calculate_data_R p qs))"
	+ by (simp add: case_prod_beta find_consistent_signs_at_roots_R_def)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/Renegar_Decision.thy b/thys/BenOr_Kozen_Reif/Renegar_Decision.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/Renegar_Decision.thy
	@@ -0,0 +1,809 @@
	+theory Renegar_Decision
	+ imports "Renegar_Proofs"
	+ "BKR_Decision"
	+begin
	+
	+(* Note that there is significant overlap between Renegar and BKR in general, so there is some
	+ similarity between this file and BKR_Decision.thy. However, there are also notable differences
	+ as Renegar and BKR use different auxiliary polynomials in their decision procedures.
	+
	+ In general, the _R's on definition and lemma names in this file are to emphasize that we are
	+ working with Renegar style.
	+
	+*)
	+
	+section "Algorithm"
	+
	+(* The set of all rational sign vectors for qs wrt the set S
	+ When S = UNIV, then this quantifies over all reals *)
	+definition consistent_sign_vectors_R::"real poly list \<Rightarrow> real set \<Rightarrow> rat list set"
	+ where "consistent_sign_vectors_R qs S = (consistent_sign_vec qs) ` S"
	+
	+primrec prod_list_var:: "real poly list \<Rightarrow> real poly"
	+ where "prod_list_var [] = 1"
	+ \| "prod_list_var (h#T) = (if h = 0 then (prod_list_var T) else (h* prod_list_var T))"
	+
	+primrec check_all_const_deg:: "real poly list \<Rightarrow> bool"
	+ where "check_all_const_deg [] = True"
	+ \| "check_all_const_deg (h#T) = (if degree h = 0 then (check_all_const_deg T) else False)"
	+
	+definition poly_f :: "real poly list \<Rightarrow> real poly"
	+ where
	+ "poly_f ps =
	+ (if (check_all_const_deg ps = True) then [:0, 1:] else
	+ (pderiv (prod_list_var ps)) * (prod_list_var ps)* ([:-(crb (prod_list_var ps)),1:]) * ([:(crb (prod_list_var ps)),1:]))"
	+
	+definition find_consistent_signs_R :: "real poly list \<Rightarrow> rat list list"
	+ where
	+ "find_consistent_signs_R ps = find_consistent_signs_at_roots_R (poly_f ps) ps"
	+
	+definition decide_universal_R :: "real poly fml \<Rightarrow> bool"
	+ where [code]:
	+ "decide_universal_R fml = (
	+ let (fml_struct,polys) = convert fml;
	+ conds = find_consistent_signs_R polys
	+ in
	+ list_all (lookup_sem fml_struct) conds
	+ )"
	+
	+definition decide_existential_R :: "real poly fml \<Rightarrow> bool"
	+ where [code]:
	+ "decide_existential_R fml = (
	+ let (fml_struct,polys) = convert fml;
	+ conds = find_consistent_signs_R polys
	+ in
	+ find (lookup_sem fml_struct) conds \<noteq> None
	+ )"
	+
	+subsection "Proofs"
	+definition roots_of_poly_f:: "real poly list \<Rightarrow> real set"
	+ where "roots_of_poly_f qs = {x. poly (poly_f qs) x = 0}"
	+
	+lemma prod_list_var_nonzero:
	+ shows "prod_list_var qs \<noteq> 0"
	+proof (induct qs)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a qs)
	+ then show ?case by auto
	+qed
	+
	+lemma q_dvd_prod_list_var_prop:
	+ assumes "q \<in> set qs"
	+ assumes "q \<noteq> 0"
	+ shows "q dvd prod_list_var qs" using assms
	+proof (induct qs)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a qs)
	+ then have eo: "q = a \<or>q \<in> set qs" by auto
	+ have c1: "q = a \<Longrightarrow> q dvd prod_list_var (a#qs)"
	+ proof -
	+ assume "q = a"
	+ then have "prod_list_var (a#qs) = q*(prod_list_var qs)" using Cons.prems
	+ unfolding prod_list_var_def by auto
	+ then show ?thesis using prod_list_var_nonzero[of qs] by auto
	+ qed
	+ have c2: "q \<in> set qs \<longrightarrow> q dvd prod_list_var qs"
	+ using Cons.prems Cons.hyps unfolding prod_list_var_def by auto
	+ show ?case using eo c1 c2 by auto
	+qed
	+
	+
	+lemma check_all_const_deg_prop:
	+ shows "check_all_const_deg l = True \<longleftrightarrow> (\<forall>p \<in> set(l). degree p = 0)"
	+proof (induct l)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a l)
	+ then show ?case by auto
	+qed
	+
	+(* lemma prod_zero shows that the product of the polynomial list is 0 at x iff there is a polynomial
	+ in the list that is 0 at x *)
	+lemma poly_f_nonzero:
	+ fixes qs :: "real poly list"
	+ shows "(poly_f qs) \<noteq> 0"
	+proof -
	+ have eo: "(\<forall>p \<in> set qs. degree p = 0) \<or> (\<exists>p \<in> set qs. degree p > 0)"
	+ by auto
	+ have c1: "(\<forall>p \<in> set qs. degree p = 0) \<longrightarrow> (poly_f qs) \<noteq> 0"
	+ unfolding poly_f_def using check_all_const_deg_prop by auto
	+ have c2: "(\<exists>p \<in> set qs. degree p > 0) \<longrightarrow> (poly_f qs) \<noteq> 0"
	+ proof clarsimp
	+ fix q
	+ assume q_in: "q \<in> set qs"
	+ assume deg_q: "0 < degree q"
	+ assume contrad: "poly_f qs = 0"
	+ have nonconst: "check_all_const_deg qs = False" using deg_q check_all_const_deg_prop
	+ q_in by auto
	+ have h1: "prod_list_var qs \<noteq> 0" using prod_list_var_nonzero by auto
	+ then have "degree (prod_list_var qs) > 0" using q_in deg_q h1
	+ proof (induct qs)
	+ case Nil
	+ then show ?case by auto
	+ next
	+ case (Cons a qs)
	+ have q_nonz: "q \<noteq> 0" using Cons.prems by auto
	+ have q_ins: "q \<in> set (a # qs) " using Cons.prems by auto
	+ then have "q = a \<or> q \<in> set qs" by auto
	+ then have eo: " q = a \<or> List.member qs q" using in_set_member[of q qs]
	+ by auto
	+ have degq: "degree q > 0" using Cons.prems by auto
	+ have h2: "(prod_list (a # qs)) = a* (prod_list qs)"
	+ by auto
	+ have isa: "q = a \<longrightarrow> 0 < degree (prod_list_var (a # qs))"
	+ using h2 degree_mult_eq_0[where p = "q", where q = "prod_list_var qs"]
	+ Cons.prems by auto
	+ have inl: "List.member qs q \<longrightarrow> 0 < degree (prod_list_var (a # qs))"
	+ proof -
	+ have nonzprod: "prod_list_var (a # qs) \<noteq> 0" using prod_list_var_nonzero by auto
	+ have "q dvd prod_list_var (a # qs)"
	+ using q_dvd_prod_list_var_prop[where q = "q", where qs = "(a#qs)"] q_nonz q_ins
	+ by auto
	+ then show ?thesis using divides_degree[where p = "q", where q = "prod_list_var (a # qs)"] nonzprod degq
	+ by auto
	+ qed
	+ then show ?case using eo isa by auto
	+ qed
	+ then have h2: "pderiv (prod_list_var qs) \<noteq> 0" using pderiv_eq_0_iff[where p = "prod_list_var qs"]
	+ by auto
	+ then have "pderiv (prod_list_var qs) * prod_list_var qs \<noteq> 0"
	+ using prod_list_var_nonzero h2 by auto
	+ then show "False" using contrad nonconst unfolding poly_f_def deg_q
	+ by (smt (z3) mult_eq_0_iff pCons_eq_0_iff)
	+ qed
	+ show ?thesis using eo c1 c2 by auto
	+qed
	+
	+lemma poly_f_roots_prop_1:
	+ fixes qs:: "real poly list"
	+ assumes non_const: "check_all_const_deg qs = False"
	+ shows "\<forall>x1. \<forall>x2. ((x1 < x2 \<and> (\<exists>q1 \<in> set (qs). q1 \<noteq> 0 \<and> (poly q1 x1) = 0) \<and> (\<exists>q2\<in> set(qs). q2 \<noteq> 0 \<and> (poly q2 x2) = 0)) \<longrightarrow> (\<exists>q. x1 < q \<and> q < x2 \<and> poly (poly_f qs) q = 0))"
	+proof clarsimp
	+ fix x1:: "real"
	+ fix x2:: "real"
	+ fix q1:: "real poly"
	+ fix q2:: "real poly"
	+ assume "x1 < x2"
	+ assume q1_in: "q1 \<in> set qs"
	+ assume q1_0: "poly q1 x1 = 0"
	+ assume q1_nonz: "q1 \<noteq> 0"
	+ assume q2_in: "q2 \<in> set qs"
	+ assume q2_0: "poly q2 x2 = 0"
	+ assume q2_nonz: "q2 \<noteq> 0"
	+ have prod_z_x1: "poly (prod_list_var qs) x1 = 0" using q1_in q1_0
	+ using q1_nonz q_dvd_prod_list_var_prop[of q1 qs] by auto
	+ have prod_z_x2: "poly (prod_list_var qs) x2 = 0" using q2_in q2_0
	+ using q2_nonz q_dvd_prod_list_var_prop[of q2 qs] by auto
	+ have "\<exists>w>x1. w < x2 \<and> poly (pderiv (prod_list_var qs)) w = 0"
	+ using Rolle_pderiv[where q = "prod_list_var qs"] prod_z_x1 prod_z_x2
	+ using \<open>x1 < x2\<close> by blast
	+ then obtain w where w_def: "w > x1 \<and>w < x2 \<and> poly (pderiv (prod_list_var qs)) w = 0"
	+ by auto
	+ then have "poly (poly_f qs) w = 0"
	+ unfolding poly_f_def using non_const
	+ by simp
	+ then show "\<exists>q>x1. q < x2 \<and> poly (poly_f qs) q = 0"
	+ using w_def by blast
	+qed
	+
	+lemma main_step_aux1_R:
	+ fixes qs:: "real poly list"
	+ assumes non_const: "check_all_const_deg qs = True"
	+ shows "set (find_consistent_signs_R qs) = consistent_sign_vectors_R qs UNIV"
	+proof -
	+ have poly_f_is: "poly_f qs = [:0, 1:]" unfolding poly_f_def using assms
	+
	+ by auto
	+ have same: "set (find_consistent_signs_at_roots_R [:0, 1:] qs) =
	+ set (characterize_consistent_signs_at_roots [:0, 1:] qs)" using find_consistent_signs_at_roots_R[of "[:0, 1:]" qs]
	+ by auto
	+ have rech: "(sorted_list_of_set {x. poly ([:0, 1:]::real poly) x = 0}) = [0]" by auto
	+ have alldeg0: "(\<forall>p \<in> set qs. degree p = 0)" using non_const check_all_const_deg_prop
	+ by auto
	+ then have allconst: "\<forall>p \<in> set qs. (\<exists>(k::real). p = [:k:])"
	+ apply (auto)
	+ by (meson degree_eq_zeroE)
	+ then have allconstvar: "\<forall>p \<in> set qs. \<forall>(x::real). \<forall>(y::real). poly p x = poly p y"
	+ by fastforce
	+ have e1: "set (remdups (map (signs_at qs) [0])) \<subseteq>
	+ consistent_sign_vectors_R qs UNIV"
	+ unfolding signs_at_def squash_def consistent_sign_vectors_R_def consistent_sign_vec_def apply (simp)
	+ by (smt (verit, best) class_ring.ring_simprules(2) comp_def image_iff length_map map_nth_eq_conv)
	+ have e2: "consistent_sign_vectors_R qs UNIV \<subseteq> set (remdups (map (signs_at qs) [0])) "
	+ unfolding signs_at_def squash_def consistent_sign_vectors_R_def consistent_sign_vec_def apply (simp)
	+ using allconstvar
	+ by (smt (verit, best) comp_apply image_iff insert_iff map_eq_conv subsetI)
	+ have "set (remdups (map (signs_at qs) [0])) =
	+ consistent_sign_vectors_R qs UNIV"
	+ using e1 e2 by auto
	+ then have "set (characterize_consistent_signs_at_roots [:0, 1:] qs) = consistent_sign_vectors_R qs UNIV"
	+ unfolding characterize_consistent_signs_at_roots_def characterize_root_list_p_def
	+ using rech by auto
	+ then show ?thesis using same poly_f_is unfolding find_consistent_signs_R_def
	+ by auto
	+qed
	+
	+lemma sorted_list_lemma_var:
	+ fixes l:: "real list"
	+ fixes x:: "real"
	+ assumes "length l > 1"
	+ assumes strict_sort: "strict_sorted l"
	+ assumes x_not_in: "\<not> (List.member l x)"
	+ assumes lt_a: "x > (l ! 0)"
	+ assumes b_lt: "x < (l ! (length l - 1))"
	+ shows "(\<exists>n. n < length l - 1 \<and> x > l ! n \<and> x < l !(n+1))" using assms
	+proof (induct l)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a l)
	+ have len_gteq: "length l \<ge> 1" using Cons.prems(1)
	+ by (metis One_nat_def Suc_eq_plus1 list.size(4) not_le not_less_eq)
	+ have len_one: "length l = 1 \<Longrightarrow> (\<exists>n. n < length (a#l) - 1 \<and> x > (a#l) ! n \<and> x < (a#l) !(n+1))"
	+ proof -
	+ assume len_is: "length l = 1"
	+ then have "x > (a#l) ! 0 \<and> x < (a#l) !1 " using Cons.prems(4) Cons.prems(5)
	+ by auto
	+ then show "(\<exists>n. n < length (a#l) - 1 \<and> x > (a#l) ! n \<and> x < (a#l) !(n+1))"
	+ using len_is by auto
	+ qed
	+ have len_gt: "length l > 1 \<Longrightarrow> (\<exists>n. n < length (a#l) - 1 \<and> x > (a#l) ! n \<and> x < (a#l) !(n+1))"
	+ proof -
	+ assume len_gt_one: "length l > 1"
	+ have eo: "x \<noteq> l ! 0" using Cons.prems(3) apply (auto)
	+ by (metis One_nat_def Suc_lessD in_set_member len_gt_one member_rec(1) nth_mem)
	+ have c1: "x < l ! 0 \<Longrightarrow> (\<exists>n. n < length (a#l) - 1 \<and> x > (a#l) ! n \<and> x < (a#l) !(n+1)) "
	+ proof -
	+ assume xlt: "x < l !0"
	+ then have "x < (a#l) ! 1 "
	+ by simp
	+ then show ?thesis using Cons.prems(4) len_gt_one apply (auto)
	+ using Cons.prems(4) Suc_lessD by blast
	+ qed
	+ have c2: "x > l ! 0 \<Longrightarrow> (\<exists>n. n < length (a#l) - 1 \<and> x > (a#l) ! n \<and> x < (a#l) !(n+1)) "
	+ proof -
	+ assume asm: "x > l ! 0"
	+ have xlt_1: " x < l ! (length l - 1)"
	+ using Cons.prems(5)
	+ by (metis Cons.prems(1) One_nat_def add_diff_cancel_right' list.size(4) nth_Cons_pos zero_less_diff)
	+ have ssl: "strict_sorted l " using Cons.prems(2)
	+ using strict_sorted.simps(2) by blast
	+ have " \<not> List.member l x" using Cons.prems(3)
	+ by (meson member_rec(1))
	+ then have " \<exists>n<length l - 1. l ! n < x \<and> x < l ! (n + 1)"
	+ using asm xlt_1 len_gt_one ssl Cons.hyps
	+ by auto
	+ then show ?thesis
	+ by (metis One_nat_def Suc_eq_plus1 diff_Suc_1 less_diff_conv list.size(4) nth_Cons_Suc)
	+ qed
	+ show "(\<exists>n. n < length (a#l) - 1 \<and> x > (a#l) ! n \<and> x < (a#l) !(n+1))"
	+ using eo c1 c2
	+ by (meson linorder_neqE_linordered_idom)
	+ qed
	+ then show ?case
	+ using len_gteq len_one len_gt
	+ apply (auto)
	+ by (metis One_nat_def less_numeral_extra(1) linorder_neqE_nat not_less nth_Cons_0)
	+qed
	+
	+(* We want to show that our auxiliary polynomial has roots in all relevant intervals:
	+ so it captures all of the zeros, and also it captures all of the points in between! *)
	+lemma all_sample_points_prop:
	+ assumes is_not_const: "check_all_const_deg qs = False"
	+ assumes s_is: "S = (characterize_root_list_p (pderiv (prod_list_var qs) * (prod_list_var qs) * ([:-(crb (prod_list_var qs)),1:]) * ([:(crb (prod_list_var qs)),1:])))"(* properties about S*)
	+ shows "consistent_sign_vectors_R qs UNIV = consistent_sign_vectors_R qs (set S)"
	+proof -
	+ let ?zer_list = "sorted_list_of_set {(x::real). (\<exists>q \<in> set(qs). (q \<noteq> 0 \<and> poly q x = 0))} :: real list"
	+ have strict_sorted_h: "strict_sorted ?zer_list" using sorted_sorted_list_of_set
	+ strict_sorted_iff by auto
	+ have poly_f_is: "poly_f qs = (pderiv (prod_list_var qs) * prod_list_var qs)* ([:-(crb (prod_list_var qs)),1:]) * ([:(crb (prod_list_var qs)),1:])"
	+ unfolding poly_f_def using is_not_const by auto
	+ then have set_S_char: "set S = ({x. poly (poly_f qs) x = 0}::real set)"
	+ using poly_roots_finite[of "poly_f qs"] set_sorted_list_of_set poly_f_nonzero[of qs]
	+ using s_is unfolding characterize_root_list_p_def by auto
	+ have difficult_direction: "consistent_sign_vectors_R qs UNIV \<subseteq> consistent_sign_vectors_R qs (set S)"
	+ proof clarsimp
	+ fix x
	+ assume "x \<in> consistent_sign_vectors_R qs UNIV "
	+ then have "\<exists>y. x = (consistent_sign_vec qs y)" unfolding consistent_sign_vectors_R_def by auto
	+ then obtain y where y_prop: "x = consistent_sign_vec qs y" by auto
	+ then have "\<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ proof -
	+ have c1: "(\<exists>q \<in> (set qs). q \<noteq> 0 \<and> poly q y = 0) \<Longrightarrow> (\<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y)"
	+ proof -
	+ assume "(\<exists>q \<in> (set qs). q \<noteq> 0 \<and> poly q y = 0)"
	+ then obtain q where "q \<in> (set qs) \<and> q \<noteq> 0 \<and> poly q y = 0" by auto
	+ then have "poly (prod_list_var qs) y = 0"
	+ using q_dvd_prod_list_var_prop[of q qs] by auto
	+ then have "poly (pderiv (prod_list_var qs) * (prod_list_var qs)([:-(crb (prod_list_var qs)),1:]) ([:(crb (prod_list_var qs)),1:])) y = 0"
	+ by auto
	+ then have "y \<in> (set S)"
	+ using s_is unfolding characterize_root_list_p_def
	+ proof -
	+ have "y \<in> {r. poly (pderiv (prod_list_var qs) * (prod_list_var qs)([:-(crb (prod_list_var qs)),1:]) ([:(crb (prod_list_var qs)),1:])) r = 0}"
	+ using \<open>poly (pderiv (prod_list_var qs) * (prod_list_var qs)([:-(crb (prod_list_var qs)),1:]) ([:(crb (prod_list_var qs)),1:])) y = 0\<close> by force
	+ then show ?thesis
	+ by (metis characterize_root_list_p_def is_not_const poly_f_def poly_f_nonzero poly_roots_finite s_is set_sorted_list_of_set)
	+ qed
	+ then show "\<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ by auto
	+ qed
	+ have len_gtz_prop: "length ?zer_list > 0 \<longrightarrow>
	+ ((\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w) \<or>
	+ (y < ?zer_list ! 0) \<or>
	+ (y > ?zer_list ! (length ?zer_list - 1)) \<or>
	+ (\<exists>k < (length ?zer_list - 1). y > ?zer_list ! k \<and> y < ?zer_list ! (k+1)))"
	+ proof -
	+ let ?c = "(\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w) \<or>
	+ (y < ?zer_list ! 0) \<or>
	+ (y > ?zer_list ! (length ?zer_list - 1)) \<or>
	+ (\<exists>k < (length ?zer_list - 1). y > ?zer_list ! k \<and> y < ?zer_list ! (k+1))"
	+ have lis1: "length ?zer_list = 1 \<Longrightarrow> ?c"
	+ by auto
	+ have h1: "\<not>(\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w) \<Longrightarrow> \<not> (List.member ?zer_list y)"
	+ by (metis (no_types, lifting) in_set_conv_nth in_set_member)
	+ have h2: "(length ?zer_list > 0 \<and> \<not>(\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w) \<and> \<not> (y < ?zer_list ! 0)) \<Longrightarrow> y > ?zer_list ! 0"
	+ by auto
	+ have h3: "(length ?zer_list > 1 \<and> \<not>(\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w) \<and> \<not> (y > ?zer_list ! (length ?zer_list - 1))) \<Longrightarrow>
	+ y < ?zer_list ! (length ?zer_list - 1)"
	+ apply (auto)
	+ by (smt (z3) diff_Suc_less gr_implies_not0 not_gr_zero)
	+ have "length ?zer_list > 1 \<and> \<not>(\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w) \<and> \<not> (y < ?zer_list ! 0) \<and> \<not> (y > ?zer_list ! (length ?zer_list - 1))
	+ \<Longrightarrow> (\<exists>k < (length ?zer_list - 1). y > ?zer_list ! k \<and> y < ?zer_list ! (k+1))"
	+ using h1 h2 h3 strict_sorted_h sorted_list_lemma_var[of ?zer_list y]
	+ using One_nat_def Suc_lessD by presburger
	+ then have lgt1: "length ?zer_list > 1 \<Longrightarrow> ?c"
	+ by auto
	+ then show ?thesis using lis1 lgt1
	+ by (smt (z3) diff_is_0_eq' not_less)
	+ qed
	+ have neg_crb_in: "(- crb (prod_list_var qs)) \<in> set S"
	+ using set_S_char poly_f_is by auto
	+ have pos_crb_in: "(crb (prod_list_var qs)) \<in> set S"
	+ using set_S_char poly_f_is by auto
	+ have set_S_nonempty: "set S \<noteq> {}" using neg_crb_in by auto
	+ have finset: "finite {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ proof -
	+ have "\<forall>q \<in> set qs. q\<noteq> 0 \<longrightarrow> finite {x. poly q x = 0} "
	+ using poly_roots_finite by auto
	+ then show ?thesis by auto
	+ qed
	+ have c2: "\<not>(\<exists>q \<in> (set qs). q \<noteq> 0 \<and> poly q y = 0) \<Longrightarrow> \<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ proof -
	+ assume "\<not>(\<exists>q \<in> (set qs). q \<noteq> 0 \<and> poly q y = 0)"
	+ have c_c1: "length ?zer_list = 0 \<Longrightarrow> \<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ proof -
	+ assume "length ?zer_list = 0"
	+ then have "\<forall>q \<in> set (qs). \<forall> (x:: real). \<forall>(y::real). squash (poly q x) = squash (poly q y)"
	+ proof clarsimp
	+ fix q x y
	+ assume czer: "card {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0} = 0"
	+ assume qin: "q \<in> set qs"
	+ have fin_means_empty: "{x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0} = {}"
	+ using finset czer
	+ by auto
	+ have qzer: "q = 0 \<Longrightarrow> squash (poly q x) = squash (poly q y)" by auto
	+ have qnonz: "q \<noteq> 0 \<Longrightarrow> squash (poly q x) = squash (poly q y)"
	+ proof -
	+ assume qnonz: "q \<noteq> 0"
	+ then have noroots: "{x. poly q x = 0} = {}" using qin finset
	+ using Collect_empty_eq fin_means_empty by auto
	+ have nonzsq1: "squash (poly q x) \<noteq> 0" using fin_means_empty qnonz czer qin
	+ unfolding squash_def by auto
	+ then have eo: "(poly q x) > 0 \<or> (poly q x) < 0" unfolding squash_def
	+ apply (auto)
	+ by presburger
	+ have eo1: "poly q x > 0 \<Longrightarrow> poly q y > 0"
	+ using noroots poly_IVT_pos[of y x q] poly_IVT_neg[of x y q]
	+ apply (auto)
	+ by (metis linorder_neqE_linordered_idom)
	+ have eo2: "poly q x < 0 \<Longrightarrow> poly q y < 0"
	+ using noroots poly_IVT_pos[of x y q] poly_IVT_neg[of y x q]
	+ apply (auto) by (metis linorder_neqE_linordered_idom)
	+ then show "squash (poly q x) = squash (poly q y)"
	+ using eo eo1 eo2 unfolding squash_def by auto
	+ qed
	+ show "squash (poly q x) = squash (poly q y)"
	+ using qzer qnonz
	+ by blast
	+ qed
	+ then have "\<forall>q \<in> set (qs). squash (poly q y) = squash (poly q (- crb (prod_list_var qs)))"
	+ by auto
	+ then show "\<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ using neg_crb_in unfolding consistent_sign_vec_def squash_def
	+ apply (auto)
	+ by (metis (no_types, hide_lams) antisym_conv3 class_field.neg_1_not_0 equal_neg_zero less_irrefl of_int_minus)
	+ qed
	+ have c_c2: "length ?zer_list > 0 \<Longrightarrow> \<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ proof -
	+ assume lengt: "length ?zer_list > 0"
	+ let ?t = " \<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ have sg1: "(\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w) \<Longrightarrow> ?t"
	+ proof -
	+ assume "(\<exists>w. w < length ?zer_list \<and> y = ?zer_list ! w)"
	+ then obtain w where w_prop: "w < length ?zer_list \<and> y = ?zer_list ! w" by auto
	+ then have " y \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ using finset set_sorted_list_of_set[of "{x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"]
	+ by (smt (verit, best) nth_mem)
	+ then have "y \<in> {x. poly (poly_f qs) x = 0}" using poly_f_is
	+ using \<open>\<not> (\<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q y = 0)\<close> by blast
	+ then show ?thesis using set_S_char
	+ by blast
	+ qed
	+ have sg2: "(y < ?zer_list ! 0) \<Longrightarrow> ?t"
	+ proof -
	+ assume ylt: "y < ?zer_list ! 0"
	+ have ynonzat_some_qs: "\<forall>q \<in> (set qs). q \<noteq> 0 \<longrightarrow> poly q y \<noteq> 0"
	+ proof clarsimp
	+ fix q
	+ assume q_in: "q \<in> set qs"
	+ assume qnonz: "q \<noteq> 0"
	+ assume "poly q y = 0"
	+ then have "y \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ using q_in qnonz by auto
	+ then have "List.member ?zer_list y"
	+ by (smt (verit, best) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have "y \<ge> ?zer_list ! 0" using strict_sorted_h
	+ using \<open>\<not> (\<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q y = 0)\<close> \<open>poly q y = 0\<close> q_in qnonz by blast
	+ then show "False" using ylt
	+ by auto
	+ qed
	+ let ?ncrb = "(- crb (prod_list_var qs))"
	+ have "\<forall>x \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}. poly (prod_list_var qs) x = 0"
	+ using q_dvd_prod_list_var_prop
	+ by fastforce
	+ then have "poly (prod_list_var qs) (sorted_list_of_set {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0} ! 0) = 0"
	+ using finset set_sorted_list_of_set
	+ by (metis (no_types, lifting) lengt nth_mem)
	+ then have ncrblt: "?ncrb < ?zer_list ! 0" using prod_list_var_nonzero crb_lem_neg[of "prod_list_var qs" "?zer_list ! 0"]
	+ by auto
	+ have qzerh: "\<forall>q \<in> (set qs). q = 0 \<longrightarrow> squash (poly q ?ncrb) = squash (poly q y)"
	+ by auto
	+ have "\<forall>q \<in> (set qs). q \<noteq> 0 \<longrightarrow> squash (poly q ?ncrb) = squash (poly q y)"
	+ proof clarsimp
	+ fix q
	+ assume q_in: "q \<in> set qs"
	+ assume qnonz: "q \<noteq> 0"
	+ have nonzylt:"\<not>(\<exists>x \<le> y. poly q x = 0)"
	+ proof clarsimp
	+ fix x
	+ assume xlt: "x \<le> y"
	+ assume "poly q x = 0"
	+ then have "x \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ using q_in qnonz by auto
	+ then have "List.member ?zer_list x"
	+ by (smt (verit, best) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have "x \<ge> ?zer_list ! 0" using strict_sorted_h
	+ by (metis (no_types, lifting) gr_implies_not0 in_set_conv_nth in_set_member not_less sorted_iff_nth_mono sorted_list_of_set(2))
	+ then show "False" using xlt ylt
	+ by auto
	+ qed
	+ have nonzncrb:"\<not>(\<exists>x \<le> (real_of_int ?ncrb). poly q x = 0)"
	+ proof clarsimp
	+ fix x
	+ assume xlt: "x \<le> - real_of_int (crb (prod_list_var qs))"
	+ assume "poly q x = 0"
	+ then have "x \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ using q_in qnonz by auto
	+ then have "List.member ?zer_list x"
	+ by (smt (verit, best) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have "x \<ge> ?zer_list ! 0" using strict_sorted_h
	+ by (metis (no_types, lifting) gr_implies_not0 in_set_conv_nth in_set_member not_less sorted_iff_nth_mono sorted_list_of_set(2))
	+ then show "False" using xlt ncrblt
	+ by auto
	+ qed
	+ have c1: " (poly q ?ncrb) > 0 \<Longrightarrow> (poly q y) > 0"
	+ proof -
	+ assume qncrbgt: "(poly q ?ncrb) > 0"
	+ then have eq: "?ncrb = y \<Longrightarrow> poly q y > 0 " by auto
	+ have gt: " ?ncrb > y \<Longrightarrow> poly q y > 0" using qncrbgt qnonz poly_IVT_pos[of y ?ncrb q] poly_IVT_neg[of ?ncrb y q] nonzncrb nonzylt
	+ apply (auto)
	+ by (meson less_eq_real_def linorder_neqE_linordered_idom)
	+ have lt: "?ncrb < y \<Longrightarrow> poly q y > 0" using qncrbgt
	+ using qnonz poly_IVT_pos[of y ?ncrb q] poly_IVT_neg[of ?ncrb y q] nonzncrb nonzylt
	+ apply (auto)
	+ by (meson less_eq_real_def linorder_neqE_linordered_idom)
	+ then show ?thesis using eq gt lt apply (auto)
	+ by (meson linorder_neqE_linordered_idom)
	+ qed
	+ have c2: "(poly q ?ncrb) < 0 \<Longrightarrow> (poly q y) < 0"
	+ using poly_IVT_pos[of ?ncrb y q] poly_IVT_neg[of y ?ncrb q] nonzncrb nonzylt
	+ apply (auto)
	+ by (metis less_eq_real_def linorder_neqE_linordered_idom)
	+ have eo: "(poly q ?ncrb) > 0 \<or> (poly q ?ncrb) < 0"
	+ using nonzncrb
	+ by auto
	+ then show "squash (poly q (- real_of_int (crb (prod_list_var qs)))) = squash (poly q y)"
	+ using c1 c2
	+ by (smt (verit, ccfv_SIG) of_int_minus squash_def)
	+ qed
	+ then have "\<forall>q \<in> (set qs). squash (poly q ?ncrb) = squash (poly q y)"
	+ using qzerh by auto
	+ then have "consistent_sign_vec qs ?ncrb = consistent_sign_vec qs y"
	+ unfolding consistent_sign_vec_def squash_def
	+ by (smt (z3) map_eq_conv)
	+ then show ?thesis using neg_crb_in by auto
	+ qed
	+ have sg3: " (y > ?zer_list ! (length ?zer_list - 1)) \<Longrightarrow> ?t"
	+ proof -
	+ assume ygt: "y > ?zer_list ! (length ?zer_list - 1)"
	+ have ynonzat_some_qs: "\<forall>q \<in> (set qs). q \<noteq> 0 \<longrightarrow> poly q y \<noteq> 0"
	+ proof clarsimp
	+ fix q
	+ assume q_in: "q \<in> set qs"
	+ assume qnonz: "q \<noteq> 0"
	+ assume "poly q y = 0"
	+ then have "y \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ using q_in qnonz by auto
	+ then have "List.member ?zer_list y"
	+ by (smt (verit, best) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have "y \<le> ?zer_list ! (length ?zer_list - 1)" using strict_sorted_h
	+ using \<open>\<not> (\<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q y = 0)\<close> \<open>poly q y = 0\<close> q_in qnonz by blast
	+ then show "False" using ygt
	+ by auto
	+ qed
	+ let ?crb = "crb (prod_list_var qs)"
	+ have "\<forall>x \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}. poly (prod_list_var qs) x = 0"
	+ using q_dvd_prod_list_var_prop
	+ by fastforce
	+ then have "poly (prod_list_var qs) (sorted_list_of_set {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0} ! 0) = 0"
	+ using finset set_sorted_list_of_set
	+ by (metis (no_types, lifting) lengt nth_mem)
	+ then have crbgt: "?crb > ?zer_list ! (length ?zer_list - 1)" using prod_list_var_nonzero crb_lem_pos[of "prod_list_var qs" "?zer_list ! (length ?zer_list - 1)"]
	+ by (metis (no_types, lifting) \<open>\<forall>x\<in>{x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}. poly (prod_list_var qs) x = 0\<close> diff_less finset lengt less_numeral_extra(1) nth_mem set_sorted_list_of_set)
	+ have qzerh: "\<forall>q \<in> (set qs). q = 0 \<longrightarrow> squash (poly q ?crb) = squash (poly q y)"
	+ by auto
	+ have "\<forall>q \<in> (set qs). q \<noteq> 0 \<longrightarrow> squash (poly q ?crb) = squash (poly q y)"
	+ proof clarsimp
	+ fix q
	+ assume q_in: "q \<in> set qs"
	+ assume qnonz: "q \<noteq> 0"
	+ have nonzylt:"\<not>(\<exists>x \<ge> y. poly q x = 0)"
	+ proof clarsimp
	+ fix x
	+ assume xgt: "x \<ge> y"
	+ assume "poly q x = 0"
	+ then have "x \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ using q_in qnonz by auto
	+ then have "List.member ?zer_list x"
	+ by (smt (verit, best) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have "x \<le> ?zer_list ! (length ?zer_list - 1)" using strict_sorted_h
	+ by (metis (no_types, lifting) One_nat_def Suc_leI Suc_pred diff_Suc_less in_set_conv_nth in_set_member lengt not_less sorted_iff_nth_mono sorted_list_of_set(2))
	+ then show "False" using xgt ygt
	+ by auto
	+ qed
	+ have nonzcrb:"\<not>(\<exists>x \<ge> (real_of_int ?crb). poly q x = 0)"
	+ proof clarsimp
	+ fix x
	+ assume xgt: "x \<ge> real_of_int (crb (prod_list_var qs))"
	+ assume "poly q x = 0"
	+ then have "x \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}"
	+ using q_in qnonz by auto
	+ then have "List.member ?zer_list x"
	+ by (smt (verit, best) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have "x \<le> ?zer_list ! (length ?zer_list - 1)" using strict_sorted_h
	+ by (meson \<open>\<forall>x\<in>{x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}. poly (prod_list_var qs) x = 0\<close> \<open>x \<in> {x. \<exists>q\<in>set qs. q \<noteq> 0 \<and> poly q x = 0}\<close> crb_lem_pos not_less prod_list_var_nonzero xgt)
	+ then show "False" using xgt crbgt
	+ by auto
	+ qed
	+ have c1: " (poly q ?crb) > 0 \<Longrightarrow> (poly q y) > 0"
	+ proof -
	+ assume qcrbgt: "(poly q ?crb) > 0"
	+ then have eq: "?crb = y \<Longrightarrow> poly q y > 0 " by auto
	+ have gt: " ?crb > y \<Longrightarrow> poly q y > 0" using qcrbgt qnonz poly_IVT_pos[of y ?crb q] poly_IVT_neg[of ?crb y q] nonzcrb nonzylt
	+ apply (auto)
	+ by (meson less_eq_real_def linorder_neqE_linordered_idom)
	+ have lt: "?crb < y \<Longrightarrow> poly q y > 0" using qcrbgt
	+ using qnonz poly_IVT_pos[of y ?crb q] poly_IVT_neg[of ?crb y q] nonzcrb nonzylt
	+ apply (auto)
	+ by (meson less_eq_real_def linorder_neqE_linordered_idom)
	+ then show ?thesis using eq gt lt apply (auto)
	+ by (meson linorder_neqE_linordered_idom)
	+ qed
	+ have c2: "(poly q ?crb) < 0 \<Longrightarrow> (poly q y) < 0"
	+ using poly_IVT_pos[of ?crb y q] poly_IVT_neg[of y ?crb q] nonzcrb nonzylt
	+ apply (auto)
	+ by (metis less_eq_real_def linorder_neqE_linordered_idom)
	+ have eo: "(poly q ?crb) > 0 \<or> (poly q ?crb) < 0"
	+ using nonzcrb
	+ by auto
	+ then show "squash (poly q (real_of_int (crb (prod_list_var qs)))) = squash (poly q y)"
	+ using c1 c2
	+ by (smt (verit, ccfv_SIG) of_int_minus squash_def)
	+ qed
	+ then have "\<forall>q \<in> (set qs). squash (poly q ?crb) = squash (poly q y)"
	+ using qzerh by auto
	+ then have "consistent_sign_vec qs ?crb = consistent_sign_vec qs y"
	+ unfolding consistent_sign_vec_def squash_def
	+ by (smt (z3) map_eq_conv)
	+ then show ?thesis using pos_crb_in by auto
	+ qed
	+ have sg4: " (\<exists>k < (length ?zer_list - 1). y > ?zer_list ! k \<and> y < ?zer_list ! (k+1)) \<Longrightarrow> ?t"
	+ proof -
	+ assume " (\<exists>k < (length ?zer_list - 1). y > ?zer_list ! k \<and> y < ?zer_list ! (k+1))"
	+ then obtain k where k_prop: "k < (length ?zer_list - 1) \<and> y > ?zer_list ! k \<and> y < ?zer_list ! (k+1)"
	+ by auto
	+ have ltk: "(?zer_list ! k) < (?zer_list ! (k+1)) "
	+ using strict_sorted_h
	+ using k_prop by linarith
	+ have q1e: "(\<exists>q1\<in>set qs. q1 \<noteq> 0 \<and> poly q1 (?zer_list ! k) = 0)"
	+ by (smt (z3) One_nat_def Suc_lessD add.right_neutral add_Suc_right finset k_prop less_diff_conv mem_Collect_eq nth_mem set_sorted_list_of_set)
	+ have q2e: "(\<exists>q2\<in>set qs. q2 \<noteq> 0 \<and> poly q2 (?zer_list ! (k + 1)) = 0)"
	+ by (smt (verit, del_insts) finset k_prop less_diff_conv mem_Collect_eq nth_mem set_sorted_list_of_set)
	+ then have "(\<exists>q>(?zer_list ! k). q < (?zer_list ! (k + 1)) \<and> poly (poly_f qs) q = 0)"
	+ using poly_f_roots_prop_1[of qs] q1e q2e ltk is_not_const
	+ by auto
	+ then have "\<exists>s \<in> set S. s > ?zer_list ! k \<and> s < ?zer_list ! (k+1)"
	+ using poly_f_is
	+ by (smt (z3) k_prop mem_Collect_eq set_S_char)
	+ then obtain s where s_prop: "s \<in> set S \<and> s > ?zer_list ! k \<and> s < ?zer_list ! (k+1)" by auto
	+ have qnon: "\<forall>q \<in> set qs. q\<noteq> 0 \<longrightarrow> squash (poly q s) = squash (poly q y)"
	+ proof clarsimp
	+ fix q
	+ assume q_in: "q \<in> set qs"
	+ assume qnonz: "q \<noteq> 0"
	+ have sgt: "s > y \<Longrightarrow> squash (poly q s) = squash (poly q y)"
	+ proof -
	+ assume "s > y"
	+ then have "\<nexists>x. List.member ?zer_list x \<and> y \<le> x \<and> x \<le> s"
	+ using sorted_list_lemma[of y s k ?zer_list] k_prop strict_sorted_h s_prop y_prop
	+ using less_diff_conv by blast
	+ then have nox: "\<nexists>x. poly q x = 0 \<and> y \<le> x \<and> x \<le> s" using q_in qnonz
	+ by (metis (mono_tags, lifting) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have c1: "poly q s \<noteq> 0" using s_prop q_in qnonz
	+ by (metis (mono_tags, lifting) \<open>y < s\<close> less_eq_real_def )
	+ have c2: "poly q s > 0 \<Longrightarrow> poly q y > 0"
	+ using poly_IVT_pos poly_IVT_neg nox
	+ by (meson \<open>y < s\<close> less_eq_real_def linorder_neqE_linordered_idom)
	+ have c3: "poly q s < 0 \<Longrightarrow> poly q y < 0" using poly_IVT_pos poly_IVT_neg nox
	+ by (meson \<open>y < s\<close> less_eq_real_def linorder_neqE_linordered_idom)
	+ show ?thesis using c1 c2 c3 unfolding squash_def
	+ by auto
	+ qed
	+ have slt: "s < y \<Longrightarrow> squash (poly q s) = squash (poly q y)"
	+ proof -
	+ assume slt: "s < y"
	+ then have "\<nexists>x. List.member ?zer_list x \<and> s \<le> x \<and> x \<le> y"
	+ using sorted_list_lemma[of s y k ?zer_list] k_prop strict_sorted_h s_prop y_prop
	+ using less_diff_conv by blast
	+ then have nox: "\<nexists>x. poly q x = 0 \<and> s \<le> x \<and> x \<le> y" using q_in qnonz
	+ by (metis (mono_tags, lifting) finset in_set_member mem_Collect_eq set_sorted_list_of_set)
	+ then have c1: "poly q s \<noteq> 0" using s_prop q_in qnonz
	+ by (metis (mono_tags, lifting) \<open>s < y\<close> less_eq_real_def )
	+ have c2: "poly q s > 0 \<Longrightarrow> poly q y > 0"
	+ using poly_IVT_pos poly_IVT_neg nox
	+ by (meson \<open>s < y\<close> less_eq_real_def linorder_neqE_linordered_idom)
	+ have c3: "poly q s < 0 \<Longrightarrow> poly q y < 0" using poly_IVT_pos poly_IVT_neg nox
	+ by (meson \<open>s < y\<close> less_eq_real_def linorder_neqE_linordered_idom)
	+ show ?thesis using c1 c2 c3 unfolding squash_def
	+ by auto
	+ qed
	+ have "s = y \<Longrightarrow> squash (poly q s) = squash (poly q y)"
	+ by auto
	+ then show "squash (poly q s) = squash (poly q y)"
	+ using sgt slt
	+ by (meson linorder_neqE_linordered_idom)
	+ qed
	+ have "\<forall>q \<in> set qs. q= 0 \<longrightarrow> squash (poly q s) = squash (poly q y)" by auto
	+ then have "\<forall>q \<in> set qs. squash (poly q s) = squash (poly q y)"
	+ using qnon
	+ by fastforce
	+ then show ?thesis
	+ using s_prop unfolding squash_def consistent_sign_vec_def apply (auto)
	+ by (metis (no_types, hide_lams) class_field.neg_1_not_0 equal_neg_zero less_irrefl linorder_neqE_linordered_idom)
	+ qed
	+ show ?thesis
	+ using lengt sg1 sg2 sg3 sg4 len_gtz_prop is_not_const
	+ by fastforce
	+ qed
	+ show "\<exists> k \<in> (set S). consistent_sign_vec qs k = consistent_sign_vec qs y"
	+ using c_c1 c_c2 by auto
	+ qed
	+ show ?thesis
	+ using c1 c2 by auto
	+ qed
	+ then show "x \<in> consistent_sign_vectors_R qs (set S)"
	+ using y_prop unfolding consistent_sign_vectors_R_def
	+ by (metis imageI)
	+ qed
	+ have easy_direction: "consistent_sign_vectors_R qs (set S) \<subseteq> consistent_sign_vectors_R qs UNIV "
	+ using consistent_sign_vectors_R_def by auto
	+ then show ?thesis using difficult_direction easy_direction by auto
	+qed
	+
	+lemma main_step_aux2_R:
	+ fixes qs:: "real poly list"
	+ assumes is_not_const: "check_all_const_deg qs = False"
	+ shows "set (find_consistent_signs_R qs) = consistent_sign_vectors_R qs UNIV"
	+proof -
	+ have poly_f_is: "poly_f qs = (pderiv (prod_list_var qs)) * (prod_list_var qs)* ([:-(crb (prod_list_var qs)),1:]) * ([:(crb (prod_list_var qs)),1:])"
	+ using is_not_const unfolding poly_f_def by auto
	+ let ?p = "(pderiv (prod_list_var qs)) * (prod_list_var qs)* ([:-(crb (prod_list_var qs)),1:]) * ([:(crb (prod_list_var qs)),1:])"
	+ let ?S = "characterize_root_list_p (pderiv (prod_list_var qs) * (prod_list_var qs) * ([:-(crb (prod_list_var qs)),1:]) * ([:(crb (prod_list_var qs)),1:]))"
	+ have "set (remdups
	+ (map (signs_at qs) ?S))
	+ = consistent_sign_vectors_R qs (set ?S)"
	+ unfolding signs_at_def squash_def consistent_sign_vectors_R_def consistent_sign_vec_def
	+ by (smt (verit, best) comp_apply map_eq_conv set_map set_remdups)
	+ then have "set (characterize_consistent_signs_at_roots ?p qs) = consistent_sign_vectors_R qs UNIV"
	+ unfolding characterize_consistent_signs_at_roots_def using assms all_sample_points_prop[of qs]
	+ by auto
	+ then show ?thesis
	+ unfolding find_consistent_signs_R_def using find_consistent_signs_at_roots_R poly_f_is poly_f_nonzero[of qs]
	+ by auto
	+qed
	+
	+lemma main_step_R:
	+ fixes qs:: "real poly list"
	+ shows "set (find_consistent_signs_R qs) = consistent_sign_vectors_R qs UNIV"
	+ using main_step_aux1_R main_step_aux2_R by auto
	+
	+(* The universal and existential decision procedure for real polys are easy
	+ if we know the consistent sign vectors *)
	+lemma consistent_sign_vec_semantics_R:
	+ assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length ls"
	+ shows "lookup_sem fml (map (\<lambda>p. poly p x) ls) = lookup_sem fml (consistent_sign_vec ls x)"
	+ using assms apply (induction)
	+ by (auto simp add: consistent_sign_vec_def)
	+
	+lemma universal_lookup_sem_R:
	+ assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length qs"
	+ assumes "set signs = consistent_sign_vectors_R qs UNIV"
	+ shows "(\<forall>x::real. lookup_sem fml (map (\<lambda>p. poly p x) qs)) \<longleftrightarrow>
	+ list_all (lookup_sem fml) signs"
	+ using assms(2) unfolding consistent_sign_vectors_R_def list_all_iff
	+ by (simp add: assms(1) consistent_sign_vec_semantics_R)
	+
	+lemma existential_lookup_sem_R:
	+ assumes "\<And>i. i \<in> set_fml fml \<Longrightarrow> i < length qs"
	+ assumes "set signs = consistent_sign_vectors_R qs UNIV"
	+ shows "(\<exists>x::real. lookup_sem fml (map (\<lambda>p. poly p x) qs)) \<longleftrightarrow>
	+ find (lookup_sem fml) signs \<noteq> None"
	+ using assms(2) unfolding consistent_sign_vectors_R_def find_None_iff
	+ by (simp add: assms(1) consistent_sign_vec_semantics_R)
	+
	+lemma decide_univ_lem_helper_R:
	+ fixes fml:: "real poly fml"
	+ assumes "(fml_struct,polys) = convert fml"
	+ shows "(\<forall>x::real. lookup_sem fml_struct (map (\<lambda>p. poly p x) polys)) \<longleftrightarrow> (decide_universal_R fml)"
	+ using assms universal_lookup_sem_R main_step_R unfolding decide_universal_R_def apply (auto)
	+ apply (metis assms convert_closed fst_conv snd_conv)
	+ by (metis (full_types) assms convert_closed fst_conv snd_conv)
	+
	+lemma decide_exis_lem_helper_R:
	+ fixes fml:: "real poly fml"
	+ assumes "(fml_struct,polys) = convert fml"
	+ shows "(\<exists>x::real. lookup_sem fml_struct (map (\<lambda>p. poly p x) polys)) \<longleftrightarrow> (decide_existential_R fml)"
	+ using assms existential_lookup_sem_R main_step_R unfolding decide_existential_R_def apply (auto)
	+ apply (metis assms convert_closed fst_conv snd_conv)
	+ by (metis (full_types) assms convert_closed fst_conv snd_conv)
	+
	+lemma convert_semantics_lem_R:
	+ assumes "\<And>p. p \<in> set (poly_list fml) \<Longrightarrow>
	+ ls ! (index_of ps p) = poly p x"
	+ shows "real_sem fml x = lookup_sem (map_fml (index_of ps) fml) ls"
	+ using assms apply (induct fml)
	+ by auto
	+
	+lemma convert_semantics_R:
	+ shows "real_sem fml x = lookup_sem (fst (convert fml)) (map (\<lambda>p. poly p x) (snd (convert fml)))"
	+ unfolding convert_def Let_def apply simp
	+ apply (intro convert_semantics_lem_R)
	+ by (simp add: index_of_lookup(1) index_of_lookup(2))
	+
	+(* Main result *)
	+theorem decision_procedure_R:
	+ shows "(\<forall>x::real. real_sem fml x) \<longleftrightarrow> (decide_universal_R fml)"
	+ "\<exists>x::real. real_sem fml x \<longleftrightarrow> (decide_existential_R fml)"
	+ using convert_semantics_lem_R decide_univ_lem_helper_R apply (auto)
	+ apply (simp add: convert_semantics_R)
	+ apply (metis convert_def convert_semantics_R fst_conv snd_conv)
	+ using convert_semantics_lem_R
	+ by (metis convert_def convert_semantics_R decide_exis_lem_helper_R fst_conv snd_conv)
	+
	+end
	diff --git a/thys/BenOr_Kozen_Reif/Renegar_Proofs.thy b/thys/BenOr_Kozen_Reif/Renegar_Proofs.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/Renegar_Proofs.thy
	@@ -0,0 +1,2776 @@
	+theory Renegar_Proofs
	+ imports "Renegar_Algorithm"
	+ "BKR_Proofs"
	+begin
	+
	+(* Note that there is significant overlap between Renegar and BKR in general, so there is some
	+ similarity between this file and BKR_Proofs.thy
	+ The main difference is that the RHS vector in Renegar is different from the RHS vector in BKR
	+ In BKR, all of the qs are assumed to be relatively prime to p. Renegar removes this assumption.
	+
	+ In general, the _R's on definition and lemma names in this file are to emphasize that we are
	+ working with Renegar style.
	+*)
	+
	+section "Tarski Queries Changed"
	+
	+lemma construct_NofI_R_relation:
	+ fixes p:: "real poly"
	+ fixes I1:: "real poly list"
	+ fixes I2:: "real poly list"
	+ shows "construct_NofI_R p I1 I2 =
	+ construct_NofI (sum_list (map power2 (p # I1))) I2"
	+ unfolding construct_NofI_R_def construct_NofI_def
	+ by metis
	+
	+lemma sum_list_map_power2:
	+ shows "sum_list (map power2 ls) \<ge> (0::real poly)"
	+ apply (induct ls)
	+ by auto
	+
	+lemma sum_list_map_power2_poly:
	+ shows "poly (sum_list (map power2 (ls::real poly list))) x \<ge> (0::real)"
	+ apply (induct ls)
	+ by auto
	+
	+lemma construct_NofI_R_prop_helper:
	+ fixes p:: "real poly"
	+ fixes I1:: "real poly list"
	+ fixes I2:: "real poly list"
	+ assumes nonzero: "p\<noteq>0"
	+ shows "construct_NofI_R p I1 I2 =
	+ rat_of_int (int (card {x. poly (sum_list (map (\<lambda>x. x^2) (p # I1))) x = 0 \<and> poly (prod_list I2) x > 0}) -
	+ int (card {x. poly (sum_list (map (\<lambda>x. x^2) (p # I1))) x = 0 \<and> poly (prod_list I2) x < 0}))"
	+proof -
	+ show ?thesis unfolding construct_NofI_R_relation[of p I1 I2]
	+ apply (subst construct_NofI_prop[of _ I2])
	+ apply auto
	+ using assms sum_list_map_power2
	+ by (metis le_add_same_cancel1 power2_less_eq_zero_iff)
	+qed
	+
	+lemma zer_iff:
	+ fixes p:: "real poly"
	+ fixes ls:: "real poly list"
	+ shows "poly (sum_list (map (\<lambda>x. x^2) ls)) x = 0 \<longleftrightarrow> (\<forall>i \<in> set ls. poly i x = 0)"
	+proof (induct ls)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a I1)
	+ then show ?case
	+ apply simp
	+ apply (subst add_nonneg_eq_0_iff)
	+ using zero_le_power2 apply blast
	+ using sum_list_map_power2_poly apply presburger
	+ by simp
	+qed
	+
	+lemma construct_NofI_prop_R:
	+ fixes p:: "real poly"
	+ fixes I1:: "real poly list"
	+ fixes I2:: "real poly list"
	+ assumes nonzero: "p\<noteq>0"
	+ shows "construct_NofI_R p I1 I2 =
	+ rat_of_int (int (card {x. poly p x = 0 \<and> (\<forall>q \<in> set I1. poly q x = 0) \<and> poly (prod_list I2) x > 0}) -
	+ int (card {x. poly p x = 0 \<and> (\<forall>q \<in> set I1. poly q x = 0) \<and> poly (prod_list I2) x < 0}))"
	+ unfolding construct_NofI_R_prop_helper[OF nonzero]
	+ using zer_iff
	+ apply auto
	+ by (smt (verit, del_insts) Collect_cong sum_list_map_power2_poly zero_le_power2 zero_less_power2)
	+
	+section "Matrix Equation"
	+
	+definition map_sgas:: "rat list \<Rightarrow> rat list"
	+ where "map_sgas l = map (\<lambda>r. (1 - r^2)) l"
	+
	+definition z_R:: "(nat list*nat list) \<Rightarrow> rat list \<Rightarrow> rat"
	+ where "z_R index_list sign_asg \<equiv> (prod_list (map (nth (map_sgas sign_asg)) (fst(index_list))))*(prod_list (map (nth sign_asg) (snd(index_list))))"
	+
	+definition mtx_row_R:: "rat list list \<Rightarrow> (nat list * nat list) \<Rightarrow> rat list"
	+ where "mtx_row_R sign_list index_list \<equiv> (map ((z_R index_list)) sign_list)"
	+
	+definition matrix_A_R:: "rat list list \<Rightarrow> (nat list * nat list) list \<Rightarrow> rat mat"
	+ where "matrix_A_R sign_list subset_list =
	+ (mat_of_rows_list (length sign_list) (map (\<lambda>i .(mtx_row_R sign_list i)) subset_list))"
	+
	+definition all_list_constr_R:: "(nat list*nat list) list \<Rightarrow> nat \<Rightarrow> bool"
	+ where "all_list_constr_R L n \<equiv> (\<forall>x. List.member L x \<longrightarrow> (list_constr (fst x) n \<and> list_constr (snd x) n))"
	+
	+definition alt_matrix_A_R:: "rat list list \<Rightarrow> (nat list*nat list) list \<Rightarrow> rat mat"
	+ where "alt_matrix_A_R signs subsets = (mat (length subsets) (length signs)
	+ (\<lambda>(i, j). z_R (subsets ! i) (signs ! j)))"
	+
	+lemma alt_matrix_char_R: "alt_matrix_A_R signs subsets = matrix_A_R signs subsets"
	+proof -
	+ have h0: "(\<And>i j. i < length subsets \<Longrightarrow>
	+ j < length signs \<Longrightarrow>
	+ map (\<lambda>index_list. map (z_R index_list) signs) subsets ! i ! j = z_R (subsets ! i) (signs ! j))"
	+ proof -
	+ fix i
	+ fix j
	+ assume i_lt: "i < length subsets"
	+ assume j_lt: "j < length signs"
	+ show "((map (\<lambda>index_list. map (z_R index_list) signs) subsets) ! i) ! j = z_R (subsets ! i) (signs ! j)"
	+ proof -
	+ have h0: "(map (\<lambda>index_list. map (z_R index_list) signs) subsets) ! i = map (z_R (subsets ! i)) signs"
	+ using nth_map i_lt
	+ by blast
	+ then show ?thesis using nth_map j_lt
	+ by simp
	+ qed
	+ qed
	+ have h: " mat (length subsets) (length signs) (\<lambda>(i, j). z_R (subsets ! i) (signs ! j)) =
	+ mat (length subsets) (length signs) (\<lambda>(i, y). map (\<lambda>index_list. map (z_R index_list) signs) subsets ! i ! y)"
	+ using h0 eq_matI[where A = "mat (length subsets) (length signs) (\<lambda>(i, j). z_R (subsets ! i) (signs ! j))",
	+ where B = "mat (length subsets) (length signs) (\<lambda>(i, y). map (\<lambda>index_list. map (z_R index_list) signs) subsets ! i ! y)"]
	+ by auto
	+ show ?thesis unfolding alt_matrix_A_R_def matrix_A_R_def mat_of_rows_list_def apply (auto) unfolding mtx_row_R_def
	+ using h by blast
	+qed
	+
	+lemma subsets_are_rows_R: "\<forall>i < (length subsets). row (alt_matrix_A_R signs subsets) i = vec (length signs) (\<lambda>j. z_R (subsets ! i) (signs ! j))"
	+ unfolding row_def unfolding alt_matrix_A_R_def by auto
	+
	+lemma signs_are_cols_R: "\<forall>i < (length signs). col (alt_matrix_A_R signs subsets) i = vec (length subsets) (\<lambda>j. z_R (subsets ! j) (signs ! i))"
	+ unfolding col_def unfolding alt_matrix_A_R_def by auto
	+
	+definition consistent_sign_vec::"real poly list \<Rightarrow> real \<Rightarrow> rat list"
	+ where "consistent_sign_vec qs x \<equiv>
	+ map (\<lambda> q. if (poly q x > 0) then (1::rat) else (if (poly q x = 0) then (0::rat) else (-1::rat))) qs"
	+
	+definition construct_lhs_vector_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> rat vec"
	+ where "construct_lhs_vector_R p qs signs \<equiv>
	+ vec_of_list (map (\<lambda>w. rat_of_int (int (length (filter (\<lambda>v. v = w) (map (consistent_sign_vec qs) (characterize_root_list_p p)))))) signs)"
	+
	+(* The ith entry of LHS vector is the number of (distinct) real zeros of p where the sign vector of
	+ the qs is the ith entry of signs.*)
	+
	+(* Putting all of the pieces of the construction together *)
	+definition satisfy_equation_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> (nat list*nat list) list \<Rightarrow> rat list list \<Rightarrow> bool"
	+ where "satisfy_equation_R p qs subset_list sign_list =
	+ (mult_mat_vec (matrix_A_R sign_list subset_list) (construct_lhs_vector_R p qs sign_list) = (construct_rhs_vector_R p qs subset_list))"
	+
	+(* Recharacterize the LHS vector *)
	+lemma construct_lhs_vector_clean_R:
	+ assumes "p \<noteq> 0"
	+ assumes "i < length signs"
	+ shows "(construct_lhs_vector_R p qs signs) $ i =
	+ card {x. poly p x = 0 \<and> ((consistent_sign_vec qs x) = (nth signs i))}"
	+proof -
	+ from poly_roots_finite[OF assms(1)] have "finite {x. poly p x = 0}" .
	+ then have eq: "(Collect
	+ ((\<lambda>v. v = signs ! i) \<circ>
	+ consistent_sign_vec qs) \<inter>
	+ set (sorted_list_of_set
	+ {x. poly p x = 0})) =
	+ {x. poly p x = 0 \<and> consistent_sign_vec qs x = signs ! i}"
	+ by auto
	+ show ?thesis
	+ unfolding construct_lhs_vector_R_def vec_of_list_index characterize_root_list_p_def
	+ apply auto
	+ apply (subst nth_map[OF assms(2)])
	+ apply auto
	+ apply (subst distinct_length_filter)
	+ apply (auto)
	+ using eq
	+ by auto
	+qed
	+
	+lemma construct_lhs_vector_cleaner_R:
	+ assumes "p \<noteq> 0"
	+ shows "(construct_lhs_vector_R p qs signs) =
	+ vec_of_list (map (\<lambda>s. rat_of_int (card {x. poly p x = 0 \<and> ((consistent_sign_vec qs x) = s)})) signs)"
	+ apply (rule eq_vecI)
	+ apply (auto simp add: construct_lhs_vector_clean_R[OF assms] )
	+ apply (simp add: vec_of_list_index)
	+ unfolding construct_lhs_vector_R_def
	+ using assms construct_lhs_vector_clean_R construct_lhs_vector_def apply auto[1]
	+ apply (simp add: construct_lhs_vector_R_def)
	+ by auto
	+
	+(* Show that because our consistent sign vectors consist of 1, 0's, and -1's, z returns 1, 0, or -1
	+ when applied to a consistent sign vector *)
	+lemma z_signs_R2:
	+ fixes I:: "nat list"
	+ fixes signs:: "rat list"
	+ assumes lf: "list_all (\<lambda>i. i < length signs) I"
	+ assumes la: "list_all (\<lambda>s. s = 1 \<or> s = 0 \<or> s = -1) signs"
	+ shows "(prod_list (map (nth signs) I)) = 1 \<or>
	+ (prod_list (map (nth signs) I)) = 0 \<or>
	+ (prod_list (map (nth signs) I)) = -1" using assms
	+proof (induct I)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a I)
	+ moreover have eo: "signs ! a = 1 \<or> signs ! a = 0 \<or> signs ! a = -1"
	+ using assms
	+ by (smt (verit, del_insts) calculation(2) list_all_length list_all_simps(1))
	+ have "prod_list (map ((!) (map_sgas signs)) (a # I)) = (1 - (signs ! a)^2)*prod_list (map ((!) (map_sgas signs)) (I))"
	+ unfolding map_sgas_def apply (auto)
	+ using calculation(2) by auto
	+ then show ?case using eo
	+ using Cons.hyps calculation(2) la by auto
	+qed
	+
	+lemma z_signs_R1:
	+ fixes I:: "nat list"
	+ fixes signs:: "rat list"
	+ assumes lf: "list_all (\<lambda>i. i < length signs) I"
	+ assumes la: "list_all (\<lambda>s. s = 1 \<or> s = 0 \<or> s = -1) signs"
	+ shows "(prod_list (map (nth (map_sgas signs)) I)) = 1 \<or>
	+(prod_list (map (nth (map_sgas signs)) I)) = 0" using assms
	+proof (induct I)
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a I)
	+ moreover have "signs ! a = 1 \<or> signs ! a = 0 \<or> signs ! a = -1"
	+ using assms
	+ by (smt (verit, best) calculation(2) list_all_length list_all_simps(1))
	+ then have eo: "1 - (signs ! a)^2 = 1 \<or> 1 - (signs !a)^2 = 0"
	+ using cancel_comm_monoid_add_class.diff_cancel diff_zero by fastforce
	+ have "prod_list (map ((!) (map_sgas signs)) (a # I)) = (1 - (signs ! a)^2)*prod_list (map ((!) (map_sgas signs)) (I))"
	+ unfolding map_sgas_def apply (auto)
	+ using calculation(2) by auto
	+ then show ?case using eo
	+ using Cons.hyps calculation(2) la by auto
	+qed
	+
	+lemma z_signs_R:
	+ fixes I:: "(nat list * nat list)"
	+ fixes signs:: "rat list"
	+ assumes lf: "list_all (\<lambda>i. i < length signs) (fst(I))"
	+ assumes ls: "list_all (\<lambda>i. i < length signs) (snd(I))"
	+ assumes la: "list_all (\<lambda>s. s = 1 \<or> s = 0 \<or> s = -1) signs"
	+ shows "(z_R I signs = 1) \<or> (z_R I signs = 0) \<or> (z_R I signs = -1)"
	+ using assms z_signs_R2 z_signs_R1 unfolding z_R_def apply (auto)
	+ by (metis (no_types, lifting) mult_cancel_left1 mult_minus1_right)
	+
	+lemma z_lemma_R:
	+ fixes I:: "nat list * nat list"
	+ fixes sign:: "rat list"
	+ assumes consistent: "sign \<in> set (characterize_consistent_signs_at_roots p qs)"
	+ assumes welldefined1: "list_constr (fst I) (length qs)"
	+ assumes welldefined2: "list_constr (snd I) (length qs)"
	+ shows "(z_R I sign = 1) \<or> (z_R I sign = 0) \<or> (z_R I sign = -1)"
	+proof (rule z_signs_R)
	+ have same: "length sign = length qs" using consistent
	+ using characterize_consistent_signs_at_roots_def signs_at_def by fastforce
	+ thus "(list_all (\<lambda>i. i < length sign) (fst I))"
	+ using welldefined1
	+ by (auto simp add: list_constr_def characterize_consistent_signs_at_roots_def consistent_sign_vec_copr_def)
	+ thus "(list_all (\<lambda>i. i < length sign) (snd I))"
	+ using same welldefined2
	+ by (auto simp add: list_constr_def characterize_consistent_signs_at_roots_def consistent_sign_vec_copr_def)
	+ show "list_all (\<lambda>s. s = 1 \<or> s = 0 \<or> s = - 1) sign" using consistent
	+ apply (auto simp add: list.pred_map characterize_consistent_signs_at_roots_def consistent_sign_vec_def)
	+ using Ball_set
	+ by (simp add: list_all_length signs_at_def squash_def)
	+qed
	+
	+(* Show that all consistent sign vectors on roots of polynomials are in characterize_consistent_signs_at_roots *)
	+lemma in_set_R:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ shows "sign \<in> set (characterize_consistent_signs_at_roots p qs)"
	+proof -
	+ have h1: "consistent_sign_vec qs x \<in>
	+ set (remdups (map (signs_at qs) (sorted_list_of_set {x. poly p x = 0})))"
	+ unfolding consistent_sign_vec_def signs_at_def squash_def
	+ using root_p nonzero poly_roots_finite set_sorted_list_of_set apply (auto)
	+ by (smt (verit, ccfv_SIG) Collect_cong comp_def image_eqI map_eq_conv mem_Collect_eq poly_roots_finite set_sorted_list_of_set)
	+ thus ?thesis unfolding characterize_consistent_signs_at_roots_def characterize_root_list_p_def using sign_fix
	+ by blast
	+qed
	+
	+lemma consistent_signs_prop_R:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ shows "list_all (\<lambda>s. s = 1 \<or> s = 0 \<or> s = -1) sign"
	+ using assms unfolding consistent_sign_vec_def squash_def apply (auto)
	+ by (smt (z3) length_map list_all_length nth_map)
	+
	+(* The next few lemmas relate z_R to the signs of the product of subsets of polynomials of qs *)
	+lemma horiz_vector_helper_pos_ind_R1:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ assumes asm: "list_constr I (length qs)"
	+ shows "(prod_list (map (nth (map_sgas sign)) I)) = 1 \<longleftrightarrow>
	+ (\<forall>p \<in> set (retrieve_polys qs I). poly p x = 0)"
	+ using asm
	+proof (induction "I")
	+ case Nil
	+ then show ?case unfolding map_sgas_def apply (auto)
	+ by (simp add: retrieve_polys_def)
	+next
	+ case (Cons a xa)
	+ then have same0: "(prod_list (map (nth (map_sgas sign)) xa)) = 1 \<longleftrightarrow>
	+ (\<forall>p \<in> set (retrieve_polys qs xa). poly p x = 0)" unfolding list_constr_def by auto
	+ have welldef: "a < length qs" using Cons.prems assms unfolding list_constr_def by auto
	+ then have h: "prod_list (map ((!) (map_sgas sign)) (a#xa)) = (1 - (sign ! a)^2)*(prod_list (map ((!) (map_sgas sign)) (xa)))"
	+ unfolding map_sgas_def using assms apply (auto)
	+ by (metis (no_types, lifting) consistent_sign_vec_def length_map nth_map)
	+ have "list_all (\<lambda>s. s = 1 \<or> s = 0 \<or> s = -1) sign" using sign_fix unfolding consistent_sign_vec_def squash_def
	+ apply (auto)
	+ by (smt (z3) length_map list_all_length nth_map)
	+ then have eo: "(prod_list (map ((!) (map_sgas sign)) (xa))) = 0 \<or> (prod_list (map ((!) (map_sgas sign)) (xa))) = 1"
	+ using z_signs_R1 assms Cons.prems consistent_sign_vec_def length_map list_all_simps(1) length_map list_all_length list_constr_def
	+ by (smt (verit, best))
	+ have "(sign ! a)^2 = 1 \<or> (sign ! a)^2 = 0" using sign_fix welldef unfolding consistent_sign_vec_def
	+ by auto
	+ then have s1: "(prod_list (map (nth (map_sgas sign)) (a#xa))) = 1 \<longleftrightarrow>
	+ ((sign ! a)^2 = 0 \<and> (prod_list (map ((!) (map_sgas sign)) (xa))) = 1)"
	+ using eo h
	+ by (metis (mono_tags, hide_lams) cancel_comm_monoid_add_class.diff_cancel diff_zero mult.left_neutral mult_zero_left)
	+ have "(sign ! a)^2 = 0 \<longleftrightarrow> (poly (qs ! a) x = 0)"
	+ using sign_fix unfolding consistent_sign_vec_def welldef apply (auto)
	+ apply (smt (z3) class_field.neg_1_not_0 class_field.zero_not_one nth_map welldef)
	+ by (smt (z3) nth_map welldef)
	+ then have same1:"(prod_list (map (nth (map_sgas sign)) (a#xa))) = 1 \<longleftrightarrow>
	+ ((poly (qs ! a) x = 0) \<and> (prod_list (map ((!) (map_sgas sign)) (xa))) = 1)" using s1 by auto
	+ have "set (retrieve_polys qs (a#xa)) = {(qs ! a)} \<union> set (retrieve_polys qs xa)"
	+ by (metis (no_types, lifting) insert_is_Un list.simps(15) list.simps(9) retrieve_polys_def)
	+ then have same2:"(\<forall>p \<in> set (retrieve_polys qs (a#xa)). poly p x = 0) = ((poly (qs ! a) x = 0)
	+ \<and> (\<forall>p \<in> set (retrieve_polys qs (xa)). poly p x = 0))"
	+ by auto
	+ then show ?case using same0 same1 same2
	+ assms by auto
	+qed
	+
	+lemma csv_length_same_as_qlist:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ shows "length sign = length qs"
	+ using assms unfolding consistent_sign_vec_def by auto
	+
	+lemma horiz_vector_helper_zer_ind_R2:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ assumes asm: "list_constr I (length qs)"
	+ shows "(prod_list (map (nth sign) I)) = 0 \<longleftrightarrow>
	+ (poly (prod_list (retrieve_polys qs I)) x = 0)"
	+ using asm
	+proof (induction "I")
	+ case Nil
	+ then show ?case unfolding map_sgas_def apply (auto) unfolding retrieve_polys_def
	+ by auto next
	+ case (Cons a xa)
	+ have "poly (prod_list (retrieve_polys qs (a # xa))) x = (poly (qs ! a) x)*poly (prod_list (retrieve_polys qs (xa))) x"
	+ by (simp add: retrieve_polys_def)
	+ then show ?case using Cons.prems
	+ by (smt (z3) Cons.IH class_field.neg_1_not_0 class_field.zero_not_one consistent_sign_vec_def list.simps(9) list_all_simps(1) list_constr_def mult_eq_0_iff nth_map prod_list.Cons sign_fix)
	+qed
	+
	+lemma horiz_vector_helper_pos_ind_R2:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ assumes asm: "list_constr I (length qs)"
	+ shows "(prod_list (map (nth sign) I)) = 1 \<longleftrightarrow>
	+ (poly (prod_list (retrieve_polys qs I)) x > 0)"
	+ using asm
	+proof (induction "I")
	+ case Nil
	+ then show ?case unfolding map_sgas_def apply (auto) unfolding retrieve_polys_def
	+ by auto next
	+ case (Cons a xa)
	+ then have ih: "(prod_list (map ((!) sign) xa) = 1) = (0 < poly (prod_list (retrieve_polys qs xa)) x)"
	+ unfolding list_constr_def by auto
	+ have lensame: "length sign = length qs" using sign_fix csv_length_same_as_qlist[of p x sign qs]
	+ nonzero root_p by auto
	+ have "poly (prod_list (retrieve_polys qs (a # xa))) x = (poly (qs ! a) x)*poly (prod_list (retrieve_polys qs (xa))) x"
	+ by (simp add: retrieve_polys_def)
	+ then have iff1: "(poly (prod_list (retrieve_polys qs (a#xa))) x > 0) \<longleftrightarrow>
	+ (((poly (qs ! a) x) > 0 \<and> poly (prod_list (retrieve_polys qs (xa))) x > 0) \<or>
	+ ((poly (qs ! a) x) < 0 \<and> poly (prod_list (retrieve_polys qs (xa))) x < 0))"
	+ by (metis zero_less_mult_iff)
	+ have prodsame: "(prod_list (map (nth sign) (a#xa))) = (sign ! a)* (prod_list (map (nth sign) (xa)))"
	+ using lensame Cons.prems unfolding list_constr_def by auto
	+ have sagt: "sign ! a = 1 \<longleftrightarrow> (poly (qs ! a) x) > 0" using assms unfolding consistent_sign_vec_def
	+ apply (auto)
	+ apply (smt (verit, best) Cons.prems list_all_simps(1) list_constr_def neg_equal_zero nth_map zero_neq_one)
	+ by (smt (verit, ccfv_threshold) Cons.prems list_all_simps(1) list_constr_def nth_map)
	+ have salt: "sign ! a = -1 \<longleftrightarrow> (poly (qs ! a) x) < 0" using assms unfolding consistent_sign_vec_def
	+ apply (auto)
	+ apply (smt (verit, ccfv_SIG) Cons.prems less_minus_one_simps(1) less_minus_one_simps(3) list_all_simps(1) list_constr_def neg_0_less_iff_less nth_map)
	+ by (smt (verit, best) Cons.prems list_all_simps(1) list_constr_def nth_map)
	+ have h1: "((poly (qs ! a) x) > 0 \<and> poly (prod_list (retrieve_polys qs (xa))) x > 0) \<longrightarrow>
	+ (prod_list (map (nth sign) (a#xa))) = 1"
	+ using prodsame sagt ih by auto
	+ have eo: "(prod_list (map ((!) sign) xa) = 1) \<or> (prod_list (map ((!) sign) xa) = 0) \<or>
	+ (prod_list (map ((!) sign) xa) = -1)"
	+ using Cons.prems consistent_signs_prop_R lensame list_constr_def nonzero root_p sign_fix z_signs_R2 by auto
	+ have d1:"(prod_list (map ((!) sign) xa) = -1) \<Longrightarrow> (0 > poly (prod_list (retrieve_polys qs xa)) x)"
	+ proof -
	+ assume "(prod_list (map ((!) sign) xa) = -1) "
	+ then show "(0 > poly (prod_list (retrieve_polys qs xa)) x)"
	+ using prodsame salt ih assms Cons.prems class_field.neg_1_not_0 equal_neg_zero horiz_vector_helper_zer_ind_R2 linorder_neqE_linordered_idom list_all_simps(1) list_constr_def
	+ apply (auto)
	+ apply (smt (verit, ccfv_threshold) class_field.neg_1_not_0 list.set_map list_all_length semidom_class.prod_list_zero_iff)
	+ by (smt (verit, ccfv_threshold) class_field.neg_1_not_0 list.set_map list_all_length semidom_class.prod_list_zero_iff)
	+ qed
	+ have d2: "(0 > poly (prod_list (retrieve_polys qs xa)) x) \<longrightarrow> (prod_list (map ((!) sign) xa) = -1)"
	+ using eo assms horiz_vector_helper_zer_ind_R2[where p = "p", where x = "x", where sign = "sign", where I ="I"]
	+ apply (auto)
	+ using ih apply force
	+ by (metis (full_types, lifting) Cons.prems class_field.neg_1_not_0 horiz_vector_helper_zer_ind_R2 ih imageI list.set_map list_all_simps(1) list_constr_def mem_Collect_eq neg_equal_0_iff_equal semidom_class.prod_list_zero_iff)
	+ have "(prod_list (map ((!) sign) xa) = -1) = (0 > poly (prod_list (retrieve_polys qs xa)) x)"
	+ using d1 d2
	+ by blast
	+ then have h2: "((poly (qs ! a) x) < 0 \<and> poly (prod_list (retrieve_polys qs (xa))) x < 0) \<longrightarrow>
	+ (prod_list (map (nth sign) (a#xa))) = 1"
	+ using prodsame salt ih by auto
	+ have h3: "(prod_list (map (nth sign) (a#xa))) = 1 \<longrightarrow> (((poly (qs ! a) x) > 0 \<and> poly (prod_list (retrieve_polys qs (xa))) x > 0) \<or>
	+ ((poly (qs ! a) x) < 0 \<and> poly (prod_list (retrieve_polys qs (xa))) x < 0))"
	+ using prodsame salt ih assms horiz_vector_helper_zer_ind_R2[where p = "p", where x = "x", where sign = "sign", where I ="I"]
	+ by (smt (verit, ccfv_threshold) Cons.prems \<open>poly (prod_list (retrieve_polys qs (a # xa))) x = poly (qs ! a) x * poly (prod_list (retrieve_polys qs xa)) x\<close> horiz_vector_helper_zer_ind_R2 mem_Collect_eq mult_cancel_left1 mult_not_zero sagt)
	+ then show ?case using h1 h2 h3 iff1 Cons.prems by auto
	+qed
	+
	+lemma horiz_vector_helper_pos_ind_R:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list * nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ assumes asm1: "list_constr (fst I) (length qs)"
	+ assumes asm2: "list_constr (snd I) (length qs)"
	+ shows "((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x > 0)) \<longleftrightarrow> (z_R I sign = 1)"
	+proof -
	+ have len: "length sign = length qs" using sign_fix csv_length_same_as_qlist[of p x sign qs]
	+ nonzero root_p by auto
	+ have d1: "((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x > 0)) \<longrightarrow> (z_R I sign = 1)"
	+ using assms horiz_vector_helper_pos_ind_R1[where p = "p", where qs = "qs", where sign = "sign", where x = "x", where I = "fst I"]
	+ horiz_vector_helper_pos_ind_R2[where p = "p", where qs = "qs", where sign = "sign", where x = "x", where I = "snd I"] unfolding z_R_def
	+ by auto
	+ have d2: "(z_R I sign = 1) \<longrightarrow> ((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x > 0))"
	+ proof -
	+ have h1: "(z_R I sign = 1) \<longrightarrow> (\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0)"
	+ proof -
	+ have "(prod_list (map (nth (map_sgas sign)) (fst I))) = 1 \<or> (prod_list (map (nth (map_sgas sign)) (fst I))) = 0"
	+ using len consistent_signs_prop_R[where p = "p", where qs = "qs", where x = "x", where sign = "sign"] z_signs_R1[where signs = "sign", where I = "fst I"] assms
	+ unfolding list_constr_def
	+ by auto
	+ then show ?thesis
	+ using z_signs_R1[where signs = "sign", where I = "fst I"] horiz_vector_helper_pos_ind_R1[where sign = "sign", where I = "fst I", where p = "p", where x = "x"] assms
	+ apply (auto)
	+ by (metis (mono_tags, hide_lams) \<open>prod_list (map ((!) (map_sgas sign)) (fst I)) = 1 \<or> prod_list (map ((!) (map_sgas sign)) (fst I)) = 0\<close> mult_zero_left z_R_def)
	+ qed
	+ then have h2: "(z_R I sign = 1) \<longrightarrow> (poly (prod_list (retrieve_polys qs (snd I))) x > 0)"
	+ unfolding z_R_def using assms horiz_vector_helper_pos_ind_R2[where p = "p", where x = "x", where sign = "sign", where qs = "qs", where I ="snd I"]
	+ by (metis horiz_vector_helper_pos_ind_R1 mult.left_neutral)
	+ show ?thesis using h1 h2 by auto
	+ qed
	+ show ?thesis using d1 d2 by blast
	+qed
	+
	+lemma horiz_vector_helper_pos_R:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list*nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ assumes welldefined1: "list_constr (fst I) (length qs)"
	+ assumes welldefined2: "list_constr (snd I) (length qs)"
	+ shows "((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x > 0)) \<longleftrightarrow> (z_R I sign = 1)"
	+ using horiz_vector_helper_pos_ind_R
	+ using nonzero root_p sign_fix welldefined1 welldefined2 by blast
	+
	+lemma horiz_vector_helper_neg_R:
	+ fixes p:: "real poly"
	+ assumes nonzero: "p\<noteq>0"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list*nat list"
	+ fixes sign:: "rat list"
	+ fixes x:: "real"
	+ assumes root_p: "x \<in> {x. poly p x = 0}"
	+ assumes sign_fix: "sign = consistent_sign_vec qs x"
	+ assumes welldefined1: "list_constr (fst I) (length qs)"
	+ assumes welldefined2: "list_constr (snd I) (length qs)"
	+ shows "((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x < 0)) \<longleftrightarrow> (z_R I sign = -1)"
	+proof -
	+ have set_hyp: "sign \<in> set (characterize_consistent_signs_at_roots p qs)"
	+ using in_set_R[of p x sign qs] nonzero root_p sign_fix by blast
	+ have z_hyp: "((z_R I sign = 1) \<or> (z_R I sign = 0) \<or> (z_R I sign = -1))"
	+ using welldefined1 welldefined2 set_hyp z_lemma_R[where sign="sign", where I = "I", where p="p", where qs="qs"] by blast
	+ have d1: "((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x < 0)) \<Longrightarrow> (z_R I sign = -1)"
	+ using horiz_vector_helper_pos_R
	+ using nonzero root_p sign_fix welldefined1 welldefined2
	+ by (smt (verit, ccfv_threshold) horiz_vector_helper_pos_ind_R1 horiz_vector_helper_zer_ind_R2 mem_Collect_eq mult_eq_0_iff z_R_def z_hyp)
	+ have d2: "(z_R I sign = -1) \<Longrightarrow> ((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x < 0))"
	+ using horiz_vector_helper_pos_ind_R1 horiz_vector_helper_zer_ind_R2 nonzero root_p sign_fix welldefined1 welldefined2
	+ by (smt (verit, ccfv_threshold) class_field.neg_1_not_0 consistent_sign_vec_def consistent_signs_prop_R equal_neg_zero horiz_vector_helper_pos_ind_R2 length_map list_all_length list_constr_def mem_Collect_eq mem_Collect_eq mult_cancel_left1 mult_not_zero retrieve_polys_def z_R_def z_signs_R1 zero_neq_one)
	+ then show ?thesis using d1 d2
	+ by linarith
	+qed
	+
	+lemma lhs_dot_rewrite:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list*nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ shows
	+ "(vec_of_list (mtx_row_R signs I) \<bullet> (construct_lhs_vector_R p qs signs)) =
	+ sum_list (map (\<lambda>s. (z_R I s) * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) signs)"
	+proof -
	+ have "p \<noteq> 0" using nonzero by auto
	+ from construct_lhs_vector_cleaner[OF this]
	+ have rhseq: "construct_lhs_vector_R p qs signs =
	+ vec_of_list
	+ (map (\<lambda>s. rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) signs)"
	+ using construct_lhs_vector_cleaner_R nonzero by presburger
	+ have "(vec_of_list (mtx_row_R signs I) \<bullet> (construct_lhs_vector_R p qs signs)) =
	+ sum_list (map2 (*) (mtx_row_R signs I) (map (\<lambda>s. rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) signs))"
	+ unfolding rhseq
	+ apply (intro vec_of_list_dot_rewrite)
	+ by (auto simp add: mtx_row_R_def)
	+ thus ?thesis unfolding mtx_row_R_def
	+ using map2_map_map
	+ by (auto simp add: map2_map_map)
	+qed
	+
	+(* If we have a superset of the signs, we can drop to just the consistent ones *)
	+lemma construct_lhs_vector_drop_consistent_R:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list*nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes welldefined1: "list_constr (fst I) (length qs)"
	+ assumes welldefined2: "list_constr (snd I) (length qs)"
	+ shows
	+ "(vec_of_list (mtx_row_R signs I) \<bullet> (construct_lhs_vector_R p qs signs)) =
	+ (vec_of_list (mtx_row_R (characterize_consistent_signs_at_roots p qs) I) \<bullet>
	+ (construct_lhs_vector_R p qs (characterize_consistent_signs_at_roots p qs)))"
	+proof -
	+ have h0: "\<forall> sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec qs ` set (characterize_root_list_p p) \<and>
	+ 0 < rat_of_nat (card {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = sgn}) \<longrightarrow> z_R I sgn = 0"
	+ proof -
	+ have "\<forall> sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec qs ` set (characterize_root_list_p p) \<and> 0 < rat_of_int (card
	+ {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = sgn}) \<longrightarrow> {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = sgn} \<noteq> {}"
	+ by fastforce
	+ then show ?thesis
	+ proof -
	+ { fix iis :: "rat list"
	+ have ff1: "0 \<noteq> p"
	+ using nonzero rsquarefree_def by blast
	+ obtain rr :: "(real \<Rightarrow> bool) \<Rightarrow> real" where
	+ ff2: "\<And>p. p (rr p) \<or> Collect p = {}"
	+ by moura
	+ { assume "\<exists>is. is = iis \<and> {r. poly p r = 0 \<and> consistent_sign_vec qs r = is} \<noteq> {}"
	+ then have "\<exists>is. consistent_sign_vec qs (rr (\<lambda>r. poly p r = 0 \<and> consistent_sign_vec qs r = is)) = iis \<and> {r. poly p r = 0 \<and> consistent_sign_vec qs r = is} \<noteq> {}"
	+ using ff2
	+ by (metis (mono_tags, lifting))
	+ then have "\<exists>r. poly p r = 0 \<and> consistent_sign_vec qs r = iis"
	+ using ff2
	+ by smt
	+ then have "iis \<in> consistent_sign_vec qs ` set (sorted_list_of_set {r. poly p r = 0})"
	+ using ff1 poly_roots_finite
	+ by (metis (mono_tags) imageI mem_Collect_eq set_sorted_list_of_set) }
	+ then have "iis \<notin> set signs \<or> iis \<in> consistent_sign_vec qs ` set (characterize_root_list_p p) \<or> \<not> 0 < rat_of_int (int (card {r. poly p r = 0 \<and> consistent_sign_vec qs r = iis}))"
	+ by (metis (no_types) \<open>\<forall>sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec qs ` set (characterize_root_list_p p) \<and> 0 < rat_of_int (int (card {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = sgn})) \<longrightarrow> {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = sgn} \<noteq> {}\<close> characterize_root_list_p_def) }
	+ then show ?thesis
	+ by fastforce
	+ qed
	+ qed
	+ then have "\<forall> sgn. sgn \<in> set signs \<and> sgn \<notin> consistent_sign_vec qs ` set (characterize_root_list_p p) \<longrightarrow> ((0 = rat_of_nat (card
	+ {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = sgn}) \<or> z_R I sgn = 0))"
	+ by auto
	+ then have hyp: "\<forall> s. s \<in> set signs \<and> s \<notin> consistent_sign_vec qs ` set (characterize_root_list_p p) \<longrightarrow> (z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}) = 0)"
	+ by auto
	+ then have "(\<Sum>s\<in> set(signs). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ (\<Sum>s\<in>(set (signs) \<inter> (consistent_sign_vec qs ` set (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ proof -
	+ have "set(signs) =(set (signs) \<inter> (consistent_sign_vec qs ` set (characterize_root_list_p p))) \<union>
	+ (set(signs)-(consistent_sign_vec qs ` set (characterize_root_list_p p)))"
	+ by blast
	+ then have sum_rewrite: "(\<Sum>s\<in> set(signs). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ (\<Sum>s\<in> (set (signs) \<inter> (consistent_sign_vec qs ` set (characterize_root_list_p p))) \<union>
	+ (set(signs)-(consistent_sign_vec qs ` set (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ by auto
	+ then have sum_split: "(\<Sum>s\<in> (set (signs) \<inter> (consistent_sign_vec qs ` set (characterize_root_list_p p))) \<union>
	+ (set(signs)-(consistent_sign_vec qs ` set (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))
	+ =
	+(\<Sum>s\<in> (set (signs) \<inter> (consistent_sign_vec qs ` set (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))
	++ (\<Sum>s\<in> (set(signs)-(consistent_sign_vec qs ` set (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ by (metis (no_types, lifting) List.finite_set sum.Int_Diff)
	+ have sum_zero: "(\<Sum>s\<in> (set(signs)-(consistent_sign_vec qs ` set (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) = 0"
	+ using hyp
	+ by (simp add: hyp)
	+ show ?thesis using sum_rewrite sum_split sum_zero by linarith
	+ qed
	+ then have set_eq: "set (remdups
	+ (map (consistent_sign_vec qs)
	+ (characterize_root_list_p p))) = set (signs) \<inter> (consistent_sign_vec qs ` set (characterize_root_list_p p))"
	+ using all_info apply (simp add: characterize_consistent_signs_at_roots_def subset_antisym)
	+ by (smt (z3) Int_subset_iff consistent_sign_vec_def list.set_map map_eq_conv o_apply signs_at_def squash_def subsetI subset_antisym)
	+ have hyp1: "(\<Sum>s\<leftarrow>signs. z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ (\<Sum>s\<in>set (signs). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ using distinct_signs sum_list_distinct_conv_sum_set by blast
	+ have hyp2: "(\<Sum>s\<leftarrow>remdups
	+ (map (consistent_sign_vec qs)
	+ (characterize_root_list_p p)). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))
	+ = (\<Sum>s\<in> set (remdups
	+ (map (consistent_sign_vec qs)
	+ (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ using sum_list_distinct_conv_sum_set by blast
	+ have set_sum_eq: "(\<Sum>s\<in>(set (signs) \<inter> (consistent_sign_vec qs ` set (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ (\<Sum>s\<in> set (remdups
	+ (map (consistent_sign_vec qs)
	+ (characterize_root_list_p p))). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ using set_eq by auto
	+ then have "(\<Sum>s\<leftarrow>signs. z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ (\<Sum>s\<leftarrow>remdups
	+ (map (consistent_sign_vec qs)
	+ (characterize_root_list_p p)). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ using set_sum_eq hyp1 hyp2
	+ using \<open>(\<Sum>s\<in>set signs. z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) = (\<Sum>s\<in>set signs \<inter> consistent_sign_vec qs ` set (characterize_root_list_p p). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))\<close> by linarith
	+ then have "consistent_sign_vec qs ` set (characterize_root_list_p p) \<subseteq> set signs \<Longrightarrow>
	+ (\<And>p qss.
	+ characterize_consistent_signs_at_roots p qss =
	+ remdups (map (consistent_sign_vec qss) (characterize_root_list_p p))) \<Longrightarrow>
	+ (\<Sum>s\<leftarrow>signs. z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ (\<Sum>s\<leftarrow>remdups
	+ (map (consistent_sign_vec qs)
	+ (characterize_root_list_p p)). z_R I s * rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ by linarith
	+ then show ?thesis unfolding lhs_dot_rewrite[OF nonzero]
	+ apply (auto intro!: sum_list_distinct_filter simp add: distinct_signs consistent_sign_vec_def characterize_consistent_signs_at_roots_def)
	+ using all_info consistent_sign_vec_def characterize_consistent_signs_at_roots_def
	+ by (smt (z3) list.set_map map_eq_conv o_apply set_remdups signs_at_def squash_def)
	+qed
	+
	+lemma matrix_equation_helper_step_R:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list*nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes welldefined1: "list_constr (fst I) (length qs)"
	+ assumes welldefined2: "list_constr (snd I) (length qs)"
	+ shows "(vec_of_list (mtx_row_R signs I) \<bullet> (construct_lhs_vector_R p qs signs)) =
	+ rat_of_int (card {x. poly p x = 0 \<and> (\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> poly (prod_list (retrieve_polys qs (snd I))) x > 0}) -
	+ rat_of_int (card {x. poly p x = 0 \<and> (\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> poly (prod_list (retrieve_polys qs (snd I))) x < 0})"
	+proof -
	+ have finset: "finite (set (map (consistent_sign_vec qs) (characterize_root_list_p p)))" by auto
	+ let ?gt = "(set (map (consistent_sign_vec qs) (characterize_root_list_p p)) \<inter> {s. z_R I s = 1})"
	+ let ?lt = " (set (map (consistent_sign_vec qs) (characterize_root_list_p p)) \<inter> {s. z_R I s = -1})"
	+ let ?zer = "(set (map (consistent_sign_vec qs) (characterize_root_list_p p)) \<inter> {s. z_R I s = 0})"
	+ have eq: "set (map (consistent_sign_vec qs) (characterize_root_list_p p)) = (?gt \<union> ?lt) \<union> ?zer"
	+ proof safe
	+ fix x
	+ assume h:"x \<in> set (map (consistent_sign_vec qs) (characterize_root_list_p p))"
	+ "z_R I x \<noteq> 0" "z_R I x \<noteq> - 1"
	+ then have "x \<in> set (characterize_consistent_signs_at_roots p qs)"
	+ unfolding characterize_consistent_signs_at_roots_def
	+ by (smt (verit, del_insts) characterize_consistent_signs_at_roots_def characterize_root_list_p_def imageE in_set_R nonzero poly_roots_finite set_map sorted_list_of_set(1))
	+ thus "z_R I x = 1"
	+ using h welldefined1 welldefined2 z_lemma_R by blast
	+ qed
	+ have sumeq: "(\<Sum>s\<in>(?gt\<union>?lt). z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))
	+ = (\<Sum>s\<in>?gt. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) +
	+ (\<Sum>s\<in>?lt. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ apply (rule sum.union_disjoint) by auto
	+ (* First, drop the signs that are irrelevant *)
	+ from construct_lhs_vector_drop_consistent_R[OF assms(1-5)] have
	+ "vec_of_list (mtx_row_R signs I) \<bullet> construct_lhs_vector_R p qs signs =
	+ vec_of_list (mtx_row_R (characterize_consistent_signs_at_roots p qs) I) \<bullet>
	+ construct_lhs_vector_R p qs (characterize_consistent_signs_at_roots p qs)" .
	+ (* Now we split the sum *)
	+ from lhs_dot_rewrite[OF assms(1)]
	+ moreover have "... =
	+ (\<Sum>s\<leftarrow>characterize_consistent_signs_at_roots p qs.
	+ z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))" .
	+ moreover have "... =
	+ (\<Sum>s\<in>set (map (consistent_sign_vec qs) (characterize_root_list_p p)).
	+ z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))" unfolding characterize_consistent_signs_at_roots_def sum_code[symmetric]
	+ apply (auto)
	+ by (smt (verit, best) consistent_sign_vec_def list.set_map map_eq_conv o_apply signs_at_def squash_def sum.set_conv_list)
	+ moreover have setc1:"... =
	+ (\<Sum>s\<in>(?gt\<union>?lt). z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) +
	+ (\<Sum>s\<in>?zer. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) "
	+ apply (subst eq)
	+ apply (rule sum.union_disjoint) by auto
	+ ultimately have setc: "... =
	+ (\<Sum>s\<in>?gt. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) +
	+ (\<Sum>s\<in>?lt. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) +
	+ (\<Sum>s\<in>?zer. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))"
	+ using sumeq by auto
	+ have "\<forall>s \<in> ?zer. (z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) = 0"
	+ by auto
	+ then have obvzer: "(\<Sum>s\<in>?zer. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) = 0"
	+ by auto
	+ (* Now recharacterize lt, gt*)
	+ have setroots: "set (characterize_root_list_p p) = {x. poly p x = 0}" unfolding characterize_root_list_p_def
	+ using poly_roots_finite nonzero rsquarefree_def set_sorted_list_of_set by blast
	+ have *: "\<And>s. {x. poly p x = 0 \<and> consistent_sign_vec qs x = s} =
	+ {x \<in>{x. poly p x = 0}. consistent_sign_vec qs x = s}"
	+ by auto
	+ have e1: "(\<Sum>s\<in>consistent_sign_vec qs ` {x. poly p x = 0} \<inter> {s. z_R I s = 1}.
	+ card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}) =
	+ (sum (\<lambda>x. if (\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x) > 0 then 1 else 0) {x. poly p x = 0})"
	+ unfolding * apply (rule sum_multicount_gen)
	+ using \<open>finite (set (map (consistent_sign_vec qs) (characterize_root_list_p p)))\<close> setroots apply auto[1]
	+ apply (metis List.finite_set setroots)
	+ proof safe
	+ fix x
	+ assume rt: "poly p x = 0"
	+ then have 1: "{s \<in> consistent_sign_vec qs ` {x. poly p x = 0} \<inter> {s. z_R I s = 1}. consistent_sign_vec qs x = s} =
	+ {s. z_R I s = 1 \<and> consistent_sign_vec qs x = s}"
	+ by auto
	+ have 2: "... = {s. (\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (0 < poly (prod_list (retrieve_polys qs (snd I))) x) \<and> consistent_sign_vec qs x = s}"
	+ using horiz_vector_helper_pos_R assms welldefined1 welldefined2 rt by blast
	+ have 3: "... = (if (\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (0 < poly (prod_list (retrieve_polys qs (snd I))) x) then {consistent_sign_vec qs x} else {})"
	+ by auto
	+ then have "card {s \<in> consistent_sign_vec qs ` {x. poly p x = 0} \<inter> {s. z_R I s = 1}. consistent_sign_vec qs x = s} =
	+ (if ((\<forall>p \<in> set (retrieve_polys qs (fst I)). poly p x = 0) \<and> 0 < poly (prod_list (retrieve_polys qs (snd I))) x)
	+ then 1 else 0)" using 1 2 3 by auto
	+ thus " card
	+ {s \<in> consistent_sign_vec qs ` {x. poly p x = 0} \<inter> {s. z_R I s = 1}.
	+ consistent_sign_vec qs x = s} =
	+ (if (\<forall>p\<in>set (retrieve_polys qs (fst I)). poly p x = 0) \<and>
	+ 0 < poly (prod_list (retrieve_polys qs (snd I))) x
	+ then 1 else 0)"
	+ by auto
	+ qed
	+
	+ have gtchr: "(\<Sum>s\<in>?gt. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ rat_of_int (card {x. poly p x = 0 \<and> (\<forall>p\<in>set (retrieve_polys qs (fst I)). poly p x = 0) \<and> 0 < poly (prod_list (retrieve_polys qs (snd I))) x})"
	+ apply (auto simp add: setroots)
	+ apply (subst of_nat_sum[symmetric])
	+ apply (subst of_nat_eq_iff)
	+ apply (subst e1)
	+ apply (subst card_eq_sum)
	+ apply (rule sum.mono_neutral_cong_right)
	+ apply (metis List.finite_set setroots)
	+ by auto
	+ have e2: " (\<Sum>s\<in>consistent_sign_vec qs ` {x. poly p x = 0} \<inter> {s. z_R I s = - 1}.
	+ card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}) =
	+ (sum (\<lambda>x. if (\<forall>p\<in>set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (poly (prod_list (retrieve_polys qs (snd I))) x) < 0 then 1 else 0) {x. poly p x = 0})"
	+ unfolding * apply (rule sum_multicount_gen)
	+ using \<open>finite (set (map (consistent_sign_vec qs) (characterize_root_list_p p)))\<close> setroots apply auto[1]
	+ apply (metis List.finite_set setroots)
	+ proof safe
	+ fix x
	+ assume rt: "poly p x = 0"
	+ then have 1: "{s \<in> consistent_sign_vec qs ` {x. poly p x = 0} \<inter> {s. z_R I s = -1}. consistent_sign_vec qs x = s} =
	+ {s. z_R I s = -1 \<and> consistent_sign_vec qs x = s}"
	+ by auto
	+ have 2: "... = {s. ((\<forall>p\<in>set (retrieve_polys qs (fst I)). poly p x = 0) \<and> 0 > poly (prod_list (retrieve_polys qs (snd I))) x) \<and> consistent_sign_vec qs x = s}"
	+ using horiz_vector_helper_neg_R assms rt welldefined1 welldefined2 by blast
	+ have 3: "... = (if (\<forall>p\<in>set (retrieve_polys qs (fst I)). poly p x = 0) \<and> (0 > poly (prod_list (retrieve_polys qs (snd I))) x) then {consistent_sign_vec qs x} else {})"
	+ by auto
	+ thus "card {s \<in> consistent_sign_vec qs ` {x. poly p x = 0} \<inter> {s. z_R I s = -1}. consistent_sign_vec qs x = s} =
	+ (if (\<forall>p\<in>set (retrieve_polys qs (fst I)). poly p x = 0) \<and> 0 > poly
	+ (prod_list
	+ (retrieve_polys qs (snd I)))
	+ x
	+ then 1 else 0)" using 1 2 3 by auto
	+ qed
	+ have ltchr: "(\<Sum>s\<in>?lt. z_R I s * rat_of_int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})) =
	+ - rat_of_int (card {x. poly p x = 0 \<and> (\<forall>p\<in>set (retrieve_polys qs (fst I)). poly p x = 0) \<and> 0 > poly (prod_list (retrieve_polys qs (snd I))) x})"
	+ apply (auto simp add: setroots sum_negf)
	+ apply (subst of_nat_sum[symmetric])
	+ apply (subst of_nat_eq_iff)
	+ apply (subst e2)
	+ apply (subst card_eq_sum)
	+ apply (rule sum.mono_neutral_cong_right)
	+ apply (metis List.finite_set setroots)
	+ by auto
	+ show ?thesis using gtchr ltchr obvzer setc
	+ using \<open>(\<Sum>s\<leftarrow>characterize_consistent_signs_at_roots p qs. z_R I s * rat_of_int (int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}))) = (\<Sum>s\<in>set (map (consistent_sign_vec qs) (characterize_root_list_p p)). z_R I s * rat_of_int (int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})))\<close> \<open>vec_of_list (mtx_row_R (characterize_consistent_signs_at_roots p qs) I) \<bullet> construct_lhs_vector_R p qs (characterize_consistent_signs_at_roots p qs) = (\<Sum>s\<leftarrow>characterize_consistent_signs_at_roots p qs. z_R I s * rat_of_int (int (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s})))\<close> \<open>vec_of_list (mtx_row_R signs I) \<bullet> construct_lhs_vector_R p qs signs = vec_of_list (mtx_row_R (characterize_consistent_signs_at_roots p qs) I) \<bullet> construct_lhs_vector_R p qs (characterize_consistent_signs_at_roots p qs)\<close> setc1 by linarith
	+qed
	+
	+lemma matrix_equation_main_step_R:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes I:: "nat list*nat list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes welldefined1: "list_constr (fst I) (length qs)"
	+ assumes welldefined2: "list_constr (snd I) (length qs)"
	+ shows "(vec_of_list (mtx_row_R signs I) \<bullet>
	+ (construct_lhs_vector_R p qs signs)) =
	+ construct_NofI_R p (retrieve_polys qs (fst I)) (retrieve_polys qs (snd I))"
	+proof -
	+ show ?thesis
	+ unfolding construct_NofI_prop_R[OF nonzero]
	+ using matrix_equation_helper_step_R[OF assms]
	+ by linarith
	+qed
	+
	+lemma mtx_row_length_R:
	+ "list_all (\<lambda>r. length r = length signs) (map (mtx_row_R signs) ls)"
	+ apply (induction ls)
	+ by (auto simp add: mtx_row_R_def)
	+
	+(* Shows that as long as we have a "basis" of sign assignments (see assumptions all_info, welldefined),
	+ and some other mild assumptions on our inputs (given in nonzero, distinct_signs), the construction
	+ will be satisfied *)
	+theorem matrix_equation_R:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ fixes subsets:: "(nat list*nat list) list"
	+ fixes signs:: "rat list list"
	+ assumes nonzero: "p\<noteq>0"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes welldefined: "all_list_constr_R (subsets) (length qs)"
	+ shows "satisfy_equation_R p qs subsets signs"
	+ unfolding satisfy_equation_R_def matrix_A_R_def
	+ construct_lhs_vector_R_def construct_rhs_vector_R_def all_list_constr_R_def
	+ apply (subst mult_mat_vec_of_list)
	+ apply (auto simp add: mtx_row_length_R intro!: map_vec_vec_of_list_eq_intro)
	+ using matrix_equation_main_step_R[OF assms(1-3), unfolded construct_lhs_vector_R_def]
	+ using all_list_constr_R_def in_set_member welldefined by fastforce
	+
	+(* Prettifying some theorems*)
	+
	+lemma consistent_signs_at_roots_eq:
	+ assumes "p \<noteq> 0"
	+ shows "consistent_signs_at_roots p qs =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ unfolding consistent_signs_at_roots_def characterize_consistent_signs_at_roots_def
	+ characterize_root_list_p_def
	+ apply auto
	+ apply (subst set_sorted_list_of_set)
	+ using assms poly_roots_finite apply blast
	+ unfolding sgn_vec_def sgn_def signs_at_def squash_def o_def
	+ using roots_def apply auto[1]
	+ by (smt Collect_cong assms image_iff poly_roots_finite roots_def sorted_list_of_set(1))
	+
	+abbreviation w_vec_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> rat vec"
	+ where "w_vec_R \<equiv> construct_lhs_vector_R"
	+
	+abbreviation v_vec_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> (nat list*nat list) list \<Rightarrow> rat vec"
	+ where "v_vec_R \<equiv> construct_rhs_vector_R"
	+
	+abbreviation M_mat_R:: "rat list list \<Rightarrow> (nat list*nat list) list \<Rightarrow> rat mat"
	+ where "M_mat_R \<equiv> matrix_A_R"
	+
	+theorem matrix_equation_pretty:
	+ fixes subsets:: "(nat list*nat list) list"
	+ assumes "p\<noteq>0"
	+ assumes "distinct signs"
	+ assumes "consistent_signs_at_roots p qs \<subseteq> set signs"
	+ assumes "\<And>a b i. (a, b) \<in> set ( subsets) \<Longrightarrow> (i \<in> set a \<or> i \<in> set b) \<Longrightarrow> i < length qs"
	+ shows "M_mat_R signs subsets *\<^sub>v w_vec_R p qs signs = v_vec_R p qs subsets"
	+ unfolding satisfy_equation_R_def[symmetric]
	+ using matrix_equation_R[of p signs qs subsets] assms
	+ using consistent_signs_at_roots_eq unfolding all_list_constr_R_def list_constr_def apply (auto)
	+ by (metis (no_types, lifting) Ball_set in_set_member)
	+
	+section "Base Case"
	+definition satisfies_properties_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> (nat list*nat list) list \<Rightarrow> rat list list \<Rightarrow> rat mat \<Rightarrow> bool"
	+ where "satisfies_properties_R p qs subsets signs matrix =
	+ ( all_list_constr_R subsets (length qs) \<and> well_def_signs (length qs) signs \<and> distinct signs
	+ \<and> satisfy_equation_R p qs subsets signs \<and> invertible_mat matrix \<and> matrix = matrix_A_R signs subsets
	+ \<and> set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)
	+ )"
	+
	+lemma mat_base_case_R:
	+ shows "matrix_A_R [[1],[0],[-1]] [([], []),([0], []),([], [0])] = (mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]])"
	+ unfolding matrix_A_R_def mtx_row_R_def z_R_def map_sgas_def apply (auto)
	+ by (simp add: numeral_3_eq_3)
	+
	+lemma base_case_sgas_R:
	+ fixes q p:: "real poly"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "set (characterize_consistent_signs_at_roots p [q]) \<subseteq> {[1],[0], [- 1]}"
	+ unfolding characterize_consistent_signs_at_roots_def signs_at_def apply (auto)
	+ by (meson squash_def)
	+
	+lemma base_case_sgas_alt_R:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ assumes len1: "length qs = 1"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "set (characterize_consistent_signs_at_roots p qs) \<subseteq> {[1], [0], [- 1]}"
	+proof -
	+ have ex_q: "\<exists>(q::real poly). qs = [q]"
	+ using len1
	+ using length_Suc_conv[of qs 0] by auto
	+ then show ?thesis using base_case_sgas_R nonzero
	+ by auto
	+qed
	+
	+lemma base_case_satisfy_equation_R:
	+ fixes q p:: "real poly"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "satisfy_equation_R p [q] [([], []),([0], []),([], [0])] [[1],[0],[-1]] "
	+proof -
	+ have h1: "set (characterize_consistent_signs_at_roots p [q]) \<subseteq> {[1], [0],[- 1]}"
	+ using base_case_sgas_R assms by auto
	+ have h2: "all_list_constr_R [([], []),([0], []),([], [0])] (Suc 0)" unfolding all_list_constr_R_def
	+ by (simp add: list_constr_def member_def)
	+ then show ?thesis using matrix_equation_R[where p = "p", where qs = "[q]", where signs = "[[1],[0],[-1]] ", where subsets = "[([], []),([0], []),([], [0])]"]
	+ nonzero h1 h2 by auto
	+qed
	+
	+lemma base_case_satisfy_equation_alt_R:
	+ fixes p:: "real poly"
	+ fixes qs:: "real poly list"
	+ assumes len1: "length qs = 1"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "satisfy_equation_R p qs [([], []),([0], []),([], [0])] [[1],[0],[-1]]"
	+proof -
	+ have ex_q: "\<exists>(q::real poly). qs = [q]"
	+ using len1
	+ using length_Suc_conv[of qs 0] by auto
	+ then show ?thesis using base_case_satisfy_equation_R nonzero
	+ by auto
	+qed
	+
	+lemma base_case_matrix_eq:
	+ fixes q p:: "real poly"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "(mult_mat_vec (mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]]) (construct_lhs_vector_R p [q] [[1],[0],[-1]]) =
	+ (construct_rhs_vector_R p [q] [([], []),([0], []),([], [0])]))"
	+ using mat_base_case_R base_case_satisfy_equation_R unfolding satisfy_equation_R_def
	+ by (simp add: nonzero)
	+
	+lemma less_three: "(n::nat) < Suc (Suc (Suc 0)) \<longleftrightarrow> n = 0 \<or> n = 1 \<or> n = 2"
	+ by auto
	+
	+lemma inverse_mat_base_case_R:
	+ shows "inverts_mat (mat_of_rows_list 3 [[1/2, -1/2, 1/2], [0, 1, 0], [1/2, -1/2, -1/2]]::rat mat) (mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]]::rat mat)"
	+ unfolding inverts_mat_def mat_of_rows_list_def mat_eq_iff apply auto
	+ unfolding less_three by (auto simp add: scalar_prod_def)
	+
	+lemma inverse_mat_base_case_2_R:
	+ shows "inverts_mat (mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]]::rat mat) (mat_of_rows_list 3 [[1/2, -1/2, 1/2], [0, 1, 0], [1/2, -1/2, -1/2]]:: rat mat)"
	+ unfolding inverts_mat_def mat_of_rows_list_def mat_eq_iff apply auto
	+ unfolding less_three by (auto simp add: scalar_prod_def)
	+
	+lemma base_case_invertible_mat_R:
	+ shows "invertible_mat (matrix_A_R [[1],[0], [- 1]] [([], []),([0], []),([], [0])])"
	+ unfolding invertible_mat_def using inverse_mat_base_case_R inverse_mat_base_case_2_R
	+ apply (auto)
	+ apply (simp add: mat_base_case mat_of_rows_list_def)
	+ using mat_base_case_R by auto
	+
	+section "Inductive Step"
	+
	+(*** Need some properties of smashing; smashing signs is just as it was in BKR ***)
	+subsection "Lemmas on smashing subsets "
	+
	+definition subsets_first_component_list::"(nat list*nat list) list \<Rightarrow> nat list list"
	+ where "subsets_first_component_list I = map (\<lambda>I. (fst I)) I"
	+
	+definition subsets_second_component_list::"(nat list*nat list) list \<Rightarrow> nat list list"
	+ where "subsets_second_component_list I = map (\<lambda>I. (snd I)) I"
	+
	+definition smash_list_list::"('a list'a list) list \<Rightarrow> ('a list'a list) list \<Rightarrow> ('a list*'a list) list"
	+ where "smash_list_list s1 s2 = concat (map (\<lambda>l1. map (\<lambda>l2. (fst l1 @ fst l2, snd l1 @ snd l2)) s2) s1)"
	+
	+lemma smash_list_list_property_set:
	+ fixes l1 l2 :: "('a list*'a list) list"
	+ fixes a b:: "nat"
	+ shows "\<forall> (elem :: ('a list*'a list)). (elem \<in> (set (smash_list_list l1 l2)) \<longrightarrow>
	+ (\<exists> (elem1:: ('a list'a list)). \<exists> (elem2:: ('a list'a list)).
	+ (elem1 \<in> set(l1) \<and> elem2 \<in> set(l2) \<and> elem = (fst elem1@ fst elem2, snd elem1 @ snd elem2))))"
	+proof clarsimp
	+ fix a b
	+ assume assum: "(a, b) \<in> set (smash_list_list l1 l2)"
	+ show "\<exists>aa ba. (aa, ba) \<in> set l1 \<and> (\<exists>ab bb. (ab, bb) \<in> set l2 \<and> a = aa @ ab \<and> b = ba @ bb)"
	+ using assum unfolding smash_list_list_def
	+ apply (auto) by blast
	+qed
	+
	+
	+lemma subsets_smash_property_R:
	+ fixes subsets1 subsets2 :: "(nat list*nat list) list"
	+ fixes n:: "nat"
	+ shows "\<forall> (elem :: nat list*nat list). (List.member (subsets_smash_R n subsets1 subsets2) elem) \<longrightarrow>
	+ (\<exists> (elem1::nat listnat list). \<exists> (elem2::nat listnat list).
	+ (elem1 \<in> set(subsets1) \<and> elem2 \<in> set(subsets2) \<and> elem = ((fst elem1) @ (map ((+) n) (fst elem2)), (snd elem1) @ (map ((+) n) (snd elem2)))))"
	+proof -
	+ let ?fst_component2 = "subsets_first_component_list subsets2"
	+ let ?snd_component2 = "subsets_second_component_list subsets2"
	+ let ?new_subsets = "map (\<lambda>I. ((map ((+) n)) (fst I), (map ((+) n)) (snd I))) subsets2"
	+ (* a slightly unorthodox use of signs_smash, but it closes the proof *)
	+ have "subsets_smash_R n subsets1 subsets2 = smash_list_list subsets1 ?new_subsets"
	+ unfolding subsets_smash_R_def smash_list_list_def apply (auto)
	+ by (simp add: comp_def)
	+ then show ?thesis using smash_list_list_property_set[of subsets1 ?new_subsets] apply (auto)
	+ using imageE in_set_member set_map smash_list_list_property_set
	+ by (smt (z3) prod.exhaust_sel)
	+qed
	+
	+(* If subsets for smaller systems are well-defined, then subsets for combined systems are, too *)
	+subsection "Well-defined subsets preserved when smashing"
	+
	+lemma well_def_step_R:
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes subsets1 subsets2 :: "(nat list*nat list) list"
	+ assumes well_def_subsets1: "all_list_constr_R (subsets1) (length qs1)"
	+ assumes well_def_subsets2: "all_list_constr_R (subsets2) (length qs2)"
	+ shows "all_list_constr_R ((subsets_smash_R (length qs1) subsets1 subsets2))
	+ (length (qs1 @ qs2))"
	+proof -
	+ let ?n = "(length qs1)"
	+ have h1: "\<forall>elem.
	+ List.member (subsets_smash_R ?n subsets1 subsets2) elem \<longrightarrow>
	+ (\<exists> (elem1::nat listnat list). \<exists> (elem2::nat listnat list).
	+ (elem1 \<in> set(subsets1) \<and> elem2 \<in> set(subsets2) \<and> elem = ((fst elem1) @ (map ((+) ?n) (fst elem2)), (snd elem1) @ (map ((+) ?n) (snd elem2)))))"
	+ using subsets_smash_property_R by blast
	+ have h2: "\<forall>elem1 elem2. (elem1 \<in> set subsets1 \<and> elem2 \<in> set subsets2) \<longrightarrow> list_constr ((fst elem1) @ map ((+) (length qs1)) (fst elem2)) (length (qs1 @ qs2))"
	+ proof clarsimp
	+ fix elem1 b elem2 ba
	+ assume e1: "(elem1, b) \<in> set subsets1"
	+ assume e2: "(elem2, ba) \<in> set subsets2"
	+ have h1: "list_constr elem1 (length qs1 + length qs2) "
	+ proof -
	+ have h1: "list_constr elem1 (length qs1)" using e1 well_def_subsets1
	+ unfolding all_list_constr_R_def
	+ apply (auto)
	+ by (simp add: in_set_member)
	+ then show ?thesis unfolding list_constr_def
	+ by (simp add: list.pred_mono_strong)
	+ qed
	+ have h2: "list_constr (map ((+) (length qs1)) elem2) (length qs1 + length qs2)"
	+ proof -
	+ have h1: "list_constr elem2 (length qs2)" using e2 well_def_subsets2
	+ unfolding all_list_constr_R_def
	+ by (simp add: in_set_member)
	+ then show ?thesis unfolding list_constr_def
	+ by (simp add: list_all_length)
	+ qed
	+ show "list_constr (elem1 @ map ((+) (length qs1)) elem2) (length qs1 + length qs2)"
	+ using h1 h2 list_constr_append
	+ by blast
	+ qed
	+ have h3: "\<forall>elem1 elem2. (elem1 \<in> set subsets1 \<and> elem2 \<in> set subsets2) \<longrightarrow> list_constr ((snd elem1) @ map ((+) (length qs1)) (snd elem2)) (length (qs1 @ qs2))"
	+ proof clarsimp
	+ fix elem1 b elem2 ba
	+ assume e1: "(b, elem1) \<in> set subsets1"
	+ assume e2: "(ba, elem2) \<in> set subsets2"
	+ have h1: "list_constr elem1 (length qs1 + length qs2) "
	+ proof -
	+ have h1: "list_constr elem1 (length qs1)" using e1 well_def_subsets1
	+ unfolding all_list_constr_R_def
	+ apply (auto)
	+ by (simp add: in_set_member)
	+ then show ?thesis unfolding list_constr_def
	+ by (simp add: list.pred_mono_strong)
	+ qed
	+ have h2: "list_constr (map ((+) (length qs1)) elem2) (length qs1 + length qs2)"
	+ proof -
	+ have h1: "list_constr elem2 (length qs2)" using e2 well_def_subsets2
	+ unfolding all_list_constr_R_def
	+ by (simp add: in_set_member)
	+ then show ?thesis unfolding list_constr_def
	+ by (simp add: list_all_length)
	+ qed
	+ show "list_constr (elem1 @ map ((+) (length qs1)) elem2) (length qs1 + length qs2)"
	+ using h1 h2 list_constr_append
	+ by blast
	+ qed
	+ show ?thesis using h1 h2 h3 unfolding all_list_constr_def
	+ by (metis all_list_constr_R_def fst_conv snd_conv)
	+qed
	+
	+subsection "Consistent Sign Assignments Preserved When Smashing"
	+
	+lemma subset_helper_R:
	+ fixes p:: "real poly"
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes signs1 signs2 :: "rat list list"
	+ shows "\<forall> x \<in> set (characterize_consistent_signs_at_roots p (qs1 @ qs2)).
	+ \<exists> x1 \<in> set (characterize_consistent_signs_at_roots p qs1).
	+ \<exists> x2 \<in> set (characterize_consistent_signs_at_roots p qs2).
	+ x = x1@x2"
	+proof clarsimp
	+ fix x
	+ assume x_in: "x \<in> set (characterize_consistent_signs_at_roots p (qs1 @ qs2))"
	+ have x_in_csv: "x \<in> set(map (consistent_sign_vec (qs1 @ qs2)) (characterize_root_list_p p))"
	+ using x_in unfolding characterize_consistent_signs_at_roots_def
	+ by (smt (z3) consistent_sign_vec_def map_eq_conv o_apply set_remdups signs_at_def squash_def)
	+ have csv_hyp: "\<forall>r. consistent_sign_vec (qs1 @ qs2) r = (consistent_sign_vec qs1 r)@(consistent_sign_vec qs2 r)"
	+ unfolding consistent_sign_vec_def by auto
	+ have exr_iff: "(\<exists>r \<in> set (characterize_root_list_p p). x = consistent_sign_vec (qs1 @ qs2) r) \<longleftrightarrow> (\<exists>r \<in> set (characterize_root_list_p p). x = (consistent_sign_vec qs1 r)@(consistent_sign_vec qs2 r))"
	+ using csv_hyp by auto
	+ have exr: "x \<in> set(map (consistent_sign_vec (qs1 @ qs2)) (characterize_root_list_p p)) \<longrightarrow> (\<exists>r \<in> set (characterize_root_list_p p). x = consistent_sign_vec (qs1 @ qs2) r)"
	+ by auto
	+ have mem_list1: "\<forall> r \<in> set (characterize_root_list_p p). (consistent_sign_vec qs1 r) \<in> set(map (consistent_sign_vec qs1) (characterize_root_list_p p))"
	+ by simp
	+ have mem_list2: "\<forall> r \<in> set (characterize_root_list_p p). (consistent_sign_vec qs2 r) \<in> set(map (consistent_sign_vec qs2) (characterize_root_list_p p))"
	+ by simp
	+ then show "\<exists>x1\<in>set (characterize_consistent_signs_at_roots p qs1).
	+ \<exists>x2\<in>set (characterize_consistent_signs_at_roots p qs2). x = x1 @ x2"
	+ using x_in_csv exr mem_list1 mem_list2 characterize_consistent_signs_at_roots_def exr_iff
	+ using imageE image_eqI map_append set_map set_remdups signs_at_def x_in
	+ by auto
	+qed
	+
	+lemma subset_step_R:
	+ fixes p:: "real poly"
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes signs1 signs2 :: "rat list list"
	+ assumes csa1: "set (characterize_consistent_signs_at_roots p qs1) \<subseteq> set (signs1)"
	+ assumes csa2: "set (characterize_consistent_signs_at_roots p qs2) \<subseteq> set (signs2)"
	+ shows "set (characterize_consistent_signs_at_roots p
	+ (qs1 @ qs2))
	+ \<subseteq> set (signs_smash signs1 signs2)"
	+proof -
	+ have h0: "\<forall> x \<in> set (characterize_consistent_signs_at_roots p (qs1 @ qs2)). \<exists> x1 \<in> set (characterize_consistent_signs_at_roots p qs1). \<exists> x2 \<in> set (characterize_consistent_signs_at_roots p qs2).
	+ (x = x1@x2)" using subset_helper_R[of p qs1 qs2]
	+ by blast
	+ then have "\<forall>x \<in> set (characterize_consistent_signs_at_roots p (qs1 @ qs2)).
	+ x \<in> set (signs_smash (characterize_consistent_signs_at_roots p qs1)
	+ (characterize_consistent_signs_at_roots p qs2))"
	+ unfolding signs_smash_def apply (auto)
	+ by fastforce
	+ then have "\<forall>x \<in> set (characterize_consistent_signs_at_roots p
	+ (qs1 @ qs2)). x \<in> set (signs_smash signs1 signs2)"
	+ using csa1 csa2 subset_smash_signs[of _ signs1 _ signs2] apply (auto)
	+ by blast
	+ thus ?thesis
	+ by blast
	+qed
	+
	+subsection "Main Results"
	+lemma dim_row_matrix_A_R[simp]:
	+ shows "dim_row (matrix_A_R signs subsets) = length subsets"
	+ unfolding matrix_A_R_def by auto
	+
	+lemma dim_col_matrix_A_R[simp]:
	+ shows "dim_col (matrix_A_R signs subsets) = length signs"
	+ unfolding matrix_A_R_def by auto
	+
	+lemma length_subsets_smash_R:
	+ shows
	+ "length (subsets_smash_R n subs1 subs2) = length subs1 * length subs2"
	+ unfolding subsets_smash_R_def length_concat
	+ by (auto simp add: o_def sum_list_triv)
	+
	+lemma z_append_R:
	+ fixes xs:: "(nat list * nat list)"
	+ assumes "\<And>i. i \<in> set (fst xs) \<Longrightarrow> i < length as"
	+ assumes "\<And>i. i \<in> set (snd xs) \<Longrightarrow> i < length as"
	+ shows "z_R ((fst xs) @ (map ((+) (length as)) (fst ys)), (snd xs) @ (map ((+) (length as)) (snd ys))) (as @ bs) = z_R xs as * z_R ys bs"
	+proof -
	+ have 1: "map ((!) (as @ bs)) (fst xs) = map ((!) as) (fst xs)"
	+ unfolding list_eq_iff_nth_eq
	+ using assms by (auto simp add:nth_append)
	+ have 2: "map ((!) (as @ bs) \<circ> (+) (length as)) (fst ys) = map ((!) bs) (fst ys)"
	+ unfolding list_eq_iff_nth_eq
	+ using assms by auto
	+ have 3: "map ((!) (as @ bs)) (snd xs) = map ((!) as) (snd xs)"
	+ unfolding list_eq_iff_nth_eq
	+ using assms by (auto simp add:nth_append)
	+ have 4: "map ((!) (as @ bs) \<circ> (+) (length as)) (snd ys) = map ((!) bs) (snd ys)"
	+ unfolding list_eq_iff_nth_eq
	+ using assms by auto
	+ show ?thesis
	+ unfolding z_R_def apply auto
	+ unfolding 1 2 3 4 apply (auto)
	+ by (smt (z3) assms(1) comp_apply length_map map_append map_eq_conv map_sgas_def nth_append nth_append_length_plus)
	+qed
	+
	+(* Shows that the matrix of a smashed system is the Kronecker product of the matrices of the two
	+ systems being combined *)
	+lemma matrix_construction_is_kronecker_product_R:
	+ fixes qs1 :: "real poly list"
	+ fixes subs1 subs2 :: "(nat list*nat list) list"
	+ fixes signs1 signs2 :: "rat list list"
	+ (* n1 is the number of polynomials in the "1" sets *)
	+ assumes "\<And>l i. l \<in> set subs1 \<Longrightarrow> (i \<in> set (fst l) \<or> i \<in> set (snd l)) \<Longrightarrow> i < n1"
	+ assumes "\<And>j. j \<in> set signs1 \<Longrightarrow> length j = n1"
	+ shows "(matrix_A_R (signs_smash signs1 signs2) (subsets_smash_R n1 subs1 subs2)) =
	+ kronecker_product (matrix_A_R signs1 subs1) (matrix_A_R signs2 subs2)"
	+ unfolding mat_eq_iff dim_row_matrix_A_R dim_col_matrix_A_R
	+ length_subsets_smash_R length_signs_smash dim_kronecker
	+proof safe
	+ fix i j
	+ assume i: "i < length subs1 * length subs2"
	+ assume j: "j < length signs1 * length signs2"
	+
	+ have ld: "i div length subs2 < length subs1"
	+ "j div length signs2 < length signs1"
	+ using i j less_mult_imp_div_less by auto
	+ have lm: "i mod length subs2 < length subs2"
	+ "j mod length signs2 < length signs2"
	+ using i j less_mult_imp_mod_less by auto
	+
	+ have n1: "n1 = length (signs1 ! (j div length signs2))"
	+ using assms(2) ld(2) nth_mem by blast
	+
	+ have 1: "matrix_A_R (signs_smash signs1 signs2) (subsets_smash_R n1 subs1 subs2) $$ (i, j) =
	+ z_R (subsets_smash_R n1 subs1 subs2 ! i) (signs_smash signs1 signs2 ! j)"
	+ unfolding mat_of_rows_list_def matrix_A_R_def mtx_row_R_def
	+ using i j by (auto simp add: length_signs_smash length_subsets_smash_R)
	+ have 2: " ... = z_R ((fst (subs1 ! (i div length subs2)) @ map ((+) n1) (fst(subs2 ! (i mod length subs2)))),
	+ (snd (subs1 ! (i div length subs2)) @ map ((+) n1) (snd (subs2 ! (i mod length subs2)))))
	+ (signs1 ! (j div length signs2) @ signs2 ! (j mod length signs2))"
	+ unfolding signs_smash_def subsets_smash_R_def
	+ apply (subst length_eq_concat)
	+ using i apply (auto simp add: mult.commute)
	+ apply (subst length_eq_concat)
	+ using j apply (auto simp add: mult.commute)
	+ using ld lm by auto
	+ have 3: "... =
	+ z_R (subs1 ! (i div length subs2)) (signs1 ! (j div length signs2)) *
	+ z_R (subs2 ! (i mod length subs2)) (signs2 ! (j mod length signs2))"
	+ unfolding n1
	+ apply (subst z_append_R)
	+ apply (auto simp add: n1[symmetric])
	+ using assms(1) ld(1) nth_mem
	+ apply blast
	+ using assms(1) ld(1) nth_mem by blast
	+ have 4: "kronecker_product (matrix_A_R signs1 subs1) (matrix_A_R signs2 subs2) $$ (i,j) =
	+ z_R (subs1 ! (i div length subs2))
	+ (signs1 ! (j div length signs2)) *
	+ z_R (subs2 ! (i mod length subs2))
	+ (signs2 ! (j mod length signs2))"
	+ unfolding kronecker_product_def matrix_A_R_def mat_of_rows_list_def mtx_row_R_def
	+ using i j apply (auto simp add: Let_def)
	+ apply (subst index_mat(1)[OF ld])
	+ apply (subst index_mat(1)[OF lm])
	+ using ld lm by auto
	+ show "matrix_A_R (signs_smash signs1 signs2) (subsets_smash_R n1 subs1 subs2) $$ (i, j) =
	+ kronecker_product (matrix_A_R signs1 subs1) (matrix_A_R signs2 subs2) $$ (i, j)"
	+ using 1 2 3 4 by auto
	+qed
	+
	+(* Given that two smaller systems satisfy some mild constraints, show that their combined system
	+ (after smashing the signs and subsets) satisfies the matrix equation, and that the matrix of the
	+ combined system is invertible. *)
	+lemma inductive_step_R:
	+ fixes p:: "real poly"
	+ fixes qs1 qs2 :: "real poly list"
	+ fixes subsets1 subsets2 :: "(nat list*nat list) list"
	+ fixes signs1 signs2 :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs1) signs1"
	+ assumes welldefined_signs2: "well_def_signs (length qs2) signs2"
	+ assumes distinct_signs1: "distinct signs1"
	+ assumes distinct_signs2: "distinct signs2"
	+ assumes all_info1: "set (characterize_consistent_signs_at_roots p qs1) \<subseteq> set(signs1)"
	+ assumes all_info2: "set (characterize_consistent_signs_at_roots p qs2) \<subseteq> set(signs2)"
	+ assumes welldefined_subsets1: "all_list_constr_R (subsets1) (length qs1)"
	+ assumes welldefined_subsets2: "all_list_constr_R (subsets2) (length qs2)"
	+ assumes invertibleMtx1: "invertible_mat (matrix_A_R signs1 subsets1)"
	+ assumes invertibleMtx2: "invertible_mat (matrix_A_R signs2 subsets2)"
	+ shows "satisfy_equation_R p (qs1@qs2) (subsets_smash_R (length qs1) subsets1 subsets2) (signs_smash signs1 signs2)
	+ \<and> invertible_mat (matrix_A_R (signs_smash signs1 signs2) (subsets_smash_R (length qs1) subsets1 subsets2))"
	+proof -
	+ have h1: "invertible_mat (matrix_A_R (signs_smash signs1 signs2) (subsets_smash_R (length qs1) subsets1 subsets2))"
	+ using matrix_construction_is_kronecker_product_R
	+ kronecker_invertible invertibleMtx1 invertibleMtx2
	+ welldefined_subsets1 welldefined_subsets2 unfolding all_list_constr_R_def list_constr_def
	+ using Ball_set in_set_member well_def_signs_def welldefined_signs1 in_set_conv_nth list_all_length
	+ apply (auto)
	+ by (smt (z3) Ball_set kronecker_invertible member_def)
	+ have h2a: "distinct (signs_smash signs1 signs2)"
	+ using distinct_signs1 distinct_signs2 welldefined_signs1 welldefined_signs2 nontriv1 nontriv2
	+ distinct_step by auto
	+ have h2c: "all_list_constr_R ((subsets_smash_R (length qs1) subsets1 subsets2)) (length (qs1@qs2))"
	+ using well_def_step_R
	+ welldefined_subsets1 welldefined_subsets2
	+ by blast
	+ have h2d: "set (characterize_consistent_signs_at_roots p (qs1@qs2)) \<subseteq> set(signs_smash signs1 signs2)"
	+ using subset_step_R all_info1 all_info2
	+ by simp
	+ have h2: "satisfy_equation_R p (qs1@qs2) (subsets_smash_R (length qs1) subsets1 subsets2) (signs_smash signs1 signs2)"
	+ using matrix_equation_R[where p="p", where qs="qs1@qs2", where subsets = "subsets_smash_R (length qs1) subsets1 subsets2",
	+ where signs = "signs_smash signs1 signs2"]
	+ h2a h2c h2d apply (auto) using nonzero by blast
	+ show ?thesis using h1 h2 by blast
	+qed
	+
	+section "Reduction Step Proofs"
	+ (* Some definitions *)
	+definition get_matrix_R:: "(rat mat \<times> ((nat list*nat list) list \<times> rat list list)) \<Rightarrow> rat mat"
	+ where "get_matrix_R data = fst(data)"
	+
	+definition get_subsets_R:: "(rat mat \<times> ((nat listnat list) list \<times> rat list list)) \<Rightarrow> (nat listnat list) list"
	+ where "get_subsets_R data = fst(snd(data))"
	+
	+definition get_signs_R:: "(rat mat \<times> ((nat list*nat list) list \<times> rat list list)) \<Rightarrow> rat list list"
	+ where "get_signs_R data = snd(snd(data))"
	+
	+definition reduction_signs_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> (nat list*nat list) list \<Rightarrow> rat mat \<Rightarrow> rat list list"
	+ where "reduction_signs_R p qs signs subsets matr =
	+ (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets matr)))"
	+
	+definition reduction_subsets_R:: "real poly \<Rightarrow> real poly list \<Rightarrow> rat list list \<Rightarrow> (nat listnat list) list \<Rightarrow> rat mat \<Rightarrow> (nat listnat list) list"
	+ where "reduction_subsets_R p qs signs subsets matr =
	+ (take_indices subsets (rows_to_keep (reduce_mat_cols matr (solve_for_lhs_R p qs subsets matr))))"
	+
	+(* Some basic lemmas *)
	+lemma reduction_signs_is_get_signs_R: "reduction_signs_R p qs signs subsets m = get_signs_R (reduce_system_R p (qs, (m, (subsets, signs))))"
	+ unfolding reduction_signs_R_def get_signs_R_def apply (simp)
	+ using reduction_step_R.elims snd_conv
	+ by metis
	+
	+lemma reduction_subsets_is_get_subsets_R: "reduction_subsets_R p qs signs subsets m = get_subsets_R (reduce_system_R p (qs, (m, (subsets, signs))))"
	+ unfolding reduction_subsets_R_def get_subsets_R_def
	+ using reduce_system.simps reduction_step.elims fst_conv snd_conv
	+ by (metis reduce_system_R.simps reduction_step_R.simps)
	+
	+subsection "Showing sign conditions preserved when reducing"
	+
	+lemma take_indices_lem_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes arb_list :: "('a list*'a list) list"
	+ fixes index_list :: "nat list"
	+ fixes n:: "nat"
	+ assumes lest: "n < length (take_indices arb_list index_list)"
	+ assumes well_def: "\<forall>q.(List.member index_list q \<longrightarrow> q < length arb_list)"
	+ shows "\<exists>k<length arb_list.
	+ (take_indices arb_list index_list) ! n = arb_list ! k"
	+ using lest well_def unfolding take_indices_def apply (auto)
	+ by (metis member_def nth_mem)
	+
	+lemma size_of_mat_R:
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ shows "(matrix_A_R signs subsets) \<in> carrier_mat (length subsets) (length signs)"
	+ unfolding matrix_A_R_def carrier_mat_def by auto
	+
	+lemma size_of_lhs_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes signs :: "rat list list"
	+ shows "dim_vec (construct_lhs_vector_R p qs signs) = length signs"
	+ unfolding construct_lhs_vector_R_def
	+ by simp
	+
	+lemma size_of_rhs_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ shows "dim_vec (construct_rhs_vector_R p qs subsets) = length subsets"
	+ unfolding construct_rhs_vector_R_def
	+ by simp
	+
	+lemma same_size_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes invertible_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "length subsets = length signs"
	+ using invertible_mat unfolding invertible_mat_def
	+ using size_of_mat_R[of signs subsets] size_of_lhs_R[of p qs signs] size_of_rhs_R[of p qs subsets]
	+ by simp
	+
	+lemma construct_lhs_matches_solve_for_lhs_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "(construct_lhs_vector_R p qs signs) = solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)"
	+proof -
	+ have matrix_equation_hyp: "(mult_mat_vec (matrix_A_R signs subsets) (construct_lhs_vector_R p qs signs) = (construct_rhs_vector_R p qs subsets))"
	+ using match unfolding satisfy_equation_R_def by blast
	+ then have eqn_hyp: " ((matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A_R signs subsets) (construct_lhs_vector_R p qs signs)) =
	+ mult_mat_vec (matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) (construct_rhs_vector_R p qs subsets))"
	+ using invertible_mat
	+ by (simp add: matrix_equation_hyp)
	+ have match_hyp: "length subsets = length signs" using same_size_R invertible_mat by auto
	+ then have dim_hyp1: "matrix_A_R signs subsets \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ then have dim_hyp2: "matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets)) \<in> carrier_mat (length signs) (length signs)"
	+ using invertible_mat dim_invertible
	+ by blast
	+ have mult_assoc_hyp: "((matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A_R signs subsets) (construct_lhs_vector_R p qs signs)))
	+ = (((matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) * (matrix_A_R signs subsets)) *\<^sub>v (construct_lhs_vector_R p qs signs))"
	+ using mult_assoc dim_hyp1 dim_hyp2 size_of_lhs_R by auto
	+ have cancel_helper: "(((matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) * (matrix_A_R signs subsets)) *\<^sub>v (construct_lhs_vector_R p qs signs))
	+ = (1\<^sub>m (length signs)) *\<^sub>v (construct_lhs_vector_R p qs signs)"
	+ using invertible_means_mult_id[where A= "matrix_A_R signs subsets"] dim_hyp1
	+ by (simp add: invertible_mat match_hyp)
	+ then have cancel_hyp: "(((matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) * (matrix_A_R signs subsets)) *\<^sub>v (construct_lhs_vector_R p qs signs))
	+ = (construct_lhs_vector_R p qs signs)"
	+ apply (auto)
	+ by (metis carrier_vec_dim_vec one_mult_mat_vec size_of_lhs_R)
	+ then have mult_hyp: "((matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) *\<^sub>v (mult_mat_vec (matrix_A_R signs subsets) (construct_lhs_vector_R p qs signs)))
	+ = (construct_lhs_vector_R p qs signs)"
	+ using mult_assoc_hyp cancel_hyp
	+ by simp
	+ then have "(construct_lhs_vector_R p qs signs) = (mult_mat_vec (matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets))) (construct_rhs_vector_R p qs subsets)) "
	+ using eqn_hyp
	+ by simp
	+ then show ?thesis
	+ unfolding solve_for_lhs_R_def
	+ by (simp add: mat_inverse_same)
	+qed
	+
	+(* Then show that dropping columns doesn't affect the consistent sign assignments *)
	+lemma reduction_doesnt_break_things_signs_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(reduction_signs_R p qs signs subsets (matrix_A_R signs subsets))"
	+proof -
	+ have dim_hyp2: "matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets)) \<in> carrier_mat (length signs) (length signs)"
	+ using invertible_mat dim_invertible
	+ using same_size_R by fastforce
	+ have "(construct_lhs_vector_R p qs signs) = solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs_R assms by auto
	+ then have "(solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) =
	+ vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}) signs))"
	+ using construct_lhs_vector_cleaner_R assms
	+ by (metis (mono_tags, lifting) list.map_cong map_map o_apply of_int_of_nat_eq)
	+ then have "\<forall> n < (dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))).
	+ (((solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) $ n = 0) \<longrightarrow>
	+ (nth signs n) \<notin> set (characterize_consistent_signs_at_roots p qs))"
	+ proof -
	+ have h0: "\<forall> n < (dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))).
	+ (((solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) $ n = 0) \<longrightarrow>
	+ rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = (nth signs n)}) = 0)"
	+ by (metis (mono_tags, lifting) \<open>construct_lhs_vector_R p qs signs = solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)\<close> construct_lhs_vector_clean_R nonzero of_nat_0_eq_iff of_rat_of_nat_eq size_of_lhs_R)
	+ have h1: "\<forall> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}) = 0 \<longrightarrow>
	+ (\<nexists> x. poly p x = 0 \<and> consistent_sign_vec qs x = w))"
	+ proof clarsimp
	+ fix x
	+ assume card_asm: "card {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = consistent_sign_vec qs x} = 0"
	+ assume zero_asm: "poly p x = 0"
	+ have card_hyp: "{xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = consistent_sign_vec qs x} = {}"
	+ using card_eq_0_iff
	+ using card_asm nonzero poly_roots_finite
	+ by (metis (full_types) finite_Collect_conjI)
	+ have "x \<in> {xa. poly p xa = 0 \<and> consistent_sign_vec qs xa = consistent_sign_vec qs x}"
	+ using zero_asm by auto
	+ thus "False" using card_hyp
	+ by blast
	+ qed
	+ have h2: "\<And> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}) = 0 \<Longrightarrow>
	+ (\<not>List.member (characterize_consistent_signs_at_roots p qs) w))"
	+ proof clarsimp
	+ fix w
	+ assume card_asm: "card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w} = 0"
	+ assume mem_asm: "List.member (characterize_consistent_signs_at_roots p qs) w"
	+ have h0: "\<nexists> x. poly p x = 0 \<and> consistent_sign_vec qs x = w" using h1 card_asm
	+ by (simp add: h1)
	+ have h1: "\<exists> x. poly p x = 0 \<and> consistent_sign_vec qs x = w" using mem_asm
	+ unfolding characterize_consistent_signs_at_roots_def characterize_root_list_p_def
	+ proof -
	+ have "w \<in> Collect (List.member (remdups (map (consistent_sign_vec qs) (sorted_list_of_set {r. poly p r = 0}))))"
	+ using characterize_consistent_signs_at_roots_def mem_asm characterize_root_list_p_def
	+ by (smt (verit, ccfv_SIG) consistent_sign_vec_def h0 imageE in_set_member list.set_map map_cong mem_Collect_eq nonzero o_apply poly_roots_finite set_remdups set_sorted_list_of_set signs_at_def squash_def)
	+ then have f1: "w \<in> set (map (consistent_sign_vec qs) (sorted_list_of_set {r. poly p r = 0}))"
	+ by (metis (no_types) in_set_member mem_Collect_eq set_remdups)
	+ have "finite {r. poly p r = 0}"
	+ using nonzero poly_roots_finite by blast
	+ then show ?thesis
	+ using f1 by auto
	+ qed
	+ show "False" using h0 h1 by auto
	+ qed
	+ then have h3: "\<forall> w. rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}) = 0 \<longrightarrow>
	+ w \<notin> set (characterize_consistent_signs_at_roots p qs)"
	+ by (simp add: in_set_member)
	+ show ?thesis using h0 h3
	+ by blast
	+ qed
	+ then have "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set (take_indices signs
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))"
	+ using all_info
	+ reduction_signs_set_helper_lemma[where A = "set (characterize_consistent_signs_at_roots p qs)", where B = "signs",
	+ where C = "(solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))"]
	+ using dim_hyp2 solve_for_lhs_R_def by (simp add: mat_inverse_same)
	+ then show ?thesis unfolding reduction_signs_R_def by auto
	+qed
	+
	+lemma reduction_deletes_bad_sign_conds_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "set (characterize_consistent_signs_at_roots p qs) = set(reduction_signs_R p qs signs subsets (matrix_A_R signs subsets))"
	+proof -
	+ have dim_hyp2: "matr_option (dim_row (matrix_A_R signs subsets))
	+ (mat_inverse (matrix_A_R signs subsets)) \<in> carrier_mat (length signs) (length signs)"
	+ using invertible_mat dim_invertible
	+ using same_size_R by fastforce
	+ have supset: "set (characterize_consistent_signs_at_roots p qs) \<supseteq> set(reduction_signs_R p qs signs subsets (matrix_A_R signs subsets))"
	+ proof -
	+ have "(construct_lhs_vector_R p qs signs) = solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs_R assms by auto
	+ then have "(solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) =
	+ vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}) signs))"
	+ using construct_lhs_vector_cleaner_R assms
	+ by (metis (mono_tags, lifting) list.map_cong map_map o_apply of_int_of_nat_eq)
	+ then have "\<forall> n < (dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))).
	+ (((solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) $ n \<noteq> 0) \<longrightarrow>
	+ (nth signs n) \<in> set (characterize_consistent_signs_at_roots p qs))"
	+ proof -
	+ have h0: "\<forall> n < (dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))).
	+ (((solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) $ n = 0) \<longrightarrow>
	+ rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = (nth signs n)}) = 0)"
	+ by (simp add: \<open>solve_for_lhs_R p qs subsets (M_mat_R signs subsets) = vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}) signs))\<close> vec_of_list_index)
	+ have h1: "\<forall> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}) \<noteq> 0 \<longrightarrow>
	+ (\<exists> x. poly p x = 0 \<and> consistent_sign_vec qs x = w))"
	+ proof clarsimp
	+ fix w
	+ assume card_asm: "0 < card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}"
	+ show "\<exists>x. poly p x = 0 \<and> consistent_sign_vec qs x = w"
	+ by (metis (mono_tags, lifting) Collect_empty_eq card_asm card_eq_0_iff gr_implies_not0)
	+ qed
	+ have h2: "\<And> w. (rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}) \<noteq> 0 \<Longrightarrow>
	+ (List.member (characterize_consistent_signs_at_roots p qs) w))"
	+ proof clarsimp
	+ fix w
	+ assume card_asm: " 0 < card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}"
	+ have h0: "\<exists>x. poly p x = 0 \<and> consistent_sign_vec qs x = w"
	+ using card_asm
	+ by (simp add: h1)
	+ then show "List.member (characterize_consistent_signs_at_roots p qs) w"
	+ unfolding characterize_consistent_signs_at_roots_def
	+ using in_set_member nonzero poly_roots_finite characterize_root_list_p_def
	+ by (smt (verit) characterize_consistent_signs_at_roots_def in_set_R mem_Collect_eq)
	+ qed
	+ then have h3: "\<forall> w. rat_of_nat (card {x. poly p x = 0 \<and> consistent_sign_vec qs x = w}) \<noteq> 0 \<longrightarrow>
	+ w \<in> set (characterize_consistent_signs_at_roots p qs)"
	+ by (simp add: in_set_member)
	+ show ?thesis using h0 h3
	+ by (metis (no_types, lifting) \<open>solve_for_lhs_R p qs subsets (matrix_A_R signs subsets) = vec_of_list (map rat_of_nat (map (\<lambda>s. card {x. poly p x = 0 \<and> consistent_sign_vec qs x = s}) signs))\<close> dim_vec_of_list length_map nth_map vec_of_list_index)
	+ qed
	+ then have "set (take_indices signs
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))) \<subseteq>
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ using all_info
	+ reduction_signs_set_helper_lemma2[where A = "set (characterize_consistent_signs_at_roots p qs)", where B = "signs",
	+ where C = "(solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))"]
	+ using distinct_signs dim_hyp2 solve_for_lhs_R_def
	+ by (simp add: mat_inverse_same)
	+ then show ?thesis unfolding reduction_signs_R_def by auto
	+ qed
	+ have subset: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(reduction_signs_R p qs signs subsets (matrix_A_R signs subsets))"
	+ using reduction_doesnt_break_things_signs_R[of p qs signs subsets] assms
	+ by blast
	+ then show ?thesis using supset subset by auto
	+qed
	+
	+
	+theorem reduce_system_sign_conditions_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "set (get_signs_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs))))) = set (characterize_consistent_signs_at_roots p qs)"
	+ unfolding get_signs_R_def
	+ using reduction_deletes_bad_sign_conds_R[of p qs signs subsets] apply (auto)
	+ apply (simp add: all_info distinct_signs match nonzero reduction_signs_def welldefined_signs1)
	+ using nonzero invertible_mat snd_conv
	+ apply (metis reduction_signs_R_def)
	+ by (metis all_info distinct_signs invertible_mat match nonzero reduction_signs_R_def snd_conv welldefined_signs1)
	+
	+subsection "Showing matrix equation preserved when reducing"
	+
	+lemma reduce_system_matrix_equation_preserved_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs: "well_def_signs (length qs) signs"
	+ assumes welldefined_subsets: "all_list_constr_R (subsets) (length qs)"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ assumes invertible_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "satisfy_equation_R p qs (get_subsets_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))
	+ (get_signs_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))"
	+proof -
	+ have poly_type_hyp: "p \<noteq> 0" using nonzero by auto
	+ have distinct_signs_hyp: "distinct (snd (snd (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs))))))"
	+ proof -
	+ let ?sym = "(find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ have h1: "\<forall> i < length (take_indices signs ?sym). \<forall>j < length(take_indices signs ?sym).
	+ i \<noteq> j \<longrightarrow> nth (take_indices signs ?sym) i \<noteq> nth (take_indices signs ?sym) j"
	+ using distinct_signs unfolding take_indices_def
	+ proof clarsimp
	+ fix i
	+ fix j
	+ assume "distinct signs"
	+ assume "i < length
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ assume "j < length
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ assume neq_hyp: "i \<noteq> j"
	+ assume "signs ! (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets
	+ (matrix_A_R signs subsets)) ! i) =
	+ signs ! (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets
	+ (matrix_A_R signs subsets)) ! j)"
	+ have h1: "find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets
	+ (matrix_A_R signs subsets)) ! i \<noteq> find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets
	+ (matrix_A_R signs subsets)) ! j"
	+ unfolding find_nonzeros_from_input_vec_def using neq_hyp
	+ by (metis \<open>i < length (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))\<close> \<open>j < length (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))\<close> distinct_conv_nth distinct_filter distinct_upt find_nonzeros_from_input_vec_def)
	+ then show "False" using distinct_signs
	+ proof -
	+ have f1: "\<forall>p ns n. ((n::nat) \<in> {n \<in> set ns. p n}) = (n \<in> set ns \<and> n \<in> Collect p)"
	+ by simp
	+ then have f2: "filter (\<lambda>n. solve_for_lhs_R p qs subsets (matrix_A_R signs subsets) $ n \<noteq> 0) [0..<dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))] ! i \<in> set [0..<length signs]"
	+ by (metis (full_types) \<open>i < length (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))\<close> construct_lhs_matches_solve_for_lhs_R find_nonzeros_from_input_vec_def invertible_mat match nth_mem set_filter size_of_lhs_R)
	+ have "filter (\<lambda>n. solve_for_lhs_R p qs subsets (matrix_A_R signs subsets) $ n \<noteq> 0) [0..<dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))] ! j \<in> set [0..<length signs]"
	+ using f1 by (metis (full_types) \<open>j < length (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))\<close> construct_lhs_matches_solve_for_lhs_R find_nonzeros_from_input_vec_def invertible_mat match nth_mem set_filter size_of_lhs_R)
	+ then show ?thesis
	+ using f2 by (metis \<open>signs ! (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) ! i) = signs ! (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) ! j)\<close> atLeastLessThan_iff distinct_conv_nth distinct_signs find_nonzeros_from_input_vec_def h1 set_upt)
	+ qed
	+ qed
	+ then have "distinct (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))"
	+ using distinct_conv_nth by blast
	+ then show ?thesis
	+ using get_signs_R_def reduction_signs_R_def reduction_signs_is_get_signs_R by auto
	+ qed
	+ have all_info_hyp: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(snd (snd (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs))))))"
	+ using reduce_system_sign_conditions_R assms unfolding get_signs_R_def by auto
	+ have welldefined_hyp: "all_list_constr_R (fst (snd (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))) (length qs)"
	+ using welldefined_subsets rows_to_keep_lem
	+ unfolding all_list_constr_R_def List.member_def list_constr_def list_all_def
	+ apply (auto simp add: Let_def take_indices_def take_cols_from_matrix_def)
	+ using nth_mem
	+ apply (smt (z3) mat_of_cols_carrier(2) rows_to_keep_lem)
	+ by (smt (z3) mat_of_cols_carrier(2) nth_mem rows_to_keep_lem)
	+ then show ?thesis using poly_type_hyp distinct_signs_hyp all_info_hyp welldefined_hyp
	+ using matrix_equation_R unfolding get_subsets_R_def get_signs_R_def
	+ by blast
	+qed
	+
	+(* Show that we are tracking the correct matrix in the algorithm *)
	+subsection "Showing matrix preserved"
	+lemma reduce_system_matrix_signs_helper_aux_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length signs"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "alt_matrix_A_R (take_indices signs S) subsets = take_cols_from_matrix (alt_matrix_A_R signs subsets) S"
	+proof -
	+ have h0a: "dim_col (take_cols_from_matrix (alt_matrix_A_R signs subsets) S) = length (take_indices signs S)"
	+ unfolding take_cols_from_matrix_def apply (auto) unfolding take_indices_def by auto
	+ have h0: "\<forall>i < length (take_indices signs S). (col (alt_matrix_A_R (take_indices signs S) subsets ) i =
	+col (take_cols_from_matrix (alt_matrix_A_R signs subsets) S) i)"
	+ proof clarsimp
	+ fix i
	+ assume asm: "i < length (take_indices signs S)"
	+ have i_lt: "i < length (map ((!) (cols (alt_matrix_A_R signs subsets))) S)" using asm
	+ apply (auto) unfolding take_indices_def by auto
	+ have h0: " vec (length subsets) (\<lambda>j. z_R (subsets ! j) (map ((!) signs) S ! i)) =
	+ vec (length subsets) (\<lambda>j. z_R (subsets ! j) (signs ! (S ! i)))" using nth_map
	+ by (metis \<open>i < length (take_indices signs S)\<close> length_map take_indices_def)
	+ have dim: "(map ((!) (cols (alt_matrix_A_R signs subsets))) S) ! i \<in> carrier_vec (dim_row (alt_matrix_A_R signs subsets))"
	+ proof -
	+ have "dim_col (alt_matrix_A_R signs subsets) = length (signs)"
	+ by (simp add: alt_matrix_A_R_def)
	+ have well_d: "S ! i < length (signs)" using well_def_h
	+ using i_lt in_set_member by fastforce
	+ have
	+ map_eq: "(map ((!) (cols (alt_matrix_A_R signs subsets))) S) ! i = nth (cols (alt_matrix_A_R signs subsets)) (S ! i)"
	+ using i_lt by auto
	+ have "nth (cols (alt_matrix_A_R signs subsets)) (S ! i) \<in> carrier_vec (dim_row (alt_matrix_A_R signs subsets))"
	+ using col_dim unfolding cols_def using nth_map well_d
	+ by (simp add: \<open>dim_col (alt_matrix_A_R signs subsets) = length signs\<close>)
	+ then show ?thesis using map_eq by auto
	+ qed
	+ have h1: "col (take_cols_from_matrix (alt_matrix_A_R signs subsets) S) i =
	+ col (mat_of_cols (dim_row (alt_matrix_A_R signs subsets)) (map ((!) (cols (alt_matrix_A_R signs subsets))) S)) i "
	+ by (simp add: take_cols_from_matrix_def take_indices_def)
	+ have h2: "col (mat_of_cols (dim_row (alt_matrix_A_R signs subsets)) (map ((!) (cols (alt_matrix_A_R signs subsets))) S)) i
	+ = nth (map ((!) (cols (alt_matrix_A_R signs subsets))) S) i "
	+ using dim i_lt asm col_mat_of_cols[where j = "i", where n = "(dim_row (alt_matrix_A_R signs subsets))",
	+ where vs = "(map ((!) (cols (alt_matrix_A_R signs subsets))) S)"]
	+ by blast
	+ have h3: "col (take_cols_from_matrix (alt_matrix_A_R signs subsets) S) i = (col (alt_matrix_A_R signs subsets) (S !i))"
	+ using h1 h2 apply (auto)
	+ by (metis alt_matrix_char_R asm cols_nth dim_col_mat(1) in_set_member length_map mat_of_rows_list_def matrix_A_R_def nth_map nth_mem take_indices_def well_def_h)
	+ have "vec (length subsets) (\<lambda>j. z_R (subsets ! j) (signs ! (S ! i))) = (col (alt_matrix_A_R signs subsets) (S !i))"
	+ by (metis asm in_set_member length_map nth_mem signs_are_cols_R take_indices_def well_def_h)
	+ then have "vec (length subsets) (\<lambda>j. z_R (subsets ! j) (take_indices signs S ! i)) =
	+ col (take_cols_from_matrix (alt_matrix_A_R signs subsets) S) i "
	+ using h0 h3
	+ by (simp add: take_indices_def)
	+ then show "col (alt_matrix_A_R (take_indices signs S) subsets) i =
	+ col (take_cols_from_matrix (alt_matrix_A_R signs subsets) S) i "
	+ using asm signs_are_cols_R[where signs = "(take_indices signs S)", where subsets = "subsets"]
	+ by auto
	+ qed
	+ then show ?thesis unfolding alt_matrix_A_R_def take_cols_from_matrix_def apply (auto)
	+ using h0a mat_col_eqI
	+ by (metis alt_matrix_A_R_def dim_col_mat(1) dim_row_mat(1) h0 mat_of_cols_def take_cols_from_matrix_def)
	+qed
	+
	+
	+lemma reduce_system_matrix_signs_helper_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length signs"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "matrix_A_R (take_indices signs S) subsets = take_cols_from_matrix (matrix_A_R signs subsets) S"
	+ using reduce_system_matrix_signs_helper_aux_R alt_matrix_char_R assms by auto
	+
	+lemma reduce_system_matrix_subsets_helper_aux_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list* nat list) list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes inv: "length subsets \<ge> length signs"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length subsets"
	+ assumes nonzero: "p \<noteq> 0"
	+ shows "alt_matrix_A_R signs (take_indices subsets S) = take_rows_from_matrix (alt_matrix_A_R signs subsets) S"
	+proof -
	+ have h0a: "dim_row (take_rows_from_matrix (alt_matrix_A_R signs subsets) S) = length (take_indices subsets S)"
	+ unfolding take_rows_from_matrix_def apply (auto) unfolding take_indices_def by auto
	+ have h0: "\<forall>i < length (take_indices subsets S). (row (alt_matrix_A_R signs (take_indices subsets S) ) i =
	+row (take_rows_from_matrix (alt_matrix_A_R signs subsets) S) i)"
	+ proof clarsimp
	+ fix i
	+ assume asm: "i < length (take_indices subsets S)"
	+ have i_lt: "i < length (map ((!) (rows (alt_matrix_A_R signs subsets))) S)" using asm
	+ apply (auto) unfolding take_indices_def by auto
	+ have h0: "row (take_rows_from_matrix (alt_matrix_A_R signs subsets) S) i =
	+ row (mat_of_rows (dim_col (alt_matrix_A_R signs subsets)) (map ((!) (rows (alt_matrix_A_R signs subsets))) S)) i "
	+ unfolding take_rows_from_matrix_def take_indices_def by auto
	+ have dim: "(map ((!) (rows (alt_matrix_A_R signs subsets))) S) ! i \<in> carrier_vec (dim_col (alt_matrix_A_R signs subsets))"
	+ proof -
	+ have "dim_col (alt_matrix_A_R signs subsets) = length (signs)"
	+ by (simp add: alt_matrix_A_R_def)
	+ then have lenh: "dim_col (alt_matrix_A_R signs subsets) \<le> length (subsets)"
	+ using assms
	+ by auto
	+ have well_d: "S ! i < length (subsets)" using well_def_h
	+ using i_lt in_set_member by fastforce
	+ have
	+ map_eq: "(map ((!) (rows (alt_matrix_A_R signs subsets))) S) ! i = nth (rows (alt_matrix_A_R signs subsets)) (S ! i)"
	+ using i_lt by auto
	+ have "nth (rows (alt_matrix_A_R signs subsets)) (S ! i) \<in> carrier_vec (dim_col (alt_matrix_A_R signs subsets))"
	+ using col_dim unfolding rows_def using nth_map well_d
	+ using lenh
	+ by (simp add: alt_matrix_A_R_def)
	+ then show ?thesis using map_eq unfolding alt_matrix_A_R_def by auto
	+ qed
	+ have h1: " row (mat_of_rows (dim_col (alt_matrix_A_R signs subsets)) (map ((!) (rows (alt_matrix_A_R signs subsets))) S)) i
	+ = (row (alt_matrix_A_R signs subsets) (S ! i)) "
	+ using dim i_lt mat_of_rows_row[where i = "i", where n = "(dim_col (alt_matrix_A_R signs subsets))",
	+ where vs = "(map ((!) (rows (alt_matrix_A_R signs subsets))) S)"]
	+ using alt_matrix_char_R in_set_member nth_mem well_def_h
	+ by fastforce
	+ have "row (alt_matrix_A_R signs (take_indices subsets S) ) i = (row (alt_matrix_A_R signs subsets) (S ! i))"
	+ using subsets_are_rows_R
	+ proof -
	+ have f1: "i < length S"
	+ by (metis (no_types) asm length_map take_indices_def)
	+ then have "List.member S (S ! i)"
	+ by (meson in_set_member nth_mem)
	+ then show ?thesis
	+ using f1
	+ by (simp add: \<open>\<And>subsets signs. \<forall>i<length subsets. row (alt_matrix_A_R signs subsets) i = vec (length signs) (\<lambda>j. z_R (subsets ! i) (signs ! j))\<close> take_indices_def well_def_h)
	+ qed
	+ then show "(row (alt_matrix_A_R signs (take_indices subsets S) ) i =
	+ row (take_rows_from_matrix (alt_matrix_A_R signs subsets) S) i)"
	+ using h0 h1 unfolding take_indices_def by auto
	+ qed
	+ then show ?thesis unfolding alt_matrix_A_R_def take_rows_from_matrix_def apply (auto)
	+ using eq_rowI
	+ by (metis alt_matrix_A_R_def dim_col_mat(1) dim_row_mat(1) h0 h0a mat_of_rows_def take_rows_from_matrix_def)
	+qed
	+
	+
	+lemma reduce_system_matrix_subsets_helper_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ fixes S:: "nat list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes inv: "length subsets \<ge> length signs"
	+ assumes well_def_h: "\<forall>x. List.member S x \<longrightarrow> x < length subsets"
	+ shows "matrix_A_R signs (take_indices subsets S) = take_rows_from_matrix (matrix_A_R signs subsets) S"
	+ using assms reduce_system_matrix_subsets_helper_aux_R alt_matrix_char_R
	+ by auto
	+
	+lemma reduce_system_matrix_match_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ assumes inv: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "matrix_A_R (get_signs_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))
	+ (get_subsets_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs))))) =
	+ (get_matrix_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))"
	+proof -
	+ let ?A = "(matrix_A_R signs subsets)"
	+ let ?lhs_vec = "(solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))"
	+ let ?red_mtx = "(take_rows_from_matrix (reduce_mat_cols (matrix_A_R signs subsets) ?lhs_vec) (rows_to_keep (reduce_mat_cols (matrix_A_R signs subsets) ?lhs_vec)))"
	+ have h1: "matrix_A_R (get_signs_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))
	+ (get_subsets_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))
	+ = matrix_A_R (reduction_signs_R p qs signs subsets (matrix_A_R signs subsets)) (reduction_subsets_R p qs signs subsets (matrix_A_R signs subsets))"
	+ using reduction_signs_is_get_signs_R reduction_subsets_is_get_subsets_R by auto
	+ have h1_var: "matrix_A_R (get_signs_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))
	+ (get_subsets_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))
	+ = matrix_A_R (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec)) (take_indices subsets (rows_to_keep (reduce_mat_cols ?A ?lhs_vec)))"
	+ using h1 reduction_signs_R_def reduction_subsets_R_def by auto
	+ have h2: "?red_mtx = (take_rows_from_matrix (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec)) (rows_to_keep (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec))))"
	+ by simp
	+ have h30: "(construct_lhs_vector_R p qs signs) = ?lhs_vec"
	+ using assms construct_lhs_matches_solve_for_lhs_R
	+ by simp
	+ have h3a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (signs)"
	+ using h30 size_of_lhs_R[of p qs signs]
	+ unfolding find_nonzeros_from_input_vec_def apply (auto)
	+ using in_set_member by force
	+ have h3b_a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (subsets)"
	+ using assms h30 size_of_lhs_R same_size_R unfolding find_nonzeros_from_input_vec_def apply (auto)
	+ by (simp add: find_nonzeros_from_input_vec_def h3a)
	+ have h3ba: "length
	+ (filter (\<lambda>i. solve_for_lhs_R p qs subsets (matrix_A_R signs subsets) $ i \<noteq> 0)
	+ [0..<length subsets])
	+ \<le> length subsets" using length_filter_le[where P = "(\<lambda>i. solve_for_lhs_R p qs subsets (matrix_A_R signs subsets) $ i \<noteq> 0)",
	+ where xs = "[0..<length subsets]"] length_upto by auto
	+ have " length subsets = dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))"
	+ using h30 inv size_of_lhs_R same_size_R[of signs subsets] apply (auto)
	+ by metis
	+ then have "length
	+ (filter (\<lambda>i. solve_for_lhs_R p qs subsets (matrix_A_R signs subsets) $ i \<noteq> 0)
	+ [0..<dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))])
	+ \<le> length subsets" using h3ba
	+ by auto
	+ then have h3b: "length subsets \<ge> length (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec))"
	+ unfolding take_indices_def find_nonzeros_from_input_vec_def by auto
	+ have h3c: "\<forall>x. List.member (rows_to_keep (reduce_mat_cols ?A ?lhs_vec)) x \<longrightarrow> x < length (subsets)"
	+ proof clarsimp
	+ fix x
	+ assume x_mem: "List.member (rows_to_keep
	+ (take_cols_from_matrix (matrix_A_R signs subsets)
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))) x"
	+ obtain nn :: "rat list list \<Rightarrow> nat list \<Rightarrow> nat" where
	+ "\<forall>x2 x3. (\<exists>v4. v4 \<in> set x3 \<and> \<not> v4 < length x2) = (nn x2 x3 \<in> set x3 \<and> \<not> nn x2 x3 < length x2)"
	+ by moura
	+ then have f4: "nn signs (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) \<in> set (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) \<and> \<not> nn signs (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) < length signs \<or> matrix_A_R (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))) subsets = take_cols_from_matrix (matrix_A_R signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ using nonzero
	+ using h3a reduce_system_matrix_signs_helper_R by auto
	+ then have "matrix_A_R (take_indices signs (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))) subsets = take_cols_from_matrix (matrix_A_R signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) \<and> x \<in> set (map snd (pivot_positions (gauss_jordan_single (take_cols_from_matrix (matrix_A_R signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))\<^sup>T)))"
	+ using f4
	+ by (metis h3a in_set_member rows_to_keep_def x_mem)
	+ thus "x < length (subsets)" using x_mem unfolding rows_to_keep_def
	+ by (metis dim_row_matrix_A_R rows_to_keep_def rows_to_keep_lem)
	+ qed
	+ have h3: "matrix_A_R (take_indices signs (find_nonzeros_from_input_vec ?lhs_vec)) (take_indices subsets (rows_to_keep (reduce_mat_cols ?A ?lhs_vec))) =
	+ (take_rows_from_matrix (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec)) (rows_to_keep (take_cols_from_matrix ?A (find_nonzeros_from_input_vec ?lhs_vec))))"
	+ using inv h3a h3b h3c reduce_system_matrix_subsets_helper_R reduce_system_matrix_signs_helper_R
	+ assms
	+ by auto
	+ show ?thesis using h1 h2 h3
	+ by (metis fst_conv get_matrix_R_def h1_var reduce_system_R.simps reduction_step_R.simps)
	+qed
	+
	+subsection "Showing invertibility preserved when reducing"
	+
	+(* gauss_jordan_single_rank is critically helpful in this subsection *)
	+thm conjugatable_vec_space.gauss_jordan_single_rank
	+
	+thm vec_space.full_rank_lin_indpt
	+
	+(* Overall:
	+ Start with a matrix equation.
	+ Input a matrix, subsets, and signs.
	+ Drop columns of the matrix based on the 0's on the LHS---so extract a list of 0's. Reduce signs accordingly.
	+ Then find a list of rows to delete based on using rank (use the transpose result, pivot positions!),
	+ and delete those rows. Reduce subsets accordingly.
	+ End with a reduced system! *)
	+lemma well_def_find_zeros_from_lhs_vec_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A_R signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ shows "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) \<Longrightarrow>
	+ j < length (cols (matrix_A_R signs subsets)))"
	+proof -
	+ fix i
	+ fix j
	+ assume j_in: " j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) "
	+ let ?og_mat = "(matrix_A_R signs subsets)"
	+ let ?lhs = "(solve_for_lhs_R p qs subsets ?og_mat)"
	+ let ?new_mat = "(take_rows_from_matrix (reduce_mat_cols ?og_mat ?lhs) (rows_to_keep (reduce_mat_cols ?og_mat ?lhs)))"
	+ have "square_mat (matrix_A_R signs subsets)" using inv
	+ using invertible_mat_def by blast
	+ then have mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ have "dim_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)) = (length signs)"
	+ using size_of_lhs_R construct_lhs_matches_solve_for_lhs_R assms
	+ by (metis (full_types))
	+ then have h: "j < (length signs)"
	+ using j_in unfolding find_nonzeros_from_input_vec_def
	+ by simp
	+ then show "j < length (cols (matrix_A_R signs subsets))"
	+ using mat_size by auto
	+qed
	+
	+
	+lemma take_cols_subsets_og_cols_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A_R signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ shows "set (take_indices (cols (matrix_A_R signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))
	+ \<subseteq> set (cols (matrix_A_R signs subsets))"
	+proof -
	+ have well_def: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) \<Longrightarrow>
	+ j < length (cols (matrix_A_R signs subsets)))"
	+ using assms well_def_find_zeros_from_lhs_vec_R by auto
	+ have "\<forall>x. x \<in> set (take_indices (cols (matrix_A_R signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))
	+ \<longrightarrow> x \<in> set (cols (matrix_A_R signs subsets))"
	+ proof clarsimp
	+ fix x
	+ let ?og_list = "(cols (matrix_A_R signs subsets))"
	+ let ?ind_list = "(find_nonzeros_from_input_vec
	+ (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ assume x_in: "x \<in> set (take_indices ?og_list ?ind_list)"
	+ show "x \<in> set (cols (matrix_A_R signs subsets))"
	+ using x_in unfolding take_indices_def using in_set_member apply (auto)
	+ using in_set_conv_nth well_def by fastforce
	+ qed
	+ then show ?thesis
	+ by blast
	+qed
	+
	+
	+lemma reduction_doesnt_break_things_invertibility_step1_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A_R signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ shows "vec_space.rank (length signs) (reduce_mat_cols (matrix_A_R signs subsets) (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) =
	+ (length (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))"
	+proof -
	+ let ?og_mat = "(matrix_A_R signs subsets)"
	+ let ?lhs = "(solve_for_lhs_R p qs subsets ?og_mat)"
	+ let ?new_mat = "(take_rows_from_matrix (reduce_mat_cols ?og_mat ?lhs) (rows_to_keep (reduce_mat_cols ?og_mat ?lhs)))"
	+ have "square_mat (matrix_A_R signs subsets)" using inv
	+ using invertible_mat_def by blast
	+ then have mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ then have mat_size_alt: "?og_mat \<in> carrier_mat (length subsets) (length subsets)"
	+ using size_of_mat same_size assms
	+ by auto
	+ have det_h: "det ?og_mat \<noteq> 0"
	+ using invertible_det[where A = "matrix_A_R signs subsets"] mat_size
	+ using inv by blast
	+ then have rank_h: "vec_space.rank (length signs) ?og_mat = (length signs)"
	+ using vec_space.det_rank_iff mat_size
	+ by auto
	+ then have dist_cols: "distinct (cols ?og_mat)" using mat_size vec_space.non_distinct_low_rank[where A = ?og_mat, where n = "length signs"]
	+ by auto
	+ have well_def: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec
	+ (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) \<Longrightarrow>
	+ j < length (cols (matrix_A_R signs subsets)))"
	+ using assms well_def_find_zeros_from_lhs_vec_R by auto
	+ have dist1: "distinct
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ unfolding find_nonzeros_from_input_vec_def by auto
	+ have clear: "set (take_indices (cols (matrix_A_R signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))
	+ \<subseteq> set (cols (matrix_A_R signs subsets))"
	+ using assms take_cols_subsets_og_cols_R by auto
	+ then have "distinct (take_indices (cols (matrix_A_R signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))"
	+ unfolding take_indices_def
	+ using dist1 dist_cols well_def conjugatable_vec_space.distinct_map_nth[where ls = "cols (matrix_A_R signs subsets)", where inds = "(find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"]
	+ by auto
	+ then have unfold_thesis: "vec_space.rank (length signs) (mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) (find_nonzeros_from_input_vec ?lhs)))
	+= (length (find_nonzeros_from_input_vec ?lhs))"
	+ using clear inv conjugatable_vec_space.rank_invertible_subset_cols[where A= "matrix_A_R signs subsets", where B = "(take_indices (cols (matrix_A_R signs subsets))
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))"]
	+ by (simp add: len_eq mat_size take_indices_def)
	+ then show ?thesis apply (simp) unfolding take_cols_from_matrix_def by auto
	+qed
	+
	+
	+lemma reduction_doesnt_break_things_invertibility_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes len_eq: "length subsets = length signs"
	+ assumes inv: "invertible_mat (matrix_A_R signs subsets)"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes welldefined_signs1: "well_def_signs (length qs) signs"
	+ assumes distinct_signs: "distinct signs"
	+ assumes all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(signs)"
	+ assumes match: "satisfy_equation_R p qs subsets signs"
	+ shows "invertible_mat (get_matrix_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))"
	+proof -
	+ let ?og_mat = "(matrix_A_R signs subsets)"
	+ let ?lhs = "(solve_for_lhs_R p qs subsets ?og_mat)"
	+ let ?step1_mat = "(reduce_mat_cols ?og_mat ?lhs)"
	+ let ?new_mat = "take_rows_from_matrix ?step1_mat (rows_to_keep ?step1_mat)"
	+ let ?ind_list = "(find_nonzeros_from_input_vec ?lhs)"
	+ have "square_mat (matrix_A_R signs subsets)" using inv
	+ using invertible_mat_def by blast
	+ then have og_mat_size: "?og_mat \<in> carrier_mat (length signs) (length signs)"
	+ using size_of_mat
	+ by auto
	+ have "dim_col (mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) ?ind_list))
	+ = (length (find_nonzeros_from_input_vec ?lhs))"
	+ by (simp add: take_indices_def)
	+ then have "mat_of_cols (dim_row ?og_mat) (take_indices (cols ?og_mat) ?ind_list)
	+ \<in> carrier_mat (length signs) (length (find_nonzeros_from_input_vec ?lhs))"
	+ by (simp add: len_eq mat_of_cols_def)
	+ then have step1_mat_size: "?step1_mat \<in> carrier_mat (length signs) (length (find_nonzeros_from_input_vec ?lhs))"
	+ by (simp add: take_cols_from_matrix_def)
	+ then have "dim_row ?step1_mat \<ge> dim_col ?step1_mat"
	+ by (metis carrier_matD(1) carrier_matD(2) construct_lhs_matches_solve_for_lhs_R diff_zero find_nonzeros_from_input_vec_def inv length_filter_le length_upt match size_of_lhs_R)
	+ then have gt_eq_assm: "dim_col ?step1_mat\<^sup>T \<ge> dim_row ?step1_mat\<^sup>T"
	+ by simp
	+ have det_h: "det ?og_mat \<noteq> 0"
	+ using invertible_det[where A = "matrix_A_R signs subsets"] og_mat_size
	+ using inv by blast
	+ then have rank_h: "vec_space.rank (length signs) ?og_mat = (length signs)"
	+ using vec_space.det_rank_iff og_mat_size
	+ by auto
	+ have rank_drop_cols: "vec_space.rank (length signs) ?step1_mat = (dim_col ?step1_mat)"
	+ using assms reduction_doesnt_break_things_invertibility_step1_R step1_mat_size
	+ by auto
	+ let ?step1_T = "?step1_mat\<^sup>T"
	+ have rank_transpose: "vec_space.rank (length signs) ?step1_mat = vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) ?step1_T"
	+ using transpose_rank[of ?step1_mat]
	+ using step1_mat_size by auto
	+ have obv: "?step1_T \<in> carrier_mat (dim_row ?step1_T) (dim_col ?step1_T)" by auto
	+ have should_have_this:"vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) ?step1_T"
	+ using obv gt_eq_assm conjugatable_vec_space.gauss_jordan_single_rank[where A = "?step1_T", where n = "dim_row ?step1_T", where nc = "dim_col ?step1_T"]
	+ by (simp add: take_cols_from_matrix_def take_indices_def)
	+ then have "vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = dim_col ?step1_mat"
	+ using rank_drop_cols rank_transpose by auto
	+ then have with_take_cols_from_matrix: "vec_space.rank (length (find_nonzeros_from_input_vec ?lhs)) (take_cols_from_matrix ?step1_T (map snd (pivot_positions (gauss_jordan_single (?step1_T))))) = dim_col ?step1_mat"
	+ using rank_transpose rechar_take_cols conjugatable_vec_space.gjs_and_take_cols_var
	+ apply (auto)
	+ by (smt conjugatable_vec_space.gjs_and_take_cols_var gt_eq_assm obv rechar_take_cols reduce_mat_cols.simps)
	+ have "(take_rows_from_matrix ?step1_mat (rows_to_keep ?step1_mat)) = (take_cols_from_matrix ?step1_T (rows_to_keep ?step1_mat))\<^sup>T"
	+ using take_rows_and_take_cols
	+ by blast
	+ then have rank_new_mat: "vec_space.rank (dim_row ?new_mat) ?new_mat = dim_col ?step1_mat"
	+ using with_take_cols_from_matrix transpose_rank apply (auto)
	+ by (smt (verit, ccfv_threshold) carrier_matD(2) index_transpose_mat(2) mat_of_cols_carrier(2) reduce_mat_cols.simps rows_to_keep_def step1_mat_size take_cols_from_matrix_def transpose_rank)
	+ have "length (pivot_positions (gauss_jordan_single (?step1_mat\<^sup>T))) \<le> (length (find_nonzeros_from_input_vec ?lhs))"
	+ using obv length_pivot_positions_dim_row[where A = "(gauss_jordan_single (?step1_mat\<^sup>T))"]
	+ by (metis carrier_matD(1) carrier_matD(2) gauss_jordan_single(2) gauss_jordan_single(3) index_transpose_mat(2) step1_mat_size)
	+ then have len_lt_eq: "length (pivot_positions (gauss_jordan_single (?step1_mat\<^sup>T))) \<le> dim_col ?step1_mat"
	+ using step1_mat_size
	+ by simp
	+ have len_gt_false: "length (rows_to_keep ?step1_mat) < (dim_col ?step1_mat) \<Longrightarrow> False"
	+ proof -
	+ assume length_lt: "length (rows_to_keep ?step1_mat) < (dim_col ?step1_mat)"
	+ have h: "dim_row ?new_mat < (dim_col ?step1_mat)"
	+ by (metis Matrix.transpose_transpose index_transpose_mat(3) length_lt length_map mat_of_cols_carrier(3) take_cols_from_matrix_def take_indices_def take_rows_and_take_cols)
	+ then show "False" using rank_new_mat
	+ by (metis Matrix.transpose_transpose carrier_matI index_transpose_mat(2) nat_less_le not_less_iff_gr_or_eq transpose_rank vec_space.rank_le_nc)
	+ qed
	+ then have len_gt_eq: "length (rows_to_keep ?step1_mat) \<ge> (dim_col ?step1_mat)"
	+ using not_less by blast
	+ have len_match: "length (rows_to_keep ?step1_mat) = (dim_col ?step1_mat)"
	+ using len_lt_eq len_gt_eq
	+ by (simp add: rows_to_keep_def)
	+ have mat_match: "matrix_A_R (get_signs_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))
	+ (get_subsets_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs))))) =
	+ (get_matrix_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))"
	+ using reduce_system_matrix_match_R[of p qs signs subsets] assms
	+ by blast
	+ have f2: "length (get_subsets_R (take_rows_from_matrix (mat_of_cols (dim_row (matrix_A_R signs subsets)) (map ((!) (cols (matrix_A_R signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))) (rows_to_keep (mat_of_cols (dim_row (matrix_A_R signs subsets)) (map ((!) (cols (matrix_A_R signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))))), map ((!) subsets) (rows_to_keep (mat_of_cols (dim_row (matrix_A_R signs subsets)) (map ((!) (cols (matrix_A_R signs subsets))) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))))), map ((!) signs) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+
	+ by (metis (no_types) \<open>dim_col (mat_of_cols (dim_row (matrix_A_R signs subsets)) (take_indices (cols (matrix_A_R signs subsets)) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))) = length (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))\<close> \<open>length (rows_to_keep (reduce_mat_cols (matrix_A_R signs subsets) (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))) = dim_col (reduce_mat_cols (matrix_A_R signs subsets) (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))\<close> length_map reduce_mat_cols.simps reduce_system_R.simps reduction_step_R.simps reduction_subsets_R_def reduction_subsets_is_get_subsets_R take_cols_from_matrix_def take_indices_def)
	+ have f3: "\<forall>p ps rss nss m. map ((!) rss) (find_nonzeros_from_input_vec (solve_for_lhs_R p ps nss m)) = get_signs_R (reduce_system_R p (ps, m, nss, rss))"
	+ by (metis (no_types) reduction_signs_R_def reduction_signs_is_get_signs_R take_indices_def)
	+ have square_final_mat: "square_mat (get_matrix_R (reduce_system_R p (qs, ((matrix_A_R signs subsets), (subsets, signs)))))"
	+ using mat_match assms size_of_mat_R same_size_R
	+ apply (auto) using f2 f3
	+ by (metis (no_types, lifting) Matrix.transpose_transpose fst_conv get_matrix_R_def index_transpose_mat(2) len_match length_map mat_of_cols_carrier(2) mat_of_cols_carrier(3) reduce_mat_cols.simps take_cols_from_matrix_def take_indices_def take_rows_and_take_cols)
	+ have rank_match: "vec_space.rank (dim_row ?new_mat) ?new_mat = dim_row ?new_mat"
	+ using len_match rank_new_mat
	+ by (simp add: take_cols_from_matrix_def take_indices_def take_rows_and_take_cols)
	+ have "invertible_mat ?new_mat"
	+ using invertible_det og_mat_size
	+ using vec_space.det_rank_iff square_final_mat
	+ by (metis dim_col_matrix_A_R dim_row_matrix_A_R fst_conv get_matrix_R_def mat_match rank_match reduce_system_R.simps reduction_step_R.simps size_of_mat_R square_mat.elims(2))
	+ then show ?thesis apply (simp)
	+ by (metis fst_conv get_matrix_R_def)
	+qed
	+
	+subsection "Well def signs preserved when reducing"
	+
	+lemma reduction_doesnt_break_length_signs_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes length_init : "\<forall> x\<in> set(signs). length x = length qs"
	+ assumes sat_eq: "satisfy_equation_R p qs subsets signs"
	+ assumes inv_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "\<forall>x \<in> set(reduction_signs_R p qs signs subsets (matrix_A_R signs subsets)).
	+ length x = length qs"
	+ unfolding reduction_signs_def using take_indices_lem
	+ by (smt (verit) atLeastLessThan_iff construct_lhs_matches_solve_for_lhs_R filter_is_subset find_nonzeros_from_input_vec_def in_set_conv_nth in_set_member inv_mat length_init reduction_signs_R_def sat_eq set_upt size_of_lhs_R subset_code(1))
	+
	+subsection "Distinct signs preserved when reducing"
	+
	+lemma reduction_signs_are_distinct_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes sat_eq: "satisfy_equation_R p qs subsets signs"
	+ assumes inv_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ assumes distinct_init: "distinct signs"
	+ shows "distinct (reduction_signs_R p qs signs subsets (matrix_A_R signs subsets))"
	+proof -
	+ have solve_construct: "construct_lhs_vector_R p qs signs =
	+ solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs_R assms
	+ by simp
	+ have h1: "distinct (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ unfolding find_nonzeros_from_input_vec_def
	+ using distinct_filter
	+ using distinct_upt by blast
	+ have h2: "(\<And>j. j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))) \<Longrightarrow>
	+ j < length signs)"
	+ proof -
	+ fix j
	+ assume "j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"
	+ show "j < length signs" using solve_construct size_of_lhs_R
	+ by (metis \<open>j \<in> set (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))\<close> atLeastLessThan_iff filter_is_subset find_nonzeros_from_input_vec_def set_upt subset_iff)
	+ qed
	+ then show ?thesis unfolding reduction_signs_R_def unfolding take_indices_def
	+ using distinct_init h1 h2 conjugatable_vec_space.distinct_map_nth[where ls = "signs", where inds = "(find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))"]
	+ by blast
	+qed
	+
	+subsection "Well def subsets preserved when reducing"
	+
	+lemma reduction_doesnt_break_subsets_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list* nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes length_init : "all_list_constr_R subsets (length qs)"
	+ assumes sat_eq: "satisfy_equation_R p qs subsets signs"
	+ assumes inv_mat: "invertible_mat (matrix_A_R signs subsets)"
	+ shows "all_list_constr_R (reduction_subsets_R p qs signs subsets (matrix_A_R signs subsets)) (length qs)"
	+ unfolding all_list_constr_R_def
	+proof clarsimp
	+ fix a b
	+ assume in_red_subsets: "List.member (reduction_subsets_R p qs signs subsets (matrix_A_R signs subsets)) (a, b) "
	+ have solve_construct: "construct_lhs_vector_R p qs signs =
	+ solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)"
	+ using construct_lhs_matches_solve_for_lhs_R assms
	+ by simp
	+ have rows_to_keep_hyp: "\<forall>y. y \<in> set (rows_to_keep (reduce_mat_cols (matrix_A_R signs subsets) (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))) \<longrightarrow>
	+ y < length subsets"
	+ proof clarsimp
	+ fix y
	+ assume in_set: "y \<in> set (rows_to_keep
	+ (take_cols_from_matrix (matrix_A_R signs subsets) (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))))"
	+ have in_set_2: "y \<in> set (rows_to_keep
	+ (take_cols_from_matrix (matrix_A_R signs subsets) (find_nonzeros_from_input_vec (construct_lhs_vector_R p qs signs))))"
	+ using in_set solve_construct by simp
	+ let ?lhs_vec = "(solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))"
	+ have h30: "(construct_lhs_vector_R p qs signs) = ?lhs_vec"
	+ using assms construct_lhs_matches_solve_for_lhs_R
	+ by simp
	+ have h3a: "\<forall>x. List.member (find_nonzeros_from_input_vec ?lhs_vec) x \<longrightarrow>x < length (signs)"
	+ using h30 size_of_lhs_R unfolding find_nonzeros_from_input_vec_def
	+ using atLeastLessThan_iff filter_is_subset member_def set_upt subset_eq apply (auto)
	+ by (smt (verit, best) atLeastLessThan_iff in_set_member mem_Collect_eq set_filter set_upt)
	+ have h3c: "\<forall>x. List.member (rows_to_keep (reduce_mat_cols (matrix_A_R signs subsets) (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets)))) x \<longrightarrow> x < length (subsets)"
	+ proof clarsimp
	+ fix x
	+ assume x_mem: "List.member (rows_to_keep
	+ (take_cols_from_matrix (matrix_A_R signs subsets)
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p qs subsets (matrix_A_R signs subsets))))) x"
	+ show "x < length (subsets)" using x_mem unfolding rows_to_keep_def using pivot_positions
	+ using dim_row_matrix_A h3a in_set_member nonzero reduce_system_matrix_signs_helper_R rows_to_keep_def rows_to_keep_lem
	+ apply (auto)
	+ by (smt (verit, best) List.member_def dim_row_matrix_A_R rows_to_keep_def rows_to_keep_lem)
	+ qed
	+ then show "y < length subsets" using in_set_member apply (auto)
	+ using in_set_2 solve_construct by fastforce
	+ qed
	+ show "list_constr a (length qs) \<and> list_constr b (length qs)" using in_red_subsets unfolding reduction_subsets_def
	+ using take_indices_lem_R[of _ subsets] rows_to_keep_hyp
	+ using all_list_constr_R_def in_set_conv_nth in_set_member length_init
	+ by (metis fst_conv reduction_subsets_R_def snd_conv)
	+qed
	+
	+section "Overall Lemmas"
	+lemma combining_to_smash_R: "combine_systems_R p (qs1, m1, (sub1, sgn1)) (qs2, m2, (sub2, sgn2))
	+ = smash_systems_R p qs1 qs2 sub1 sub2 sgn1 sgn2 m1 m2"
	+ by simp
	+
	+lemma getter_functions_R: "calculate_data_R p qs = (get_matrix_R (calculate_data_R p qs), (get_subsets_R (calculate_data_R p qs), get_signs_R (calculate_data_R p qs))) "
	+ unfolding get_matrix_R_def get_subsets_R_def get_signs_R_def by auto
	+
	+subsection "Key properties preserved"
	+
	+subsubsection "Properties preserved when combining and reducing systems"
	+lemma combining_sys_satisfies_properties_helper_R:
	+ fixes p:: "real poly"
	+ fixes qs1 :: "real poly list"
	+ fixes qs2 :: "real poly list"
	+ fixes subsets1 subsets2 :: "(nat list * nat list) list"
	+ fixes signs1 signs2 :: "rat list list"
	+ fixes matrix1 matrix2:: "rat mat"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes satisfies_properties_sys1: "satisfies_properties_R p qs1 subsets1 signs1 matrix1"
	+ assumes satisfies_properties_sys2: "satisfies_properties_R p qs2 subsets2 signs2 matrix2"
	+ shows "satisfies_properties_R p (qs1@qs2) (get_subsets_R (snd ((combine_systems_R p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2)))))))
	+ (get_signs_R (snd ((combine_systems_R p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2)))))))
	+ (get_matrix_R (snd ((combine_systems_R p (qs1,(matrix1, (subsets1, signs1))) (qs2,(matrix2, (subsets2, signs2)))))))"
	+proof -
	+ let ?subsets = "(get_subsets_R (snd (combine_systems_R p (qs1, matrix1, subsets1, signs1)
	+ (qs2, matrix2, subsets2, signs2))))"
	+ let ?signs = "(get_signs_R (snd (combine_systems_R p (qs1, matrix1, subsets1, signs1) (qs2, matrix2, subsets2, signs2))))"
	+ let ?matrix = "(get_matrix_R (snd (combine_systems_R p (qs1, matrix1, subsets1, signs1) (qs2, matrix2, subsets2, signs2))))"
	+ have h1: "all_list_constr_R ?subsets (length (qs1 @ qs2))"
	+ using well_def_step_R[of subsets1 qs1 subsets2 qs2] assms
	+ by (simp add: nontriv2 get_subsets_R_def satisfies_properties_R_def smash_systems_R_def)
	+ have h2: "well_def_signs (length (qs1 @ qs2)) ?signs"
	+ using well_def_signs_step[of qs1 qs2 signs1 signs2]
	+ using get_signs_R_def nontriv1 nontriv2 satisfies_properties_R_def satisfies_properties_sys1 satisfies_properties_sys2 smash_systems_R_def by auto
	+ have h3: "distinct ?signs"
	+ using distinct_step[of _ signs1 _ signs2] assms
	+ using combine_systems.simps get_signs_R_def satisfies_properties_R_def smash_systems_R_def snd_conv by auto
	+ have h4: "satisfy_equation_R p (qs1 @ qs2) ?subsets ?signs"
	+ using assms inductive_step_R[of p qs1 qs2 signs1 signs2 subsets1 subsets2]
	+ using get_signs_R_def get_subsets_R_def satisfies_properties_R_def smash_systems_R_def
	+ by auto
	+ have h5: " invertible_mat ?matrix"
	+ using assms inductive_step_R[of p qs1 qs2 signs1 signs2 subsets1 subsets2]
	+ by (metis combining_to_smash_R fst_conv get_matrix_R_def kronecker_invertible satisfies_properties_R_def smash_systems_R_def snd_conv)
	+ have h6: "?matrix = matrix_A_R ?signs ?subsets"
	+ unfolding get_matrix_R_def combine_systems_R.simps smash_systems_R_def get_signs_R_def get_subsets_R_def
	+ apply simp
	+ apply (subst matrix_construction_is_kronecker_product_R[of subsets1 _ signs1 signs2 subsets2])
	+ apply (metis Ball_set all_list_constr_R_def in_set_member list_constr_def satisfies_properties_R_def satisfies_properties_sys1)
	+ using satisfies_properties_R_def satisfies_properties_sys1 well_def_signs_def apply blast
	+ using satisfies_properties_R_def satisfies_properties_sys1 satisfies_properties_sys2 by auto
	+ have h7: "set (characterize_consistent_signs_at_roots p (qs1 @ qs2))
	+ \<subseteq> set (?signs)"
	+ using subset_step_R[of p qs1 signs1 qs2 signs2] assms
	+ by (simp add: nonzero get_signs_R_def satisfies_properties_R_def smash_systems_R_def)
	+ then show ?thesis unfolding satisfies_properties_R_def using h1 h2 h3 h4 h5 h6 h7 by blast
	+qed
	+
	+lemma combining_sys_satisfies_properties_R:
	+ fixes p:: "real poly"
	+ fixes qs1 :: "real poly list"
	+ fixes qs2 :: "real poly list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes satisfies_properties_sys1: "satisfies_properties_R p qs1 (get_subsets_R (calculate_data_R p qs1)) (get_signs_R (calculate_data_R p qs1)) (get_matrix_R (calculate_data_R p qs1))"
	+ assumes satisfies_properties_sys2: "satisfies_properties_R p qs2 (get_subsets_R (calculate_data_R p qs2)) (get_signs_R (calculate_data_R p qs2)) (get_matrix_R (calculate_data_R p qs2))"
	+ shows "satisfies_properties_R p (qs1@qs2) (get_subsets_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))
	+ (get_signs_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))
	+ (get_matrix_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))"
	+ using combining_sys_satisfies_properties_helper_R[of p qs1 qs2]
	+ by (metis getter_functions_R nontriv1 nontriv2 nonzero satisfies_properties_sys1 satisfies_properties_sys2)
	+
	+lemma reducing_sys_satisfies_properties_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ fixes matrix:: "rat mat"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv: "length qs > 0"
	+ assumes satisfies_properties_sys: "satisfies_properties_R p qs subsets signs matrix"
	+ shows "satisfies_properties_R p qs (get_subsets_R (reduce_system_R p (qs,matrix,subsets,signs)))
	+ (get_signs_R (reduce_system_R p (qs,matrix,subsets,signs)))
	+ (get_matrix_R (reduce_system_R p (qs,matrix,subsets,signs)))"
	+proof -
	+ have h1: " all_list_constr_R (get_subsets_R (reduce_system_R p (qs, matrix, subsets, signs))) (length qs)"
	+ using reduction_doesnt_break_subsets_R assms reduction_subsets_is_get_subsets_R satisfies_properties_R_def satisfies_properties_sys by auto
	+ have h2: "well_def_signs (length qs) (get_signs_R (reduce_system_R p (qs, matrix, subsets, signs)))"
	+ using reduction_doesnt_break_length_signs_R[of signs qs p subsets] assms reduction_signs_is_get_signs_R satisfies_properties_R_def well_def_signs_def by auto
	+ have h3: "distinct (get_signs_R (reduce_system_R p (qs, matrix, subsets, signs)))"
	+ using reduction_signs_are_distinct_R[of p qs subsets signs] assms reduction_signs_is_get_signs_R satisfies_properties_R_def by auto
	+ have h4: "satisfy_equation_R p qs (get_subsets_R (reduce_system_R p (qs, matrix, subsets, signs)))
	+ (get_signs_R (reduce_system_R p (qs, matrix, subsets, signs)))"
	+ using reduce_system_matrix_equation_preserved_R[of p qs signs subsets] assms satisfies_properties_R_def by auto
	+ have h5: "invertible_mat (get_matrix_R (reduce_system_R p (qs, matrix, subsets, signs)))"
	+ using reduction_doesnt_break_things_invertibility_R assms same_size_R satisfies_properties_R_def by auto
	+ have h6: "get_matrix_R (reduce_system_R p (qs, matrix, subsets, signs)) =
	+ matrix_A_R (get_signs_R (reduce_system_R p (qs, matrix, subsets, signs)))
	+ (get_subsets_R (reduce_system_R p (qs, matrix, subsets, signs)))"
	+ using reduce_system_matrix_match_R[of p qs signs subsets] assms satisfies_properties_R_def by auto
	+ have h7: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set (get_signs_R (reduce_system_R p (qs, matrix, subsets, signs)))"
	+ using reduction_doesnt_break_things_signs_R[of p qs signs subsets] assms reduction_signs_is_get_signs_R satisfies_properties_R_def by auto
	+ then show ?thesis unfolding satisfies_properties_R_def using h1 h2 h3 h4 h5 h6 h7
	+ by blast
	+qed
	+
	+subsubsection "For length 1 qs"
	+
	+lemma length_1_calculate_data_satisfies_properties_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes len1: "length qs = 1"
	+ shows "satisfies_properties_R p qs (get_subsets_R (calculate_data_R p qs)) (get_signs_R (calculate_data_R p qs)) (get_matrix_R (calculate_data_R p qs))"
	+proof -
	+ have h1: "all_list_constr_R [([], []),([0], []),([], [0])] (length qs)"
	+ using len1 unfolding all_list_constr_R_def list_constr_def apply (auto)
	+ apply (smt (verit, best) Ball_set in_set_member member_rec(1) member_rec(2) prod.inject)
	+ by (smt (verit, ccfv_threshold) Ball_set in_set_member member_rec(1) member_rec(2) prod.inject)
	+ have h2: "well_def_signs (length qs) [[1],[-1]]"
	+ unfolding well_def_signs_def using len1 in_set_member
	+ by auto
	+ have h3: "distinct ([[1],[0],[-1]]::rat list list)"
	+ unfolding distinct_def using in_set_member by auto
	+ have h4: "satisfy_equation_R p qs [([], []),([0], []),([], [0])] [[1],[0],[-1]]"
	+ using assms base_case_satisfy_equation_alt_R[of qs p] by auto
	+ have h6: "(mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]]::rat mat) = (matrix_A_R ([[1],[0],[-1]]) ([([], []),([0], []),([], [0])]) :: rat mat)"
	+ using mat_base_case_R by auto
	+ then have h5: "invertible_mat (mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]]::rat mat)"
	+ using base_case_invertible_mat_R
	+ by simp
	+ have h7: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set ([[1],[0],[-1]])"
	+ using assms base_case_sgas_alt_R[of qs p]
	+ by simp
	+ have base_case_hyp: "satisfies_properties_R p qs [([], []),([0], []),([], [0])] [[1],[0],[-1]] (mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]]::rat mat)"
	+ using h1 h2 h3 h4 h5 h6 h7
	+ using satisfies_properties_R_def apply (auto)
	+ by (simp add: well_def_signs_def)
	+ then have key_hyp: "satisfies_properties_R p qs (get_subsets_R (reduce_system_R p (qs,base_case_info_R))) (get_signs_R (reduce_system_R p (qs,base_case_info_R))) (get_matrix_R (reduce_system_R p (qs,base_case_info_R)))"
	+ using reducing_sys_satisfies_properties_R
	+ by (metis base_case_info_R_def len1 nonzero nonzero zero_less_one_class.zero_less_one)
	+ show ?thesis
	+ by (simp add: key_hyp len1)
	+qed
	+
	+subsubsection "For arbitrary qs"
	+
	+lemma calculate_data_satisfies_properties_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ shows "(p \<noteq> 0 \<and> (length qs > 0))
	+ \<longrightarrow> satisfies_properties_R p qs (get_subsets_R (calculate_data_R p qs)) (get_signs_R (calculate_data_R p qs)) (get_matrix_R (calculate_data_R p qs))"
	+proof (induction "length qs" arbitrary: qs rule: less_induct)
	+ case less
	+ have len1_h: "length qs = 1 \<longrightarrow> ( p \<noteq> 0 \<and> (length qs > 0)) \<longrightarrow> satisfies_properties_R p qs (get_subsets_R (calculate_data_R p qs)) (get_signs_R (calculate_data_R p qs)) (get_matrix_R (calculate_data_R p qs))"
	+ using length_1_calculate_data_satisfies_properties_R
	+ by blast
	+ let ?len = "length qs"
	+ let ?q1 = "take (?len div 2) qs"
	+ let ?left = "calculate_data_R p ?q1"
	+ let ?q2 = "drop (?len div 2) qs"
	+ let ?right = "calculate_data_R p ?q2"
	+ let ?comb = "combine_systems_R p (?q1,?left) (?q2,?right)"
	+ let ?red = "reduce_system_R p ?comb"
	+ have h_q1_len: "length qs > 1 \<longrightarrow> (length ?q1 > 0)" by auto
	+ have h_q2_len: "length qs > 1 \<longrightarrow> (length ?q2 > 0)" by auto
	+ have q1_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0)) \<longrightarrow> satisfies_properties_R p ?q1 (get_subsets_R (calculate_data_R p ?q1)) (get_signs_R (calculate_data_R p ?q1)) (get_matrix_R (calculate_data_R p ?q1))"
	+ using less.hyps[of ?q1] h_q1_len
	+ by (metis div_le_dividend div_less_dividend length_take min.absorb2 one_less_numeral_iff semiring_norm(76))
	+ have q2_help: "length qs > 1 \<longrightarrow> length (drop (length qs div 2) qs) < length qs"
	+ using h_q1_len by auto
	+ then have q2_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0)) \<longrightarrow> satisfies_properties_R p ?q2 (get_subsets_R (calculate_data_R p ?q2)) (get_signs_R (calculate_data_R p ?q2)) (get_matrix_R (calculate_data_R p ?q2))"
	+ using less.hyps[of ?q2] h_q2_len
	+ by blast
	+ have put_tog: "?q1@?q2 = qs"
	+ using append_take_drop_id by blast
	+ then have comb_sat_props: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0)) \<longrightarrow> (satisfies_properties_R p (qs) (get_subsets_R (snd ((combine_systems_R p (?q1,calculate_data_R p ?q1) (?q2,calculate_data_R p ?q2)))))
	+ (get_signs_R (snd ((combine_systems_R p (?q1,calculate_data_R p ?q1) (?q2,calculate_data_R p ?q2)))))
	+ (get_matrix_R (snd ((combine_systems_R p (?q1,calculate_data_R p ?q1) (?q2,calculate_data_R p ?q2))))))"
	+ using q1_sat_props q2_sat_props combining_sys_satisfies_properties_R
	+ using h_q1_len h_q2_len put_tog
	+ by metis
	+ then have comb_sat: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0)) \<longrightarrow>
	+ (satisfies_properties_R p (qs) (get_subsets_R (snd ?comb)) (get_signs_R (snd ?comb)) (get_matrix_R (snd ?comb)))"
	+ by blast
	+ have red_char: "?red = (reduce_system_R p (qs,(get_matrix_R (snd ?comb)),(get_subsets_R (snd ?comb)),(get_signs_R (snd ?comb))))"
	+ using getter_functions
	+ by (smt (z3) combine_systems_R.simps find_consistent_signs_at_roots_R_def find_consistent_signs_at_roots_thm_R fst_conv get_matrix_R_def get_signs_R_def get_subsets_R_def prod.collapse put_tog smash_systems_R_def)
	+ then have "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0)) \<longrightarrow> (satisfies_properties_R p qs (get_subsets_R ?red) (get_signs_R ?red) (get_matrix_R ?red))"
	+ using reducing_sys_satisfies_properties_R comb_sat
	+ by presburger
	+ then have len_gt1: "length qs > 1 \<longrightarrow> (p \<noteq> 0 \<and> (length qs > 0) ) \<longrightarrow> satisfies_properties_R p qs (get_subsets_R (calculate_data_R p qs)) (get_signs_R (calculate_data_R p qs)) (get_matrix_R (calculate_data_R p qs))"
	+ apply (auto)
	+ by (smt (z3) div_le_dividend min.absorb2)
	+ then show ?case using len1_h len_gt1
	+ by (metis One_nat_def Suc_lessI)
	+qed
	+
	+
	+subsection "Some key results on consistent sign assignments"
	+
	+lemma find_consistent_signs_at_roots_len1_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes len1: "length qs = 1"
	+ shows "set (find_consistent_signs_at_roots_R p qs) = set (characterize_consistent_signs_at_roots p qs)"
	+proof -
	+ let ?signs = "[[1],[0],[-1]]::rat list list"
	+ let ?subsets = "[([], []),([0], []),([], [0])]::(nat list*nat list) list"
	+ let ?mat = "(mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]])"
	+ have mat_help: "matrix_A_R ?signs ?subsets = (mat_of_rows_list 3 [[1,1,1], [0,1,0], [1,0,-1]])"
	+ using mat_base_case_R by auto
	+ have well_def_signs: "well_def_signs (length qs) ?signs" unfolding well_def_signs_def
	+ using len1 by auto
	+ have distinct_signs: "distinct ?signs"
	+ unfolding distinct_def by auto
	+ have ex_q: "\<exists>(q::real poly). qs = [q]"
	+ using len1
	+ using length_Suc_conv[of qs 0] by auto
	+ then have all_info: "set (characterize_consistent_signs_at_roots p qs) \<subseteq> set(?signs)"
	+ using assms base_case_sgas_R by auto
	+ have match: "satisfy_equation_R p qs ?subsets ?signs"
	+ using ex_q base_case_satisfy_equation_R nonzero
	+ by auto
	+ have invertible_mat: "invertible_mat (matrix_A_R ?signs ?subsets)"
	+ using inverse_mat_base_case_R inverse_mat_base_case_2_R unfolding invertible_mat_def using mat_base_case_R
	+ by auto
	+ have h: "set (get_signs_R (reduce_system_R p (qs, ((matrix_A_R ?signs ?subsets), (?subsets, ?signs))))) =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ using nonzero nonzero well_def_signs distinct_signs all_info match invertible_mat
	+ reduce_system_sign_conditions_R[where p = "p", where qs = "qs", where signs = ?signs, where subsets = ?subsets]
	+ by blast
	+ then have "set (snd (snd (reduce_system_R p (qs, (?mat, (?subsets, ?signs)))))) =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ unfolding get_signs_R_def using mat_help by auto
	+ then have "set (snd (snd (reduce_system_R p (qs, base_case_info_R)))) = set (characterize_consistent_signs_at_roots p qs)"
	+ unfolding base_case_info_R_def
	+ by auto
	+ then show ?thesis using len1
	+ by (simp add: find_consistent_signs_at_roots_thm_R)
	+qed
	+
	+lemma smaller_sys_are_good_R:
	+ fixes p:: "real poly"
	+ fixes qs1 :: "real poly list"
	+ fixes qs2 :: "real poly list"
	+ fixes subsets :: "(nat list*nat list) list"
	+ fixes signs :: "rat list list"
	+ assumes nonzero: "p \<noteq> 0"
	+ assumes nontriv1: "length qs1 > 0"
	+ assumes nontriv2: "length qs2 > 0"
	+ assumes "set(find_consistent_signs_at_roots_R p qs1) = set(characterize_consistent_signs_at_roots p qs1)"
	+ assumes "set(find_consistent_signs_at_roots_R p qs2) = set(characterize_consistent_signs_at_roots p qs2)"
	+ shows "set(snd(snd(reduce_system_R p (combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))
	+ = set(characterize_consistent_signs_at_roots p (qs1@qs2))"
	+proof -
	+ let ?signs = "(get_signs_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2))))) "
	+ let ?subsets = "(get_subsets_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2))))) "
	+ have h0: "satisfies_properties_R p (qs1@qs2) ?subsets ?signs
	+ (get_matrix_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))"
	+ using calculate_data_satisfies_properties_R combining_sys_satisfies_properties_R
	+ using nontriv1 nontriv2 nonzero nonzero
	+ by simp
	+ then have h1: "set(characterize_consistent_signs_at_roots p (qs1@qs2)) \<subseteq> set ?signs"
	+ unfolding satisfies_properties_R_def
	+ by linarith
	+ have h2: "well_def_signs (length (qs1@qs2)) ?signs"
	+ using calculate_data_satisfies_properties_R
	+ using h0 satisfies_properties_R_def by blast
	+ have h3: "distinct ?signs"
	+ using calculate_data_satisfies_properties_R
	+ using h0 satisfies_properties_R_def by blast
	+ have h4: "satisfy_equation_R p (qs1@qs2) ?subsets ?signs"
	+ using calculate_data_satisfies_properties_R
	+ using h0 satisfies_properties_R_def by blast
	+ have h5: "invertible_mat (matrix_A_R ?signs ?subsets) "
	+ using calculate_data_satisfies_properties_R
	+ using h0 satisfies_properties_R_def
	+ by auto
	+ have h: "set (take_indices ?signs
	+ (find_nonzeros_from_input_vec (solve_for_lhs_R p (qs1@qs2) ?subsets (matrix_A_R ?signs ?subsets))))
	+ = set(characterize_consistent_signs_at_roots p (qs1@qs2))"
	+ using h1 h2 h3 h4 h5 reduction_deletes_bad_sign_conds_R
	+ using nonzero reduction_signs_R_def by auto
	+ then have h: "set (characterize_consistent_signs_at_roots p (qs1@qs2)) =
	+ set (reduction_signs_R p (qs1@qs2) ?signs ?subsets (matrix_A_R ?signs ?subsets ))"
	+ unfolding reduction_signs_R_def get_signs_R_def
	+ by blast
	+ have help_h: "reduction_signs_R p (qs1@qs2) ?signs ?subsets (matrix_A_R ?signs ?subsets)
	+ = (take_indices ?signs (find_nonzeros_from_input_vec (solve_for_lhs_R p (qs1@qs2) ?subsets (matrix_A_R?signs ?subsets))))"
	+ unfolding reduction_signs_R_def by auto
	+ have clear_signs: "(signs_smash (get_signs_R (calculate_data_R p qs1)) (get_signs_R (calculate_data_R p qs2))) = (get_signs_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))"
	+ using combining_to_smash get_signs_R_def getter_functions_R smash_systems_R_def snd_conv
	+ proof -
	+ have "combine_systems_R p (qs1, calculate_data_R p qs1) (qs2, calculate_data_R p qs2) = (qs1 @ qs2, kronecker_product (get_matrix_R (calculate_data_R p qs1)) (get_matrix_R (calculate_data_R p qs2)), subsets_smash_R (length qs1) (get_subsets_R (calculate_data_R p qs1)) (get_subsets_R (calculate_data_R p qs2)), signs_smash (snd (snd (calculate_data_R p qs1))) (snd (snd (calculate_data_R p qs2))))"
	+ by (metis (no_types) combine_systems_R.simps get_signs_R_def getter_functions_R smash_systems_R_def)
	+ then show ?thesis
	+ by (simp add: get_signs_R_def)
	+ qed
	+ have clear_subsets: "(subsets_smash_R (length qs1) (get_subsets_R(calculate_data_R p qs1)) (get_subsets_R (calculate_data_R p qs2))) = (get_subsets_R (snd ((combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))"
	+ using Pair_inject combining_to_smash get_subsets_R_def prod.collapse smash_systems_R_def
	+ by (smt (z3) combine_systems_R.simps)
	+ have "well_def_signs (length qs1) (get_signs_R (calculate_data_R p qs1))"
	+ using calculate_data_satisfies_properties_R
	+ using nontriv1 nonzero nonzero satisfies_properties_R_def
	+ by auto
	+ then have well_def_signs1: "(\<And>j. j \<in> set (get_signs_R (calculate_data_R p qs1)) \<Longrightarrow> length j = (length qs1))"
	+ using well_def_signs_def by blast
	+ have "all_list_constr_R (get_subsets_R(calculate_data_R p qs1)) (length qs1) "
	+ using calculate_data_satisfies_properties_R
	+ using nontriv1 nonzero nonzero satisfies_properties_R_def
	+ by auto
	+ then have well_def_subsets1: "(\<And>l i. l \<in> set (get_subsets_R(calculate_data_R p qs1)) \<Longrightarrow> (i \<in> set (fst l) \<longrightarrow> i < (length qs1)) \<and> (i \<in> set (snd l) \<longrightarrow> i < (length qs1)))"
	+ unfolding all_list_constr_R_def list_constr_def
	+ using in_set_member
	+ by (metis in_set_conv_nth list_all_length)
	+ have extra_matrix_same: "matrix_A_R (signs_smash (get_signs_R (calculate_data_R p qs1)) (get_signs_R (calculate_data_R p qs2)))
	+ (subsets_smash_R (length qs1) (get_subsets_R(calculate_data_R p qs1)) (get_subsets_R (calculate_data_R p qs2)))
	+ = kronecker_product (get_matrix_R (calculate_data_R p qs1)) (get_matrix_R (calculate_data_R p qs2))"
	+ using well_def_signs1 well_def_subsets1
	+ using matrix_construction_is_kronecker_product_R
	+ using calculate_data_satisfies_properties_R nontriv1 nontriv2 nonzero nonzero satisfies_properties_R_def
	+ by fastforce
	+ then have matrix_same: "matrix_A_R ?signs ?subsets = kronecker_product (get_matrix_R (calculate_data_R p qs1)) (get_matrix_R (calculate_data_R p qs2))"
	+ using clear_signs clear_subsets
	+ by simp
	+ have comb_sys_h: "snd(snd(reduce_system_R p (combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))) =
	+ snd(snd(reduce_system_R p (qs1@qs2, (matrix_A_R ?signs ?subsets, (?subsets, ?signs)))))"
	+ unfolding get_signs_R_def get_subsets_R_def using matrix_same
	+ by (metis (full_types) clear_signs clear_subsets combine_systems_R.simps get_signs_R_def get_subsets_R_def getter_functions_R smash_systems_R_def)
	+ then have extra_h: " snd(snd(reduce_system_R p (qs1@qs2, (matrix_A_R ?signs ?subsets, (?subsets, ?signs))))) =
	+ snd(snd(reduction_step_R (matrix_A_R ?signs ?subsets) ?signs ?subsets (solve_for_lhs_R p (qs1@qs2) ?subsets (matrix_A_R ?signs ?subsets)))) "
	+ by simp
	+ then have same_h: "set(snd(snd(reduce_system_R p (combine_systems_R p (qs1,calculate_data_R p qs1) (qs2,calculate_data_R p qs2)))))
	+ = set (reduction_signs_R p (qs1@qs2) ?signs ?subsets (matrix_A_R ?signs ?subsets ))"
	+ using comb_sys_h unfolding reduction_signs_R_def
	+ by (metis get_signs_R_def help_h reduction_signs_is_get_signs_R)
	+ then show ?thesis using h
	+ by blast
	+qed
	+
	+lemma find_consistent_signs_at_roots_1_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ shows "(p \<noteq> 0 \<and> length qs > 0) \<longrightarrow>
	+ set(find_consistent_signs_at_roots_R p qs) = set(characterize_consistent_signs_at_roots p qs)"
	+proof (induction "length qs" arbitrary: qs rule: less_induct)
	+ case less
	+ then show ?case
	+ proof clarsimp
	+ assume ind_hyp: "(\<And>qsa.
	+ length qsa < length qs \<Longrightarrow> qsa \<noteq> [] \<longrightarrow>
	+ set (find_consistent_signs_at_roots_R p qsa) =
	+ set (characterize_consistent_signs_at_roots p qsa))"
	+ assume nonzero: "p \<noteq> 0"
	+ assume nontriv: "qs \<noteq> []"
	+ let ?len = "length qs"
	+ let ?q1 = "take ((?len) div 2) qs"
	+ let ?left = "calculate_data_R p ?q1"
	+ let ?q2 = "drop ((?len) div 2) qs"
	+ let ?right = "calculate_data_R p ?q2"
	+ have nontriv_q1: "length qs>1 \<longrightarrow> length ?q1 > 0"
	+ by auto
	+ have qs_more_q1: "length qs>1 \<longrightarrow> length qs > length ?q1"
	+ by auto
	+ have nontriv_q2: "length qs>1 \<longrightarrow>length ?q2 > 0"
	+ by auto
	+ have qs_more_q2: "length qs>1 \<longrightarrow> length qs > length ?q2"
	+ by auto
	+ have key_h: "set (snd (snd (if ?len \<le> Suc 0 then reduce_system_R p (qs, base_case_info_R)
	+ else Let (combine_systems_R p (?q1, ?left) (?q2, ?right))
	+ (reduce_system_R p)))) =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ proof -
	+ have h_len1 : "?len = 1 \<longrightarrow> set (snd (snd (if ?len \<le> Suc 0 then reduce_system_R p (qs, base_case_info_R)
	+ else Let (combine_systems_R p (?q1, ?left) (?q2, ?right))
	+ (reduce_system_R p)))) =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ using find_consistent_signs_at_roots_len1_R[of p qs] nonzero nontriv
	+ by (simp add: find_consistent_signs_at_roots_thm_R)
	+ have h_len_gt1 : "?len > 1 \<longrightarrow> set (snd (snd (if ?len \<le> Suc 0 then reduce_system_R p (qs, base_case_info_R)
	+ else Let (combine_systems_R p (?q1, ?left) (?q2, ?right))
	+ (reduce_system_R p)))) =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ proof -
	+ have h_imp_a: "?len > 1 \<longrightarrow> set (snd (snd (reduce_system_R p (combine_systems_R p (?q1, ?left) (?q2, ?right))))) =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ proof -
	+ have h1: "?len > 1 \<longrightarrow> set(snd(snd(?left))) = set (characterize_consistent_signs_at_roots p ?q1)"
	+ using nontriv_q1 ind_hyp[of ?q1] qs_more_q1
	+ by (metis find_consistent_signs_at_roots_thm_R less_numeral_extra(3) list.size(3))
	+ have h2: "?len > 1 \<longrightarrow> set(snd(snd(?right))) = set (characterize_consistent_signs_at_roots p ?q2)"
	+ using nontriv_q2 ind_hyp[of ?q2] qs_more_q2
	+ by (metis (full_types) find_consistent_signs_at_roots_thm_R list.size(3) not_less_zero)
	+ show ?thesis using nonzero nontriv_q1 nontriv_q2 h1 h2 smaller_sys_are_good_R
	+ by (metis append_take_drop_id find_consistent_signs_at_roots_thm_R)
	+ qed
	+ then have h_imp: "?len > 1 \<longrightarrow> set (snd (snd (Let (combine_systems_R p (?q1, ?left) (?q2, ?right))
	+ (reduce_system_R p)))) =
	+ set (characterize_consistent_signs_at_roots p qs)"
	+ by auto
	+ then show ?thesis by auto
	+ qed
	+ show ?thesis using h_len1 h_len_gt1
	+ by (meson \<open>qs \<noteq> []\<close> length_0_conv less_one nat_neq_iff)
	+ qed
	+ then show "set (find_consistent_signs_at_roots_R p qs) = set (characterize_consistent_signs_at_roots p qs)"
	+ using One_nat_def calculate_data.simps find_consistent_signs_at_roots_thm length_0_conv nontriv
	+ by (smt (z3) calculate_data_R.simps find_consistent_signs_at_roots_thm_R)
	+ qed
	+qed
	+
	+lemma find_consistent_signs_at_roots_0_R:
	+ fixes p:: "real poly"
	+ assumes "p \<noteq> 0"
	+ shows "set(find_consistent_signs_at_roots_R p []) =
	+ set(characterize_consistent_signs_at_roots p [])"
	+proof -
	+ obtain a b c where abc: "reduce_system_R p ([1], base_case_info_R) = (a,b,c)"
	+ using prod_cases3 by blast
	+ have "find_consistent_signs_at_roots_R p [1] = c" using abc
	+ by (simp add: find_consistent_signs_at_roots_thm_R)
	+ have *: "set (find_consistent_signs_at_roots_R p [1]) = set (characterize_consistent_signs_at_roots p [1])"
	+ apply (subst find_consistent_signs_at_roots_1_R)
	+ using assms by auto
	+ have "set(characterize_consistent_signs_at_roots p []) = drop 1 ` set(characterize_consistent_signs_at_roots p [1])"
	+ unfolding characterize_consistent_signs_at_roots_def consistent_sign_vec_def signs_at_def squash_def apply simp
	+ using drop0 drop_Suc_Cons image_cong image_image
	+ proof -
	+ have "(\<lambda>r. []) ` set (characterize_root_list_p p) = (\<lambda>r. drop (Suc 0) [1::rat]) ` set (characterize_root_list_p p)"
	+ by force
	+ then show "(\<lambda>r. []) ` set (characterize_root_list_p p) = drop (Suc 0) ` (\<lambda>r. [1::rat]) ` set (characterize_root_list_p p)"
	+ by blast
	+ qed
	+ thus ?thesis using abc *
	+ apply (auto) apply (simp add: find_consistent_signs_at_roots_thm_R)
	+ by (simp add: find_consistent_signs_at_roots_thm_R)
	+qed
	+
	+lemma find_consistent_signs_at_roots_R:
	+ fixes p:: "real poly"
	+ fixes qs :: "real poly list"
	+ assumes "p \<noteq> 0"
	+ shows "set(find_consistent_signs_at_roots_R p qs) = set(characterize_consistent_signs_at_roots p qs)"
	+ by (metis assms find_consistent_signs_at_roots_0_R find_consistent_signs_at_roots_1_R length_greater_0_conv)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/document/root.bib b/thys/BenOr_Kozen_Reif/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/document/root.bib
	@@ -0,0 +1,32 @@
	+@article{DBLP:journals/jcss/Ben-OrKR86,
	+ author = {Michael Ben{-}Or and
	+ Dexter Kozen and
	+ John H. Reif},
	+ title = {The Complexity of Elementary Algebra and Geometry},
	+ journal = {J. Comput. Syst. Sci.},
	+ volume = {32},
	+ number = {2},
	+ pages = {251--264},
	+ year = {1986},
	+ skipurl = {https://doi.org/10.1016/0022-0000(86)90029-2},
	+ doi = {10.1016/0022-0000(86)90029-2},
	+ timestamp = {Sat, 20 May 2017 00:25:56 +0200},
	+ biburl = {https://dblp.org/rec/journals/jcss/Ben-OrKR86.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	+
	+@article{DBLP:journals/jsc/Renegar92b,
	+ author = {James Renegar},
	+ title = {On the Computational Complexity and Geometry of the First-Order Theory
	+ of the Reals, Part {III:} {Q}uantifier Elimination},
	+ journal = {J. Symb. Comput.},
	+ volume = {13},
	+ number = {3},
	+ pages = {329--352},
	+ year = {1992},
	+ skipurl = {https://doi.org/10.1016/S0747-7171(10)80005-7},
	+ doi = {10.1016/S0747-7171(10)80005-7},
	+ timestamp = {Wed, 17 May 2017 14:25:48 +0200},
	+ biburl = {https://dblp.org/rec/journals/jsc/Renegar92b.bib},
	+ bibsource = {dblp computer science bibliography, https://dblp.org}
	+}
	\ No newline at end of file
	diff --git a/thys/BenOr_Kozen_Reif/document/root.tex b/thys/BenOr_Kozen_Reif/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/BenOr_Kozen_Reif/document/root.tex
	@@ -0,0 +1,72 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+
	+% further packages required for unusual symbols (see also
	+% isabellesym.sty), use only when needed
	+
	+\usepackage{amssymb}
	+ %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
	+ %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
	+ %\<triangleq>, \<yen>, \<lozenge>
	+
	+%\usepackage{eurosym}
	+ %for \<euro>
	+
	+%\usepackage[only,bigsqcap]{stmaryrd}
	+ %for \<Sqinter>
	+
	+%\usepackage{eufrak}
	+ %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
	+
	+%\usepackage{textcomp}
	+ %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
	+ %\<currency>
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+
	+
	+\begin{document}
	+
	+\title{The BKR Decision Procedure for Univariate Real Arithmetic}
	+\author{Katherine Cordwell, Yong Kiam Tan, and Andr\'e Platzer}
	+\maketitle
	+
	+\begin{abstract}
	+We formalize the univariate case of Ben-Or, Kozen, and Reif's decision procedure for first-order real arithmetic \cite{DBLP:journals/jcss/Ben-OrKR86} (the BKR algorithm). We also formalize the univariate case of Renegar's variation \cite{DBLP:journals/jsc/Renegar92b} of the BKR algorithm. The two formalizations differ mathematically in minor ways (that have significant impact on the multivariate case), but are quite similar in proof structure. Both rely on sign-determination (finding the set of consistent sign assignments for a set of polynomials). The method used for sign-determination is similar to Tarski's original quantifier elimination algorithm (it stores key information in a matrix equation), but with a reduction step to keep complexity low.
	+\end{abstract}
	+
	+\section*{Remark} Note that theories BKR\_Decision and Renegar\_Decision inherit oracles $\mathtt{holds\_by\_evaluation}$ and $\mathtt{cancel\_type\_definition}$ from Berlekamp\_Zassenhaus.
	+
	+\tableofcontents
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+% generated text of all theories
	+\input{session}
	+
	+% optional bibliography
	+\section*{Acknowledgements}
	+This material is based upon work supported by the National Science Foundation Graduate Research Fellowship under Grants Nos. DGE1252522 and DGE1745016.
	+Any opinions, findings, and conclusions or recommendations expressed in this material are those of the authors and do not necessarily reflect the views of the National Science Foundation.
	+This research was also sponsored by the National Science Foundation under Grant No. CNS-1739629, the AFOSR under grant number FA9550-16-1-0288, and A*STAR, Singapore.
	+The views and conclusions contained in this document are those of the authors and should not be interpreted as representing the official policies, either expressed or implied, of any sponsoring institution, the U.S. government or any other entity.
	+
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/GaleStewart_Games/AlternatingLists.thy b/thys/GaleStewart_Games/AlternatingLists.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/AlternatingLists.thy
	@@ -0,0 +1,144 @@
	+section \<open> Alternating lists \<close>
	+
	+text \<open>In lists where even and odd elements play different roles, it helps to define functions to
	+ take out the even elements. We defined the function (l)alternate on (coinductive) lists to
	+ do exactly this, and define certain properties.\<close>
	+
	+theory AlternatingLists
	+ imports MoreCoinductiveList2 (* for notation and lemmas like infinite_small_llength *)
	+begin
	+
	+text \<open>The functions ``alternate" and ``lalternate" are our main workhorses:
	+ they take every other item, so every item at even indices.\<close>
	+
	+fun alternate where
	+ "alternate Nil = Nil" \|
	+ "alternate (Cons x xs) = Cons x (alternate (tl xs))"
	+
	+text \<open>``lalternate" takes every other item from a co-inductive list.\<close>
	+primcorec lalternate :: "'a llist \<Rightarrow> 'a llist"
	+ where
	+ "lalternate xs = (case xs of LNil \<Rightarrow> LNil \|
	+ (LCons x xs) \<Rightarrow> LCons x (lalternate (ltl xs)))"
	+
	+lemma lalternate_ltake:
	+ "ltake (enat n) (lalternate xs) = lalternate (ltake (2*n) xs)"
	+proof(induct n arbitrary:xs)
	+ case 0
	+ then show ?case by (metis LNil_eq_ltake_iff enat_defs(1) lalternate.ctr(1) lnull_def mult_zero_right)
	+next
	+ case (Suc n)
	+ hence lt:"ltake (enat n) (lalternate (ltl (ltl xs))) = lalternate (ltake (enat (2 * n)) (ltl (ltl xs)))".
	+ show ?case
	+ proof(cases "lalternate xs")
	+ case LNil
	+ then show ?thesis by(metis lalternate.disc(2) lnull_def ltake_LNil)
	+ next
	+ case (LCons x21 x22)
	+ thus ?thesis unfolding ltake_ltl mult_Suc_right add_2_eq_Suc
	+ using eSuc_enat lalternate.code lalternate.ctr(1) lhd_LCons_ltl llist.sel(1)
	+ by (smt (z3) lt ltake_ltl llist.simps(3) llist.simps(5) ltake_eSuc_LCons)
	+ qed
	+qed
	+
	+lemma lalternate_llist_of[simp]:
	+ "lalternate (llist_of xs) = llist_of (alternate xs)"
	+proof(induct "alternate xs" arbitrary:xs)
	+ case Nil
	+ then show ?case
	+ by (metis alternate.elims lalternate.ctr(1) list.simps(3) llist_of.simps(1) lnull_llist_of)
	+next
	+ case (Cons a xs)
	+ then show ?case by(cases xs,auto simp: lalternate.ctr)
	+qed
	+
	+lemma lalternate_finite_helper: (* The other direction is proved later, added as SIMP rule *)
	+ assumes "lfinite (lalternate xs)"
	+ shows "lfinite xs"
	+using assms proof(induct "lalternate xs" arbitrary:xs rule:lfinite_induct)
	+ case LNil
	+ then show ?case unfolding lalternate.code[of xs] by(cases xs;auto)
	+next
	+ case (LCons xs)
	+ then show ?case unfolding lalternate.code[of xs] by(cases "xs";cases "ltl xs";auto)
	+qed
	+
	+lemma alternate_list_of: (* Note that this only holds for finite lists,
	+ as the other direction is left undefined with arguments (not just undefined) *)
	+ assumes "lfinite xs"
	+ shows "alternate (list_of xs) = list_of (lalternate xs)"
	+ using assms by (metis lalternate_llist_of list_of_llist_of llist_of_list_of)
	+
	+lemma alternate_length:
	+ "length (alternate xs) = (1+length xs) div 2"
	+ by (induct xs rule:induct_list012;simp)
	+
	+lemma lalternate_llength:
	+ "llength (lalternate xs) * 2 = (1+llength xs) \<or> llength (lalternate xs) * 2 = llength xs"
	+proof(cases "lfinite xs")
	+ case True
	+ let ?xs = "list_of xs"
	+ have "length (alternate ?xs) = (1+length ?xs) div 2" using alternate_length by auto
	+ hence "length (alternate ?xs) * 2 = (1+length ?xs) \<or> length (alternate ?xs) * 2 = length ?xs"
	+ by auto
	+ then show ?thesis using alternate_list_of[OF True] lalternate_llist_of True
	+ length_list_of_conv_the_enat[OF True] llist_of_list_of[OF True]
	+ by (metis llength_llist_of numeral_One of_nat_eq_enat of_nat_mult of_nat_numeral plus_enat_simps(1))
	+next
	+ case False
	+ have "\<not> lfinite (lalternate xs)" using False lalternate_finite_helper by auto
	+ hence l1:"llength (lalternate xs) = \<infinity>" by(rule not_lfinite_llength)
	+ from False have l2:"llength xs = \<infinity>" using not_lfinite_llength by auto
	+ show ?thesis using l1 l2 by (simp add: mult_2_right)
	+qed
	+
	+lemma lalternate_finite[simp]:
	+ shows "lfinite (lalternate xs) = lfinite xs"
	+proof(cases "lfinite xs")
	+ case True
	+ then show ?thesis
	+ proof(cases "lfinite (lalternate xs)")
	+ case False
	+ hence False using not_lfinite_llength[OF False] True[unfolded lfinite_conv_llength_enat]
	+ lalternate_llength[of xs]
	+ by (auto simp:one_enat_def numeral_eq_enat)
	+ thus ?thesis by metis
	+ qed auto
	+next
	+ case False
	+ then show ?thesis using lalternate_finite_helper by blast
	+qed
	+
	+lemma nth_alternate:
	+ assumes "2*n < length xs"
	+ shows "alternate xs ! n = xs ! (2 * n)"
	+ using assms proof (induct xs arbitrary:n rule:induct_list012)
	+ case (3 x y zs)
	+ then show ?case proof(cases n)
	+ case (Suc nat)
	+ show ?thesis using "3.hyps"(1) "3.prems" Suc by force
	+ qed simp
	+qed auto
	+
	+lemma lnth_lalternate:
	+ assumes "2*n < llength xs"
	+ shows "lalternate xs $ n = xs $ (2 * n)"
	+proof -
	+ let ?xs = "ltake (2*Suc n) xs"
	+ have "lalternate ?xs $ n = ?xs $ (2 * n)"
	+ using assms alternate_list_of[of "ltake (2*Suc n) xs"] nth_alternate[of n "list_of ?xs"]
	+ by (smt (z3) Suc_1 Suc_mult_less_cancel1 enat_ord_simps(2) infinite_small_llength lalternate_ltake length_list_of lessI llength_eq_enat_lfiniteD llength_ltake' ltake_all not_less nth_list_of numeral_eq_enat the_enat.simps times_enat_simps(1))
	+ thus ?thesis
	+ by (metis Suc_1 Suc_mult_less_cancel1 enat_ord_simps(2) lalternate_ltake lessI lnth_ltake)
	+qed
	+
	+lemma lnth_lalternate2[simp]:
	+ assumes "n < llength (lalternate xs)"
	+ shows "lalternate xs $ n = xs $ (2 * n)"
	+proof -
	+ from assms have "2*enat n < llength xs"
	+ by (metis enat_numeral lalternate_ltake leI linorder_neq_iff llength_ltake' ltake_all times_enat_simps(1))
	+ from lnth_lalternate[OF this] show ?thesis.
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/FilteredList.thy b/thys/GaleStewart_Games/FilteredList.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/FilteredList.thy
	@@ -0,0 +1,310 @@
	+theory FilteredList
	+ imports MoreCoinductiveList2
	+begin
	+
	+subsection \<open>More on filtered lists\<close>
	+
	+text \<open>We will reason about (co-inductive) lists with distinct elements.
	+ However, for our setting, this 'distinct' property only holds on the list after filtering.
	+ For this reason, we need some additional lemmas.\<close>
	+
	+text \<open>Taking a sublist preserves distinctness after filtering.\<close>
	+lemma ldistinct_lfilter_ltake[intro]:
	+ assumes "ldistinct (lfilter P xs)"
	+ shows "ldistinct (lfilter P (ltake x xs))"
	+ using assms
	+ by(induct xs,force,force
	+ ,(* sledgehammer found this gem to prove the inductive step via lfilter_lappend_lfinite!
	+ We will use this strategy ourselves later on *)
	+ metis lappend_ltake_ldrop ldistinct_lappend lfilter_lappend_lfinite lfinite_LConsI lfinite_ltake)
	+
	+text \<open>The function lfind is used in multiple proofs, all are introduced to prove ltake_lfilter.\<close>
	+definition lfind where "lfind P lst = (LEAST i. P (lst $ i))"
	+
	+lemma lfilter_lfind:
	+ assumes "lfilter P lst \<noteq> LNil"
	+ shows "P (lst $ lfind P lst)" (is ?g1)
	+ "P (lst $ y) \<Longrightarrow> lfind P lst \<le> y" (is "?a \<Longrightarrow> ?g2")
	+ "lfind P lst < llength lst" (is ?g3)
	+proof -
	+ let ?I = "{n. enat n < llength lst \<and> P (lst $ n)}"
	+ let ?xs = lst
	+ from assms[unfolded lfilter_conv_lnths] lset_LNil
	+ have "lset (lnths lst {n. enat n < llength lst \<and> P (lst $ n)}) \<noteq> {}" by auto
	+ hence "{?xs $ i \|i. enat i < llength ?xs \<and> i \<in> ?I} \<noteq> {}" using lset_lnths[of ?xs ?I] by metis
	+ then obtain i where p:"P (lst $ i)" "i < llength lst" by auto
	+ from p show ?g1 using LeastI lfind_def by metis
	+ from p show "?a \<Longrightarrow> ?g2" using Least_le lfind_def by metis
	+ from p show ?g3 using Least_le lfind_def by (metis enat_ord_simps(1) le_less_trans)
	+qed
	+
	+lemma ltake_lfind_lset:
	+ assumes "x \<in> lset (ltake (enat (lfind P lst)) lst)"
	+ shows "\<not> P x"
	+proof(cases "lfilter P (ltake (enat (lfind P lst)) lst) = LNil")
	+ case True
	+ then show ?thesis using assms unfolding lfilter_eq_LNil by auto
	+next
	+ case False
	+ from assms[unfolded in_lset_conv_lnth] obtain n where
	+ n:"enat n < llength (ltake (enat (lfind P lst)) lst)" "ltake (enat (lfind P lst)) lst $ n = x"
	+ by blast
	+ { assume a:"P x"
	+ (* The idea of this {block} is that the element n must come after (lfind P lst) by lfilter_lfind(2)
	+ but this contradicts n(1).
	+ However, in the last step when writing this proof, sledgehammer found one that didn't use
	+ any of my previous steps, so here's a one-liner: *)
	+ from n Coinductive_List.lset_ltake False a enat_ord_simps(1) leD lfilter_empty_conv lfilter_lfind(2,3) llength_ltake' lnth_ltake subset_eq
	+ have False by metis
	+ }
	+ then show ?thesis by blast
	+qed
	+
	+lemma ltake_lfind_conv:
	+ assumes "lfilter P lst \<noteq> LNil"
	+ shows "ltake (lfind P lst) lst = ltakeWhile (Not o P) lst" (is "?t1 = ?t2")
	+ "ldrop (lfind P lst) lst = ldropWhile (Not o P) lst" (is "?t3 = ?t4")
	+proof -
	+ have lfin:"lfinite ?t1" by simp
	+ have [simp]:"min (enat (lfind P lst)) (llength lst) = (lfind P lst)"
	+ using lfilter_lfind(3)[OF assms] by (metis min.strict_order_iff)
	+ have l1:"llength ?t1 = lfind P lst" by simp
	+ from ltake_lfind_lset ltakeWhile_all
	+ have t:"ltakeWhile (Not o P) ?t1 = ?t1" unfolding o_def by metis
	+ have inset:"lset (ltake (enat (lfind P lst)) lst) \<subseteq> {x. (Not \<circ> P) x}"
	+ using ltake_lfind_lset[of _ P lst] by auto (* for use in ltakeWhile_lappend2 *)
	+ have isnull:"ltakeWhile (Not \<circ> P) (ldrop (enat (lfind P lst)) lst) = LNil"
	+ apply(cases "ldrop (enat (lfind P lst)) lst")
	+ using lfilter_lfind(1)[OF assms] lhd_ldrop[OF lfilter_lfind(3)[OF assms]]
	+ by auto
	+ have "ltakeWhile (Not o P) ?t1 = ltakeWhile (Not o P) (lappend ?t1 ?t3)"
	+ unfolding ltakeWhile_lappend2[OF inset] isnull lappend_LNil2 t..
	+ hence leneq:"llength ?t1 = llength ?t2" using t l1 lappend_ltake_ldrop by metis
	+ have "lappend ?t1 ?t3 = lappend ?t2 ?t4"
	+ unfolding lappend_ltakeWhile_ldropWhile[of "Not \<circ> P" lst]
	+ lappend_ltake_ldrop[of "lfind P lst" lst]
	+ by simp
	+ from this[unfolded lappend_eq_lappend_conv[OF leneq]] lfin
	+ show "?t1 = ?t2" "?t3 = ?t4" by auto
	+qed
	+
	+lemma lfilter_hdtl:
	+ assumes "lfilter P lst \<noteq> LNil"
	+ shows "\<exists> n. LCons (lhd (lfilter P lst)) LNil = lfilter P (ltake (enat n) lst) \<and>
	+ ltl (lfilter P lst) = lfilter P (ldrop (enat n) lst)"
	+proof(standard,standard)
	+ note * = lfilter_lfind[OF assms]
	+ let ?n = "Suc (lfind P lst)"
	+ let ?ltake = "ltake (enat ?n) lst"
	+ have ltake:"lappend (ltakeWhile (Not \<circ> P) ?ltake) (ldropWhile (Not \<circ> P) ?ltake) = ?ltake"
	+ (is "lappend ?ltw ?ldw = _")
	+ using lappend_ltakeWhile_ldropWhile by blast
	+ have "llength ?ldw \<le> 1"
	+ unfolding ldropWhile_lappend ltake_Suc_conv_snoc_lnth[OF *(3)]
	+ using ltake_lfind_lset[of _ P lst] by (auto intro:* simp:one_eSuc)
	+ hence null:"lnull (ltl (ldropWhile (Not \<circ> P) ?ltake))"
	+ unfolding llength_eq_0[symmetric] llength_ltl
	+ by (metis dual_order.order_iff_strict enat_ile epred_0 epred_1 iless_Suc_eq le_zero_eq one_eSuc one_enat_def)
	+ have e:"enat (lfind P lst) < enat (Suc (lfind P lst))" by auto
	+ from * have "P (?ltake $ lfind P lst)" using lnth_ltake[OF e] by metis
	+ hence nonnull:"\<not> lnull (lfilter P ?ltake)" unfolding lnull_lfilter
	+ by (metis "*"(3) e in_lset_conv_lnth leI llength_ltake' ltake_all)
	+
	+ show a:"LCons (lhd (lfilter P lst)) LNil = lfilter P ?ltake" (is "?lhs = ?rhs")
	+ proof -
	+ have "lhd (lfilter P ?ltake) = lhd (lfilter P lst)"
	+ by(rule lprefix_lhdD[OF lprefix_lfilterI[OF ltake_is_lprefix] nonnull])
	+ hence h:"lhd ?lhs = lhd ?rhs" by simp
	+ have "ltl ?rhs = LNil"
	+ unfolding ltl_lfilter using null by (metis lfilter_LNil llist.collapse(1))
	+ hence t:"ltl ?lhs = ltl ?rhs" by simp
	+ have flt:"?rhs \<noteq> LNil" using nonnull by fastforce
	+ show ?thesis by(rule llist_eq_lcons[of ?lhs ?rhs,OF _ flt h t],auto)
	+ qed
	+
	+ from lappend_ltake_ldrop[of ?n lst] lappend_ltakeWhile_ldropWhile[of "Not \<circ> P" lst]
	+ have "lappend (ltake ?n lst) (ldrop ?n lst) = lappend (ltakeWhile (Not \<circ> P) lst) (ldropWhile (Not \<circ> P) lst)"
	+ by auto
	+ from ltake_lfind_conv(2)[OF assms]
	+ have "ltl (ldropWhile (Not \<circ> P) lst) = ldrop (enat (Suc (lfind P lst))) lst"
	+ unfolding ldrop_eSuc_conv_ltl eSuc_enat[symmetric] by simp
	+ thus "ltl (lfilter P lst) = lfilter P (ldrop (enat ?n) lst)" unfolding ltl_lfilter by metis
	+qed
	+
	+lemma ltake_lfilter:
	+ shows "\<exists> n. ltake (enat x) (lfilter P lst) = lfilter P (ltake (enat n) lst) \<and> ldrop (enat x) (lfilter P lst) = lfilter P (ldrop (enat n) lst)"
	+proof(induct x)
	+ case 0
	+ then show ?case by (metis LNil_eq_ltake_iff ldrop_enat ldropn_0 lfilter_code(1) zero_enat_def)
	+next
	+ let ?fP = "lfilter P"
	+ case (Suc x)
	+ then obtain n where n:"ltake (enat x) (?fP lst) = ?fP (ltake (enat n) lst)"
	+ "ldrop (enat x) (lfilter P lst) = lfilter P (ldrop (enat n) lst)" by blast
	+ consider "lfilter P (ldrop (enat n) lst) \<noteq> LNil \<and> x < llength (?fP lst)" \|
	+ "lfilter P (ldrop (enat n) lst) = LNil" \| "x \<ge> llength (?fP lst)" by force
	+ then show ?case proof(cases)
	+ case 1
	+ hence *:"lfilter P (ldrop (enat n) lst) \<noteq> LNil" "enat x < llength (lfilter P lst)" by auto
	+ from lappend_ltake_ldrop have "lst = lappend (ltake (enat n) lst) (ldrop (enat n) lst)" by metis
	+ from lfilter_hdtl[OF *(1)] obtain delta where
	+ delta:"LCons (lhd (?fP (ldrop (enat n) lst))) LNil = ?fP (ltake (enat delta) (ldrop (enat n) lst))"
	+ "ltl (lfilter P (ldrop (enat n) lst)) = lfilter P (ldrop (enat delta) (ldrop (enat n) lst))" by blast
	+ have "ltake (enat (Suc x)) (?fP lst) = lappend (?fP (ltake (enat n) lst)) (LCons (?fP lst $ x) LNil)"
	+ using n ltake_Suc_conv_snoc_lnth * by metis
	+ also have "?fP lst $ x = ?fP lst $ (the_enat x)" by auto
	+ also have "\<dots> = lhd (ldrop x (?fP lst))" using lhd_ldrop[symmetric] *(2) by metis
	+ also have "\<dots> = lhd (?fP (ldrop (enat n) lst))" using n by metis
	+ also note delta(1)
	+ finally have take_part:"ltake (enat (Suc x)) (?fP lst) = ?fP (ltake (enat (n + delta)) lst)"
	+ using ltake_plus_conv_lappend
	+ by (metis infinite_small_llength lfilter_lappend_lfinite llength_ltake' ltake_all min.strict_order_iff not_less plus_enat_simps(1))
	+ have "ldrop (enat (Suc x)) (?fP lst) = ltl (ldrop x (?fP lst))" by (simp add: ltl_ldropn ldrop_eSuc_ltl ldrop_enat)
	+ also have "ldrop x (?fP lst) = ?fP (ldrop (enat n) lst)" using n by metis
	+ also note delta(2)
	+ also have "lfilter P (ldrop (enat delta) (ldrop (enat n) lst)) = lfilter P (ldrop (enat delta + enat n) lst)"
	+ by simp
	+ also have "(enat delta + enat n) = enat (n + delta)" by simp
	+ finally have drop_part:"ldrop (enat (Suc x)) (?fP lst) = ?fP (ldrop (enat (n + delta)) lst)".
	+ from take_part drop_part show ?thesis by blast
	+ next
	+ case 2
	+ note * = 2 lappend_ltake_ldrop[of "enat n" lst] Suc_llength infinite_small_llength
	+ lappend_LNil2 leI lfilter_lappend_lfinite llength_ltake' min.strict_order_iff n
	+ have take_part:"ltake (enat (Suc x)) (?fP lst) = ?fP (ltake (enat n) lst)"
	+ using * by (smt (z3) ltake_all)
	+ from 2 have drop_part:"ldrop (enat (Suc x)) (?fP lst) = ?fP (ldrop (enat n) lst)"
	+ using * by (smt (z3) ldrop_all)
	+ from take_part drop_part show ?thesis by blast
	+ next
	+ case 3
	+ then show ?thesis using n dual_order.order_iff_strict eSuc_enat iless_Suc_eq le_less_trans ltake_all ldrop_all
	+ by metis
	+ qed
	+qed
	+
	+lemma filter_obtain_two:
	+ assumes "i < j" "j < length (filter P lst)"
	+ shows "\<exists> i2 j2. i2 < j2 \<and> j2 < length lst \<and> lst ! i2 = filter P lst ! i \<and> lst ! j2 = filter P lst ! j"
	+ using assms
	+proof(induct lst arbitrary: i j)
	+ case (Cons a lst)
	+ then obtain jprev where jprev:"j = Suc jprev" using lessE by metis
	+ show ?case proof(cases "P a")
	+ case True
	+ hence lnth[simp]:"length (filter P (a # lst)) = Suc (length (filter P lst))" by auto
	+ show ?thesis proof(cases i)
	+ case 0
	+ from jprev True Cons(3) have "jprev < length (filter P lst) " by auto
	+ from nth_mem[OF this]
	+ have "filter P lst ! jprev \<in> set lst" by auto
	+ from this[unfolded in_set_conv_nth] obtain j2 where
	+ "j2<length lst" "lst ! j2 = filter P lst ! jprev" by blast
	+ hence "0 < Suc j2" "Suc j2 < length (a # lst)"
	+ "(a # lst) ! 0 = filter P (a # lst) ! i"
	+ "(a # lst) ! Suc j2 = filter P (a # lst) ! j" using 0 True jprev by auto
	+ then show ?thesis by blast
	+ next
	+ case (Suc nat)
	+ then obtain jprev where jprev:"j = Suc jprev" using Cons lessE by metis
	+ hence "nat < jprev" "jprev < length (filter P lst)" using Cons Suc lnth by auto
	+ from Cons(1)[OF this] obtain i2 j2 where "i2 < j2" "j2 < length lst"
	+ "lst ! i2 = filter P lst ! nat" "lst ! j2 = filter P lst ! jprev" by blast
	+ hence "Suc i2 < Suc j2" "Suc j2 < length (a # lst)"
	+ "(a # lst) ! Suc i2 = filter P (a # lst) ! Suc nat"
	+ "(a # lst) ! Suc j2 = filter P (a # lst) ! Suc jprev" using lnth by auto
	+ then show ?thesis unfolding jprev[symmetric] Suc[symmetric] by blast
	+ qed
	+ next
	+ case False
	+ hence [simp]: "filter P (a # lst) = filter P lst" by auto
	+ from Cons(1)[OF Cons(2)] Cons(3)[unfolded this]
	+ obtain i2 j2 where "i2 < j2" "j2 < length lst"
	+ "lst ! i2 = filter P lst ! i" "lst ! j2 = filter P lst ! j" by blast
	+ hence "Suc i2 < Suc j2" "Suc j2 < length (a # lst)"
	+ "(a # lst) ! Suc i2 = filter P (a # lst) ! i"
	+ "(a # lst) ! Suc j2 = filter P (a # lst) ! j" by (auto simp:False)
	+ then show ?thesis by blast
	+ qed
	+qed auto
	+
	+lemma ldistinct_lfilterI:
	+ assumes "\<And> i j. i < llength lst \<Longrightarrow> j < llength lst \<Longrightarrow> lst $ i = lst $ j \<Longrightarrow> P (lst $ i) \<Longrightarrow> i = j"
	+ shows "ldistinct (lfilter P lst)"
	+proof -
	+{ fix i j
	+ assume *: "enat i < llength (lfilter P lst)"
	+ "enat j < llength (lfilter P lst)"
	+ "lfilter P lst $ i = lfilter P lst $ j"
	+ "i < j"
	+ hence "lfilter P lst $ i \<in> lset (lfilter P lst)"
	+ unfolding in_lset_conv_lnth by auto
	+ with lset_lfilter
	+ have P:"P (lfilter P lst $ i)" by auto
	+ let ?maxij = "Suc (max i j)"
	+ from ltake_lfilter obtain maxij where
	+ maxij:"ltake ?maxij (lfilter P lst) = lfilter P (ltake (enat maxij) lst)"
	+ by blast
	+ let ?lst = "ltake (enat maxij) lst"
	+ have "lfinite ?lst" by auto
	+ define flst where "flst = list_of ?lst"
	+ hence flst:"llist_of flst = ?lst" by auto
	+ let ?flst = "llist_of flst"
	+ from * P
	+ have "enat i < llength (lfilter P ?flst)"
	+ "enat j < llength (lfilter P ?flst)"
	+ "lfilter P ?flst $ i = lfilter P ?flst $ j"
	+ and P2:"P (lfilter P ?lst $ i)"
	+ unfolding maxij[symmetric] flst by (auto simp add: lnth_ltake)
	+ hence "i < length (filter P flst)"
	+ "j < length (filter P flst)"
	+ and eq_ij: "filter P flst ! i = filter P flst ! j"
	+ unfolding llength_llist_of lfilter_llist_of lnth_llist_of by auto
	+ with filter_obtain_two[OF *(4) this(2)] obtain i2 j2
	+ where "i2 < length flst" "j2 < length flst"
	+ "flst ! i2 = filter P flst ! i"
	+ "flst ! j2 = filter P flst ! j"
	+ and ineq:"i2<j2"
	+ by auto
	+ hence "i2 < llength ?flst" "j2 < llength ?flst" "?flst $ i2 = ?flst $ j2" "?flst $ i2 = lfilter P ?flst $ i" "i2<j2"
	+ unfolding llength_llist_of lfilter_llist_of lnth_llist_of eq_ij by auto
	+ hence "enat i2 < llength lst" "enat j2 < llength lst" "lst $ i2 = lst $ j2" "P (lst $ i2)"
	+ using P2 unfolding flst by (auto simp add: lnth_ltake)
	+ from assms[OF this]
	+ have False using ineq by auto
	+}
	+thus ?thesis unfolding ldistinct_conv_lnth by (smt (z3) le_cases3 less_le)
	+qed
	+
	+lemma ldistinct_lfilterE:
	+ assumes "ldistinct (lfilter P lst)" "e = lst $ i" "e = lst $ j"
	+ "i < llength lst" "j < llength lst" "P e"
	+ shows "i = j"
	+proof -
	+ let ?maxij = "Suc (max i j)"
	+ let ?lst = "ltake (enat ?maxij) lst"
	+ have jle:"j < length (list_of (ltake (enat (Suc (max i j))) lst))" using assms(4,5)
	+ apply(subst length_list_of_conv_the_enat,force)
	+ by(cases "llength lst", auto simp:min_enat2_conv_enat min_enat1_conv_enat)
	+ have ile:"i < length (list_of (ltake (enat (Suc (max i j))) lst))" using assms(4,5)
	+ apply(subst length_list_of_conv_the_enat,force)
	+ by(cases "llength lst", auto simp:min_enat2_conv_enat min_enat1_conv_enat)
	+ have "enat i < ?maxij" "enat j < ?maxij" by auto
	+ from this[THEN lnth_ltake,of lst] assms
	+ have "ldistinct (lfilter P ?lst)" "e = ?lst $ i" "e = ?lst $ j" by auto
	+ hence d:"distinct (filter P (list_of ?lst))"
	+ "(list_of ?lst) ! j = e" "(list_of ?lst) ! i = e"
	+ using lfilter_llist_of[of P "list_of ?lst"] by auto
	+ show ?thesis by(rule distinct_filterD[OF d(1) jle ile assms(6) d(2,3)])
	+qed
	+
	+lemma ldistinct_lfilter_conv:
	+ "ldistinct (lfilter P lst) = (\<forall> i j. i < llength lst \<longrightarrow> j < llength lst \<longrightarrow> P (lst $ i) \<longrightarrow> lst $ i = lst $ j \<longrightarrow> i = j)"
	+proof
	+ show "ldistinct (lfilter P lst) \<Longrightarrow> \<forall>i j. enat i < llength lst \<longrightarrow> enat j < llength lst \<longrightarrow> P (lst $ i) \<longrightarrow> lst $ i = lst $ j \<longrightarrow> i = j"
	+ by (auto simp add: ldistinct_lfilterE)
	+ show "\<forall>i j. enat i < llength lst \<longrightarrow> enat j < llength lst \<longrightarrow> P (lst $ i) \<longrightarrow> lst $ i = lst $ j \<longrightarrow> i = j \<Longrightarrow> ldistinct (lfilter P lst) "
	+ using ldistinct_lfilterI by blast
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/GaleStewartDefensiveStrategies.thy b/thys/GaleStewart_Games/GaleStewartDefensiveStrategies.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/GaleStewartDefensiveStrategies.thy
	@@ -0,0 +1,239 @@
	+subsection \<open>Defensive strategies\<close>
	+
	+text \<open> A strategy is defensive if a player can avoid reaching winning positions.
	+ If the opponent is not already in a winning position, such defensive strategies exist.
	+ In closed games, a defensive strategy is winning for the closed player,
	+ so these strategies are a crucial step towards proving that such games are determined.
	+ \<close>
	+theory GaleStewartDefensiveStrategies
	+ imports GaleStewartGames
	+begin
	+
	+context GSgame
	+begin
	+
	+definition move_defensive_by_Even where
	+ "move_defensive_by_Even m p \<equiv> even (length p) \<longrightarrow> \<not> winning_position_Odd (p @ [m])"
	+definition move_defensive_by_Odd where
	+ "move_defensive_by_Odd m p \<equiv> odd (length p) \<longrightarrow> \<not> winning_position_Even (p @ [m])"
	+
	+(* This was a tricky part of the proof, it required explicit use of the choice theorem *)
	+lemma defensive_move_exists_for_Even:
	+assumes [intro]:"position p"
	+shows "winning_position_Odd p \<or> (\<exists> m. move_defensive_by_Even m p)" (is "?w \<or> ?d")
	+proof(cases "length p = 2*N \<or> odd (length p)")
	+ case False
	+ hence pl[intro]:"length p < 2*N"
	+ and ev[intro]:"even (length p)" using assms[unfolded position_def] by auto
	+ show ?thesis proof(rule impI[of "\<not> ?d \<longrightarrow> \<not> ?w \<longrightarrow> False", rule_format], force)
	+ assume not_def:"\<not> ?d"
	+ from not_def[unfolded move_defensive_by_Even_def]
	+ have "\<forall> m. \<exists>\<sigma>. strategy_winning_by_Odd \<sigma> (p @ [m])" by blast
	+ from choice[OF this] obtain \<sigma>\<^sub>o where
	+ str_Odd:"\<And> m. strategy_winning_by_Odd (\<sigma>\<^sub>o m) (p @ [m])" by blast
	+ define \<sigma> where "\<sigma> p' = \<sigma>\<^sub>o (p' ! length p) p'" for p'
	+ assume not_win:"\<not> ?w"
	+ from not_win[unfolded move_defensive_by_Even_def strategy_winning_by_Odd_def]
	+ obtain \<sigma>\<^sub>e where
	+ str_Even:"induced_play (joint_strategy \<sigma>\<^sub>e \<sigma>) p \<in> A"
	+ (is "?pe p \<in> A")
	+ by blast
	+ let ?pnext = "(p @ [joint_strategy \<sigma>\<^sub>e \<sigma> p])"
	+ { fix p' m
	+ assume "prefix (p @ [m]) p'"
	+ hence "(p' ! length p) = m"
	+ unfolding prefix_def by auto
	+ }
	+ hence eq_a:"\<forall> p'. prefix ?pnext p' \<longrightarrow> p' @ [joint_strategy \<sigma>\<^sub>e \<sigma> p'] =
	+ p' @ [joint_strategy \<sigma>\<^sub>e (\<sigma>\<^sub>o (joint_strategy \<sigma>\<^sub>e \<sigma> p)) p']"
	+ unfolding joint_strategy_def \<sigma>_def by auto
	+ have simps:"?pe p = ?pe (p @ [joint_strategy \<sigma>\<^sub>e \<sigma> p])"
	+ unfolding induced_play_def by auto
	+ from str_Even str_Odd[of "joint_strategy \<sigma>\<^sub>e \<sigma> p", unfolded strategy_winning_by_Odd_def, rule_format, of "\<sigma>\<^sub>e"]
	+ induced_play_eq[OF eq_a]
	+ show False unfolding simps by auto
	+ qed
	+qed (auto simp: move_defensive_by_Even_def strategy_winning_by_Even_def position_maxlength_cannotbe_augmented)
	+
	+(* This is a repetition of the proof for defensive_move_exists_for_Even *)
	+lemma defensive_move_exists_for_Odd:
	+assumes [intro]:"position p"
	+shows "winning_position_Even p \<or> (\<exists> m. move_defensive_by_Odd m p)" (is "?w \<or> ?d")
	+proof(cases "length p = 2*N \<or> even (length p)")
	+ case False
	+ hence pl[intro]:"length p < 2*N"
	+ and ev[intro]:"odd (length p)" using assms[unfolded position_def] by auto
	+ show ?thesis proof(rule impI[of "\<not> ?d \<longrightarrow> \<not> ?w \<longrightarrow> False", rule_format], force)
	+ assume not_def:"\<not> ?d"
	+ from not_def[unfolded move_defensive_by_Odd_def]
	+ have "\<forall> m. \<exists>\<sigma>. strategy_winning_by_Even \<sigma> (p @ [m])" by blast
	+ from choice[OF this] obtain \<sigma>\<^sub>e where
	+ str_Even:"\<And> m. strategy_winning_by_Even (\<sigma>\<^sub>e m) (p @ [m])" by blast
	+ define \<sigma> where "\<sigma> p' = \<sigma>\<^sub>e (p' ! length p) p'" for p'
	+ assume not_win:"\<not> ?w"
	+ from not_win[unfolded move_defensive_by_Odd_def strategy_winning_by_Even_def]
	+ obtain \<sigma>\<^sub>o where
	+ str_Odd:"induced_play (joint_strategy \<sigma> \<sigma>\<^sub>o) p \<notin> A"
	+ (is "?pe p \<notin> A")
	+ by blast
	+ let ?strat = "joint_strategy \<sigma> \<sigma>\<^sub>o"
	+ let ?pnext = "(p @ [?strat p])"
	+ { fix p' m
	+ assume "prefix (p @ [m]) p'"
	+ hence "(p' ! length p) = m"
	+ unfolding prefix_def by auto
	+ }
	+ hence eq_a:"\<forall> p'. prefix ?pnext p' \<longrightarrow> p' @ [?strat p'] =
	+ p' @ [joint_strategy (\<sigma>\<^sub>e (?strat p)) \<sigma>\<^sub>o p']"
	+ unfolding joint_strategy_def \<sigma>_def by auto
	+ have simps:"?pe p = ?pe (p @ [?strat p])"
	+ unfolding induced_play_def by auto
	+ from str_Odd str_Even[of "?strat p", unfolded strategy_winning_by_Even_def, rule_format]
	+ induced_play_eq[OF eq_a]
	+ show False unfolding simps by auto
	+ qed
	+qed (auto simp: move_defensive_by_Odd_def strategy_winning_by_Odd_def position_maxlength_cannotbe_augmented)
	+
	+definition defensive_strategy_Even where
	+"defensive_strategy_Even p \<equiv> SOME m. move_defensive_by_Even m p"
	+definition defensive_strategy_Odd where
	+"defensive_strategy_Odd p \<equiv> SOME m. move_defensive_by_Odd m p"
	+
	+lemma position_augment:
	+ assumes "position ((augment_list f ^^ n) p)"
	+ shows "position p"
	+ using assms length_augment_list[of n f p] unfolding position_def
	+ by fastforce
	+
	+lemma defensive_strategy_Odd:
	+ assumes "\<not> winning_position_Even p"
	+ shows "\<not> winning_position_Even (((augment_list (joint_strategy \<sigma>\<^sub>e defensive_strategy_Odd)) ^^ n) p)"
	+proof -
	+ show ?thesis using assms proof(induct n arbitrary:p)
	+ case (Suc n)
	+ show ?case proof(cases "position p")
	+ case True
	+ from Suc.prems defensive_move_exists_for_Odd[OF True] defensive_strategy_Odd_def someI
	+ have "move_defensive_by_Odd (defensive_strategy_Odd p) p" by metis
	+ from this[unfolded move_defensive_by_Odd_def] Suc.prems
	+ non_winning_moves_remains_non_winning_Even[of p]
	+ have "\<not> winning_position_Even (p @ [joint_strategy \<sigma>\<^sub>e defensive_strategy_Odd p])"
	+ by (simp add: joint_strategy_def True)
	+ with Suc.hyps[of "p @ [joint_strategy \<sigma>\<^sub>e defensive_strategy_Odd p]"]
	+ show ?thesis unfolding funpow_Suc_right comp_def by fastforce
	+ qed (insert position_augment,blast)
	+ qed auto
	+qed
	+
	+lemma defensive_strategy_Even:
	+ assumes "\<not> winning_position_Odd p"
	+ shows "\<not> winning_position_Odd (((augment_list (joint_strategy defensive_strategy_Even \<sigma>\<^sub>o)) ^^ n) p)"
	+proof -
	+ show ?thesis using assms proof(induct n arbitrary:p)
	+ case (Suc n)
	+ show ?case proof(cases "position p")
	+ case True
	+ from Suc.prems defensive_move_exists_for_Even[OF True] defensive_strategy_Even_def someI
	+ have "move_defensive_by_Even (defensive_strategy_Even p) p" by metis
	+ from this[unfolded move_defensive_by_Even_def] Suc.prems
	+ non_winning_moves_remains_non_winning_Odd[of p]
	+ have "\<not> winning_position_Odd (p @ [joint_strategy defensive_strategy_Even \<sigma>\<^sub>o p])"
	+ by (simp add: joint_strategy_def True)
	+ with Suc.hyps[of "p @ [joint_strategy defensive_strategy_Even \<sigma>\<^sub>o p]"]
	+ show ?thesis unfolding funpow_Suc_right comp_def by fastforce
	+ qed (insert position_augment,blast)
	+ qed auto
	+qed
	+
	+
	+end
	+
	+locale closed_GSgame = GSgame +
	+ assumes closed:"e \<in> A \<Longrightarrow> \<exists> p. lprefix (llist_of p) e \<and> (\<forall> e'. lprefix (llist_of p) e' \<longrightarrow> llength e' = 2*N \<longrightarrow> e' \<in> A)"
	+
	+(* Perhaps a misnomer, GSgames are supposed to be infinite ... *)
	+locale finite_GSgame = GSgame +
	+ assumes fin:"N \<noteq> \<infinity>"
	+begin
	+
	+text \<open> Finite games are closed games. As a corollary to the GS theorem, this lets us conclude that finite games are determined. \<close>
	+sublocale closed_GSgame
	+proof
	+ fix e assume eA:"e \<in> A"
	+ let ?p = "list_of e"
	+ from eA have len:"llength e = 2*N" using length by blast
	+ with fin have p:"llist_of ?p = e"
	+ by (metis llist_of_list_of mult_2 not_lfinite_llength plus_eq_infty_iff_enat)
	+ hence pfx:"lprefix (llist_of ?p) e" by auto
	+ { fix e'
	+ assume "lprefix (llist_of ?p) e'" "llength e' = 2 * N"
	+ hence "e' = e" using len by (metis lprefix_llength_eq_imp_eq p)
	+ with eA have "e' \<in> A" by simp
	+ }
	+ with pfx show "\<exists>p. lprefix (llist_of p) e \<and> (\<forall>e'. lprefix (llist_of p) e' \<longrightarrow> llength e' = 2 * N \<longrightarrow> e' \<in> A)"
	+ by blast
	+qed
	+end
	+
	+context closed_GSgame begin
	+lemma never_winning_is_losing_even:
	+ assumes "position p" "\<forall> n. \<not> winning_position_Even (((augment_list \<sigma>) ^^ n) p)"
	+ shows "induced_play \<sigma> p \<notin> A"
	+proof
	+ assume "induced_play \<sigma> p \<in> A"
	+ from closed[OF this] obtain p' where
	+ p':"lprefix (llist_of p') (induced_play \<sigma> p)"
	+ "\<And> e. lprefix (llist_of p') e \<Longrightarrow> llength e = 2 * N \<Longrightarrow> e \<in> A" by blast
	+ from lprefix_llength_le[OF p'(1)] have lp':"llength (llist_of p') \<le> 2 * N" by auto
	+ show False proof (cases "length p' \<le> length p")
	+ case True
	+ hence "llength (llist_of p') \<le> llength (llist_of p)" by auto
	+ from lprefix_llength_lprefix[OF p'(1) _ this]
	+ induced_play_is_lprefix[OF assms(1)]
	+ lprefix_trans
	+ have pref:"lprefix (llist_of p') (induced_play strat p)" for strat by blast
	+ from assms(2)[rule_format,of 0] assms(1) have "\<not> strategy_winning_by_Even \<sigma> p" for \<sigma> by auto
	+ from this[unfolded strategy_winning_by_Even_def] obtain strat where
	+ strat:"induced_play strat p \<notin> A" by auto
	+ from strat p'(2)[OF pref] show False by simp
	+ next
	+ case False
	+ let ?n = "length p' - length p"
	+ let ?pos = "(augment_list \<sigma> ^^ ?n) p"
	+ from False have "length p' \<ge> length p" by auto
	+ hence [simp]:"length ?pos = length p'"
	+ by (auto simp:length_augment_list)
	+ hence pos[intro]:"position ?pos"
	+ using False lp'(1) unfolding position_def by auto
	+ have "llist_of p' = llist_of ?pos"
	+ using p'(1)
	+ by(intro lprefix_antisym[OF lprefix_llength_lprefix lprefix_llength_lprefix],auto)
	+ hence p'_pos:"p' = ?pos" by simp
	+ from assms(2)[rule_format,of ?n] assms(1) have "\<not> strategy_winning_by_Even \<sigma> ?pos" for \<sigma> by auto
	+ from this[unfolded strategy_winning_by_Even_def] obtain strat where
	+ strat:"induced_play strat ?pos \<notin> A" by auto
	+ from p'_pos induced_play_is_lprefix[OF pos, of strat]
	+ have pref:"lprefix (llist_of p') (induced_play strat ?pos)" by simp
	+ with p'(2)[OF pref] strat show False by simp
	+ qed
	+qed
	+
	+lemma every_position_is_determined:
	+ assumes "position p"
	+ shows "winning_position_Even p \<or> winning_position_Odd p" (is "?we \<or> ?wo")
	+proof(rule impI[of "\<not> ?we \<longrightarrow> \<not> ?wo \<longrightarrow> False",rule_format],force)
	+ assume "\<not> ?we"
	+ from defensive_strategy_Odd[OF this] never_winning_is_losing_even[OF assms]
	+ have js_no:"induced_play
	+ (joint_strategy s defensive_strategy_Odd) p \<notin> A" for s
	+ by auto
	+ assume "\<not> ?wo"
	+ from this[unfolded strategy_winning_by_Odd_def] assms
	+ have "\<exists> s. induced_play
	+ (joint_strategy s defensive_strategy_Odd) p \<in> A" by simp
	+ thus False using js_no by simp
	+qed
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/GaleStewartDeterminedGames.thy b/thys/GaleStewart_Games/GaleStewartDeterminedGames.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/GaleStewartDeterminedGames.thy
	@@ -0,0 +1,116 @@
	+subsection \<open>Determined games\<close>
	+
	+theory GaleStewartDeterminedGames
	+ imports GaleStewartDefensiveStrategies
	+begin
	+
	+locale closed_GSgame = GSgame +
	+ assumes closed:"e \<in> A \<Longrightarrow> \<exists> p. lprefix (llist_of p) e \<and> (\<forall> e'. lprefix (llist_of p) e' \<longrightarrow> llength e' = 2*N \<longrightarrow> e' \<in> A)"
	+
	+(* Perhaps a misnomer, GSgames are supposed to be infinite, but this is very much the GS variation
	+ of finite games, as definitions still use coinductive lists rather than the more common
	+ inductive (and finite) ones. *)
	+locale finite_GSgame = GSgame +
	+ assumes fin:"N \<noteq> \<infinity>"
	+begin
	+
	+text \<open> Finite games are closed games. As a corollary to the GS theorem, this lets us conclude that finite games are determined. \<close>
	+sublocale closed_GSgame
	+proof
	+ fix e assume eA:"e \<in> A"
	+ let ?p = "list_of e"
	+ from eA have len:"llength e = 2*N" using length by blast
	+ with fin have p:"llist_of ?p = e"
	+ by (metis llist_of_list_of mult_2 not_lfinite_llength plus_eq_infty_iff_enat)
	+ hence pfx:"lprefix (llist_of ?p) e" by auto
	+ { fix e'
	+ assume "lprefix (llist_of ?p) e'" "llength e' = 2 * N"
	+ hence "e' = e" using len by (metis lprefix_llength_eq_imp_eq p)
	+ with eA have "e' \<in> A" by simp
	+ }
	+ with pfx show "\<exists>p. lprefix (llist_of p) e \<and> (\<forall>e'. lprefix (llist_of p) e' \<longrightarrow> llength e' = 2 * N \<longrightarrow> e' \<in> A)"
	+ by blast
	+qed
	+end
	+
	+context closed_GSgame begin
	+lemma never_winning_is_losing_even:
	+ assumes "position p" "\<forall> n. \<not> winning_position_Even (((augment_list \<sigma>) ^^ n) p)"
	+ shows "induced_play \<sigma> p \<notin> A"
	+proof
	+ assume "induced_play \<sigma> p \<in> A"
	+ from closed[OF this] obtain p' where
	+ p':"lprefix (llist_of p') (induced_play \<sigma> p)"
	+ "\<And> e. lprefix (llist_of p') e \<Longrightarrow> llength e = 2 * N \<Longrightarrow> e \<in> A" by blast
	+ from lprefix_llength_le[OF p'(1)] have lp':"llength (llist_of p') \<le> 2 * N" by auto
	+ show False proof (cases "length p' \<le> length p")
	+ case True
	+ hence "llength (llist_of p') \<le> llength (llist_of p)" by auto
	+ from lprefix_llength_lprefix[OF p'(1) _ this]
	+ induced_play_is_lprefix[OF assms(1)]
	+ lprefix_trans
	+ have pref:"lprefix (llist_of p') (induced_play strat p)" for strat by blast
	+ from assms(2)[rule_format,of 0] assms(1) have "\<not> strategy_winning_by_Even \<sigma> p" for \<sigma> by auto
	+ from this[unfolded strategy_winning_by_Even_def] obtain strat where
	+ strat:"induced_play strat p \<notin> A" by auto
	+ from strat p'(2)[OF pref] show False by simp
	+ next
	+ case False
	+ let ?n = "length p' - length p"
	+ let ?pos = "(augment_list \<sigma> ^^ ?n) p"
	+ from False have "length p' \<ge> length p" by auto
	+ hence [simp]:"length ?pos = length p'"
	+ by (auto simp:length_augment_list)
	+ hence pos[intro]:"position ?pos"
	+ using False lp'(1) unfolding position_def by auto
	+ have "llist_of p' = llist_of ?pos"
	+ using p'(1)
	+ by(intro lprefix_antisym[OF lprefix_llength_lprefix lprefix_llength_lprefix],auto)
	+ hence p'_pos:"p' = ?pos" by simp
	+ from assms(2)[rule_format,of ?n] assms(1) have "\<not> strategy_winning_by_Even \<sigma> ?pos" for \<sigma> by auto
	+ from this[unfolded strategy_winning_by_Even_def] obtain strat where
	+ strat:"induced_play strat ?pos \<notin> A" by auto
	+ from p'_pos induced_play_is_lprefix[OF pos, of strat]
	+ have pref:"lprefix (llist_of p') (induced_play strat ?pos)" by simp
	+ with p'(2)[OF pref] strat show False by simp
	+ qed
	+qed
	+
	+text \<open> By proving that every position is determined, this proves that every game is determined
	+ (since a game is determined if its initial position [] is) \<close>
	+lemma every_position_is_determined:
	+ assumes "position p"
	+ shows "winning_position_Even p \<or> winning_position_Odd p" (is "?we \<or> ?wo")
	+proof(rule impI[of "\<not> ?we \<longrightarrow> \<not> ?wo \<longrightarrow> False",rule_format],force)
	+ assume "\<not> ?we"
	+ from defensive_strategy_Odd[OF this] never_winning_is_losing_even[OF assms]
	+ have js_no:"induced_play
	+ (joint_strategy s defensive_strategy_Odd) p \<notin> A" for s
	+ by auto
	+ assume "\<not> ?wo"
	+ from this[unfolded strategy_winning_by_Odd_def] assms
	+ have "\<exists> s. induced_play
	+ (joint_strategy s defensive_strategy_Odd) p \<in> A" by simp
	+ thus False using js_no by simp
	+qed
	+lemma empty_position: "position []" using zero_enat_def position_def by auto
	+lemmas every_game_is_determined = every_position_is_determined[OF empty_position]
	+
	+
	+text \<open> We expect that this theorem can be easier to apply without the 'position p' requirement,
	+ so we present that theorem as well. \<close>
	+lemma every_position_has_winning_strategy:
	+ shows "(\<exists> \<sigma>. strategy_winning_by_Even \<sigma> p) \<or> (\<exists> \<sigma>. strategy_winning_by_Odd \<sigma> p)" (is "?we \<or> ?wo")
	+proof(cases "position p")
	+ case True
	+ then show ?thesis using every_position_is_determined by blast
	+next
	+ case False
	+ hence "2 * N \<le> enat (length p)" unfolding position_def by force
	+ from induced_play_lprefix_non_positions[OF this]
	+ show ?thesis unfolding strategy_winning_by_Even_def strategy_winning_by_Odd_def by simp
	+qed
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/GaleStewartGames.thy b/thys/GaleStewart_Games/GaleStewartGames.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/GaleStewartGames.thy
	@@ -0,0 +1,403 @@
	+section \<open>Gale Stewart Games\<close>
	+
	+text \<open>Gale Stewart Games are infinite two player games.\<close>
	+(* [Gale & Stewart 1953] David Gale, F. M. Stewart, Infinite games with perfect information,
	+ Contributions to the Theory of Games II, ed. H. W. Kuhn and A. W. Tucker,
	+ Annals of Mathematics Studies 28, Princeton University Press (1953), pp 245–266. *)
	+
	+theory GaleStewartGames
	+ imports AlternatingLists MorePrefix MoreENat
	+begin
	+
	+subsection \<open>Basic definitions and their properties.\<close>
	+
	+text \<open>A GSgame G(A) is defined by a set of sequences that denote the winning games for the first
	+ player. Our notion of GSgames generalizes both finite and infinite games by setting a game length.
	+ Note that the type of n is 'enat' (extended nat): either a nonnegative integer or infinity.
	+ Our only requirement on GSgames is that the winning games must have the length as specified
	+ as the length of the game. This helps certain theorems about winning look a bit more natural.\<close>
	+
	+locale GSgame =
	+ fixes A N
	+ assumes length:"\<forall>e\<in>A. llength e = 2*N"
	+begin
	+
	+text \<open>A position is a finite sequence of valid moves.\<close>
	+definition "position" where
	+ "position (e::'a list) \<equiv> length e \<le> 2*N"
	+
	+lemma position_maxlength_cannotbe_augmented:
	+assumes "length p = 2*N"
	+shows "\<not> position (p @ [m])"
	+ by (auto simp:position_def assms[symmetric])
	+
	+text \<open>A play is a sequence of valid moves of the right length.\<close>
	+definition "play" where
	+ "play (e::'a llist) \<equiv> llength e = 2*N"
	+
	+lemma plays_are_positions_conv:
	+ shows "play (llist_of p) \<longleftrightarrow> position p \<and> length p = 2*N"
	+unfolding play_def position_def by auto
	+
	+lemma finite_plays_are_positions:
	+ assumes "play p" "lfinite p"
	+ shows "position (list_of p)"
	+using assms
	+unfolding play_def position_def by (cases "lfinite p";auto simp:length_list_of)
	+
	+end
	+
	+text \<open>We call our players Even and Odd, where Even makes the first move.
	+ This means that Even is to make moves on plays of even length, and Odd on the others.
	+ This corresponds nicely to Even making all the moves in an even position, as
	+ the `nth' and `lnth' functions as predefined in Isabelle's library count from 0.
	+ In literature the players are sometimes called I and II.\<close>
	+
	+text \<open>A strategy for Even/Odd is simply a function that takes a position of even/odd length and
	+ returns a move. We use total functions for strategies. This means that their Isabelle-type
	+ determines that it is a strategy. Consequently, we do not have a definition of 'strategy'.
	+ Nevertheless, we will use $\sigma$ as a letter to indicate when something is a strategy.
	+ We can combine two strategies into one function, which gives a collective strategy that
	+ we will refer to as the joint strategy.\<close>
	+
	+definition joint_strategy :: "('b list \<Rightarrow> 'a) \<Rightarrow> ('b list \<Rightarrow> 'a) \<Rightarrow> ('b list \<Rightarrow> 'a)" where
	+ "joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o p = (if even (length p) then \<sigma>\<^sub>e p else \<sigma>\<^sub>o p)"
	+
	+text \<open>Following a strategy leads to an infinite sequence of moves.
	+ Note that we are not in the context of 'GSGame' where 'N' determines the length of our plays:
	+ we just let sequences go on ad infinitum here.
	+ Rather than reasoning about our own recursive definitions,
	+ we build this infinite sequence by reusing definitions that are already in place.
	+ We do this by first defining all prefixes of the infinite sequence we are interested in.
	+ This gives an infinite list such that the nth element is of length n.
	+ Note that this definition allows us to talk about how a strategy would continue if it were
	+ played from an arbitrary position (not necessarily one that is reached via that strategy). \<close>
	+
	+definition strategy_progression where
	+ "strategy_progression \<sigma> p = lappend (llist_of (prefixes p)) (ltl (iterates (augment_list \<sigma>) p))"
	+
	+lemma induced_play_infinite:
	+ "\<not> lfinite (strategy_progression \<sigma> p)"
	+unfolding strategy_progression_def by auto
	+
	+lemma plays_from_strategy_lengths[simp]:
	+ "length (strategy_progression \<sigma> p $ i) = i"
	+proof(induct i)
	+ case 0
	+ then show ?case by(cases p;auto simp:strategy_progression_def lnth_lappend take_map ltake_lappend)
	+next
	+ case (Suc i)
	+ then show ?case
	+ by (cases "i<length p") (auto simp:strategy_progression_def lnth_lappend length_augment_list tl_prefixes_idx)
	+qed
	+
	+lemma length_plays_from_strategy[simp]:
	+ "llength (strategy_progression \<sigma> p) = \<infinity>"
	+ unfolding strategy_progression_def by auto
	+lemma length_ltl_plays_from_strategy[simp]:
	+ "llength (ltl (strategy_progression \<sigma> p)) = \<infinity>"
	+ unfolding strategy_progression_def by auto
	+
	+lemma plays_from_strategy_chain_Suc:
	+ shows "prefix (strategy_progression \<sigma> p $ n) (strategy_progression \<sigma> p $ Suc n)"
	+ unfolding strategy_progression_def
	+ by (auto simp:take_Suc_prefix nth_prefixes lnth_lappend nth_prefixes_is_prefix_tl
	+ augment_list_prefix)
	+
	+lemma plays_from_strategy_chain:
	+ shows "n \<le> m \<Longrightarrow> prefix (strategy_progression \<sigma> p $ n) (strategy_progression \<sigma> p $ m)"
	+proof (induct "m-n" arbitrary:m n)
	+ case (Suc x)
	+ hence [simp]:"Suc (x + n) = m" by auto
	+ from Suc.hyps(2)
	+ prefix_order.order.trans[OF Suc.hyps(1)[of "x + n" n] plays_from_strategy_chain_Suc[of _ _ "x+n"]]
	+ show ?case by auto
	+qed auto
	+
	+lemma plays_from_strategy_remains_const:
	+ assumes "n \<le> i"
	+ shows "take n (strategy_progression \<sigma> p $ i) = strategy_progression \<sigma> p $ n"
	+ apply(rule sym,subst prefix_same_length_eq[symmetric])
	+ using assms plays_from_strategy_chain[OF assms]
	+ by (auto intro!:prefix_takeI)
	+
	+lemma infplays_augment_one[simp]:
	+ "strategy_progression \<sigma> (p @ [\<sigma> p]) = strategy_progression \<sigma> p"
	+proof(induct p)
	+ note defs = strategy_progression_def
	+ {
	+ case Nil
	+ then show ?case
	+ by (auto simp:defs iterates.code[of _ "[\<sigma> []]"])
	+ next
	+ case (Cons a p)
	+ then show ?case
	+ by (auto simp:defs iterates.code[of _ "a # p @ [\<sigma> (a # p)]"] lappend_llist_of_LCons)
	+ }
	+qed
	+
	+lemma infplays_augment_many[simp]:
	+ "strategy_progression \<sigma> ((augment_list \<sigma> ^^ n) p) = strategy_progression \<sigma> p"
	+by(induct n,auto)
	+
	+lemma infplays_augment_one_joint[simp]:
	+ "even (length p) \<Longrightarrow> strategy_progression (joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o) (augment_list \<sigma>\<^sub>e p)
	+ = strategy_progression (joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o) p"
	+ "odd (length p) \<Longrightarrow> strategy_progression (joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o) (augment_list \<sigma>\<^sub>o p)
	+ = strategy_progression (joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o) p"
	+using infplays_augment_one[of "joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o" p]
	+unfolding joint_strategy_def by auto
	+
	+text \<open>Following two different strategies from a single position will lead to the same plays
	+ if the strategies agree on moves played after that position.
	+ This lemma allows us to ignore the behavior of strategies for moves that are already played. \<close>
	+lemma infplays_eq:
	+ assumes "\<And> p'. prefix p p' \<Longrightarrow> augment_list s1 p' = augment_list s2 p'"
	+ shows "strategy_progression s1 p = strategy_progression s2 p"
	+proof -
	+ from assms[of p] have [intro]:"s1 p = s2 p" by auto
	+ have "(augment_list s1 ^^ n) (augment_list s1 p) =
	+ (augment_list s2 ^^ n) (augment_list s2 p)" for n
	+ proof(induct n)
	+ case (Suc n)
	+ with assms[OF prefix_order.order.trans[OF _ prefix_augment]]
	+ show ?case by (auto)
	+ qed auto
	+ hence "strategy_progression s1 p $ n = strategy_progression s2 p $ n"
	+ for n (* different n *) unfolding strategy_progression_def lnth_lappend by auto
	+ thus ?thesis by(intro coinductive_eq_I,auto)
	+qed
	+
	+
	+context GSgame
	+begin
	+
	+text \<open>By looking at the last elements of the infinite progression,
	+ we can get a single sequence, which we trim down to the right length.
	+ Since it has the right length, this always forms a play.
	+ We therefore name this the 'induced play'. \<close>
	+
	+definition induced_play where
	+ "induced_play \<sigma> \<equiv> ltake (2*N) o lmap last o ltl o strategy_progression \<sigma>"
	+
	+lemma induced_play_infinite_le[simp]:
	+ "enat x < llength (strategy_progression \<sigma> p)"
	+ "enat x < llength (lmap f (strategy_progression \<sigma> p))"
	+ "enat x < llength (ltake (2N) (lmap f (strategy_progression \<sigma> p))) \<longleftrightarrow> x < 2N"
	+using induced_play_infinite by auto
	+
	+lemma induced_play_is_lprefix:
	+ assumes "position p"
	+ shows "lprefix (llist_of p) (induced_play \<sigma> p)"
	+proof -
	+ have l:"llength (llist_of p) \<le> 2 * N" using assms unfolding position_def by auto
	+ have "lprefix (llist_of p) (lmap last (ltl (llist_of (prefixes p))))" by auto
	+ hence "lprefix (llist_of p) ((lmap last o ltl o strategy_progression \<sigma>) p)"
	+ unfolding strategy_progression_def by(auto simp add: lmap_lappend_distrib lprefix_lappend)
	+ thus ?thesis unfolding induced_play_def o_def
	+ using lprefix_ltakeI[OF _ l] by blast
	+qed
	+
	+lemma length_induced_play[simp]:
	+ "llength (induced_play s p) = 2 * N"
	+ unfolding induced_play_def by auto
	+
	+lemma induced_play_lprefix_non_positions: (* 'opposite' of induced_play_is_lprefix *)
	+ assumes "length (p::'a list) \<ge> 2 * N"
	+ shows "induced_play \<sigma> p = ltake (2 * N) (llist_of p)"
	+proof(cases "N")
	+ case (enat nat)
	+ let ?p = "take (2 * nat) p"
	+ from assms have [intro]:"2 * N \<le> enat (length p)" by auto
	+ have [intro]:"2 * N \<le> enat (min (length p) (2 * nat))" unfolding enat
	+ by (metis assms enat min.orderI min_def numeral_eq_enat times_enat_simps(1))
	+ have [intro]:"enat (min (length p) (2 * nat)) = 2 * N"
	+ by (metis (mono_tags, lifting) assms enat min.absorb2 min_enat_simps(1)
	+ numeral_eq_enat times_enat_simps(1))
	+ have n:"2 * N \<le> llength (llist_of p)" "2 * N \<le> llength (llist_of (take (2 * nat) p))" by auto
	+ have pp:"position ?p"
	+ apply(subst position_def) (* for some reason 'unfolding' does not work here, tested in Isabelle 2021 *)
	+ by (metis (no_types, lifting) assms dual_order.order_iff_strict enat llength_llist_of
	+ llength_ltake' ltake_llist_of numeral_eq_enat take_all times_enat_simps(1))
	+ have lp:"lprefix (llist_of ?p) (induced_play \<sigma> ?p)" by(rule induced_play_is_lprefix[OF pp])
	+ (* this would make a great separate lemma, but we have a conversion between N and its nat
	+ to make that more involved *)
	+ have "ltake (2 * N) (llist_of p) = ltake (2 * N) (llist_of (take (2 * nat) p))"
	+ unfolding ltake_llist_of[symmetric] enat ltake_ltake numeral_eq_enat by auto
	+ hence eq:"induced_play \<sigma> p = induced_play \<sigma> ?p"
	+ unfolding induced_play_def strategy_progression_def
	+ by(auto simp add: lmap_lappend_distrib n[THEN ltake_lappend1])
	+ have "llist_of (take (2 * nat) p) = induced_play \<sigma> p"
	+ by(rule lprefix_llength_eq_imp_eq[OF lp[folded eq]],auto)
	+ then show ?thesis
	+ unfolding enat ltake_llist_of[symmetric] (* simp applies this one in the wrong direction *)
	+ numeral_eq_enat times_enat_simps(1) by metis
	+next
	+ case infinity
	+ hence "2 * N = \<infinity>" by (simp add: imult_is_infinity)
	+ then show ?thesis using assms by auto
	+qed
	+
	+lemma infplays_augment_many_lprefix[simp]:
	+ shows "lprefix (llist_of ((augment_list \<sigma> ^^ n) p)) (induced_play \<sigma> p)
	+ = position ((augment_list \<sigma> ^^ n) p)" (is "?lhs = ?rhs")
	+proof
	+ assume ?lhs
	+ from lprefix_llength_le[OF this] show ?rhs unfolding induced_play_def
	+ by (auto simp:position_def length_augment_list) next
	+ assume assm:?rhs
	+ from induced_play_is_lprefix[OF this, of "\<sigma>"]
	+ show ?lhs unfolding induced_play_def by simp
	+qed
	+
	+subsection \<open> Winning strategies \<close>
	+
	+text \<open> A strategy is winning (in position p) if, no matter the moves by the other player,
	+ it leads to a sequence in the winning set. \<close>
	+definition strategy_winning_by_Even where
	+ "strategy_winning_by_Even \<sigma>\<^sub>e p \<equiv> (\<forall> \<sigma>\<^sub>o. induced_play (joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o) p \<in> A)"
	+definition strategy_winning_by_Odd where
	+ "strategy_winning_by_Odd \<sigma>\<^sub>o p \<equiv> (\<forall> \<sigma>\<^sub>e. induced_play (joint_strategy \<sigma>\<^sub>e \<sigma>\<^sub>o) p \<notin> A)"
	+
	+text \<open> It immediately follows that not both players can have a winning strategy. \<close>
	+lemma at_most_one_player_winning:
	+shows "\<not> (\<exists> \<sigma>\<^sub>e. strategy_winning_by_Even \<sigma>\<^sub>e p) \<or> \<not> (\<exists> \<sigma>\<^sub>o. strategy_winning_by_Odd \<sigma>\<^sub>o p)"
	+ unfolding strategy_winning_by_Even_def strategy_winning_by_Odd_def by auto
	+
	+text \<open> If a player whose turn it is not makes any move, winning strategies remain winning.
	+ All of the following proofs are duplicated for Even and Odd,
	+ as the game is entirely symmetrical. These 'dual' theorems can be obtained
	+ by considering a game in which an additional first and final move are played yet ignored,
	+ but it is quite convenient to have both theorems at hand regardless, and the proofs are
	+ quite small, so we accept the code duplication. \<close>
	+
	+lemma any_moves_remain_winning_Even:
	+ assumes "odd (length p)" "strategy_winning_by_Even \<sigma> p"
	+ shows "strategy_winning_by_Even \<sigma> (p @ [m])"
	+unfolding strategy_winning_by_Even_def proof
	+ fix \<sigma>\<^sub>o
	+ let ?s = "\<sigma>\<^sub>o(p:=m)"
	+ have prfx:"prefix (p @ [m]) p' \<Longrightarrow>
	+ p' @ [joint_strategy \<sigma> \<sigma>\<^sub>o p'] = p' @ [joint_strategy \<sigma> ?s p']"
	+ for p' by (auto simp: joint_strategy_def)
	+ from assms(2)[unfolded strategy_winning_by_Even_def,rule_format,of ?s]
	+ infplays_augment_one_joint(2)[OF assms(1)]
	+ have "induced_play (joint_strategy \<sigma> ?s) (augment_list ?s p) \<in> A"
	+ by (metis (mono_tags, lifting) induced_play_def comp_apply)
	+ thus "induced_play (joint_strategy \<sigma> \<sigma>\<^sub>o) (p @ [m]) \<in> A"
	+ unfolding induced_play_def o_def
	+ using infplays_eq[OF prfx] by auto
	+qed
	+
	+lemma any_moves_remain_winning_Odd:
	+ assumes "even (length p)" "strategy_winning_by_Odd \<sigma> p"
	+ shows "strategy_winning_by_Odd \<sigma> (p @ [m])"
	+unfolding strategy_winning_by_Odd_def proof
	+ fix \<sigma>\<^sub>e
	+ let ?s = "\<sigma>\<^sub>e(p:=m)"
	+ have prfx:"prefix (p @ [m]) p' \<Longrightarrow>
	+ p' @ [joint_strategy \<sigma>\<^sub>e \<sigma> p'] = p' @ [joint_strategy ?s \<sigma> p']"
	+ for p' by (auto simp:joint_strategy_def)
	+ from assms(2)[unfolded strategy_winning_by_Odd_def,rule_format,of ?s]
	+ infplays_augment_one_joint(1)[OF assms(1)]
	+ have "induced_play (joint_strategy ?s \<sigma>) (augment_list ?s p) \<notin> A"
	+ by (metis (mono_tags, lifting) induced_play_def comp_apply)
	+ thus "induced_play (joint_strategy \<sigma>\<^sub>e \<sigma>) (p @ [m]) \<notin> A"
	+ unfolding induced_play_def o_def
	+ using infplays_eq[OF prfx] by auto
	+qed
	+
	+text \<open> If a player does not have a winning strategy,
	+ a move by that player will not give it one. \<close>
	+
	+lemma non_winning_moves_remains_non_winning_Even:
	+ assumes "even (length p)" "\<forall> \<sigma>. \<not> strategy_winning_by_Even \<sigma> p"
	+ shows "\<not> strategy_winning_by_Even \<sigma> (p @ [m])"
	+proof(rule contrapos_nn[of "\<exists> \<sigma>. strategy_winning_by_Even \<sigma> p"])
	+ assume a:"strategy_winning_by_Even \<sigma> (p @ [m])"
	+ let ?s = "\<sigma>(p:=m)"
	+ have prfx:"prefix (p @ [m]) p' \<Longrightarrow>
	+ p' @ [joint_strategy \<sigma> \<sigma>\<^sub>o p'] = p' @ [joint_strategy ?s \<sigma>\<^sub>o p']"
	+ for p' \<sigma>\<^sub>o by (auto simp:joint_strategy_def)
	+ from a infplays_eq[OF prfx]
	+ have "strategy_winning_by_Even ?s (p @ [m])"
	+ unfolding strategy_winning_by_Even_def induced_play_def by simp
	+ hence "strategy_winning_by_Even ?s p"
	+ using infplays_augment_one_joint(1)[OF assms(1)]
	+ unfolding strategy_winning_by_Even_def induced_play_def o_def
	+ by (metis fun_upd_same)
	+ thus "\<exists>\<sigma>. strategy_winning_by_Even \<sigma> p" by blast next
	+ from assms(2) show "\<not> (\<exists> \<sigma>. strategy_winning_by_Even \<sigma> p)" by meson
	+qed
	+
	+lemma non_winning_moves_remains_non_winning_Odd:
	+ assumes "odd (length p)" "\<forall> \<sigma>. \<not> strategy_winning_by_Odd \<sigma> p"
	+ shows "\<not> strategy_winning_by_Odd \<sigma> (p @ [m])"
	+proof(rule contrapos_nn[of "\<exists> \<sigma>. strategy_winning_by_Odd \<sigma> p"])
	+ assume a:"strategy_winning_by_Odd \<sigma> (p @ [m])"
	+ let ?s = "\<sigma>(p:=m)"
	+ have prfx:"prefix (p @ [m]) p' \<Longrightarrow>
	+ p' @ [joint_strategy \<sigma>\<^sub>e \<sigma> p'] = p' @ [joint_strategy \<sigma>\<^sub>e ?s p']"
	+ for p' \<sigma>\<^sub>e by (auto simp:joint_strategy_def)
	+ from a infplays_eq[OF prfx]
	+ have "strategy_winning_by_Odd ?s (p @ [m])"
	+ unfolding strategy_winning_by_Odd_def induced_play_def by simp
	+ hence "strategy_winning_by_Odd ?s p"
	+ using infplays_augment_one_joint(2)[OF assms(1)]
	+ unfolding strategy_winning_by_Odd_def induced_play_def o_def
	+ by (metis fun_upd_same)
	+ thus "\<exists>\<sigma>. strategy_winning_by_Odd \<sigma> p" by blast next
	+ from assms(2) show "\<not> (\<exists> \<sigma>. strategy_winning_by_Odd \<sigma> p)" by meson
	+qed
	+
	+text \<open> If a player whose turn it is makes a move according to its stragey,
	+ the new position will remain winning. \<close>
	+
	+lemma winning_moves_remain_winning_Even:
	+ assumes "even (length p)" "strategy_winning_by_Even \<sigma> p"
	+ shows "strategy_winning_by_Even \<sigma> (p @ [\<sigma> p])"
	+using assms infplays_augment_one
	+unfolding induced_play_def strategy_winning_by_Even_def by auto
	+
	+lemma winning_moves_remain_winning_Odd:
	+ assumes "odd (length p)" "strategy_winning_by_Odd \<sigma> p"
	+ shows "strategy_winning_by_Odd \<sigma> (p @ [\<sigma> p])"
	+using assms infplays_augment_one
	+unfolding induced_play_def strategy_winning_by_Odd_def by auto
	+
	+text \<open> We speak of winning positions as those positions in which the player has a winning strategy.
	+ This is mainly for presentation purposes. \<close>
	+
	+abbreviation winning_position_Even where
	+ "winning_position_Even p \<equiv> position p \<and> (\<exists> \<sigma>. strategy_winning_by_Even \<sigma> p)"
	+abbreviation winning_position_Odd where
	+ "winning_position_Odd p \<equiv> position p \<and> (\<exists> \<sigma>. strategy_winning_by_Odd \<sigma> p)"
	+
	+lemma winning_position_can_remain_winning_Even:
	+ assumes "even (length p)" "\<forall> m. position (p @ [m])" "winning_position_Even p"
	+ shows "\<exists> m. winning_position_Even (p @ [m])"
	+using assms winning_moves_remain_winning_Even[OF assms(1)] by auto
	+
	+lemma winning_position_can_remain_winning_Odd:
	+ assumes "odd (length p)" "\<forall> m. position (p @ [m])" "winning_position_Odd p"
	+ shows "\<exists> m. winning_position_Odd (p @ [m])"
	+using assms winning_moves_remain_winning_Odd[OF assms(1)] by auto
	+
	+lemma winning_position_will_remain_winning_Even:
	+ assumes "odd (length p)" "position (p @ [m])" "winning_position_Even p"
	+ shows "winning_position_Even (p @ [m])"
	+using assms any_moves_remain_winning_Even[OF assms(1)] by auto
	+
	+lemma winning_position_will_remain_winning_Odd:
	+ assumes "even (length p)" "position (p @ [m])" "winning_position_Odd p"
	+ shows "winning_position_Odd (p @ [m])"
	+using assms any_moves_remain_winning_Odd[OF assms(1)] by auto
	+
	+lemma induced_play_eq:
	+assumes "\<forall> p'. prefix p p' \<longrightarrow> (augment_list s1) p' = (augment_list s2) p'"
	+shows "induced_play s1 p = induced_play s2 p"
	+unfolding induced_play_def by (auto simp:infplays_eq[OF assms[rule_format]])
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/MoreCoinductiveList2.thy b/thys/GaleStewart_Games/MoreCoinductiveList2.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/MoreCoinductiveList2.thy
	@@ -0,0 +1,51 @@
	+section \<open>Coinductive lists\<close>
	+
	+theory MoreCoinductiveList2
	+ imports Parity_Game.MoreCoinductiveList (* for notation and lemmas like infinite_small_llength *)
	+begin
	+
	+lemma ltake_infinity[simp]: "ltake \<infinity> x = x" by (simp add: ltake_all)
	+
	+lemma coinductive_eq_iff_lnth_eq:
	+ "a = b \<longleftrightarrow> (llength a = llength b \<and> (\<forall> n. enat n < llength a \<longrightarrow> a $ n = b $ n))"
	+proof
	+ assume "llength a = llength b \<and> (\<forall>n. enat n < llength a \<longrightarrow> a $ n = b $ n)"
	+ hence len:"llength a = llength b"
	+ and lnth:"enat n < llength a \<Longrightarrow> a $ n = b $ n" for n by auto
	+ show "a = b" proof(cases "llength a")
	+ case (enat nat)
	+ hence leq:"llist_of (list_of (ltake nat a)) = a" "llist_of (list_of (ltake nat b)) = b"
	+ by (auto simp add: len llength_eq_enat_lfiniteD ltake_all)
	+ with lnth_llist_of lnth
	+ have [intro]:"i < length (list_of (ltake (enat nat) a)) \<Longrightarrow> ltake (enat nat) a $ i = ltake (enat nat) b $ i" for i
	+ by (metis enat_ord_code(4) enat_ord_simps(2) lfinite_ltake llength_llist_of llist_of_list_of)
	+ from len have [intro]:"length (list_of (ltake (enat nat) a)) = length (list_of (ltake (enat nat) b))"
	+ by (simp add: length_list_of_conv_the_enat)
	+ have "list_of (ltake nat a) = list_of (ltake nat b)" by(subst list_eq_iff_nth_eq, auto)
	+ then show ?thesis using leq by metis
	+ next
	+ case infinity
	+ hence inf:"\<not> lfinite a" "\<not> lfinite b" using len llength_eq_infty_conv_lfinite by auto
	+ from lnth[unfolded infinity] have "(($) a) = (($) b)" by auto
	+ then show ?thesis using inf[THEN inf_llist_lnth] by metis
	+ qed
	+qed auto
	+
	+lemma coinductive_eq_I:
	+ assumes "(llength a = llength b \<and> (\<forall> n. enat n < llength a \<longrightarrow> a $ n = b $ n))"
	+ shows "a = b"
	+ using coinductive_eq_iff_lnth_eq assms by auto
	+text \<open>Our co-inductive lists will have Option types in them, so we can return None for out of bounds.\<close>
	+definition lnth_option where
	+ "lnth_option xs i \<equiv> if enat i < llength xs then xs $ i else None"
	+
	+lemma enat_times_less:
	+ "enat c * enat lst < y * enat c \<Longrightarrow> lst < y"
	+by (cases y;auto)
	+
	+lemma llist_eq_lcons:
	+ assumes "a \<noteq> LNil" "b \<noteq> LNil" "lhd a = lhd b" "ltl a = ltl b"
	+ shows "a = b"
	+using assms by(cases a;cases b;auto)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/MoreENat.thy b/thys/GaleStewart_Games/MoreENat.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/MoreENat.thy
	@@ -0,0 +1,63 @@
	+subsection \<open>Theorems about the extended naturals\<close>
	+
	+text \<open>Extended naturals are the natural numbers plus infinity.
	+ They are slightly more cumbersome to reason about, and this file contains
	+ some lemmas that should help with that.\<close>
	+
	+theory MoreENat
	+ imports MoreCoinductiveList2
	+begin
	+
	+lemma eSuc_n_not_le_n[simp]:
	+"(eSuc x \<le> x) \<longleftrightarrow> x = \<infinity>"
	+ by (metis enat_ord_simps(3) Suc_n_not_le_n antisym ile_eSuc le_add2 plus_1_eq_Suc the_enat_eSuc)
	+
	+lemma mult_two_impl1[elim]:
	+ assumes "a * 2 = 2 * b"
	+ shows "(a::enat) = b" using assms by(cases a;cases b,auto simp add: mult_2 mult_2_right)
	+
	+lemma mult_two_impl2[dest]:
	+ assumes "a * 2 = 1 + 2 * b"
	+ shows "(a::enat) = \<infinity> \<and> b=\<infinity>"
	+ apply(cases a;cases b)
	+ using assms Suc_double_not_eq_double[unfolded mult_2, symmetric]
	+ by (auto simp add: mult_2 one_enat_def mult_2_right)
	+
	+lemma mult_two_impl3[dest]:
	+ assumes "a * 2 = 1 + (2 * b - 1)"
	+ shows "(a::enat) = b \<and> a \<ge> 1"
	+ using assms by(cases a;cases b,auto simp add: one_enat_def mult_2 mult_2_right)
	+
	+lemma mult_two_impl4[dest]:
	+ assumes "a * 2 = 2 * b - 1"
	+ shows "((a::enat) = 0 \<and> b = 0) \<or> (a = \<infinity> \<and> b=\<infinity>)"
	+proof(cases a;cases b)
	+ fix anat bnat
	+ assume *:"a = enat anat" "b = enat bnat"
	+ hence "anat + anat = bnat + bnat - Suc 0"
	+ using assms by (auto simp add:enat_0_iff one_enat_def mult_2 mult_2_right)
	+ thus ?thesis unfolding * using Suc_double_not_eq_double[unfolded mult_2, symmetric]
	+ by (metis Suc_pred add_gr_0 enat_0_iff(1) neq0_conv not_less0 zero_less_diff)
	+qed(insert assms,auto simp add:enat_0_iff one_enat_def mult_2 mult_2_right)
	+
	+
	+lemma times_two_div_two[intro]:
	+ assumes "enat n < x" shows "2 * enat (n div 2) < x"
	+proof -
	+ have "2 * n div 2 \<le> n" by auto
	+ hence "2 * enat (n div 2) \<le> enat n"
	+ using enat_numeral enat_ord_simps(2) linorder_not_less mult.commute times_enat_simps(1)
	+ by (metis div_times_less_eq_dividend)
	+ with assms show ?thesis by auto
	+qed
	+
	+lemma enat_sum_le[simp]:
	+ shows "enat (a + b) \<le> c \<Longrightarrow> b \<le> c"
	+ by (meson dual_order.trans enat_ord_simps(1) le_add2)
	+
	+
	+lemma enat_Suc_nonzero[simp]:
	+shows "enat (Suc n)\<noteq> 0"
	+ by (metis Zero_not_Suc enat.inject zero_enat_def)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/MorePrefix.thy b/thys/GaleStewart_Games/MorePrefix.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/MorePrefix.thy
	@@ -0,0 +1,148 @@
	+section \<open>Extra theorems on prefixes of Lists and their coinductive counterparts\<close>
	+
	+theory MorePrefix
	+ imports MoreCoinductiveList2 (* for notation and lemmas like infinite_small_llength *)
	+begin
	+
	+subsection \<open> Reasoning about prefixes \<close>
	+lemma head_prefixes [simp]:
	+ "prefixes list ! 0 = []"
	+ by (metis hd_conv_nth hd_prefixes prefixes_not_Nil)
	+
	+lemma non_head_prefixes [simp]:
	+ assumes "n < length p" shows "(prefixes p ! Suc n) \<noteq> []"
	+proof -
	+ have "0 < length (prefixes p)" "Suc n < length (prefixes p)" by (auto simp: assms)
	+ then show ?thesis by (metis Zero_not_Suc distinct_prefixes head_prefixes nth_eq_iff_index_eq)
	+qed
	+
	+lemma last_prefixes:
	+ assumes "i < length p"
	+ shows "last (tl (prefixes p) ! i) = p ! i"
	+ using assms
	+proof(induct p arbitrary:i)
	+ case (Cons a p i)
	+ show ?case proof(cases i)
	+ case (Suc nat)
	+ with Cons have "p ! nat = last (tl (prefixes p) ! nat)" "nat < length p" by auto
	+ then show ?thesis unfolding Suc by(auto simp:nth_tl)
	+ qed auto
	+qed force
	+
	+lemma take_1_prefixes[simp]:
	+ "take (Suc 0) (prefixes list) = [[]]"
	+ by (simp add: take_Suc)
	+
	+lemma map_last_prefixes [simp]:
	+ shows "map last (tl (prefixes p)) = p"
	+ unfolding list_eq_iff_nth_eq
	+ using last_prefixes by auto
	+
	+lemma ltake_zero[simp]: "ltake (enat (0::nat)) lst = LNil"
	+ (* nitpick finds a counterexample in Isabelle2021*)
	+ by (simp add: zero_enat_def)
	+
	+lemma ltakes_one_iterates:
	+ "ltake (enat (Suc 0)) (iterates f p) = LCons p LNil"
	+ by (metis One_nat_def iterates_lmap ltake_eSuc_LCons ltake_zero one_eSuc one_enat_def zero_enat_def)
	+
	+lemma ltakes_suc_iterates[simp]:
	+ "ltake (enat (Suc n)) (iterates f p) = LCons p (ltake (enat n) (iterates f (f p)))"
	+ by (induct n,force simp:ltakes_one_iterates,metis eSuc_enat iterates.code ltake_eSuc_LCons)
	+
	+lemma prefixes_nth_take[simp]:
	+ assumes "i \<le> length p"
	+ shows "prefixes p ! i = take i p"
	+ using assms proof(induct p arbitrary:i)
	+ case (Cons a p i) thus ?case by (cases i, auto)
	+qed auto
	+
	+lemma tl_prefixes_idx:
	+ assumes "i < length p"
	+ shows "tl (prefixes p) ! i = take (Suc i) p"
	+ using assms by(induct p,auto)
	+
	+lemma list_of_lappend_llist_of[simp]:
	+ assumes "lfinite q"
	+ shows "list_of (lappend (llist_of p) q) = append p (list_of q)"
	+ using assms by(induct p,auto)
	+
	+lemma nth_prefixes:
	+ "n < length p \<Longrightarrow> \<not> Suc n < length p \<Longrightarrow> tl (prefixes p) ! n = p"
	+ by(induct p arbitrary:n,auto)
	+
	+lemma take_Suc_prefix:
	+ "prefix (take n p) (take (Suc n) p)"
	+proof(induct p arbitrary:n)
	+ case (Cons a p n)
	+ then show ?case by(cases n,auto)
	+qed auto
	+
	+lemma nth_prefixes_is_prefix:
	+ "n < length p \<Longrightarrow> prefix ((prefixes p) ! n) ((prefixes p) ! Suc n)"
	+ by(induct "length p" n arbitrary:p rule:diff_induct,auto simp:take_Suc_prefix)
	+
	+lemma nth_prefixes_is_prefix_tl:
	+ "Suc n < length p \<Longrightarrow> prefix (tl (prefixes p) ! n) (tl (prefixes p) ! Suc n)"
	+ by (cases p) (auto simp:nth_prefixes_is_prefix take_Suc_prefix)
	+
	+lemma prefix_same_length_eq:
	+ shows "(prefix a b \<and> length a = length b) \<longleftrightarrow> a = b"
	+ by (metis prefix_length_le prefix_length_prefix prefix_order.antisym prefix_order.order_refl)
	+
	+lemma prefix_takeI:
	+ assumes "prefix a b" "n \<ge> length a"
	+ shows "prefix a (take n b)"
	+ using assms
	+ by (smt (verit) prefix_length_prefix length_take min.absorb2 nat_le_linear take_all take_is_prefix)
	+
	+thm prefix_length_prefix (* compare to *)
	+lemma lprefix_llength_lprefix:
	+ assumes "lprefix a c" "lprefix b c" "llength a \<le> llength b"
	+ shows "lprefix a b"
	+ using assms
	+ by (metis dual_order.antisym lprefix_down_linear lprefix_llength_eq_imp_eq lprefix_llength_le)
	+
	+thm prefix_takeI (* compare to *)
	+lemma lprefix_ltakeI:
	+ assumes "lprefix a b" "llength a \<le> n"
	+ shows "lprefix a (ltake n b)"
	+ by (smt (verit, best) dual_order.antisym lappend_eq_lappend_conv lappend_ltake_ldrop llength_ltake
	+ assms lprefix_conv_lappend lprefix_down_linear lprefix_llength_le min_def)
	+
	+abbreviation augment_list where
	+ "augment_list \<sigma> p \<equiv> p @ [\<sigma> p]"
	+
	+lemma length_augment_list:
	+ "length ((augment_list f ^^ n) p) = n + length p"
	+ by(induct n,auto)
	+
	+lemma augment_list_nonempty:
	+ assumes "p\<noteq>[]" shows "(augment_list f ^^ i) p \<noteq> []"
	+ using assms by(cases i,auto)
	+
	+lemma augment_list_Suc_prefix:
	+ "prefix ((augment_list f ^^ n) p) ((augment_list f ^^ Suc n) p)"
	+ by(cases n,auto simp:take_Suc_prefix)
	+
	+lemma augment_list_prefix:
	+ "n \<le> m \<Longrightarrow> prefix ((augment_list f ^^ n) p) ((augment_list f ^^ m) p)"
	+proof(induct "m-n" arbitrary:m n)
	+ case (Suc x)
	+ hence [simp]:"Suc (x + n) = m" by auto
	+ from Suc.hyps(2)
	+ prefix_order.order.trans[OF Suc.hyps(1)[of "x + n" n] augment_list_Suc_prefix[of "x+n" f p]]
	+ show ?case by auto
	+qed auto
	+
	+lemma augment_list_nonsense[dest]:
	+assumes "(augment_list \<sigma> ^^ n) p = []"
	+shows "n=0" "p=[]"
	+using assms by(induct n,auto)
	+
	+lemma prefix_augment:
	+ shows "prefix p ((augment_list s ^^ n) p)"
	+ by (induct n,auto simp:prefix_def)
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/GaleStewart_Games/ROOT b/thys/GaleStewart_Games/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/ROOT
	@@ -0,0 +1,14 @@
	+chapter AFP
	+
	+session "GaleStewart_Games" (AFP) = Parity_Game +
	+ options [timeout = 300]
	+ theories [document = false]
	+ MoreCoinductiveList2
	+ MoreENat
	+ MorePrefix
	+ theories
	+ GaleStewartGames
	+ GaleStewartDeterminedGames
	+ document_files
	+ "root.bib"
	+ "root.tex"
	diff --git a/thys/GaleStewart_Games/document/root.bib b/thys/GaleStewart_Games/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/document/root.bib
	@@ -0,0 +1,52 @@
	+%% This BibTeX bibliography file was created using BibDesk.
	+%% http://bibdesk.sourceforge.net/
	+
	+
	+%% Created for Sebastiaan Joosten at 2021-04-22 22:55:14 -0400
	+
	+
	+%% Saved with string encoding Unicode (UTF-8)
	+
	+
	+
	+@article{Parity_Game-AFP,
	+ author = {Christoph Dittmann},
	+ date-added = {2021-04-22 22:55:11 -0400},
	+ date-modified = {2021-04-22 22:55:11 -0400},
	+ issn = {2150-914x},
	+ journal = {Archive of Formal Proofs},
	+ month = nov,
	+ note = {\url{https://isa-afp.org/entries/Parity_Game.html}, Formal proof development},
	+ title = {Positional Determinacy of Parity Games},
	+ year = 2015}
	+
	+@inproceedings{ZF13,
	+ author = {Zermelo, Ernst},
	+ booktitle = {Proceedings of the fifth international congress of mathematicians},
	+ date-added = {2021-04-22 20:21:47 -0400},
	+ date-modified = {2021-04-22 20:21:55 -0400},
	+ organization = {Cambridge University Press Cambridge, UK},
	+ pages = {501--504},
	+ title = {{\"U}ber eine Anwendung der Mengenlehre auf die Theorie des Schachspiels},
	+ volume = {2},
	+ year = {1913}}
	+
	+@article{GS53,
	+ author = {Gale, David and Stewart, Frank M},
	+ date-added = {2021-04-22 20:10:31 -0400},
	+ date-modified = {2021-04-22 20:10:42 -0400},
	+ journal = {Contributions to the Theory of Games},
	+ number = {245-266},
	+ pages = {2--16},
	+ title = {Infinite games with perfect information},
	+ volume = {2},
	+ year = {1953}}
	+
	+@book{LNCS2283,
	+ author = {Tobias Nipkow and Lawrence Paulson and Markus Wenzel},
	+ note = {\url{http://www.in.tum.de/~nipkow/LNCS2283/}},
	+ publisher = Springer,
	+ series = LNCS,
	+ title = {Isabelle/HOL --- A Proof Assistant for Higher-Order Logic},
	+ volume = 2283,
	+ year = 2002}
	diff --git a/thys/GaleStewart_Games/document/root.tex b/thys/GaleStewart_Games/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/GaleStewart_Games/document/root.tex
	@@ -0,0 +1,57 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+
	+\begin{document}
	+
	+\title{Gale-Stewart Games}
	+\author{Sebastiaan J.\,C. Joosten}
	+\maketitle
	+
	+\begin{abstract}
	+ This is a formalisation of the main result of Gale and Stewart from 1953, showing that closed finite games are determined.
	+ This property is now known as the Gale Stewart Theorem.
	+ While the original paper shows some additional theorems as well, we only formalize this main result, but do so in a somewhat general way.
	+ We formalize games of a fixed arbitrary length, including infinite length, using co-inductive lists, and show that defensive strategies exist unless the other player is winning.
	+ For closed games, defensive strategies are winning for the closed player, proving that such games are determined.
	+ For finite games, which are a special case in our formalisation, all games are closed.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+\section{Introduction}
	+The original paper from Gale and Stewart~\cite{GS53} uses a function to point to a previous position.
	+This encoding of sequences is not followed in this formalization, as it is not the way we think of games these days.
	+Instead, we follow the approach taken in the formalization of Parity Games~\cite{Parity_Game-AFP}, where co-inductive lists are used to talk about possibly infinite plays.
	+Although we rely on the Parity Games theory for some of the theorems about co-inductive lists, none of the notions about games are shared with that formalization.
	+
	+We have proven some basic lemmas about prefixes, extended naturals (natural numbers plus infinity), and defined a function 'alternate' alternating lists.
	+We have done this in separate Isabelle theory files, so that they can be reused independently without depending on the formalizations of infinite games presented here.
	+In the same way this formalization is giving a nod to the parity games formalization.
	+In this document, we only present the alternating lists, as this theory file contains new definitions, which are relevant preliminaries to know about.
	+The additional lemmas about prefixes and extended natural numbers are less essential, they only contain `obvious' properties, so we have left those theory files out of this document.
	+
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+% generated text of all theories
	+\input{session}
	+
	+% optional bibliography
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Grothendieck_Schemes/Comm_Ring.thy b/thys/Grothendieck_Schemes/Comm_Ring.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/Comm_Ring.thy
	@@ -0,0 +1,5669 @@
	+
	+text \<open>Authors: Anthony Bordg and Lawrence Paulson,
	+with some contributions from Wenda Li\<close>
	+
	+theory Comm_Ring
	+ imports
	+ "Group_Extras"
	+ "Topological_Space"
	+ "Jacobson_Basic_Algebra.Ring_Theory"
	+ "Set_Extras"
	+begin
	+
	+(*Suppresses the built-in plus sign, but why does
	+ no_notation minus (infixl "-" 65)
	+cause errors with monoid subtraction below? --LCP
	+*)
	+no_notation plus (infixl "+" 65)
	+
	+lemma (in monoid_homomorphism) monoid_preimage: "Group_Theory.monoid (\<eta> \<^sup>\<inverse> M M') (\<cdot>) \<one>"
	+ by (simp add: Int_absorb1 source.monoid_axioms subsetI)
	+
	+lemma (in group_homomorphism) group_preimage: "Group_Theory.group (\<eta> \<^sup>\<inverse> G G') (\<cdot>) \<one>"
	+ by (simp add: Int_absorb1 source.group_axioms subsetI)
	+
	+lemma (in ring_homomorphism) ring_preimage: "ring (\<eta> \<^sup>\<inverse> R R') (+) (\<cdot>) \<zero> \<one>"
	+ by (simp add: Int_absorb2 Int_commute source.ring_axioms subset_iff)
	+
	+section \<open>Commutative Rings\<close>
	+
	+subsection \<open>Commutative Rings\<close>
	+
	+locale comm_ring = ring +
	+ assumes comm_mult: "\<lbrakk> a \<in> R; b \<in> R \<rbrakk> \<Longrightarrow> a \<cdot> b = b \<cdot> a"
	+
	+text \<open>The zero ring is a commutative ring.\<close>
	+
	+lemma invertible_0: "monoid.invertible {0} (\<lambda>n m. 0) 0 0"
	+ using Group_Theory.monoid.intro monoid.unit_invertible by force
	+
	+interpretation ring0: ring "{0::nat}" "\<lambda>n m. 0" "\<lambda>n m. 0" 0 0
	+ using invertible_0 by unfold_locales auto
	+
	+declare ring0.additive.left_unit [simp del] ring0.additive.invertible [simp del]
	+declare ring0.additive.invertible_left_inverse [simp del] ring0.right_zero [simp del]
	+
	+interpretation cring0: comm_ring "{0::nat}" "\<lambda>n m. 0" "\<lambda>n m. 0" 0 0
	+ by (metis comm_ring_axioms_def comm_ring_def ring0.ring_axioms)
	+
	+(* def 0.13 *)
	+definition (in ring) zero_divisor :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
	+ where "zero_divisor x y \<equiv> (x \<noteq> \<zero>) \<and> (y \<noteq> \<zero>) \<and> (x \<cdot> y = \<zero>)"
	+
	+subsection \<open>Entire Rings\<close>
	+
	+(* def 0.14 *)
	+locale entire_ring = comm_ring + assumes units_neq: "\<one> \<noteq> \<zero>" and
	+no_zero_div: "\<lbrakk> x \<in> R; y \<in> R\<rbrakk> \<Longrightarrow> \<not>(zero_divisor x y)"
	+
	+subsection \<open>Ideals\<close>
	+
	+context comm_ring begin
	+
	+lemma mult_left_assoc: "\<lbrakk> a \<in> R; b \<in> R; c \<in> R \<rbrakk> \<Longrightarrow> b \<cdot> (a \<cdot> c) = a \<cdot> (b \<cdot> c)"
	+ using comm_mult multiplicative.associative by auto
	+
	+lemmas ring_mult_ac = comm_mult multiplicative.associative mult_left_assoc
	+
	+(* ex. 0.16 *)
	+lemma ideal_R_R: "ideal R R (+) (\<cdot>) \<zero> \<one>"
	+proof qed auto
	+
	+lemma ideal_0_R: "ideal {\<zero>} R (+) (\<cdot>) \<zero> \<one>"
	+proof
	+ show "monoid.invertible {\<zero>} (+) \<zero> u"
	+ if "u \<in> {\<zero>}"
	+ for u :: 'a
	+ proof (rule monoid.invertibleI)
	+ show "Group_Theory.monoid {\<zero>} (+) \<zero>"
	+ proof qed (use that in auto)
	+ qed (use that in auto)
	+qed auto
	+
	+definition ideal_gen_by_prod :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set"
	+ where "ideal_gen_by_prod \<aa> \<bb> \<equiv> additive.subgroup_generated {x. \<exists>a b. x = a \<cdot> b \<and> a \<in> \<aa> \<and> b \<in> \<bb>}"
	+
	+lemma ideal_zero: "ideal A R add mult zero unit \<Longrightarrow> zero \<in> A"
	+ by (simp add: ideal_def subgroup_of_additive_group_of_ring_def subgroup_def submonoid_def submonoid_axioms_def)
	+
	+lemma ideal_implies_subset:
	+ assumes "ideal A R add mult zero unit"
	+ shows "A \<subseteq> R"
	+ by (meson assms ideal_def subgroup_def subgroup_of_additive_group_of_ring_def submonoid_axioms_def submonoid_def)
	+
	+lemma ideal_inverse:
	+ assumes "a \<in> A" "ideal A R (+) mult zero unit"
	+ shows "additive.inverse a \<in> A"
	+ by (meson additive.invertible assms comm_ring.ideal_implies_subset comm_ring_axioms ideal_def subgroup.subgroup_inverse_iff subgroup_of_additive_group_of_ring_def subsetD)
	+
	+lemma ideal_add:
	+ assumes "a \<in> A" "b \<in> A" "ideal A R add mult zero unit"
	+ shows "add a b \<in> A"
	+ by (meson Group_Theory.group_def assms ideal_def monoid.composition_closed subgroup_def subgroup_of_additive_group_of_ring_def)
	+
	+lemma ideal_mult_in_subgroup_generated:
	+ assumes \<aa>: "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and \<bb>: "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>" and "a \<in> \<aa>" "b \<in> \<bb>"
	+ shows "a \<cdot> b \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ proof -
	+ have "\<exists>x y. a \<cdot> b = x \<cdot> y \<and> x \<in> \<aa> \<and> y \<in> \<bb>"
	+ using assms ideal_implies_subset by blast
	+ with ideal_implies_subset show ?thesis
	+ unfolding additive.subgroup_generated_def ideal_gen_by_prod_def
	+ using assms ideal_implies_subset by (blast intro: additive.generate.incl)
	+qed
	+
	+subsection \<open>Ideals generated by an Element\<close>
	+
	+definition gen_ideal:: "'a \<Rightarrow> 'a set" ("\<langle>_\<rangle>")
	+ where "\<langle>x\<rangle> \<equiv> {y. \<exists>r\<in>R. y = r \<cdot> x}"
	+
	+lemma zero_in_gen_ideal:
	+ assumes "x \<in> R"
	+ shows "\<zero> \<in> \<langle>x\<rangle>"
	+proof -
	+ have "\<exists>a. a \<in> R \<and> \<zero> = a \<cdot> x"
	+ by (metis (lifting) additive.unit_closed assms left_zero)
	+ then show ?thesis
	+ using gen_ideal_def by blast
	+qed
	+
	+lemma add_in_gen_ideal:
	+ "\<lbrakk>x \<in> R; a \<in> \<langle>x\<rangle>; b \<in> \<langle>x\<rangle>\<rbrakk> \<Longrightarrow> a + b \<in> \<langle>x\<rangle>"
	+ apply (clarsimp simp : gen_ideal_def)
	+ by (metis (no_types) additive.composition_closed distributive(2))
	+
	+lemma gen_ideal_subset:
	+ assumes "x \<in> R"
	+ shows "\<langle>x\<rangle> \<subseteq> R"
	+ using assms comm_ring.gen_ideal_def local.comm_ring_axioms by fastforce
	+
	+lemma gen_ideal_monoid:
	+ assumes "x \<in> R"
	+ shows "Group_Theory.monoid \<langle>x\<rangle> (+) \<zero>"
	+proof
	+ show "a + b \<in> \<langle>x\<rangle>" if "a \<in> \<langle>x\<rangle>" "b \<in> \<langle>x\<rangle>" for a b
	+ by (simp add: add_in_gen_ideal assms that)
	+qed (use assms zero_in_gen_ideal gen_ideal_def in auto)
	+
	+lemma gen_ideal_group:
	+ assumes "x \<in> R"
	+ shows "Group_Theory.group \<langle>x\<rangle> (+) \<zero>"
	+proof
	+ fix a b c
	+ assume "a \<in> \<langle>x\<rangle>" "b \<in> \<langle>x\<rangle>" "c \<in> \<langle>x\<rangle>"
	+ then show "a + b + c = a + (b + c)"
	+ by (meson assms gen_ideal_monoid monoid.associative)
	+next
	+ fix a
	+ assume a: "a \<in> \<langle>x\<rangle>"
	+ show "\<zero> + a = a"
	+ by (meson a assms gen_ideal_monoid monoid.left_unit)
	+ show "a + \<zero> = a"
	+ by (meson a assms gen_ideal_monoid monoid.right_unit)
	+ interpret M: monoid "\<langle>x\<rangle>" "(+)" \<zero>
	+ by (simp add: assms gen_ideal_monoid)
	+ obtain r where r: "r\<in>R" "a = r \<cdot> x"
	+ using a gen_ideal_def by auto
	+ show "monoid.invertible \<langle>x\<rangle> (+) \<zero> a"
	+ proof (rule M.invertibleI)
	+ have "\<exists>r\<in>R. - a = r \<cdot> x"
	+ by (metis assms ideal_R_R ideal_inverse local.left_minus r)
	+ then show "-a \<in> \<langle>x\<rangle>" by (simp add: gen_ideal_def)
	+ qed (use a r assms in auto)
	+qed (auto simp: zero_in_gen_ideal add_in_gen_ideal assms)
	+
	+lemma gen_ideal_ideal:
	+ assumes "x \<in> R"
	+ shows "ideal \<langle>x\<rangle> R (+) (\<cdot>) \<zero> \<one>"
	+proof intro_locales
	+ show "submonoid_axioms \<langle>x\<rangle> R (+) \<zero>"
	+ by (simp add: add_in_gen_ideal assms gen_ideal_subset submonoid_axioms.intro zero_in_gen_ideal)
	+ show "Group_Theory.group_axioms \<langle>x\<rangle> (+) \<zero>"
	+ by (meson Group_Theory.group_def assms gen_ideal_group)
	+ show "ideal_axioms \<langle>x\<rangle> R (\<cdot>)"
	+ proof
	+ fix a b
	+ assume "a \<in> R" "b \<in> \<langle>x\<rangle>"
	+ then obtain r where r: "r\<in>R" "b = r \<cdot> x"
	+ by (auto simp add: gen_ideal_def)
	+ have "a \<cdot> (r \<cdot> x) = (a \<cdot> r) \<cdot> x"
	+ using \<open>a \<in> R\<close> \<open>r \<in> R\<close> assms multiplicative.associative by presburger
	+ then show "a \<cdot> b \<in> \<langle>x\<rangle>"
	+ using \<open>a \<in> R\<close> r gen_ideal_def by blast
	+ then show "b \<cdot> a \<in> \<langle>x\<rangle>"
	+ by (simp add: \<open>a \<in> R\<close> assms comm_mult r)
	+ qed
	+qed (auto simp add: assms gen_ideal_monoid)
	+
	+
	+subsection \<open>Exercises\<close>
	+
	+lemma in_ideal_gen_by_prod:
	+ assumes \<aa>: "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and \<bb>: "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
	+ and "a \<in> R" and b: "b \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ shows "a \<cdot> b \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ using b \<open>a \<in> R\<close>
	+ unfolding additive.subgroup_generated_def ideal_gen_by_prod_def
	+proof (induction arbitrary: a)
	+ case unit
	+ then show ?case
	+ by (simp add: additive.generate.unit)
	+next
	+ case (incl x u)
	+ with \<aa> \<bb> have "\<And>a b. \<lbrakk>a \<cdot> b \<in> R; a \<in> \<aa>; b \<in> \<bb>\<rbrakk> \<Longrightarrow> \<exists>x y. u \<cdot> (a \<cdot> b) = x \<cdot> y \<and> x \<in> \<aa> \<and> y \<in> \<bb>"
	+ by simp (metis ideal.ideal(1) ideal_implies_subset multiplicative.associative subset_iff)
	+ then show ?case
	+ using additive.generate.incl incl.hyps incl.prems by force
	+next
	+ case (inv u v)
	+ then show ?case
	+ proof clarsimp
	+ fix a b
	+ assume "v \<in> R" "a \<cdot> b \<in> R" "a \<in> \<aa>" "b \<in> \<bb>"
	+ then have "v \<cdot> (- a \<cdot> b) = v \<cdot> a \<cdot> (- b) \<and> v \<cdot> a \<in> \<aa> \<and> - b \<in> \<bb>"
	+ by (metis \<aa> \<bb> ideal.ideal(1) ideal_implies_subset ideal_inverse in_mono local.right_minus multiplicative.associative)
	+ then show "v \<cdot> (- a \<cdot> b) \<in> additive.generate (R \<inter> {a \<cdot> b \|a b. a \<in> \<aa> \<and> b \<in> \<bb>})"
	+ using \<aa> \<bb> additive.subgroup_generated_def ideal_mult_in_subgroup_generated
	+ unfolding ideal_gen_by_prod_def
	+ by presburger
	+ qed
	+next
	+ case (mult u v)
	+ then show ?case
	+ using additive.generate.mult additive.generate_into_G distributive(1) by force
	+qed
	+
	+(* ex. 0.12 *)
	+lemma ideal_subgroup_generated:
	+ assumes "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
	+ shows "ideal (ideal_gen_by_prod \<aa> \<bb>) R (+) (\<cdot>) \<zero> \<one>"
	+ proof
	+ show "ideal_gen_by_prod \<aa> \<bb> \<subseteq> R"
	+ by (simp add: additive.subgroup_generated_is_subset ideal_gen_by_prod_def)
	+ show "a + b \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ if "a \<in> ideal_gen_by_prod \<aa> \<bb>" "b \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ for a b
	+ using that additive.subgroup_generated_is_monoid monoid.composition_closed
	+ by (fastforce simp: ideal_gen_by_prod_def)
	+ show "\<zero> \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ using additive.generate.unit additive.subgroup_generated_def ideal_gen_by_prod_def by presburger
	+ show "a + b + c = a + (b + c)"
	+ if "a \<in> ideal_gen_by_prod \<aa> \<bb>" "b \<in> ideal_gen_by_prod \<aa> \<bb>" "c \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ for a b c
	+ using that additive.subgroup_generated_is_subset
	+ unfolding ideal_gen_by_prod_def
	+ by blast
	+ show "\<zero> + a = a" "a + \<zero> = a"
	+ if "a \<in> ideal_gen_by_prod \<aa> \<bb>" for a
	+ using that additive.subgroup_generated_is_subset unfolding ideal_gen_by_prod_def
	+ by blast+
	+ show "monoid.invertible (ideal_gen_by_prod \<aa> \<bb>) (+) \<zero> u"
	+ if "u \<in> ideal_gen_by_prod \<aa> \<bb>" for u
	+ using that additive.subgroup_generated_is_subgroup group.invertible
	+ unfolding ideal_gen_by_prod_def subgroup_def
	+ by fastforce
	+ show "a \<cdot> b \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ if "a \<in> R" "b \<in> ideal_gen_by_prod \<aa> \<bb>" for a b
	+ using that by (simp add: assms in_ideal_gen_by_prod)
	+ then show "b \<cdot> a \<in> ideal_gen_by_prod \<aa> \<bb>"
	+ if "a \<in> R" "b \<in> ideal_gen_by_prod \<aa> \<bb>" for a b
	+ using that
	+ by (metis \<open>ideal_gen_by_prod \<aa> \<bb> \<subseteq> R\<close> comm_mult in_mono)
	+qed
	+
	+lemma ideal_gen_by_prod_is_inter:
	+ assumes "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
	+ shows "ideal_gen_by_prod \<aa> \<bb> = \<Inter> {I. ideal I R (+) (\<cdot>) \<zero> \<one> \<and> {a \<cdot> b \|a b. a \<in> \<aa> \<and> b \<in> \<bb>} \<subseteq> I}"
	+ (is "?lhs = ?rhs")
	+proof
	+ have "x \<in> ?rhs" if "x \<in> ?lhs" for x
	+ using that
	+ unfolding ideal_gen_by_prod_def additive.subgroup_generated_def
	+ by induction (force simp: ideal_zero ideal_inverse ideal_add)+
	+ then show "?lhs \<subseteq> ?rhs" by blast
	+ show "?rhs \<subseteq> ?lhs"
	+ using assms ideal_subgroup_generated by (force simp: ideal_mult_in_subgroup_generated)
	+qed
	+
	+end (* comm_ring *)
	+
	+text \<open>def. 0.18, see remark 0.20\<close>
	+locale pr_ideal = comm:comm_ring R "(+)" "(\<cdot>)" "\<zero>" "\<one>" + ideal I R "(+)" "(\<cdot>)" "\<zero>" "\<one>"
	+ for R and I and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and
	+unit ("\<one>")
	++ assumes carrier_neq: "I \<noteq> R" and absorbent: "\<lbrakk>x \<in> R; y \<in> R\<rbrakk> \<Longrightarrow> (x \<cdot> y \<in> I) \<Longrightarrow> (x \<in> I \<or> y \<in> I)"
	+begin
	+
	+text \<open>
	+Note that in the locale prime ideal the order of I and R is reversed with respect to the locale
	+ideal, so that we can introduce some syntactic sugar later.
	+\<close>
	+
	+text \<open>remark 0.21\<close>
	+lemma not_1 [simp]:
	+ shows "\<one> \<notin> I"
	+proof
	+ assume "\<one> \<in> I"
	+ then have "\<And>x. \<lbrakk>\<one> \<in> I; x \<in> R\<rbrakk> \<Longrightarrow> x \<in> I"
	+ by (metis ideal(1) comm.multiplicative.right_unit)
	+ with \<open>\<one> \<in> I\<close> have "I = R"
	+ by auto
	+ then show False
	+ using carrier_neq by blast
	+qed
	+
	+lemma not_invertible:
	+ assumes "x \<in> I"
	+ shows "\<not> comm.multiplicative.invertible x"
	+ using assms ideal(2) not_1 by blast
	+
	+text \<open>ex. 0.22\<close>
	+lemma submonoid_notin:
	+ assumes "S = {x \<in> R. x \<notin> I}"
	+ shows "submonoid S R (\<cdot>) \<one>"
	+proof
	+ show "S \<subseteq> R"
	+ using assms by force
	+ show "a \<cdot> b \<in> S"
	+ if "a \<in> S"
	+ and "b \<in> S"
	+ for a :: 'a
	+ and b :: 'a
	+ using that
	+ using absorbent assms by blast
	+ show "\<one> \<in> S"
	+ using assms carrier_neq ideal(1) by fastforce
	+qed
	+
	+end (* pr_ideal *)
	+
	+
	+section \<open>Spectrum of a ring\<close>
	+
	+subsection \<open>The Zariski Topology\<close>
	+
	+context comm_ring begin
	+
	+text \<open>Notation 1\<close>
	+definition closed_subsets :: "'a set \<Rightarrow> ('a set) set" ("\<V> _" [900] 900)
	+ where "\<V> \<aa> \<equiv> {I. pr_ideal R I (+) (\<cdot>) \<zero> \<one> \<and> \<aa> \<subseteq> I}"
	+
	+text \<open>Notation 2\<close>
	+definition spectrum :: "('a set) set" ("Spec")
	+ where "Spec \<equiv> {I. pr_ideal R I (+) (\<cdot>) \<zero> \<one>}"
	+
	+lemma cring0_spectrum_eq [simp]: "cring0.spectrum = {}"
	+ unfolding cring0.spectrum_def pr_ideal_def
	+ by (metis (no_types, lifting) Collect_empty_eq cring0.ideal_zero pr_ideal.intro pr_ideal.not_1)
	+
	+text \<open>remark 0.11\<close>
	+lemma closed_subsets_R [simp]:
	+ shows "\<V> R = {}"
	+ using ideal_implies_subset
	+ by (auto simp: closed_subsets_def pr_ideal_axioms_def pr_ideal_def)
	+
	+lemma closed_subsets_zero [simp]:
	+ shows "\<V> {\<zero>} = Spec"
	+ unfolding closed_subsets_def spectrum_def pr_ideal_def pr_ideal_axioms_def
	+ by (auto dest: ideal_zero)
	+
	+lemma closed_subsets_ideal_aux:
	+ assumes \<aa>: "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and \<bb>: "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
	+ and prime: "pr_ideal R x (+) (\<cdot>) \<zero> \<one>" and disj: "\<aa> \<subseteq> x \<or> \<bb> \<subseteq> x"
	+ shows "ideal_gen_by_prod \<aa> \<bb> \<subseteq> x"
	+ unfolding ideal_gen_by_prod_def additive.subgroup_generated_def
	+proof
	+ fix u
	+ assume u: "u \<in> additive.generate (R \<inter> {a \<cdot> b \|a b. a \<in> \<aa> \<and> b \<in> \<bb>})"
	+ have "\<aa> \<subseteq> R" "\<bb> \<subseteq> R"
	+ using \<aa> \<bb> ideal_implies_subset by auto
	+ show "u \<in> x" using u
	+ proof induction
	+ case unit
	+ then show ?case
	+ by (meson comm_ring.ideal_zero prime pr_ideal_def)
	+ next
	+ case (incl a)
	+ then have "a \<in> R"
	+ by blast
	+ with incl pr_ideal.axioms [OF prime] show ?case
	+ by clarsimp (metis \<open>\<aa> \<subseteq> R\<close> \<open>\<bb> \<subseteq> R\<close> disj ideal.ideal subset_iff)
	+ next
	+ case (inv a)
	+ then have "a \<in> R"
	+ by blast
	+ with inv pr_ideal.axioms [OF prime] show ?case
	+ by clarsimp (metis \<open>\<aa> \<subseteq> R\<close> \<open>\<bb> \<subseteq> R\<close> disj ideal.ideal ideal_inverse subset_iff)
	+ next
	+ case (mult a b)
	+ then show ?case
	+ by (meson prime comm_ring.ideal_add pr_ideal_def)
	+ qed
	+qed
	+
	+
	+text \<open>ex. 0.13\<close>
	+lemma closed_subsets_ideal_iff:
	+ assumes "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
	+ shows "\<V> (ideal_gen_by_prod \<aa> \<bb>) = (\<V> \<aa>) \<union> (\<V> \<bb>)" (is "?lhs = ?rhs")
	+proof
	+ show "?lhs \<subseteq> ?rhs"
	+ unfolding closed_subsets_def
	+ by clarsimp (meson assms ideal_implies_subset ideal_mult_in_subgroup_generated in_mono pr_ideal.absorbent)
	+ show "?rhs \<subseteq> ?lhs"
	+ unfolding closed_subsets_def
	+ using closed_subsets_ideal_aux [OF assms] by auto
	+qed
	+
	+abbreviation finsum:: "'b set \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a"
	+ where "finsum I f \<equiv> additive.finprod I f"
	+
	+lemma finsum_empty [simp]: "finsum {} f = \<zero>"
	+ by (simp add: additive.finprod_def)
	+
	+lemma finsum_insert:
	+ assumes "finite I" "i \<notin> I"
	+ and R: "f i \<in> R" "\<And>j. j \<in> I \<Longrightarrow> f j \<in> R"
	+ shows "finsum (insert i I) f = f i + finsum I f"
	+ unfolding additive.finprod_def
	+proof (subst LCD.foldD_insert [where B = "insert i I"])
	+ show "LCD (insert i I) R ((+) \<circ> f)"
	+ proof
	+ show "((+) \<circ> f) x (((+) \<circ> f) y z) = ((+) \<circ> f) y (((+) \<circ> f) x z)"
	+ if "x \<in> insert i I" "y \<in> insert i I" "z \<in> R" for x y z
	+ using that additive.associative additive.commutative R by auto
	+ show "((+) \<circ> f) x y \<in> R"
	+ if "x \<in> insert i I" "y \<in> R" for x y
	+ using that R by force
	+ qed
	+qed (use assms in auto)
	+
	+lemma finsum_singleton [simp]:
	+ assumes "f i \<in> R"
	+ shows "finsum {i} f = f i"
	+ by (metis additive.right_unit assms finite.emptyI finsum_empty finsum_insert insert_absorb insert_not_empty)
	+
	+
	+(* ex. 0.15 *)
	+lemma ex_15:
	+ fixes J :: "'b set" and \<aa> :: "'b \<Rightarrow> 'a set"
	+ assumes "J \<noteq> {}" and J: "\<And>j. j\<in>J \<Longrightarrow> ideal (\<aa> j) R (+) (\<cdot>) \<zero> \<one>"
	+ shows "\<V> ({x. \<exists>I f. x = finsum I f \<and> I \<subseteq> J \<and> finite I \<and> (\<forall>i. i\<in>I \<longrightarrow> f i \<in> \<aa> i)}) = (\<Inter>j\<in>J. \<V> (\<aa> j))"
	+ proof -
	+ have "y \<in> U"
	+ if j: "j \<in> J" "y \<in> \<aa> j"
	+ and "pr_ideal R U (+) (\<cdot>) \<zero> \<one>"
	+ and U: "{finsum I f \|I f. I \<subseteq> J \<and> finite I \<and> (\<forall>i. i \<in> I \<longrightarrow> f i \<in> \<aa> i)} \<subseteq> U"
	+ for U j y
	+ proof -
	+ have "y \<in> R"
	+ using J j ideal_implies_subset by blast
	+ then have y: "y = finsum {j} (\<lambda>_. y)"
	+ by simp
	+ then have "y \<in> {finsum I f \|I f. I \<subseteq> J \<and> finite I \<and> (\<forall>i. i \<in> I \<longrightarrow> f i \<in> \<aa> i)}"
	+ using that by blast
	+ then show ?thesis
	+ by (rule subsetD [OF U])
	+ qed
	+ moreover have PI: "pr_ideal R x (+) (\<cdot>) \<zero> \<one>" if "\<forall>j\<in>J. pr_ideal R x (+) (\<cdot>) \<zero> \<one> \<and> \<aa> j \<subseteq> x" for x
	+ using that assms(1) by fastforce
	+ moreover have "finsum I f \<in> U"
	+ if "finite I"
	+ and "\<forall>j\<in>J. pr_ideal R U (+) (\<cdot>) \<zero> \<one> \<and> \<aa> j \<subseteq> U"
	+ and "I \<subseteq> J" "\<forall>i. i \<in> I \<longrightarrow> f i \<in> \<aa> i" for U I f
	+ using that
	+ proof (induction I rule: finite_induct)
	+ case empty
	+ then show ?case
	+ using PI assms ideal_zero by fastforce
	+ next
	+ case (insert i I)
	+ then have "finsum (insert i I) f = f i + finsum I f"
	+ by (metis assms(2) finsum_insert ideal_implies_subset insertCI subset_iff)
	+ also have "... \<in> U"
	+ using insert by (metis ideal_add insertCI pr_ideal.axioms(2) subset_eq)
	+ finally show ?case .
	+ qed
	+ ultimately show ?thesis
	+ by (auto simp: closed_subsets_def)
	+qed
	+
	+(* ex 0.16 *)
	+definition is_zariski_open:: "'a set set \<Rightarrow> bool" where
	+"is_zariski_open U \<equiv> generated_topology Spec {U. (\<exists>\<aa>. ideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<and> U = Spec - \<V> \<aa>)} U"
	+
	+lemma is_zariski_open_empty [simp]: "is_zariski_open {}"
	+ using UNIV is_zariski_open_def generated_topology_is_topology topological_space.open_empty
	+ by simp
	+
	+lemma is_zariski_open_Spec [simp]: "is_zariski_open Spec"
	+ by (simp add: UNIV is_zariski_open_def)
	+
	+lemma is_zariski_open_Union [intro]:
	+ "(\<And>x. x \<in> F \<Longrightarrow> is_zariski_open x) \<Longrightarrow> is_zariski_open (\<Union> F)"
	+ by (simp add: UN is_zariski_open_def)
	+
	+lemma is_zariski_open_Int [simp]:
	+ "\<lbrakk>is_zariski_open U; is_zariski_open V\<rbrakk> \<Longrightarrow> is_zariski_open (U \<inter> V)"
	+ using Int is_zariski_open_def by blast
	+
	+lemma zariski_is_topological_space [iff]:
	+ shows "topological_space Spec is_zariski_open"
	+ unfolding is_zariski_open_def using generated_topology_is_topology
	+ by blast
	+
	+lemma zariski_open_is_subset:
	+ assumes "is_zariski_open U"
	+ shows "U \<subseteq> Spec"
	+ using assms zariski_is_topological_space topological_space.open_imp_subset by auto
	+
	+lemma cring0_is_zariski_open [simp]: "cring0.is_zariski_open = (\<lambda>U. U={})"
	+ using cring0.cring0_spectrum_eq cring0.is_zariski_open_empty cring0.zariski_open_is_subset by blast
	+
	+subsection \<open>Standard Open Sets\<close>
	+
	+definition standard_open:: "'a \<Rightarrow> 'a set set" ("\<D>'(_')")
	+ where "\<D>(x) \<equiv> (Spec \<setminus> \<V>(\<langle>x\<rangle>))"
	+
	+lemma standard_open_is_zariski_open:
	+ assumes "x \<in> R"
	+ shows "is_zariski_open \<D>(x)"
	+ unfolding is_zariski_open_def standard_open_def
	+ using assms gen_ideal_ideal generated_topology.simps by fastforce
	+
	+lemma standard_open_is_subset:
	+ assumes "x \<in> R"
	+ shows "\<D>(x) \<subseteq> Spec"
	+ by (simp add: assms standard_open_is_zariski_open zariski_open_is_subset)
	+
	+lemma belongs_standard_open_iff:
	+ assumes "x \<in> R" and "\<pp> \<in> Spec"
	+ shows "x \<notin> \<pp> \<longleftrightarrow> \<pp> \<in> \<D>(x)"
	+ using assms
	+ apply (auto simp: standard_open_def closed_subsets_def spectrum_def gen_ideal_def subset_iff)
	+ apply (metis pr_ideal.absorbent)
	+ by (meson ideal.ideal(1) pr_ideal_def)
	+
	+end (* comm_ring *)
	+
	+
	+subsection \<open>Presheaves of Rings\<close>
	+
	+(* def 0.17 *)
	+locale presheaf_of_rings = Topological_Space.topological_space
	+ + fixes \<FF>:: "'a set \<Rightarrow> 'b set"
	+ and \<rho>:: "'a set \<Rightarrow> 'a set \<Rightarrow> ('b \<Rightarrow> 'b)" and b:: "'b"
	+ and add_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)" ("+\<^bsub>_\<^esub>")
	+ and mult_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)" ("\<cdot>\<^bsub>_\<^esub>")
	+ and zero_str:: "'a set \<Rightarrow> 'b" ("\<zero>\<^bsub>_\<^esub>") and one_str:: "'a set \<Rightarrow> 'b" ("\<one>\<^bsub>_\<^esub>")
	+assumes is_ring_morphism:
	+ "\<And>U V. is_open U \<Longrightarrow> is_open V \<Longrightarrow> V \<subseteq> U \<Longrightarrow> ring_homomorphism (\<rho> U V)
	+ (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>
	+ (\<FF> V) (+\<^bsub>V\<^esub>) (\<cdot>\<^bsub>V\<^esub>) \<zero>\<^bsub>V\<^esub> \<one>\<^bsub>V\<^esub>"
	+ and ring_of_empty: "\<FF> {} = {b}"
	+ and identity_map [simp]: "\<And>U. is_open U \<Longrightarrow> (\<And>x. x \<in> \<FF> U \<Longrightarrow> \<rho> U U x = x)"
	+ and assoc_comp:
	+ "\<And>U V W. is_open U \<Longrightarrow> is_open V \<Longrightarrow> is_open W \<Longrightarrow> V \<subseteq> U \<Longrightarrow> W \<subseteq> V \<Longrightarrow>
	+(\<And>x. x \<in> (\<FF> U) \<Longrightarrow> \<rho> U W x = (\<rho> V W \<circ> \<rho> U V) x)"
	+begin
	+
	+lemma is_ring_from_is_homomorphism:
	+ shows "\<And>U. is_open U \<Longrightarrow> ring (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
	+ using is_ring_morphism ring_homomorphism.axioms(2) by fastforce
	+
	+lemma is_map_from_is_homomorphism:
	+ assumes "is_open U" and "is_open V" and "V \<subseteq> U"
	+ shows "Set_Theory.map (\<rho> U V) (\<FF> U) (\<FF> V)"
	+ using assms by (meson is_ring_morphism ring_homomorphism.axioms(1))
	+
	+lemma eq_\<rho>:
	+ assumes "is_open U" and "is_open V" and "is_open W" and "W \<subseteq> U \<inter> V" and "s \<in> \<FF> U" and "t \<in> \<FF> V"
	+ and "\<rho> U W s = \<rho> V W t" and "is_open W'" and "W' \<subseteq> W"
	+ shows "\<rho> U W' s = \<rho> V W' t"
	+ by (metis Int_subset_iff assms assoc_comp comp_apply)
	+
	+end (* presheaf_of_rings *)
	+
	+locale morphism_presheaves_of_rings =
	+source: presheaf_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ + target: presheaf_of_rings X is_open \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str'
	+ for X and is_open
	+ and \<FF> and \<rho> and b and add_str ("+\<^bsub>_\<^esub>") and mult_str ("\<cdot>\<^bsub>_\<^esub>")
	+ and zero_str ("\<zero>\<^bsub>_\<^esub>") and one_str ("\<one>\<^bsub>_\<^esub>")
	+ and \<FF>' and \<rho>' and b' and add_str' ("+''\<^bsub>_\<^esub>") and mult_str' ("\<cdot>''\<^bsub>_\<^esub>")
	+ and zero_str' ("\<zero>''\<^bsub>_\<^esub>") and one_str' ("\<one>''\<^bsub>_\<^esub>") +
	+ fixes fam_morphisms:: "'a set \<Rightarrow> ('b \<Rightarrow> 'c)"
	+ assumes is_ring_morphism: "\<And>U. is_open U \<Longrightarrow> ring_homomorphism (fam_morphisms U)
	+ (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>
	+ (\<FF>' U) (+'\<^bsub>U\<^esub>) (\<cdot>'\<^bsub>U\<^esub>) \<zero>'\<^bsub>U\<^esub> \<one>'\<^bsub>U\<^esub>"
	+ and comm_diagrams: "\<And>U V. is_open U \<Longrightarrow> is_open V \<Longrightarrow> V \<subseteq> U \<Longrightarrow>
	+ (\<And>x. x \<in> \<FF> U \<Longrightarrow> (\<rho>' U V \<circ> fam_morphisms U) x = (fam_morphisms V \<circ> \<rho> U V) x)"
	+begin
	+
	+lemma fam_morphisms_are_maps:
	+ assumes "is_open U"
	+ shows "Set_Theory.map (fam_morphisms U) (\<FF> U) (\<FF>' U)"
	+ using assms is_ring_morphism by (simp add: ring_homomorphism_def)
	+
	+end (* morphism_presheaves_of_rings *)
	+
	+(* Identity presheaf *)
	+lemma (in presheaf_of_rings) id_is_mor_pr_rngs:
	+ shows "morphism_presheaves_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str \<FF> \<rho> b add_str mult_str zero_str one_str (\<lambda>U. identity (\<FF> U))"
	+proof (intro morphism_presheaves_of_rings.intro morphism_presheaves_of_rings_axioms.intro)
	+ show "\<And>U. is_open U \<Longrightarrow> ring_homomorphism (identity (\<FF> U))
	+ (\<FF> U) (add_str U) (mult_str U) (zero_str U) (one_str U)
	+ (\<FF> U) (add_str U) (mult_str U) (zero_str U) (one_str U)"
	+ by (metis identity_map is_map_from_is_homomorphism is_ring_morphism restrict_ext restrict_on_source subset_eq)
	+ show "\<And>U V. \<lbrakk>is_open U; is_open V; V \<subseteq> U\<rbrakk>
	+ \<Longrightarrow> (\<And>x. x \<in> (\<FF> U) \<Longrightarrow> (\<rho> U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> \<rho> U V) x)"
	+ using map.map_closed by (metis comp_apply is_map_from_is_homomorphism restrict_apply')
	+qed (use presheaf_of_rings_axioms in auto)
	+
	+lemma comp_ring_morphisms:
	+ assumes "ring_homomorphism \<eta> A addA multA zeroA oneA B addB multB zeroB oneB"
	+and "ring_homomorphism \<theta> B addB multB zeroB oneB C addC multC zeroC oneC"
	+shows "ring_homomorphism (compose A \<theta> \<eta>) A addA multA zeroA oneA C addC multC zeroC oneC"
	+ using comp_monoid_morphisms comp_group_morphisms assms
	+ by (metis monoid_homomorphism_def ring_homomorphism_def)
	+
	+(* Composition of presheaves *)
	+ lemma comp_of_presheaves:
	+ assumes 1: "morphism_presheaves_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str' \<phi>"
	+ and 2: "morphism_presheaves_of_rings X is_open \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str' \<FF>'' \<rho>'' b'' add_str'' mult_str'' zero_str'' one_str'' \<phi>'"
	+ shows "morphism_presheaves_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str \<FF>'' \<rho>'' b'' add_str'' mult_str'' zero_str'' one_str'' (\<lambda>U. (\<phi>' U \<circ> \<phi> U \<down> \<FF> U))"
	+proof (intro morphism_presheaves_of_rings.intro morphism_presheaves_of_rings_axioms.intro)
	+ show "ring_homomorphism (\<phi>' U \<circ> \<phi> U \<down> \<FF> U) (\<FF> U) (add_str U) (mult_str U) (zero_str U) (one_str U) (\<FF>'' U) (add_str'' U) (mult_str'' U) (zero_str'' U) (one_str'' U)"
	+ if "is_open U"
	+ for U :: "'a set"
	+ using that
	+ by (metis assms comp_ring_morphisms morphism_presheaves_of_rings.is_ring_morphism)
	+next
	+ show "\<And>x. x \<in> (\<FF> U) \<Longrightarrow> (\<rho>'' U V \<circ> (\<phi>' U \<circ> \<phi> U \<down> \<FF> U)) x = (\<phi>' V \<circ> \<phi> V \<down> \<FF> V \<circ> \<rho> U V) x"
	+ if "is_open U" "is_open V" "V \<subseteq> U" for U V
	+ using that
	+ using morphism_presheaves_of_rings.comm_diagrams [OF 1]
	+ using morphism_presheaves_of_rings.comm_diagrams [OF 2]
	+ using presheaf_of_rings.is_map_from_is_homomorphism [OF morphism_presheaves_of_rings.axioms(1) [OF 1]]
	+ by (metis "1" comp_apply compose_eq map.map_closed morphism_presheaves_of_rings.fam_morphisms_are_maps)
	+qed (use assms in \<open>auto simp: morphism_presheaves_of_rings_def\<close>)
	+
	+locale iso_presheaves_of_rings = mor:morphism_presheaves_of_rings
	++ assumes is_inv:
	+"\<exists>\<psi>. morphism_presheaves_of_rings X is_open \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str' \<FF> \<rho> b add_str mult_str zero_str one_str \<psi>
	+\<and> (\<forall>U. is_open U \<longrightarrow> (\<forall>x \<in> (\<FF>' U). (fam_morphisms U \<circ> \<psi> U) x = x) \<and> (\<forall>x \<in> (\<FF> U). (\<psi> U \<circ> fam_morphisms U) x = x))"
	+
	+
	+subsection \<open>Sheaves of Rings\<close>
	+
	+(* def 0.19 *)
	+locale sheaf_of_rings = presheaf_of_rings +
	+ assumes locality: "\<And>U I V s. open_cover_of_open_subset S is_open U I V \<Longrightarrow> (\<And>i. i\<in>I \<Longrightarrow> V i \<subseteq> U) \<Longrightarrow>
	+s \<in> \<FF> U \<Longrightarrow> (\<And>i. i\<in>I \<Longrightarrow> \<rho> U (V i) s = \<zero>\<^bsub>(V i)\<^esub>) \<Longrightarrow> s = \<zero>\<^bsub>U\<^esub>"
	+and
	+glueing: "\<And>U I V s. open_cover_of_open_subset S is_open U I V \<Longrightarrow> (\<forall>i. i\<in>I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> \<FF> (V i)) \<Longrightarrow>
	+(\<And>i j. i\<in>I \<Longrightarrow> j\<in>I \<Longrightarrow> \<rho> (V i) (V i \<inter> V j) (s i) = \<rho> (V j) (V i \<inter> V j) (s j)) \<Longrightarrow>
	+(\<exists>t. t \<in> \<FF> U \<and> (\<forall>i. i\<in>I \<longrightarrow> \<rho> U (V i) t = s i))"
	+
	+(* def. 0.20 *)
	+locale morphism_sheaves_of_rings = morphism_presheaves_of_rings
	+
	+locale iso_sheaves_of_rings = iso_presheaves_of_rings
	+
	+(* ex. 0.21 *)
	+locale ind_sheaf = sheaf_of_rings +
	+ fixes U:: "'a set"
	+ assumes is_open_subset: "is_open U"
	+begin
	+
	+interpretation it: ind_topology S is_open U
	+ by (simp add: ind_topology.intro ind_topology_axioms.intro is_open_subset open_imp_subset topological_space_axioms)
	+
	+definition ind_sheaf:: "'a set \<Rightarrow> 'b set"
	+ where "ind_sheaf V \<equiv> \<FF> (U \<inter> V)"
	+
	+definition ind_ring_morphisms:: "'a set \<Rightarrow> 'a set \<Rightarrow> ('b \<Rightarrow> 'b)"
	+ where "ind_ring_morphisms V W \<equiv> \<rho> (U \<inter> V) (U \<inter> W)"
	+
	+definition ind_add_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)"
	+ where "ind_add_str V \<equiv> \<lambda>x y. +\<^bsub>(U \<inter> V)\<^esub> x y"
	+
	+definition ind_mult_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)"
	+ where "ind_mult_str V \<equiv> \<lambda>x y. \<cdot>\<^bsub>(U \<inter> V)\<^esub> x y"
	+
	+definition ind_zero_str:: "'a set \<Rightarrow> 'b"
	+ where "ind_zero_str V \<equiv> \<zero>\<^bsub>(U\<inter>V)\<^esub>"
	+
	+definition ind_one_str:: "'a set \<Rightarrow> 'b"
	+ where "ind_one_str V \<equiv> \<one>\<^bsub>(U\<inter>V)\<^esub>"
	+
	+lemma ind_is_open_imp_ring:
	+ "\<And>U. it.ind_is_open U
	+ \<Longrightarrow> ring (ind_sheaf U) (ind_add_str U) (ind_mult_str U) (ind_zero_str U) (ind_one_str U)"
	+ unfolding ind_add_str_def it.ind_is_open_def ind_mult_str_def ind_one_str_def ind_sheaf_def ind_zero_str_def
	+ using is_open_subset is_ring_from_is_homomorphism it.is_subset open_inter by force
	+
	+lemma ind_sheaf_is_presheaf:
	+ shows "presheaf_of_rings U (it.ind_is_open) ind_sheaf ind_ring_morphisms b
	+ind_add_str ind_mult_str ind_zero_str ind_one_str"
	+proof -
	+ have "topological_space U it.ind_is_open" by (simp add: it.ind_space_is_top_space)
	+ moreover have "ring_homomorphism (ind_ring_morphisms W V)
	+ (ind_sheaf W) (ind_add_str W) (ind_mult_str W) (ind_zero_str W) (ind_one_str W)
	+ (ind_sheaf V) (ind_add_str V) (ind_mult_str V) (ind_zero_str V) (ind_one_str V)"
	+ if "it.ind_is_open W" "it.ind_is_open V" "V \<subseteq> W" for W V
	+ proof (intro ring_homomorphism.intro ind_is_open_imp_ring)
	+ show "Set_Theory.map (ind_ring_morphisms W V) (ind_sheaf W) (ind_sheaf V)"
	+ unfolding ind_ring_morphisms_def ind_sheaf_def
	+ by (metis that it.ind_is_open_def inf.left_idem is_open_subset is_ring_morphism
	+ open_inter ring_homomorphism_def)
	+ from that
	+ obtain o: "is_open (U \<inter> V)" "is_open (U \<inter> W)" "U \<inter> V \<subseteq> U \<inter> W"
	+ by (metis (no_types) it.ind_is_open_def inf.absorb_iff2 is_open_subset open_inter)
	+ then show "group_homomorphism (ind_ring_morphisms W V) (ind_sheaf W) (ind_add_str W) (ind_zero_str W) (ind_sheaf V) (ind_add_str V) (ind_zero_str V)"
	+ unfolding ind_ring_morphisms_def ind_sheaf_def ind_zero_str_def
	+ by (metis ind_sheaf.ind_add_str_def ind_sheaf_axioms is_ring_morphism ring_homomorphism.axioms(4))
	+ show "monoid_homomorphism (ind_ring_morphisms W V) (ind_sheaf W) (ind_mult_str W) (ind_one_str W) (ind_sheaf V) (ind_mult_str V) (ind_one_str V)"
	+ using o by (metis ind_mult_str_def ind_one_str_def ind_ring_morphisms_def ind_sheaf_def is_ring_morphism ring_homomorphism_def)
	+ qed (use that in auto)
	+ moreover have "ind_sheaf {} = {b}"
	+ by (simp add: ring_of_empty ind_sheaf_def)
	+ moreover have "\<And>U. it.ind_is_open U \<Longrightarrow> (\<And>x. x \<in> (ind_sheaf U) \<Longrightarrow> ind_ring_morphisms U U x = x)"
	+ by (simp add: Int_absorb1 it.ind_is_open_def ind_ring_morphisms_def ind_sheaf_def it.is_open_from_ind_is_open is_open_subset)
	+ moreover have "\<And>U V W. it.ind_is_open U \<Longrightarrow> it.ind_is_open V \<Longrightarrow> it.ind_is_open W \<Longrightarrow> V \<subseteq> U \<Longrightarrow> W \<subseteq> V
	+ \<Longrightarrow> (\<And>x. x \<in> (ind_sheaf U) \<Longrightarrow> ind_ring_morphisms U W x = (ind_ring_morphisms V W \<circ> ind_ring_morphisms U V) x)"
	+ by (metis Int_absorb1 assoc_comp it.ind_is_open_def ind_ring_morphisms_def ind_sheaf_def it.is_open_from_ind_is_open is_open_subset)
	+ ultimately show ?thesis
	+ unfolding presheaf_of_rings_def presheaf_of_rings_axioms_def by blast
	+qed
	+
	+lemma ind_sheaf_is_sheaf:
	+ shows "sheaf_of_rings U it.ind_is_open ind_sheaf ind_ring_morphisms b ind_add_str ind_mult_str ind_zero_str ind_one_str"
	+proof (intro sheaf_of_rings.intro sheaf_of_rings_axioms.intro)
	+ show "presheaf_of_rings U it.ind_is_open ind_sheaf ind_ring_morphisms b ind_add_str ind_mult_str ind_zero_str ind_one_str"
	+ using ind_sheaf_is_presheaf by blast
	+next
	+ fix V I W s
	+ assume oc: "open_cover_of_open_subset U it.ind_is_open V I W"
	+ and WV: "\<And>i. i \<in> I \<Longrightarrow> W i \<subseteq> V"
	+ and s: "s \<in> ind_sheaf V"
	+ and eq: "\<And>i. i \<in> I \<Longrightarrow> ind_ring_morphisms V (W i) s = ind_zero_str (W i)"
	+ have "it.ind_is_open V"
	+ using oc open_cover_of_open_subset.is_open_subset by blast
	+ then have "s \<in> \<FF> V"
	+ by (metis ind_sheaf.ind_sheaf_def ind_sheaf_axioms it.ind_is_open_def inf.absorb2 s)
	+ then have "s = \<zero>\<^bsub>V\<^esub>"
	+ by (metis Int_absorb1 Int_subset_iff WV ind_sheaf.ind_zero_str_def ind_sheaf_axioms eq it.ind_is_open_def ind_ring_morphisms_def is_open_subset locality oc it.open_cover_from_ind_open_cover open_cover_of_open_subset.is_open_subset)
	+ then show "s = ind_zero_str V"
	+ by (metis Int_absorb1 it.ind_is_open_def ind_zero_str_def oc open_cover_of_open_subset.is_open_subset)
	+next
	+ fix V I W s
	+ assume oc: "open_cover_of_open_subset U it.ind_is_open V I W"
	+ and WV: "\<forall>i. i \<in> I \<longrightarrow> W i \<subseteq> V \<and> s i \<in> ind_sheaf (W i)"
	+ and eq: "\<And>i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> ind_ring_morphisms (W i) (W i \<inter> W j) (s i) = ind_ring_morphisms (W j) (W i \<inter> W j) (s j)"
	+ have "is_open V"
	+ using it.is_open_from_ind_is_open is_open_subset oc open_cover_of_open_subset.is_open_subset by blast
	+ moreover have "open_cover_of_open_subset S is_open V I W"
	+ using it.open_cover_from_ind_open_cover oc ind_topology.intro ind_topology_axioms_def is_open_subset it.is_subset topological_space_axioms by blast
	+ moreover have "\<rho> (W i) (W i \<inter> W j) (s i) = \<rho> (W j) (W i \<inter> W j) (s j)"
	+ if "i\<in>I" "j\<in>I" for i j
	+ proof -
	+ have "U \<inter> W i = W i" and "U \<inter> W j = W j"
	+ by (metis Int_absorb1 WV it.ind_is_open_def oc open_cover_of_open_subset.is_open_subset
	+ subset_trans that)+
	+ then show ?thesis
	+ using eq[unfolded ind_ring_morphisms_def,OF that] by (metis inf_sup_aci(2))
	+ qed
	+ moreover have "\<forall>i. i\<in>I \<longrightarrow> W i \<subseteq> V \<and> s i \<in> \<FF> (W i)"
	+ by (metis WV it.ind_is_open_def ind_sheaf_def inf.orderE inf_idem inf_aci(3) oc open_cover_of_open_subset.is_open_subset)
	+ ultimately
	+ obtain t where "t \<in> (\<FF> V) \<and> (\<forall>i. i\<in>I \<longrightarrow> \<rho> V (W i) t = s i)"
	+ using glueing by blast
	+ then have "t \<in> ind_sheaf V"
	+ unfolding ind_sheaf_def using oc
	+ by (metis Int_absorb1 cover_of_subset_def open_cover_of_open_subset_def open_cover_of_subset_def)
	+ moreover have "\<forall>i. i\<in>I \<longrightarrow> ind_ring_morphisms V (W i) t = s i"
	+ unfolding ind_ring_morphisms_def
	+ by (metis oc Int_absorb1 \<open>t \<in> \<FF> V \<and> (\<forall>i. i \<in> I \<longrightarrow> \<rho> V (W i) t = s i)\<close> cover_of_subset_def open_cover_of_open_subset_def open_cover_of_subset_def)
	+ ultimately show "\<exists>t. t \<in> (ind_sheaf V) \<and> (\<forall>i. i\<in>I \<longrightarrow> ind_ring_morphisms V (W i) t = s i)" by blast
	+qed
	+
	+end (* ind_sheaf *)
	+
	+(* construction 0.22 *)
	+locale im_sheaf = sheaf_of_rings + continuous_map
	+begin
	+
	+(* def 0.24 *)
	+definition im_sheaf:: "'c set => 'b set"
	+ where "im_sheaf V \<equiv> \<FF> (f\<^sup>\<inverse> S V)"
	+
	+definition im_sheaf_morphisms:: "'c set \<Rightarrow> 'c set \<Rightarrow> ('b \<Rightarrow> 'b)"
	+ where "im_sheaf_morphisms U V \<equiv> \<rho> (f\<^sup>\<inverse> S U) (f\<^sup>\<inverse> S V)"
	+
	+definition add_im_sheaf:: "'c set \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b"
	+ where "add_im_sheaf \<equiv> \<lambda>V x y. +\<^bsub>(f\<^sup>\<inverse> S V)\<^esub> x y"
	+
	+definition mult_im_sheaf:: "'c set \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b"
	+ where "mult_im_sheaf \<equiv> \<lambda>V x y. \<cdot>\<^bsub>(f\<^sup>\<inverse> S V)\<^esub> x y"
	+
	+definition zero_im_sheaf:: "'c set \<Rightarrow> 'b"
	+ where "zero_im_sheaf \<equiv> \<lambda>V. \<zero>\<^bsub>(f\<^sup>\<inverse> S V)\<^esub>"
	+
	+definition one_im_sheaf:: "'c set \<Rightarrow> 'b"
	+ where "one_im_sheaf \<equiv> \<lambda>V. \<one>\<^bsub>(f\<^sup>\<inverse> S V)\<^esub>"
	+
	+lemma im_sheaf_is_presheaf:
	+ "presheaf_of_rings S' (is_open') im_sheaf im_sheaf_morphisms b
	+add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
	+proof (intro presheaf_of_rings.intro presheaf_of_rings_axioms.intro)
	+ show "topological_space S' is_open'"
	+ by (simp add: target.topological_space_axioms)
	+ show "\<And>U V. \<lbrakk>is_open' U; is_open' V; V \<subseteq> U\<rbrakk>
	+ \<Longrightarrow> ring_homomorphism (im_sheaf_morphisms U V)
	+(im_sheaf U) (add_im_sheaf U) (mult_im_sheaf U) (zero_im_sheaf U) (one_im_sheaf U)
	+(im_sheaf V) (add_im_sheaf V) (mult_im_sheaf V) (zero_im_sheaf V) (one_im_sheaf V)"
	+ unfolding add_im_sheaf_def mult_im_sheaf_def zero_im_sheaf_def one_im_sheaf_def
	+ by (metis Int_commute Int_mono im_sheaf_def im_sheaf_morphisms_def is_continuous is_ring_morphism subset_refl vimage_mono)
	+ show "im_sheaf {} = {b}" using im_sheaf_def ring_of_empty by simp
	+ show "\<And>U. is_open' U \<Longrightarrow> (\<And>x. x \<in> (im_sheaf U) \<Longrightarrow> im_sheaf_morphisms U U x = x)"
	+ using im_sheaf_morphisms_def by (simp add: im_sheaf_def is_continuous)
	+ show "\<And>U V W.
	+ \<lbrakk>is_open' U; is_open' V; is_open' W; V \<subseteq> U; W \<subseteq> V\<rbrakk>
	+ \<Longrightarrow> (\<And>x. x \<in> (im_sheaf U) \<Longrightarrow> im_sheaf_morphisms U W x = (im_sheaf_morphisms V W \<circ> im_sheaf_morphisms U V) x)"
	+ by (metis Int_mono assoc_comp im_sheaf_def im_sheaf_morphisms_def ind_topology.is_subset is_continuous ind_topology_is_open_self vimage_mono)
	+qed
	+
	+(* ex 0.23 *)
	+lemma im_sheaf_is_sheaf:
	+ shows "sheaf_of_rings S' (is_open') im_sheaf im_sheaf_morphisms b
	+add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
	+proof (intro sheaf_of_rings.intro sheaf_of_rings_axioms.intro)
	+ show "presheaf_of_rings S' is_open' im_sheaf im_sheaf_morphisms b
	+add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
	+ using im_sheaf_is_presheaf by force
	+next
	+ fix U I V s
	+ assume oc: "open_cover_of_open_subset S' is_open' U I V"
	+ and VU: "\<And>i. i \<in> I \<Longrightarrow> V i \<subseteq> U"
	+ and s: "s \<in> im_sheaf U"
	+ and eq0: "\<And>i. i \<in> I \<Longrightarrow> im_sheaf_morphisms U (V i) s =zero_im_sheaf (V i)"
	+ have "open_cover_of_open_subset S is_open (f\<^sup>\<inverse> S U) I (\<lambda>i. f\<^sup>\<inverse> S (V i))"
	+ by (simp add: oc open_cover_of_open_subset_from_target_to_source)
	+ then show "s = zero_im_sheaf U" using zero_im_sheaf_def
	+ by (smt VU im_sheaf_def im_sheaf_morphisms_def eq0 inf.absorb_iff2 inf_le2 inf_sup_aci(1) inf_sup_aci(3) locality s vimage_Int)
	+next
	+ fix U I V s
	+ assume oc: "open_cover_of_open_subset S' is_open' U I V"
	+ and VU: "\<forall>i. i \<in> I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> im_sheaf (V i)"
	+ and eq: "\<And>i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> im_sheaf_morphisms (V i) (V i \<inter> V j) (s i) = im_sheaf_morphisms (V j) (V i \<inter> V j) (s j)"
	+ have "\<exists>t. t \<in> \<FF> (f \<^sup>\<inverse> S U) \<and> (\<forall>i. i \<in> I \<longrightarrow> \<rho> (f \<^sup>\<inverse> S U) (f \<^sup>\<inverse> S (V i)) t = s i)"
	+ proof (rule glueing)
	+ show "open_cover_of_open_subset S is_open (f \<^sup>\<inverse> S U) I (\<lambda>i. f \<^sup>\<inverse> S (V i))"
	+ using oc open_cover_of_open_subset_from_target_to_source by presburger
	+ show "\<forall>i. i \<in> I \<longrightarrow> f \<^sup>\<inverse> S (V i) \<subseteq> f \<^sup>\<inverse> S U \<and> s i \<in> \<FF> (f \<^sup>\<inverse> S (V i))"
	+ using VU im_sheaf_def by blast
	+ show "\<rho> (f \<^sup>\<inverse> S (V i)) (f \<^sup>\<inverse> S (V i) \<inter> f \<^sup>\<inverse> S (V j)) (s i) = \<rho> (f \<^sup>\<inverse> S (V j)) (f \<^sup>\<inverse> S (V i) \<inter> f \<^sup>\<inverse> S (V j)) (s j)"
	+ if "i \<in> I" "j \<in> I" for i j
	+ using im_sheaf_morphisms_def eq that
	+ by (smt Int_commute Int_left_commute inf.left_idem vimage_Int)
	+ qed
	+ then obtain t where "t \<in> \<FF> (f\<^sup>\<inverse> S U) \<and> (\<forall>i. i\<in>I \<longrightarrow> \<rho> (f\<^sup>\<inverse> S U) (f\<^sup>\<inverse> S (V i)) t = s i)" ..
	+ then show "\<exists>t. t \<in> im_sheaf U \<and> (\<forall>i. i \<in> I \<longrightarrow> im_sheaf_morphisms U (V i) t = s i)"
	+ using im_sheaf_def im_sheaf_morphisms_def by auto
	+qed
	+
	+sublocale sheaf_of_rings S' is_open' im_sheaf im_sheaf_morphisms b
	+ add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
	+ using im_sheaf_is_sheaf .
	+
	+end (* im_sheaf *)
	+
	+lemma (in sheaf_of_rings) id_to_iso_of_sheaves:
	+ shows "iso_sheaves_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ (im_sheaf.im_sheaf S \<FF> (identity S))
	+ (im_sheaf.im_sheaf_morphisms S \<rho> (identity S))
	+ b
	+ (\<lambda>V. +\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>V. \<cdot>\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>V. \<zero>\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>V. \<one>\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>U. identity (\<FF> U))"
	+ (is "iso_sheaves_of_rings S is_open \<FF> \<rho> b _ _ _ _ _ _ b ?add ?mult ?zero ?one ?F")
	+proof-
	+ have preq[simp]: "\<And>V. V \<subseteq> S \<Longrightarrow> (identity S \<^sup>\<inverse> S V) = V"
	+ by auto
	+ interpret id: im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
	+ by intro_locales (auto simp add: Set_Theory.map_def continuous_map_axioms_def open_imp_subset)
	+ have 1[simp]: "\<And>V. V \<subseteq> S \<Longrightarrow> im_sheaf.im_sheaf S \<FF> (identity S) V = \<FF> V"
	+ by (simp add: id.im_sheaf_def)
	+ have 2[simp]: "\<And>U V. \<lbrakk>U \<subseteq> S; V \<subseteq> S\<rbrakk> \<Longrightarrow> im_sheaf.im_sheaf_morphisms S \<rho> (identity S) U V \<equiv> \<rho> U V"
	+ using id.im_sheaf_morphisms_def by auto
	+ show ?thesis
	+ proof intro_locales
	+ have rh: "\<And>U. is_open U \<Longrightarrow>
	+ ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
	+ using id_is_mor_pr_rngs morphism_presheaves_of_rings.is_ring_morphism by fastforce
	+ show "morphism_presheaves_of_rings_axioms is_open \<FF> \<rho> add_str mult_str zero_str one_str
	+ id.im_sheaf id.im_sheaf_morphisms ?add ?mult ?zero ?one ?F"
	+ unfolding morphism_presheaves_of_rings_axioms_def
	+ by (auto simp: rh open_imp_subset intro: is_map_from_is_homomorphism map.map_closed)
	+ have \<rho>: "\<And>U V W x. \<lbrakk>is_open U; is_open V; is_open W; V \<subseteq> U; W \<subseteq> V; x \<in> \<FF> U\<rbrakk> \<Longrightarrow> \<rho> V W (\<rho> U V x) = \<rho> U W x"
	+ by (metis assoc_comp comp_def)
	+ show "presheaf_of_rings_axioms is_open id.im_sheaf id.im_sheaf_morphisms b ?add ?mult ?zero ?one"
	+ by (auto simp: \<rho> presheaf_of_rings_axioms_def is_ring_morphism open_imp_subset ring_of_empty)
	+ then have "presheaf_of_rings S is_open id.im_sheaf id.im_sheaf_morphisms b ?add ?mult ?zero ?one"
	+ by (metis id.im_sheaf_is_presheaf presheaf_of_rings_def)
	+ moreover
	+ have "morphism_presheaves_of_rings_axioms is_open
	+ id.im_sheaf id.im_sheaf_morphisms ?add ?mult ?zero ?one \<FF> \<rho> add_str
	+ mult_str zero_str one_str (\<lambda>U. \<lambda>x\<in>\<FF> U. x)"
	+ unfolding morphism_presheaves_of_rings_axioms_def
	+ by (auto simp: rh open_imp_subset intro: is_map_from_is_homomorphism map.map_closed)
	+ ultimately
	+ show "iso_presheaves_of_rings_axioms S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ id.im_sheaf id.im_sheaf_morphisms b ?add ?mult ?zero ?one ?F"
	+ by (auto simp: presheaf_of_rings_axioms iso_presheaves_of_rings_axioms_def morphism_presheaves_of_rings_def open_imp_subset)
	+ qed
	+qed
	+
	+
	+subsection \<open>Quotient Ring\<close>
	+
	+(Probably for Group_Theory)
	+context group begin
	+
	+lemma cancel_imp_equal:
	+ "\<lbrakk> u \<cdot> inverse v = \<one>; u \<in> G; v \<in> G \<rbrakk> \<Longrightarrow> u = v"
	+ by (metis invertible invertible_inverse_closed invertible_right_cancel invertible_right_inverse)
	+
	+end
	+
	+(Probably for Ring_Theory)
	+context ring begin
	+
	+lemma inverse_distributive: "\<lbrakk> a \<in> R; b \<in> R; c \<in> R \<rbrakk> \<Longrightarrow> a \<cdot> (b - c) = a \<cdot> b - a \<cdot> c"
	+ "\<lbrakk> a \<in> R; b \<in> R; c \<in> R \<rbrakk> \<Longrightarrow> (b - c) \<cdot> a = b \<cdot> a - c \<cdot> a"
	+ using additive.invertible additive.invertible_inverse_closed distributive
	+ local.left_minus local.right_minus by presburger+
	+
	+end
	+
	+locale quotient_ring = comm:comm_ring R "(+)" "(\<cdot>)" "\<zero>" "\<one>" + submonoid S R "(\<cdot>)" "\<one>"
	+ for S and R and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and
	+unit ("\<one>")
	+begin
	+
	+lemmas comm_ring_simps =
	+ comm.multiplicative.associative
	+ comm.additive.associative
	+ comm.comm_mult
	+ comm.additive.commutative
	+ right_minus
	+
	+definition rel:: "('a \<times> 'a) \<Rightarrow> ('a \<times> 'a) \<Rightarrow> bool" (infix "\<sim>" 80)
	+ where "x \<sim> y \<equiv> \<exists>s1. s1 \<in> S \<and> s1 \<cdot> (snd y \<cdot> fst x - snd x \<cdot> fst y) = \<zero>"
	+
	+lemma rel_refl: "\<And>x. x \<in> R \<times> S \<Longrightarrow> x \<sim> x"
	+ by (auto simp: rel_def)
	+
	+lemma rel_sym:
	+ assumes "x \<sim> y" "x \<in> R \<times> S" "y \<in> R \<times> S" shows "y \<sim> x"
	+proof -
	+ obtain rx sx ry sy s
	+ where \<section>: "rx \<in> R" "sx \<in> S" "ry \<in> R" "s \<in> S" "sy \<in> S" "s \<cdot> (sy \<cdot> rx - sx \<cdot> ry) = \<zero>" "x = (rx,sx)" "y = (ry,sy)"
	+ using assms by (auto simp: rel_def)
	+ then have "s \<cdot> (sx \<cdot> ry - sy \<cdot> rx) = \<zero>"
	+ by (metis sub comm.additive.cancel_imp_equal comm.inverse_distributive(1) comm.multiplicative.composition_closed)
	+ with \<section> show ?thesis
	+ by (auto simp: rel_def)
	+qed
	+
	+lemma rel_trans:
	+ assumes "x \<sim> y" "y \<sim> z" "x \<in> R \<times> S" "y \<in> R \<times> S" "z \<in> R \<times> S" shows "x \<sim> z"
	+ using assms
	+proof (clarsimp simp: rel_def)
	+ fix r s r2 s2 r1 s1 sx sy
	+ assume \<section>: "r \<in> R" "s \<in> S" "r1 \<in> R" "s1 \<in> S" "sx \<in> S" "r2 \<in> R" "s2 \<in> S" "sy \<in> S"
	+ and sx0: "sx \<cdot> (s1 \<cdot> r2 - s2 \<cdot> r1) = \<zero>" and sy0: "sy \<cdot> (s2 \<cdot> r - s \<cdot> r2) = \<zero>"
	+ show "\<exists>u. u \<in> S \<and> u \<cdot> (s1 \<cdot> r - s \<cdot> r1) = \<zero>"
	+ proof (intro exI conjI)
	+ show "sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<in> S"
	+ using \<section> by blast
	+ have sx: "sx \<cdot> s1 \<cdot> r2 = sx \<cdot> s2 \<cdot> r1" and sy: "sy \<cdot> s2 \<cdot> r = sy \<cdot> s \<cdot> r2"
	+ using sx0 sy0 \<section> comm.additive.cancel_imp_equal comm.inverse_distributive(1)
	+ comm.multiplicative.associative comm.multiplicative.composition_closed sub
	+ by metis+
	+ then
	+ have "sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> (s1 \<cdot> r - s \<cdot> r1) = sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> s1 \<cdot> r - sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> s \<cdot> r1"
	+ using "\<section>" \<open>sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<in> S\<close>
	+ comm.inverse_distributive(1) comm.multiplicative.associative comm.multiplicative.composition_closed
	+ sub
	+ by presburger
	+ also have "... = sx \<cdot> sy \<cdot> s1 \<cdot> s \<cdot> s1 \<cdot> r2 - sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> s \<cdot> r1"
	+ using \<section>
	+ by (smt sy comm.comm_mult comm.multiplicative.associative comm.multiplicative.composition_closed sub)
	+ also have "... = sx \<cdot> sy \<cdot> s1 \<cdot> s \<cdot> s1 \<cdot> r2 - sx \<cdot> sy \<cdot> s1 \<cdot> s1 \<cdot> s \<cdot> r2"
	+ using \<section> by (smt sx comm.comm_mult comm.multiplicative.associative
	+ comm.multiplicative.composition_closed sub)
	+ also have "... = \<zero>"
	+ using \<section> by (simp add: comm.ring_mult_ac)
	+ finally show "sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> (s1 \<cdot> r - s \<cdot> r1) = \<zero>" .
	+ qed
	+qed
	+
	+interpretation rel: equivalence "R \<times> S" "{(x,y) \<in> (R\<times>S)\<times>(R\<times>S). x \<sim> y}"
	+ by (blast intro: equivalence.intro rel_refl rel_sym rel_trans)
	+
	+
	+notation equivalence.Partition (infixl "'/" 75)
	+
	+definition frac:: "'a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set" (infixl "'/" 75)
	+ where "r / s \<equiv> rel.Class (r, s)"
	+
	+lemma frac_Pow:"(r, s) \<in> R \<times> S \<Longrightarrow> frac r s \<in> Pow (R \<times> S) "
	+ using local.frac_def rel.Class_closed2 by auto
	+
	+lemma frac_eqI:
	+ assumes "s1\<in>S" and "(r, s) \<in> R \<times> S" "(r', s') \<in> R \<times> S"
	+ and eq:"s1 \<cdot> s' \<cdot> r = s1 \<cdot> s \<cdot> r'"
	+ shows "frac r s = frac r' s'"
	+ unfolding frac_def
	+proof (rule rel.Class_eq)
	+ have "s1 \<cdot> (s' \<cdot> r - s \<cdot> r') = \<zero>"
	+ using assms comm.inverse_distributive(1) comm.multiplicative.associative by auto
	+ with \<open>s1\<in>S\<close> have "(r, s) \<sim> (r', s')"
	+ unfolding rel_def by auto
	+ then show "((r, s), r', s') \<in> {(x, y). (x, y) \<in> (R \<times> S) \<times> R \<times> S \<and> x \<sim> y}"
	+ using assms(2,3) by auto
	+qed
	+
	+lemma frac_eq_Ex:
	+ assumes "(r, s) \<in> R \<times> S" "(r', s') \<in> R \<times> S" "frac r s = frac r' s'"
	+ obtains s1 where "s1\<in>S" "s1 \<cdot> (s' \<cdot> r - s \<cdot> r') = \<zero>"
	+proof -
	+ have "(r, s) \<sim> (r', s')"
	+ using \<open>frac r s = frac r' s'\<close> rel.Class_equivalence[OF assms(1,2)]
	+ unfolding frac_def by auto
	+ then show ?thesis unfolding rel_def
	+ by (metis fst_conv snd_conv that)
	+qed
	+
	+lemma frac_cancel:
	+ assumes "s1\<in>S" and "(r, s) \<in> R \<times> S"
	+ shows "frac (s1\<cdot>r) (s1\<cdot>s) = frac r s"
	+ apply (rule frac_eqI[of \<one>])
	+ using assms comm_ring_simps by auto
	+
	+lemma frac_eq_obtains:
	+ assumes "(r,s) \<in> R \<times> S" and x_def:"x=(SOME x. x\<in>(frac r s))"
	+ obtains s1 where "s1\<in>S" "s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and "x \<in> R \<times> S"
	+proof -
	+ have "x\<in>(r/s)"
	+ unfolding x_def
	+ apply (rule someI[of _ "(r,s)"])
	+ using assms(1) local.frac_def by blast
	+ from rel.ClassD[OF this[unfolded frac_def] \<open>(r,s) \<in> R \<times> S\<close>]
	+ have x_RS:"x\<in>R \<times> S" and "x \<sim> (r,s)" by auto
	+ from this(2) obtain s1 where "s1\<in>S" and "s1 \<cdot> (s \<cdot> fst x - snd x \<cdot> r) = \<zero>"
	+ unfolding rel_def by auto
	+ then have x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r"
	+ using comm.distributive x_RS assms(1)
	+ by (smt comm.additive.group_axioms group.cancel_imp_equal comm.inverse_distributive(1)
	+ mem_Sigma_iff comm.multiplicative.associative comm.multiplicative.composition_closed prod.collapse sub)
	+ then show ?thesis using that x_RS \<open>s1\<in>S\<close> by auto
	+qed
	+
	+definition valid_frac::"('a \<times> 'a) set \<Rightarrow> bool" where
	+ "valid_frac X \<equiv> \<exists>r\<in>R. \<exists>s\<in>S. r / s = X"
	+
	+lemma frac_non_empty[simp]:"(a,b) \<in> R \<times> S \<Longrightarrow> valid_frac (frac a b)"
	+ unfolding frac_def valid_frac_def by blast
	+
	+definition add_rel_aux:: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set"
	+ where "add_rel_aux r s r' s' \<equiv> (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
	+
	+definition add_rel:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
	+ where "add_rel X Y \<equiv>
	+ let x = (SOME x. x \<in> X) in
	+ let y = (SOME y. y \<in> Y) in
	+ add_rel_aux (fst x) (snd x) (fst y) (snd y)"
	+
	+lemma add_rel_frac:
	+ assumes "(r,s) \<in> R \<times> S" "(r',s')\<in> R \<times> S"
	+ shows "add_rel (r/s) (r'/s') = (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
	+proof -
	+ define x where "x=(SOME x. x\<in>(r/s))"
	+ define y where "y=(SOME y. y\<in>(r'/s'))"
	+
	+ obtain s1 where [simp]:"s1 \<in> S" and x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and x_RS:"x \<in> R \<times> S"
	+ using frac_eq_obtains[OF \<open>(r,s) \<in> R \<times> S\<close> x_def] by auto
	+ obtain s2 where [simp]:"s2 \<in> S" and y_eq:"s2 \<cdot> s' \<cdot> fst y = s2 \<cdot> snd y \<cdot> r'" and y_RS:"y \<in> R \<times> S"
	+ using frac_eq_obtains[OF \<open>(r',s') \<in> R \<times> S\<close> y_def] by auto
	+
	+ have "add_rel (r/s) (r'/s') = (fst x \<cdot> snd y + fst y \<cdot> snd x) / (snd x \<cdot> snd y)"
	+ unfolding add_rel_def add_rel_aux_def x_def y_def Let_def by auto
	+ also have "... = (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
	+ proof (rule frac_eqI[of "s1 \<cdot> s2"])
	+ have "snd y \<cdot> s' \<cdot> s2 \<cdot> (s1 \<cdot> s \<cdot> fst x) = snd y \<cdot> s' \<cdot> s2 \<cdot> (s1 \<cdot> snd x \<cdot> r)"
	+ using x_eq by simp
	+ then have "s1 \<cdot> s2 \<cdot> s \<cdot> s' \<cdot> fst x \<cdot> snd y = s1 \<cdot> s2 \<cdot> snd x \<cdot> snd y \<cdot> r \<cdot> s'"
	+ using comm.multiplicative.associative assms x_RS y_RS comm.comm_mult by auto
	+ moreover have "snd x \<cdot> s \<cdot>s1 \<cdot> (s2 \<cdot> s' \<cdot> fst y) = snd x \<cdot> s \<cdot>s1 \<cdot> (s2 \<cdot> snd y \<cdot> r')"
	+ using y_eq by simp
	+ then have "s1 \<cdot> s2 \<cdot> s \<cdot> s' \<cdot> fst y \<cdot> snd x = s1 \<cdot> s2 \<cdot> snd x \<cdot> snd y \<cdot> r' \<cdot> s"
	+ using comm.multiplicative.associative assms x_RS y_RS comm.comm_mult
	+ by auto
	+ ultimately show "s1 \<cdot> s2 \<cdot> (s \<cdot> s') \<cdot> (fst x \<cdot> snd y + fst y \<cdot> snd x)
	+ = s1 \<cdot> s2 \<cdot> (snd x \<cdot> snd y) \<cdot> (r \<cdot> s' + r' \<cdot> s)"
	+ using comm.multiplicative.associative assms x_RS y_RS comm.distributive
	+ by auto
	+ show "s1 \<cdot> s2 \<in> S" "(fst x \<cdot> snd y + fst y \<cdot> snd x, snd x \<cdot> snd y) \<in> R \<times> S"
	+ "(r \<cdot> s' + r' \<cdot> s, s \<cdot> s') \<in> R \<times> S"
	+ using assms x_RS y_RS by auto
	+ qed
	+ finally show ?thesis by auto
	+qed
	+
	+lemma valid_frac_add[intro,simp]:
	+ assumes "valid_frac X" "valid_frac Y"
	+ shows "valid_frac (add_rel X Y)"
	+proof -
	+ obtain r s r' s' where "r\<in>R" "s\<in>S" "r'\<in>R" "s'\<in>S"
	+ and *:"add_rel X Y = (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
	+ proof -
	+ define x where "x=(SOME x. x\<in>X)"
	+ define y where "y=(SOME y. y\<in>Y)"
	+ have "x\<in>X" "y\<in>Y"
	+ using assms unfolding x_def y_def valid_frac_def some_in_eq local.frac_def
	+ by blast+
	+ then obtain "x \<in> R \<times> S" "y \<in> R \<times> S"
	+ using assms
	+ by (simp add: valid_frac_def x_def y_def) (metis frac_eq_obtains mem_Sigma_iff)
	+ moreover have "add_rel X Y = (fst x \<cdot> snd y + fst y \<cdot> snd x) / (snd x \<cdot> snd y)"
	+ unfolding add_rel_def add_rel_aux_def x_def y_def Let_def by auto
	+ ultimately show ?thesis using that by auto
	+ qed
	+ from this(1-4)
	+ have "(r\<cdot>s' + r'\<cdot>s,s\<cdot>s') \<in> R \<times> S"
	+ by auto
	+ with * show ?thesis by auto
	+qed
	+
	+definition uminus_rel:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
	+ where "uminus_rel X \<equiv> let x = (SOME x. x \<in> X) in (comm.additive.inverse (fst x) / snd x)"
	+
	+lemma uminus_rel_frac:
	+ assumes "(r,s) \<in> R \<times> S"
	+ shows "uminus_rel (r/s) = (comm.additive.inverse r) / s"
	+proof -
	+ define x where "x=(SOME x. x\<in>(r/s))"
	+
	+ obtain s1 where [simp]:"s1 \<in> S" and x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and x_RS:"x \<in> R \<times> S"
	+ using frac_eq_obtains[OF \<open>(r,s) \<in> R \<times> S\<close> x_def] by auto
	+
	+ have "uminus_rel (r/s)= (comm.additive.inverse (fst x)) / (snd x )"
	+ unfolding uminus_rel_def x_def Let_def by auto
	+ also have "... = (comm.additive.inverse r) / s"
	+ apply (rule frac_eqI[of s1])
	+ using x_RS assms x_eq by (auto simp add: comm.right_minus)
	+ finally show ?thesis .
	+qed
	+
	+lemma valid_frac_uminus[intro,simp]:
	+ assumes "valid_frac X"
	+ shows "valid_frac (uminus_rel X)"
	+proof -
	+ obtain r s where "r\<in>R" "s\<in>S"
	+ and *:"uminus_rel X = (comm.additive.inverse r) / s"
	+ proof -
	+ define x where "x=(SOME x. x\<in>X)"
	+ have "x\<in>X"
	+ using assms unfolding x_def valid_frac_def some_in_eq local.frac_def
	+ by blast
	+ then have "x\<in> R \<times> S"
	+ using assms valid_frac_def
	+ by (metis frac_eq_obtains mem_Sigma_iff x_def)
	+ moreover have "uminus_rel X = (comm.additive.inverse (fst x) ) / (snd x)"
	+ unfolding uminus_rel_def x_def Let_def by auto
	+ ultimately show ?thesis using that by auto
	+ qed
	+ from this(1-3)
	+ have "(comm.additive.inverse r,s) \<in> R \<times> S" by auto
	+ with * show ?thesis by auto
	+qed
	+
	+definition mult_rel_aux:: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set"
	+ where "mult_rel_aux r s r' s' \<equiv> (r\<cdot>r') / (s\<cdot>s')"
	+
	+definition mult_rel:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
	+ where "mult_rel X Y \<equiv>
	+ let x = (SOME x. x \<in> X) in
	+ let y = (SOME y. y \<in> Y) in
	+ mult_rel_aux (fst x) (snd x) (fst y) (snd y)"
	+
	+lemma mult_rel_frac:
	+ assumes "(r,s) \<in> R \<times> S" "(r',s')\<in> R \<times> S"
	+ shows "mult_rel (r/s) (r'/s') = (r\<cdot> r') / (s\<cdot>s')"
	+proof -
	+ define x where "x=(SOME x. x\<in>(r/s))"
	+ define y where "y=(SOME y. y\<in>(r'/s'))"
	+
	+ obtain s1 where [simp]:"s1 \<in> S" and x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and x_RS:"x \<in> R \<times> S"
	+ using frac_eq_obtains[OF \<open>(r,s) \<in> R \<times> S\<close> x_def] by auto
	+ obtain s2 where [simp]:"s2 \<in> S" and y_eq:"s2 \<cdot> s' \<cdot> fst y = s2 \<cdot> snd y \<cdot> r'" and y_RS:"y \<in> R \<times> S"
	+ using frac_eq_obtains[OF \<open>(r',s') \<in> R \<times> S\<close> y_def] by auto
	+
	+ have "mult_rel (r/s) (r'/s') = (fst x \<cdot> fst y ) / (snd x \<cdot> snd y)"
	+ unfolding mult_rel_def mult_rel_aux_def x_def y_def Let_def by auto
	+ also have "... = (r\<cdot> r') / (s\<cdot>s')"
	+ proof (rule frac_eqI[of "s1 \<cdot> s2"])
	+ have "(s1 \<cdot> s \<cdot> fst x) \<cdot> (s2 \<cdot> s' \<cdot> fst y) = (s1 \<cdot> snd x \<cdot> r) \<cdot> (s2 \<cdot> snd y \<cdot> r')"
	+ using x_eq y_eq by auto
	+ then show "s1 \<cdot> s2 \<cdot> (s \<cdot> s') \<cdot> (fst x \<cdot> fst y) = s1 \<cdot> s2 \<cdot> (snd x \<cdot> snd y) \<cdot> (r \<cdot> r')"
	+ using comm.multiplicative.associative assms x_RS y_RS comm.distributive comm.comm_mult by auto
	+ show "s1 \<cdot> s2 \<in> S" "(fst x \<cdot> fst y, snd x \<cdot> snd y) \<in> R \<times> S"
	+ "(r \<cdot> r', s \<cdot> s') \<in> R \<times> S"
	+ using assms x_RS y_RS by auto
	+ qed
	+ finally show ?thesis by auto
	+qed
	+
	+lemma valid_frac_mult[intro,simp]:
	+ assumes "valid_frac X" "valid_frac Y"
	+ shows "valid_frac (mult_rel X Y)"
	+proof -
	+ obtain r s r' s' where "r\<in>R" "s\<in>S" "r'\<in>R" "s'\<in>S"
	+ and *:"mult_rel X Y = (r\<cdot> r') / (s\<cdot>s')"
	+ proof -
	+ define x where "x=(SOME x. x\<in>X)"
	+ define y where "y=(SOME y. y\<in>Y)"
	+ have "x\<in>X" "y\<in>Y"
	+ using assms unfolding x_def y_def valid_frac_def some_in_eq local.frac_def
	+ by blast+
	+ then obtain "x \<in> R \<times> S" "y \<in> R \<times> S"
	+ using assms
	+ by (simp add: valid_frac_def x_def y_def) (metis frac_eq_obtains mem_Sigma_iff)
	+ moreover have "mult_rel X Y = (fst x \<cdot> fst y) / (snd x \<cdot> snd y)"
	+ unfolding mult_rel_def mult_rel_aux_def x_def y_def Let_def by auto
	+ ultimately show ?thesis using that by auto
	+ qed
	+ from this(1-4)
	+ have "(r\<cdot>r',s\<cdot>s') \<in> R \<times> S"
	+ by auto
	+ with * show ?thesis by auto
	+qed
	+
	+definition zero_rel::"('a \<times> 'a) set" where
	+ "zero_rel = frac \<zero> \<one>"
	+
	+definition one_rel::"('a \<times> 'a) set" where
	+ "one_rel = frac \<one> \<one>"
	+
	+lemma valid_frac_zero[simp]:
	+ "valid_frac zero_rel"
	+ unfolding zero_rel_def valid_frac_def by blast
	+
	+lemma valid_frac_one[simp]:
	+ "valid_frac one_rel"
	+ unfolding one_rel_def valid_frac_def by blast
	+
	+definition carrier_quotient_ring:: "('a \<times> 'a) set set"
	+ where "carrier_quotient_ring \<equiv> rel.Partition"
	+
	+lemma carrier_quotient_ring_iff[iff]: "X \<in> carrier_quotient_ring \<longleftrightarrow> valid_frac X "
	+ unfolding valid_frac_def carrier_quotient_ring_def
	+ using local.frac_def rel.natural.map_closed rel.representant_exists by fastforce
	+
	+lemma frac_from_carrier:
	+ assumes "X \<in> carrier_quotient_ring"
	+ obtains r s where "r \<in> R" "s \<in> S" "X = rel.Class (r,s)"
	+ using assms carrier_quotient_ring_def
	+ by (metis (no_types, lifting) SigmaE rel.representant_exists)
	+
	+lemma add_minus_zero_rel:
	+ assumes "valid_frac a"
	+ shows "add_rel a (uminus_rel a) = zero_rel"
	+proof -
	+ obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
	+ using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
	+ have "add_rel a (uminus_rel a) = \<zero> / (a2 \<cdot> a2)"
	+ unfolding a12 using comm_ring_simps a_RS
	+ by (simp add:add_rel_frac uminus_rel_frac comm.right_minus)
	+ also have "... = \<zero> / \<one>"
	+ apply (rule frac_eqI[of \<one>])
	+ using a_RS by auto
	+ also have "... = zero_rel" unfolding zero_rel_def ..
	+ finally show "add_rel a (uminus_rel a) = zero_rel" .
	+qed
	+
	+
	+(* ex. 0.26 *)
	+sublocale comm_ring carrier_quotient_ring add_rel mult_rel zero_rel one_rel
	+proof (unfold_locales; unfold carrier_quotient_ring_iff)
	+ show add_assoc:"add_rel (add_rel a b) c = add_rel a (add_rel b c)" and
	+ mult_assoc:"mult_rel (mult_rel a b) c = mult_rel a (mult_rel b c)" and
	+ distr:"mult_rel a (add_rel b c) = add_rel (mult_rel a b) (mult_rel a c)"
	+ if "valid_frac a" and "valid_frac b" and "valid_frac c" for a b c
	+ proof -
	+ obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
	+ using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
	+ obtain b1 b2 where b_RS:"(b1, b2)\<in>R \<times> S" and b12:"b = b1 / b2 "
	+ using \<open>valid_frac b\<close> unfolding valid_frac_def by auto
	+ obtain c1 c2 where c_RS:"(c1, c2)\<in>R \<times> S" and c12:"c = c1 / c2"
	+ using \<open>valid_frac c\<close> unfolding valid_frac_def by auto
	+
	+ have "add_rel (add_rel a b) c = add_rel (add_rel (a1/a2) (b1/b2)) (c1/c2)"
	+ using a12 b12 c12 by auto
	+ also have "... = ((a1 \<cdot> b2 + b1 \<cdot> a2) \<cdot> c2 + c1 \<cdot> (a2 \<cdot> b2)) / (a2 \<cdot> b2 \<cdot> c2)"
	+ using a_RS b_RS c_RS by (simp add:add_rel_frac)
	+ also have "... = add_rel (a1/a2) (add_rel (b1/b2) (c1/c2))"
	+ using a_RS b_RS c_RS comm.distributive comm_ring_simps
	+ by (auto simp add:add_rel_frac)
	+ also have "... = add_rel a (add_rel b c)"
	+ using a12 b12 c12 by auto
	+ finally show "add_rel (add_rel a b) c = add_rel a (add_rel b c)" .
	+
	+ show "mult_rel (mult_rel a b) c = mult_rel a (mult_rel b c)"
	+ unfolding a12 b12 c12 using comm_ring_simps a_RS b_RS c_RS
	+ by (auto simp add:mult_rel_frac)
	+
	+ have "mult_rel a (add_rel b c) = (a1 \<cdot> (b1 \<cdot> c2 + c1 \<cdot> b2)) / (a2 \<cdot> (b2 \<cdot> c2))"
	+ unfolding a12 b12 c12 using a_RS b_RS c_RS
	+ by (simp add:mult_rel_frac add_rel_frac)
	+ also have "... = (a2 \<cdot> (a1 \<cdot> (b1 \<cdot> c2 + c1 \<cdot> b2))) / (a2 \<cdot> (a2 \<cdot> (b2 \<cdot> c2)))"
	+ using a_RS b_RS c_RS by (simp add:frac_cancel)
	+ also have "... = add_rel (mult_rel a b) (mult_rel a c)"
	+ unfolding a12 b12 c12 using comm_ring_simps a_RS b_RS c_RS comm.distributive
	+ by (auto simp add:mult_rel_frac add_rel_frac)
	+ finally show "mult_rel a (add_rel b c) = add_rel (mult_rel a b) (mult_rel a c)"
	+ .
	+ qed
	+ show add_0:"add_rel zero_rel a = a"
	+ and mult_1:"mult_rel one_rel a = a"
	+ if "valid_frac a" for a
	+ proof -
	+ obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
	+ using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
	+ have "add_rel zero_rel a = add_rel zero_rel (a1/a2)"
	+ using a12 by simp
	+ also have "... = (a1/a2)"
	+ using a_RS comm_ring_simps comm.distributive zero_rel_def
	+ by (auto simp add:add_rel_frac)
	+ also have "... = a"
	+ using a12 by auto
	+ finally show "add_rel zero_rel a = a" .
	+ show "mult_rel one_rel a = a"
	+ unfolding a12 one_rel_def using a_RS by (auto simp add:mult_rel_frac)
	+ qed
	+ show add_commute:"add_rel a b = add_rel b a"
	+ and mult_commute:"mult_rel a b = mult_rel b a"
	+ if "valid_frac a" and "valid_frac b" for a b
	+ proof -
	+ obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
	+ using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
	+ obtain b1 b2 where b_RS:"(b1, b2)\<in>R \<times> S" and b12:"b = b1 / b2 "
	+ using \<open>valid_frac b\<close> unfolding valid_frac_def by auto
	+
	+ show "add_rel a b = add_rel b a" "mult_rel a b = mult_rel b a"
	+ unfolding a12 b12 using comm_ring_simps a_RS b_RS
	+ by (auto simp add:mult_rel_frac add_rel_frac)
	+ qed
	+ show "add_rel a zero_rel = a" if "valid_frac a" for a
	+ using that add_0 add_commute by auto
	+ show "mult_rel a one_rel = a" if "valid_frac a" for a
	+ using that mult_commute mult_1 by auto
	+ show "monoid.invertible carrier_quotient_ring add_rel zero_rel a"
	+ if "valid_frac a" for a
	+ proof -
	+ have "Group_Theory.monoid carrier_quotient_ring add_rel zero_rel"
	+ apply (unfold_locales)
	+ using add_0 add_assoc add_commute by simp_all
	+ moreover have "add_rel a (uminus_rel a) = zero_rel" "add_rel (uminus_rel a) a = zero_rel"
	+ using add_minus_zero_rel add_commute that by auto
	+ ultimately show "monoid.invertible carrier_quotient_ring add_rel zero_rel a"
	+ unfolding monoid.invertible_def
	+ apply (rule monoid.invertibleI)
	+ using add_commute \<open>valid_frac a\<close> by auto
	+ qed
	+ show "mult_rel (add_rel b c) a = add_rel (mult_rel b a) (mult_rel c a)"
	+ if "valid_frac a" and "valid_frac b" and "valid_frac c" for a b c
	+ using that mult_commute add_commute distr by (simp add: valid_frac_add)
	+qed auto
	+
	+end (* quotient_ring *)
	+
	+notation quotient_ring.carrier_quotient_ring
	+ ("(_ \<^sup>\<inverse> _/ \<^bsub>(2_ _ _))\<^esub>" [60,1000,1000,1000,1000]1000)
	+
	+
	+subsection \<open>Local Rings at Prime Ideals\<close>
	+
	+context pr_ideal
	+begin
	+
	+lemma submonoid_pr_ideal:
	+ shows "submonoid (R \<setminus> I) R (\<cdot>) \<one>"
	+proof
	+ show "a \<cdot> b \<in> R\<setminus>I" if "a \<in> R\<setminus>I" "b \<in> R\<setminus>I" for a b
	+ using that by (metis Diff_iff absorbent comm.multiplicative.composition_closed)
	+ show "\<one> \<in> R\<setminus>I"
	+ using ideal.ideal(2) ideal_axioms pr_ideal.carrier_neq pr_ideal_axioms by fastforce
	+qed auto
	+
	+interpretation local:quotient_ring "(R \<setminus> I)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ by intro_locales (meson submonoid_def submonoid_pr_ideal)
	+
	+(* definition 0.28 *)
	+definition carrier_local_ring_at:: "('a \<times> 'a) set set"
	+ where "carrier_local_ring_at \<equiv> (R \<setminus> I)\<^sup>\<inverse> R\<^bsub>(+) (\<cdot>) \<zero>\<^esub>"
	+
	+definition add_local_ring_at:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
	+ where "add_local_ring_at \<equiv> local.add_rel "
	+
	+definition mult_local_ring_at:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
	+ where "mult_local_ring_at \<equiv> local.mult_rel "
	+
	+definition uminus_local_ring_at:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
	+ where "uminus_local_ring_at \<equiv> local.uminus_rel "
	+
	+definition zero_local_ring_at:: "('a \<times> 'a) set"
	+ where "zero_local_ring_at \<equiv> local.zero_rel"
	+
	+definition one_local_ring_at:: "('a \<times> 'a) set"
	+ where "one_local_ring_at \<equiv> local.one_rel"
	+
	+sublocale comm_ring carrier_local_ring_at add_local_ring_at mult_local_ring_at
	+ zero_local_ring_at one_local_ring_at
	+ by (simp add: add_local_ring_at_def carrier_local_ring_at_def local.local.comm_ring_axioms
	+ mult_local_ring_at_def one_local_ring_at_def zero_local_ring_at_def)
	+
	+
	+lemma frac_from_carrier_local:
	+ assumes "X \<in> carrier_local_ring_at"
	+ obtains r s where "r \<in> R" "s \<in> R" "s \<notin> I" "X = local.frac r s"
	+proof-
	+ have "X \<in> (R \<setminus> I)\<^sup>\<inverse> R\<^bsub>(+) (\<cdot>) \<zero>\<^esub>" using assms by (simp add: carrier_local_ring_at_def)
	+ then have "X \<in> quotient_ring.carrier_quotient_ring (R \<setminus> I) R (+) (\<cdot>) \<zero>" by blast
	+ then obtain r s where "r \<in> R" "s \<in> (R \<setminus> I)" "X = local.frac r s"
	+ using local.frac_from_carrier by (metis local.frac_def)
	+ thus thesis using that by blast
	+qed
	+
	+lemma eq_from_eq_frac:
	+ assumes "local.frac r s = local.frac r' s'"
	+ and "s \<in> (R \<setminus> I)" and "s' \<in> (R \<setminus> I)" and "r \<in> R" "r' \<in> R"
	+ obtains h where "h \<in> (R \<setminus> I)" "h \<cdot> (s' \<cdot> r - s \<cdot> r') = \<zero>"
	+ using local.frac_eq_Ex[of r s r' s'] assms by blast
	+
	+end (* pr_ideal *)
	+
	+abbreviation carrier_of_local_ring_at::
	+"'a set \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set set" ("_ \<^bsub>_ _ _ _\<^esub>" [1000]1000)
	+where "R \<^bsub>I add mult zero\<^esub> \<equiv> pr_ideal.carrier_local_ring_at R I add mult zero"
	+
	+
	+subsection \<open>Spectrum of a Ring\<close>
	+
	+(* construction 0.29 *)
	+context comm_ring
	+begin
	+
	+interpretation zariski_top_space: topological_space Spec is_zariski_open
	+ unfolding is_zariski_open_def using generated_topology_is_topology
	+ by blast
	+
	+lemma spectrum_imp_cxt_quotient_ring:
	+ "\<pp> \<in> Spec \<Longrightarrow> quotient_ring (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
	+ apply (intro_locales)
	+ using pr_ideal.submonoid_pr_ideal spectrum_def submonoid_def by fastforce
	+
	+lemma spectrum_imp_pr:
	+ "\<pp> \<in> Spec \<Longrightarrow> pr_ideal R \<pp> (+) (\<cdot>) \<zero> \<one>"
	+ unfolding spectrum_def by auto
	+
	+lemma frac_in_carrier_local:
	+ assumes "\<pp> \<in> Spec" and "r \<in> R" and "s \<in> R" and "s \<notin> \<pp>"
	+ shows "(quotient_ring.frac (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> r s) \<in> R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
	+proof -
	+ interpret qr:quotient_ring "R \<setminus> \<pp>" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ using spectrum_imp_cxt_quotient_ring[OF \<open>\<pp> \<in> Spec\<close>] .
	+ interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ using spectrum_imp_pr[OF \<open>\<pp> \<in> Spec\<close>] .
	+ show ?thesis unfolding pi.carrier_local_ring_at_def
	+ using assms(2-) by (auto intro:qr.frac_non_empty)
	+qed
	+
	+definition is_locally_frac:: "('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> 'a set set \<Rightarrow> bool"
	+ where "is_locally_frac s V \<equiv> (\<exists>r f. r \<in> R \<and> f \<in> R \<and> (\<forall>\<qq> \<in> V. f \<notin> \<qq> \<and>
	+ s \<qq> = quotient_ring.frac (R \<setminus> \<qq>) R (+) (\<cdot>) \<zero> r f))"
	+
	+lemma is_locally_frac_subset:
	+ assumes "is_locally_frac s U" "V \<subseteq> U"
	+ shows "is_locally_frac s V"
	+ using assms unfolding is_locally_frac_def
	+ by (meson subsetD)
	+
	+lemma is_locally_frac_cong:
	+ assumes "\<And>x. x\<in>U \<Longrightarrow> f x=g x"
	+ shows "is_locally_frac f U = is_locally_frac g U"
	+ unfolding is_locally_frac_def using assms by simp
	+
	+definition is_regular:: "('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> 'a set set \<Rightarrow> bool"
	+ where "is_regular s U \<equiv>
	+\<forall>\<pp>. \<pp> \<in> U \<longrightarrow> (\<exists>V. is_zariski_open V \<and> V \<subseteq> U \<and> \<pp> \<in> V \<and> (is_locally_frac s V))"
	+
	+lemma map_on_empty_is_regular:
	+ fixes s:: "'a set \<Rightarrow> ('a \<times> 'a) set"
	+ shows "is_regular s {}"
	+ by (simp add: is_regular_def)
	+
	+lemma cring0_is_regular [simp]: "cring0.is_regular x = (\<lambda>U. U={})"
	+ unfolding cring0.is_regular_def cring0_is_zariski_open
	+ by blast
	+
	+definition sheaf_spec:: "'a set set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) set" ("\<O> _" [90]90)
	+ where "\<O> U \<equiv> {s\<in>(\<Pi>\<^sub>E \<pp>\<in>U. (R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)). is_regular s U}"
	+
	+lemma cring0_sheaf_spec_empty [simp]: "cring0.sheaf_spec {} = {\<lambda>x. undefined}"
	+ by (simp add: cring0.sheaf_spec_def)
	+
	+lemma sec_has_right_codom:
	+ assumes "s \<in> \<O> U" and "\<pp> \<in> U"
	+ shows "s \<pp> \<in> (R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+using assms sheaf_spec_def by auto
	+
	+
	+lemma is_regular_has_right_codom:
	+ assumes "U \<subseteq> Spec" "\<pp> \<in> U" "is_regular s U"
	+ shows "s \<pp> \<in> R\<setminus>\<pp> \<^sup>\<inverse> R\<^bsub>(+) (\<cdot>) \<zero>\<^esub>"
	+proof -
	+ interpret qr:quotient_ring "(R \<setminus> \<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ using spectrum_imp_cxt_quotient_ring assms by auto
	+ show ?thesis using assms
	+ by (smt frac_in_carrier_local is_locally_frac_def is_regular_def
	+ pr_ideal.carrier_local_ring_at_def spectrum_imp_pr subset_eq)
	+qed
	+
	+lemma sec_is_extensional:
	+ assumes "s \<in> \<O> U"
	+ shows "s \<in> extensional U"
	+ using assms sheaf_spec_def by (simp add: PiE_iff)
	+
	+definition \<O>b::"'a set \<Rightarrow> ('a \<times> 'a) set"
	+ where "\<O>b = (\<lambda>\<pp>. undefined)"
	+
	+lemma \<O>_on_emptyset: "\<O> {} = {\<O>b}"
	+ unfolding sheaf_spec_def \<O>b_def
	+ by (auto simp:Set_Theory.map_def map_on_empty_is_regular)
	+
	+lemma sheaf_spec_of_empty_is_singleton:
	+ fixes U:: "'a set set"
	+ assumes "U = {}" and "s \<in> extensional U" and "t \<in> extensional U"
	+ shows "s = t"
	+ using assms by (simp add: Set_Theory.map_def)
	+
	+definition add_sheaf_spec:: "('a set) set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
	+ where "add_sheaf_spec U s s' \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.add_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> (s \<pp>) (s' \<pp>)"
	+
	+lemma is_regular_add_sheaf_spec:
	+ assumes "is_regular s U" and "is_regular s' U" and "U \<subseteq> Spec"
	+ shows "is_regular (add_sheaf_spec U s s') U"
	+proof -
	+ have "add_sheaf_spec U s s' \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret pi: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ using \<open>U \<subseteq> Spec\<close>[unfolded spectrum_def] \<open>\<pp> \<in> U\<close> by blast
	+ have "s \<pp> \<in> pi.carrier_local_ring_at"
	+ "s' \<pp> \<in> pi.carrier_local_ring_at"
	+ using \<open>is_regular s U\<close> \<open>is_regular s' U\<close>
	+ unfolding is_regular_def is_locally_frac_def using that
	+ using assms(3) frac_in_carrier_local by fastforce+
	+ then show ?thesis
	+ unfolding add_sheaf_spec_def using that
	+ by (simp flip:pi.add_local_ring_at_def)
	+ qed
	+ moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (add_sheaf_spec U s s') V)"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ obtain V1 r1 f1 where "V1 \<subseteq>U" "is_zariski_open V1" "\<pp> \<in> V1" "r1 \<in> R" "f1 \<in> R" and
	+ q_V1:"(\<forall>\<qq>. \<qq> \<in> V1 \<longrightarrow> f1 \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r1 f1)"
	+ using \<open>is_regular s U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close>
	+ unfolding is_locally_frac_def by auto
	+ obtain V2 r2 f2 where "V2 \<subseteq>U" "is_zariski_open V2" "\<pp> \<in> V2" "r2 \<in> R" "f2 \<in> R" and
	+ q_V2:"(\<forall>\<qq>. \<qq> \<in> V2 \<longrightarrow> f2 \<notin> \<qq> \<and> s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r2 f2)"
	+ using \<open>is_regular s' U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close>
	+ unfolding is_locally_frac_def by auto
	+
	+ define V3 where "V3 = V1 \<inter> V2"
	+ define r3 where "r3 = r1 \<cdot> f2 + r2 \<cdot> f1 "
	+ define f3 where "f3 = f1 \<cdot> f2"
	+ have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
	+ unfolding V3_def r3_def f3_def
	+ using \<open>V1 \<subseteq> U\<close> \<open>\<pp> \<in> V1\<close> \<open>V2 \<subseteq> U\<close> \<open>\<pp> \<in> V2\<close> \<open>f1 \<in> R\<close> \<open>f2 \<in> R\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close> by blast+
	+ moreover have "is_zariski_open V3" using \<open>is_zariski_open V1\<close> \<open>is_zariski_open V2\<close> topological_space.open_inter by (simp add: V3_def)
	+ moreover have "f3 \<notin> \<qq>"
	+ "add_sheaf_spec U s s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
	+ if "\<qq> \<in> V3" for \<qq>
	+ proof -
	+ interpret q:quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
	+ using \<open>U \<subseteq> Spec\<close> \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> quotient_ring_def local.comm_ring_axioms
	+ pr_ideal.submonoid_pr_ideal spectrum_def
	+ by fastforce
	+ have "f1 \<notin> \<qq>" "s \<qq> = q.frac r1 f1"
	+ using q_V1 \<open>\<qq> \<in> V3\<close> unfolding V3_def by auto
	+ have "f2 \<notin> \<qq>" "s' \<qq> = q.frac r2 f2"
	+ using q_V2 \<open>\<qq> \<in> V3\<close> unfolding V3_def by auto
	+
	+ have "q.add_rel (q.frac r1 f1) (q.frac r2 f2) = q.frac (r1 \<cdot> f2 + r2 \<cdot> f1) (f1 \<cdot> f2)"
	+ apply (rule q.add_rel_frac)
	+ subgoal by (simp add: \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close>)
	+ subgoal using \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> \<open>r2 \<in> R\<close> by blast
	+ done
	+ then have "q.add_rel (s \<qq>) (s' \<qq>) = q.frac r3 f3"
	+ unfolding r3_def f3_def using \<open>s \<qq> = q.frac r1 f1\<close> \<open>s' \<qq> = q.frac r2 f2\<close>
	+ by auto
	+ then show "add_sheaf_spec U s s' \<qq> = q.frac r3 f3"
	+ unfolding add_sheaf_spec_def using \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> by auto
	+ show "f3 \<notin> \<qq>" using that unfolding V3_def f3_def
	+ using \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> q.sub_composition_closed by auto
	+ qed
	+ ultimately show ?thesis using is_locally_frac_def by metis
	+ qed
	+ ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
	+qed
	+
	+lemma add_sheaf_spec_in_sheaf_spec:
	+ assumes "s \<in> \<O> U" and "t \<in> \<O> U" and "U \<subseteq> Spec"
	+ shows "add_sheaf_spec U s t \<in> \<O> U"
	+proof -
	+ have "add_sheaf_spec U s t \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ apply (rule spectrum_imp_cxt_quotient_ring)
	+ using that \<open>U \<subseteq> Spec\<close> by auto
	+ interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ using that \<open>U \<subseteq> Spec\<close> by (auto intro:spectrum_imp_pr)
	+ have "qr.valid_frac (s \<pp>)" "qr.valid_frac (t \<pp>)"
	+ using sec_has_right_codom[OF _ that] \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close>
	+ by (auto simp:pi.carrier_local_ring_at_def)
	+ then show ?thesis
	+ using that unfolding add_sheaf_spec_def pi.carrier_local_ring_at_def
	+ by auto
	+ qed
	+ moreover have "is_regular (add_sheaf_spec U s t) U"
	+ using \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close> \<open>U \<subseteq> Spec\<close> is_regular_add_sheaf_spec
	+ unfolding sheaf_spec_def by auto
	+ moreover have "add_sheaf_spec U s t \<in> extensional U"
	+ unfolding add_sheaf_spec_def by auto
	+ ultimately show ?thesis
	+ unfolding sheaf_spec_def by (simp add: PiE_iff)
	+qed
	+
	+definition mult_sheaf_spec:: "('a set) set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
	+ where "mult_sheaf_spec U s s' \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.mult_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> (s \<pp>) (s' \<pp>)"
	+
	+lemma is_regular_mult_sheaf_spec:
	+ assumes "is_regular s U" and "is_regular s' U" and "U \<subseteq> Spec"
	+ shows "is_regular (mult_sheaf_spec U s s') U"
	+proof -
	+ have "mult_sheaf_spec U s s' \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret pi: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ using \<open>U \<subseteq> Spec\<close>[unfolded spectrum_def] \<open>\<pp> \<in> U\<close> by blast
	+ have "s \<pp> \<in> pi.carrier_local_ring_at"
	+ "s' \<pp> \<in> pi.carrier_local_ring_at"
	+ using \<open>is_regular s U\<close> \<open>is_regular s' U\<close>
	+ unfolding is_regular_def using that
	+ using assms(3) frac_in_carrier_local in_mono is_locally_frac_def by fastforce+
	+ then show ?thesis
	+ unfolding mult_sheaf_spec_def using that
	+ by (simp flip:pi.mult_local_ring_at_def)
	+ qed
	+ moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (mult_sheaf_spec U s s') V)"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ obtain V1 r1 f1 where "V1 \<subseteq>U" "is_zariski_open V1" "\<pp> \<in> V1" "r1 \<in> R" "f1 \<in> R" and
	+ q_V1:"(\<forall>\<qq>. \<qq> \<in> V1 \<longrightarrow> f1 \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r1 f1)"
	+ using \<open>is_regular s U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close> unfolding is_locally_frac_def
	+ by auto
	+ obtain V2 r2 f2 where "V2 \<subseteq>U" "is_zariski_open V2" "\<pp> \<in> V2" "r2 \<in> R" "f2 \<in> R" and
	+ q_V2:"(\<forall>\<qq>. \<qq> \<in> V2 \<longrightarrow> f2 \<notin> \<qq> \<and> s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r2 f2)"
	+ using \<open>is_regular s' U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close> unfolding is_locally_frac_def
	+ by auto
	+
	+ define V3 where "V3 = V1 \<inter> V2"
	+ define r3 where "r3 = r1 \<cdot> r2 "
	+ define f3 where "f3 = f1 \<cdot> f2"
	+ have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
	+ unfolding V3_def r3_def f3_def
	+ using \<open>V1 \<subseteq> U\<close> \<open>\<pp> \<in> V1\<close> \<open>\<pp> \<in> V2\<close> \<open>f1 \<in> R\<close> \<open>f2 \<in> R\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close> by blast+
	+ moreover have "is_zariski_open V3"
	+ using topological_space.open_inter by (simp add: V3_def \<open>is_zariski_open V1\<close> \<open>is_zariski_open V2\<close>)
	+ moreover have "f3 \<notin> \<qq>"
	+ "mult_sheaf_spec U s s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
	+ if "\<qq> \<in> V3" for \<qq>
	+ proof -
	+ interpret q:quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
	+ using \<open>U \<subseteq> Spec\<close> \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> quotient_ring_def local.comm_ring_axioms
	+ pr_ideal.submonoid_pr_ideal spectrum_def
	+ by fastforce
	+ have "f1 \<notin> \<qq>" "s \<qq> = q.frac r1 f1"
	+ using q_V1 \<open>\<qq> \<in> V3\<close> unfolding V3_def by auto
	+ have "f2 \<notin> \<qq>" "s' \<qq> = q.frac r2 f2"
	+ using q_V2 \<open>\<qq> \<in> V3\<close> unfolding V3_def by auto
	+
	+ have "q.mult_rel (q.frac r1 f1) (q.frac r2 f2) = q.frac (r1 \<cdot> r2 ) (f1 \<cdot> f2)"
	+ apply (rule q.mult_rel_frac)
	+ subgoal by (simp add: \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close>)
	+ subgoal using \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> \<open>r2 \<in> R\<close> by blast
	+ done
	+ then have "q.mult_rel (s \<qq>) (s' \<qq>) = q.frac r3 f3"
	+ unfolding r3_def f3_def using \<open>s \<qq> = q.frac r1 f1\<close> \<open>s' \<qq> = q.frac r2 f2\<close>
	+ by auto
	+ then show "mult_sheaf_spec U s s' \<qq> = q.frac r3 f3"
	+ unfolding mult_sheaf_spec_def using \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> by auto
	+ show "f3 \<notin> \<qq>" using that unfolding V3_def f3_def
	+ using \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> q.sub_composition_closed by auto
	+ qed
	+ ultimately show ?thesis using is_locally_frac_def by metis
	+ qed
	+ ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
	+qed
	+
	+lemma mult_sheaf_spec_in_sheaf_spec:
	+ assumes "s \<in> \<O> U" and "t \<in> \<O> U" and "U \<subseteq> Spec"
	+ shows "mult_sheaf_spec U s t \<in> \<O> U"
	+proof -
	+ have "mult_sheaf_spec U s t \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ apply (rule spectrum_imp_cxt_quotient_ring)
	+ using that \<open>U \<subseteq> Spec\<close> by auto
	+ interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ using that \<open>U \<subseteq> Spec\<close> by (auto intro:spectrum_imp_pr)
	+ have "qr.valid_frac (s \<pp>)" "qr.valid_frac (t \<pp>)"
	+ using sec_has_right_codom[OF _ that] \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close>
	+ by (auto simp:pi.carrier_local_ring_at_def)
	+ then show ?thesis
	+ using that unfolding mult_sheaf_spec_def pi.carrier_local_ring_at_def
	+ by auto
	+ qed
	+ moreover have "is_regular (mult_sheaf_spec U s t) U"
	+ using \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close> \<open>U \<subseteq> Spec\<close> is_regular_mult_sheaf_spec
	+ unfolding sheaf_spec_def by auto
	+ moreover have "mult_sheaf_spec U s t \<in> extensional U"
	+ unfolding mult_sheaf_spec_def by auto
	+ ultimately show ?thesis
	+ unfolding sheaf_spec_def by (simp add: PiE_iff)
	+qed
	+
	+definition uminus_sheaf_spec::"('a set) set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
	+ where "uminus_sheaf_spec U s \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.uminus_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> (s \<pp>) "
	+
	+lemma is_regular_uminus_sheaf_spec:
	+ assumes "is_regular s U" and "U \<subseteq> Spec"
	+ shows "is_regular (uminus_sheaf_spec U s) U"
	+proof -
	+ have "uminus_sheaf_spec U s \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret pi: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ using \<open>U \<subseteq> Spec\<close>[unfolded spectrum_def] \<open>\<pp> \<in> U\<close> by blast
	+ interpret qr:quotient_ring "(R\<setminus>\<pp>)"
	+ by (simp add: quotient_ring_def local.comm_ring_axioms pi.submonoid_pr_ideal)
	+
	+ have "s \<pp> \<in> pi.carrier_local_ring_at"
	+ using \<open>is_regular s U\<close>
	+ unfolding is_regular_def using that
	+ using assms(2) frac_in_carrier_local in_mono is_locally_frac_def by fastforce
	+ then show ?thesis
	+ unfolding uminus_sheaf_spec_def pi.carrier_local_ring_at_def using that
	+ by simp
	+ qed
	+ moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (uminus_sheaf_spec U s) V)"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ obtain V1 r1 f1 where "V1 \<subseteq>U" "is_zariski_open V1" "\<pp> \<in> V1" "r1 \<in> R" "f1 \<in> R" and
	+ q_V1:"(\<forall>\<qq>. \<qq> \<in> V1 \<longrightarrow> f1 \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r1 f1)"
	+ using \<open>is_regular s U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close> unfolding is_locally_frac_def
	+ by auto
	+
	+ define V3 where "V3 = V1 "
	+ define r3 where "r3 = additive.inverse r1"
	+ define f3 where "f3 = f1"
	+ have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
	+ unfolding V3_def r3_def f3_def
	+ using \<open>V1 \<subseteq> U\<close> \<open>\<pp> \<in> V1\<close> \<open>f1 \<in> R\<close> \<open>r1 \<in> R\<close> by blast+
	+ moreover have "is_zariski_open V3"
	+ using topological_space.open_inter by (simp add: V3_def \<open>is_zariski_open V1\<close>)
	+ moreover have "f3 \<notin> \<qq>"
	+ "uminus_sheaf_spec U s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
	+ if "\<qq> \<in> V3" for \<qq>
	+ proof -
	+ interpret q:quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
	+ using \<open>U \<subseteq> Spec\<close> \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> quotient_ring_def local.comm_ring_axioms
	+ pr_ideal.submonoid_pr_ideal spectrum_def
	+ by fastforce
	+ have "f1 \<notin> \<qq>" "s \<qq> = q.frac r1 f1"
	+ using q_V1 \<open>\<qq> \<in> V3\<close> unfolding V3_def by auto
	+
	+ have "q.uminus_rel (q.frac r1 f1) = q.frac (additive.inverse r1) f1"
	+ apply (rule q.uminus_rel_frac)
	+ by (simp add: \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>r1 \<in> R\<close>)
	+ then have "q.uminus_rel (s \<qq>) = q.frac r3 f3"
	+ unfolding r3_def f3_def using \<open>s \<qq> = q.frac r1 f1\<close> by auto
	+ then show "uminus_sheaf_spec U s \<qq> = q.frac r3 f3"
	+ unfolding uminus_sheaf_spec_def using \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> by auto
	+ show "f3 \<notin> \<qq>" using that unfolding V3_def f3_def
	+ using \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> q.sub_composition_closed by auto
	+ qed
	+ ultimately show ?thesis using is_locally_frac_def by metis
	+ qed
	+ ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
	+qed
	+
	+lemma uminus_sheaf_spec_in_sheaf_spec:
	+ assumes "s \<in> \<O> U" and "U \<subseteq> Spec"
	+ shows "uminus_sheaf_spec U s \<in> \<O> U"
	+proof -
	+ have "uminus_sheaf_spec U s \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ apply (rule spectrum_imp_cxt_quotient_ring)
	+ using that \<open>U \<subseteq> Spec\<close> by auto
	+ interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ using that \<open>U \<subseteq> Spec\<close> by (auto intro:spectrum_imp_pr)
	+ have "qr.valid_frac (s \<pp>)"
	+ using sec_has_right_codom[OF _ that] \<open>s \<in> \<O> U\<close>
	+ by (auto simp:pi.carrier_local_ring_at_def)
	+ then show ?thesis
	+ using that unfolding uminus_sheaf_spec_def pi.carrier_local_ring_at_def
	+ by auto
	+ qed
	+ moreover have "is_regular (uminus_sheaf_spec U s) U"
	+ using \<open>s \<in> \<O> U\<close> \<open>U \<subseteq> Spec\<close> is_regular_uminus_sheaf_spec
	+ unfolding sheaf_spec_def by auto
	+ moreover have "uminus_sheaf_spec U s \<in> extensional U"
	+ unfolding uminus_sheaf_spec_def by auto
	+ ultimately show ?thesis
	+ unfolding sheaf_spec_def by (simp add: PiE_iff)
	+qed
	+
	+definition zero_sheaf_spec:: "'a set set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
	+ where "zero_sheaf_spec U \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.zero_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
	+
	+lemma is_regular_zero_sheaf_spec:
	+ assumes "is_zariski_open U"
	+ shows "is_regular (zero_sheaf_spec U) U"
	+proof -
	+ have "zero_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
	+ unfolding zero_sheaf_spec_def
	+ using assms comm_ring.frac_in_carrier_local local.comm_ring_axioms pr_ideal.not_1
	+ quotient_ring.zero_rel_def spectrum_imp_cxt_quotient_ring spectrum_imp_pr subsetD that
	+ zariski_top_space.open_imp_subset by fastforce
	+ moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (zero_sheaf_spec U) V)"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ define V3 where "V3 = U"
	+ define r3 where "r3 = \<zero> "
	+ define f3 where "f3 = \<one>"
	+ have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
	+ unfolding V3_def r3_def f3_def using that by auto
	+ moreover have "is_zariski_open V3" using assms by (simp add: V3_def)
	+ moreover have "f3 \<notin> \<qq>"
	+ "zero_sheaf_spec U \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
	+ if "\<qq> \<in> V3" for \<qq>
	+ subgoal using V3_def assms f3_def pr_ideal.submonoid_pr_ideal spectrum_def
	+ submonoid.sub_unit_closed that zariski_open_is_subset by fastforce
	+ subgoal
	+ proof -
	+ interpret q:quotient_ring "R\<setminus>\<qq>" R
	+ using V3_def assms quotient_ring_def local.comm_ring_axioms
	+ pr_ideal.submonoid_pr_ideal spectrum_def that zariski_open_is_subset by fastforce
	+ show ?thesis unfolding zero_sheaf_spec_def
	+ using V3_def f3_def q.zero_rel_def r3_def that by auto
	+ qed
	+ done
	+ ultimately show ?thesis using is_locally_frac_def by metis
	+ qed
	+ ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
	+qed
	+
	+lemma zero_sheaf_spec_in_sheaf_spec:
	+ assumes "is_zariski_open U"
	+ shows "zero_sheaf_spec U \<in> \<O> U"
	+proof -
	+ have "zero_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ by (meson assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
	+ spectrum_imp_cxt_quotient_ring subsetD that)
	+ interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ by (meson assms spectrum_imp_pr subsetD that zariski_open_is_subset)
	+ show ?thesis unfolding zero_sheaf_spec_def pi.carrier_local_ring_at_def
	+ using that by auto
	+ qed
	+ moreover have "is_regular (zero_sheaf_spec U) U"
	+ using is_regular_zero_sheaf_spec assms by auto
	+ moreover have "zero_sheaf_spec U \<in> extensional U"
	+ by (simp add: zero_sheaf_spec_def)
	+ ultimately show ?thesis unfolding sheaf_spec_def by (simp add: PiE_iff)
	+qed
	+
	+definition one_sheaf_spec:: "'a set set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
	+ where "one_sheaf_spec U \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.one_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
	+
	+lemma is_regular_one_sheaf_spec:
	+ assumes "is_zariski_open U"
	+ shows "is_regular (one_sheaf_spec U) U"
	+proof -
	+ have "one_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
	+ unfolding one_sheaf_spec_def
	+ by (smt assms closed_subsets_zero comm_ring.closed_subsets_def
	+ quotient_ring.carrier_quotient_ring_iff quotient_ring.valid_frac_one
	+ quotient_ring_def local.comm_ring_axioms mem_Collect_eq
	+ pr_ideal.carrier_local_ring_at_def pr_ideal.submonoid_pr_ideal
	+ restrict_apply subsetD that zariski_open_is_subset)
	+ moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (one_sheaf_spec U) V)"
	+ if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ define V3 where "V3 = U"
	+ define r3 where "r3 = \<one>"
	+ define f3 where "f3 = \<one>"
	+ have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
	+ unfolding V3_def r3_def f3_def using that by auto
	+ moreover have "is_zariski_open V3" using assms by (simp add: V3_def)
	+ moreover have "f3 \<notin> \<qq>"
	+ "one_sheaf_spec U \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
	+ if "\<qq> \<in> V3" for \<qq>
	+ subgoal using V3_def assms f3_def pr_ideal.submonoid_pr_ideal spectrum_def
	+ submonoid.sub_unit_closed that zariski_open_is_subset by fastforce
	+ subgoal
	+ proof -
	+ interpret q:quotient_ring "R\<setminus>\<qq>" R
	+ using V3_def assms quotient_ring_def local.comm_ring_axioms
	+ pr_ideal.submonoid_pr_ideal spectrum_def that zariski_open_is_subset by fastforce
	+ show ?thesis unfolding one_sheaf_spec_def
	+ using V3_def f3_def q.one_rel_def r3_def that by auto
	+ qed
	+ done
	+ ultimately show ?thesis using is_locally_frac_def by metis
	+ qed
	+ ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
	+qed
	+
	+lemma one_sheaf_spec_in_sheaf_spec:
	+ assumes "is_zariski_open U"
	+ shows "one_sheaf_spec U \<in> \<O> U"
	+proof -
	+ have "one_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ by (meson assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
	+ spectrum_imp_cxt_quotient_ring subsetD that)
	+ interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ by (meson assms spectrum_imp_pr subsetD that zariski_open_is_subset)
	+ show ?thesis unfolding one_sheaf_spec_def pi.carrier_local_ring_at_def
	+ using that by auto
	+ qed
	+ moreover have "is_regular (one_sheaf_spec U) U"
	+ using is_regular_one_sheaf_spec assms by auto
	+ moreover have "one_sheaf_spec U \<in> extensional U"
	+ by (simp add: one_sheaf_spec_def)
	+ ultimately show ?thesis unfolding sheaf_spec_def by (simp add: PiE_iff)
	+qed
	+
	+lemma zero_sheaf_spec_extensional[simp]:
	+ "zero_sheaf_spec U \<in> extensional U"
	+ unfolding zero_sheaf_spec_def by simp
	+
	+lemma one_sheaf_spec_extensional[simp]:
	+ "one_sheaf_spec U \<in> extensional U"
	+ unfolding one_sheaf_spec_def by simp
	+
	+lemma add_sheaf_spec_extensional[simp]:
	+ "add_sheaf_spec U a b \<in> extensional U"
	+ unfolding add_sheaf_spec_def by simp
	+
	+lemma mult_sheaf_spec_extensional[simp]:
	+ "mult_sheaf_spec U a b \<in> extensional U"
	+ unfolding mult_sheaf_spec_def by simp
	+
	+lemma sheaf_spec_extensional[simp]:
	+ "a \<in> \<O> U \<Longrightarrow> a \<in> extensional U"
	+ unfolding sheaf_spec_def by (simp add: PiE_iff Set_Theory.map_def)
	+
	+lemma sheaf_spec_on_open_is_comm_ring:
	+ assumes "is_zariski_open U"
	+ shows "comm_ring (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)"
	+proof unfold_locales
	+ show add_\<O>:"add_sheaf_spec U a b \<in> \<O> U"
	+ and "mult_sheaf_spec U a b \<in> \<O> U"
	+ if "a \<in> \<O> U" "b \<in> \<O> U" for a b
	+ subgoal by (simp add: add_sheaf_spec_in_sheaf_spec assms that(1,2) zariski_open_is_subset)
	+ subgoal by (simp add: assms mult_sheaf_spec_in_sheaf_spec that(1,2) zariski_open_is_subset)
	+ done
	+ show "zero_sheaf_spec U \<in> \<O> U" "one_sheaf_spec U \<in> \<O> U"
	+ subgoal by (simp add: assms zero_sheaf_spec_in_sheaf_spec)
	+ subgoal by (simp add: assms one_sheaf_spec_in_sheaf_spec)
	+ done
	+
	+ have imp_qr:"quotient_ring (R\<setminus>\<pp>) R (+) (\<cdot>) \<zero> \<one>" if "\<pp> \<in> U" for \<pp>
	+ using that
	+ by (meson assms comm_ring.spectrum_imp_cxt_quotient_ring in_mono local.comm_ring_axioms
	+ zariski_open_is_subset)
	+ have qr_valid_frac:"quotient_ring.valid_frac (R\<setminus>\<pp>) R (+) (\<cdot>) \<zero> (s \<pp>)"
	+ if "s \<in> \<O> U" "\<pp> \<in> U" for s \<pp>
	+ using assms comm_ring.zariski_open_is_subset quotient_ring.carrier_quotient_ring_iff
	+ imp_qr local.comm_ring_axioms pr_ideal.carrier_local_ring_at_def sec_has_right_codom
	+ spectrum_imp_pr that(1) that(2) by fastforce
	+
	+ show add_zero:"add_sheaf_spec U (zero_sheaf_spec U) a = a" if "a \<in> \<O> U" for a
	+ proof -
	+ have "add_sheaf_spec U (zero_sheaf_spec U) a \<pp> = a \<pp>" if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ using imp_qr that by auto
	+ show ?thesis unfolding add_sheaf_spec_def zero_sheaf_spec_def
	+ using that by (simp add: \<open>a \<in> \<O> U\<close> qr_valid_frac)
	+ qed
	+ then show "add_sheaf_spec U (zero_sheaf_spec U) a = a"
	+ using that by(auto intro: extensionalityI[where A=U])
	+ qed
	+ show add_assoc:"add_sheaf_spec U (add_sheaf_spec U a b) c
	+ = add_sheaf_spec U a (add_sheaf_spec U b c)"
	+ if "a \<in> \<O> U" and "b \<in> \<O> U" and "c \<in> \<O> U"
	+ for a b c
	+ proof (rule extensionalityI)
	+ fix \<pp> assume "\<pp> \<in> U"
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
	+ show "add_sheaf_spec U (add_sheaf_spec U a b) c \<pp> = add_sheaf_spec U a (add_sheaf_spec U b c) \<pp>"
	+ unfolding add_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
	+ by (simp add: cq.additive.associative qr_valid_frac that(1) that(2) that(3))
	+ qed (auto simp add:add_sheaf_spec_def)
	+ show add_comm:"add_sheaf_spec U x y = add_sheaf_spec U y x"
	+ if "x \<in> \<O> U" and "y \<in> \<O> U" for x y
	+ proof (rule extensionalityI)
	+ fix \<pp> assume "\<pp> \<in> U"
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
	+ show " add_sheaf_spec U x y \<pp> = add_sheaf_spec U y x \<pp>"
	+ unfolding add_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
	+ by (simp add: cq.additive.commutative qr_valid_frac that(1) that(2))
	+ qed auto
	+ show mult_comm:"mult_sheaf_spec U x y = mult_sheaf_spec U y x"
	+ if "x \<in> \<O> U" and "y \<in> \<O> U" for x y
	+ proof (rule extensionalityI)
	+ fix \<pp> assume "\<pp> \<in> U"
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
	+ show "mult_sheaf_spec U x y \<pp> = mult_sheaf_spec U y x \<pp>"
	+ unfolding mult_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
	+ by (simp add: cq.comm_mult qr_valid_frac that(1) that(2))
	+ qed auto
	+ show add_zero:"add_sheaf_spec U a (zero_sheaf_spec U) = a"
	+ if "a \<in> \<O> U" for a
	+ using add_zero add_comm that by (simp add: \<open>zero_sheaf_spec U \<in> \<O> U\<close>)
	+
	+ show "mult_sheaf_spec U (mult_sheaf_spec U a b) c = mult_sheaf_spec U a (mult_sheaf_spec U b c)"
	+ if "a \<in> \<O> U" and "b \<in> \<O> U"
	+ and "c \<in> \<O> U"
	+ for a b c
	+ proof (rule extensionalityI)
	+ fix \<pp> assume "\<pp> \<in> U"
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
	+ show "mult_sheaf_spec U (mult_sheaf_spec U a b) c \<pp>
	+ = mult_sheaf_spec U a (mult_sheaf_spec U b c) \<pp>"
	+ unfolding mult_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
	+ by (simp add: cq.multiplicative.associative qr_valid_frac that(1) that(2) that(3))
	+ qed (auto simp add:add_sheaf_spec_def)
	+
	+ show "mult_sheaf_spec U (one_sheaf_spec U) a = a"
	+ if "a \<in> \<O> U" for a
	+ proof (rule extensionalityI)
	+ fix \<pp> assume "\<pp> \<in> U"
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
	+ show "mult_sheaf_spec U (one_sheaf_spec U) a \<pp> = a \<pp>"
	+ unfolding mult_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
	+ by (simp add: one_sheaf_spec_def qr_valid_frac that)
	+ qed (auto simp add: \<open>a \<in> \<O> U\<close>)
	+ then show "mult_sheaf_spec U a (one_sheaf_spec U) = a"
	+ if "a \<in> \<O> U" for a
	+ by (simp add: \<open>one_sheaf_spec U \<in> \<O> U\<close> mult_comm that)
	+
	+ show "mult_sheaf_spec U a (add_sheaf_spec U b c)
	+ = add_sheaf_spec U (mult_sheaf_spec U a b) (mult_sheaf_spec U a c)"
	+ if "a \<in> \<O> U" and "b \<in> \<O> U" and "c \<in> \<O> U" for a b c
	+ proof (rule extensionalityI)
	+ fix \<pp> assume "\<pp> \<in> U"
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
	+ show "mult_sheaf_spec U a (add_sheaf_spec U b c) \<pp> =
	+ add_sheaf_spec U (mult_sheaf_spec U a b) (mult_sheaf_spec U a c) \<pp>"
	+ unfolding mult_sheaf_spec_def add_sheaf_spec_def
	+ by (simp add: cq.distributive(1) qr_valid_frac that(1) that(2) that(3))
	+ qed auto
	+ then show "mult_sheaf_spec U (add_sheaf_spec U b c) a
	+ = add_sheaf_spec U (mult_sheaf_spec U b a) (mult_sheaf_spec U c a)"
	+ if "a \<in> \<O> U" and "b \<in> \<O> U" and "c \<in> \<O> U" for a b c
	+ by (simp add: add_\<O> mult_comm that(1) that(2) that(3))
	+ show "monoid.invertible (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U) u"
	+ if "u \<in> \<O> U" for u
	+ proof (rule monoid.invertibleI)
	+ show "Group_Theory.monoid (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
	+ apply unfold_locales
	+ using add_\<O> \<open>zero_sheaf_spec U \<in> \<O> U\<close> add_assoc \<open>zero_sheaf_spec U \<in> \<O> U\<close>
	+ add_comm add_zero add_zero
	+ by simp_all
	+ show "add_sheaf_spec U u (uminus_sheaf_spec U u) = zero_sheaf_spec U"
	+ proof (rule extensionalityI)
	+ fix \<pp> assume "\<pp> \<in> U"
	+ interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
	+
	+ have "cq.add_rel (u \<pp>) (cq.uminus_rel (u \<pp>)) = cq.zero_rel"
	+ by (simp add: \<open>\<pp> \<in> U\<close> cq.add_minus_zero_rel qr_valid_frac that)
	+ then show "add_sheaf_spec U u (uminus_sheaf_spec U u) \<pp> = zero_sheaf_spec U \<pp>"
	+ unfolding add_sheaf_spec_def uminus_sheaf_spec_def zero_sheaf_spec_def
	+ using \<open>\<pp> \<in> U\<close> by simp
	+ qed auto
	+ then show "add_sheaf_spec U (uminus_sheaf_spec U u) u = zero_sheaf_spec U"
	+ by (simp add: add_comm assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
	+ that uminus_sheaf_spec_in_sheaf_spec)
	+ show "u \<in> \<O> U" using that .
	+ show "uminus_sheaf_spec U u \<in> \<O> U"
	+ by (simp add: assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
	+ that uminus_sheaf_spec_in_sheaf_spec)
	+ qed
	+qed
	+
	+definition sheaf_spec_morphisms::
	+"'a set set \<Rightarrow> 'a set set \<Rightarrow> (('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set))"
	+where "sheaf_spec_morphisms U V \<equiv> \<lambda>s\<in>(\<O> U). restrict s V"
	+
	+lemma sheaf_morphisms_sheaf_spec:
	+ assumes "s \<in> \<O> U"
	+ shows "sheaf_spec_morphisms U U s = s"
	+ using assms sheaf_spec_def restrict_on_source sheaf_spec_morphisms_def
	+ by auto
	+
	+lemma sheaf_spec_morphisms_are_maps:
	+ assumes (this assumption seems redundant: "is_zariski_open U" and)
	+ "is_zariski_open V" and "V \<subseteq> U"
	+ shows "Set_Theory.map (sheaf_spec_morphisms U V) (\<O> U) (\<O> V)"
	+proof -
	+ have "sheaf_spec_morphisms U V \<in> extensional (\<O> U)"
	+ unfolding sheaf_spec_morphisms_def by auto
	+ moreover have "sheaf_spec_morphisms U V \<in> (\<O> U) \<rightarrow> (\<O> V)"
	+ unfolding sheaf_spec_morphisms_def
	+ proof
	+ fix s assume "s \<in> \<O> U"
	+ then have "s \<in> (\<Pi>\<^sub>E \<pp>\<in>U. R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ and p:"\<forall>\<pp>. \<pp> \<in> U \<longrightarrow> (\<exists>V. is_zariski_open V \<and> V \<subseteq> U \<and> \<pp> \<in> V \<and> is_locally_frac s V)"
	+ unfolding sheaf_spec_def is_regular_def by auto
	+ have "restrict s V \<in> (\<Pi>\<^sub>E \<pp>\<in>V. R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ using \<open>s \<in> (\<Pi>\<^sub>E \<pp>\<in>U. R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)\<close> using \<open>V \<subseteq> U\<close> by auto
	+ moreover have "(\<exists>Va. is_zariski_open Va \<and> Va \<subseteq> V \<and> \<pp> \<in> Va \<and> is_locally_frac (restrict s V) Va)"
	+ if "\<pp> \<in> V" for \<pp>
	+ proof -
	+ obtain U1 where "is_zariski_open U1" "U1 \<subseteq> U" "\<pp> \<in> U1" "is_locally_frac s U1"
	+ using p[rule_format, of \<pp>] that \<open>V \<subseteq> U\<close> \<open>\<pp> \<in> V\<close> by auto
	+ define V1 where "V1 = U1 \<inter> V"
	+ have "is_zariski_open V1"
	+ using \<open>is_zariski_open V\<close> \<open>is_zariski_open U1\<close> by (simp add: V1_def)
	+ moreover have "is_locally_frac s V1"
	+ using is_locally_frac_subset[OF \<open>is_locally_frac s U1\<close>] unfolding V1_def by simp
	+ then have "is_locally_frac (restrict s V) V1"
	+ unfolding restrict_def V1_def using is_locally_frac_cong by (smt in_mono inf_le2)
	+ moreover have "V1 \<subseteq> V" "\<pp> \<in> V1"
	+ unfolding V1_def using \<open>V \<subseteq> U\<close> \<open>\<pp> \<in> U1\<close> that by auto
	+ ultimately show ?thesis by auto
	+ qed
	+ ultimately show "restrict s V \<in> \<O> V"
	+ unfolding sheaf_spec_def is_regular_def by auto
	+ qed
	+ ultimately show ?thesis
	+ by (simp add: extensional_funcset_def map.intro)
	+qed
	+
	+lemma sheaf_spec_morphisms_are_ring_morphisms:
	+ assumes U: "is_zariski_open U" and V: "is_zariski_open V" and "V \<subseteq> U"
	+ shows "ring_homomorphism (sheaf_spec_morphisms U V)
	+ (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)
	+ (\<O> V) (add_sheaf_spec V) (mult_sheaf_spec V) (zero_sheaf_spec V) (one_sheaf_spec V)"
	+proof intro_locales
	+ show "Set_Theory.map (sheaf_spec_morphisms U V) (\<O> U) (\<O> V)"
	+ by (simp add: assms sheaf_spec_morphisms_are_maps)
	+ show "Group_Theory.monoid (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
	+ using sheaf_spec_on_open_is_comm_ring [OF U]
	+ by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def)
	+ show "Group_Theory.group_axioms (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
	+ using sheaf_spec_on_open_is_comm_ring [OF U]
	+ by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
	+ show "commutative_monoid_axioms (\<O> U) (add_sheaf_spec U)"
	+ using sheaf_spec_on_open_is_comm_ring [OF U]
	+ by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
	+ show "Group_Theory.monoid (\<O> U) (mult_sheaf_spec U) (one_sheaf_spec U)"
	+ by (meson U comm_ring_def ring_def sheaf_spec_on_open_is_comm_ring)
	+ show "ring_axioms (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U)"
	+ by (meson U comm_ring.axioms(1) ring_def sheaf_spec_on_open_is_comm_ring)
	+ show "Group_Theory.monoid (\<O> V) (add_sheaf_spec V) (zero_sheaf_spec V)"
	+ using sheaf_spec_on_open_is_comm_ring [OF V]
	+ by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def)
	+ show "Group_Theory.group_axioms (\<O> V) (add_sheaf_spec V) (zero_sheaf_spec V)"
	+ using sheaf_spec_on_open_is_comm_ring [OF V]
	+ by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
	+ show "commutative_monoid_axioms (\<O> V) (add_sheaf_spec V)"
	+ using sheaf_spec_on_open_is_comm_ring [OF V]
	+ by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
	+ show "Group_Theory.monoid (\<O> V) (mult_sheaf_spec V) (one_sheaf_spec V)"
	+ by (meson V comm_ring.axioms(1) ring_def sheaf_spec_on_open_is_comm_ring)
	+ show "ring_axioms (\<O> V) (add_sheaf_spec V) (mult_sheaf_spec V)"
	+ by (meson V comm_ring_def ring_def sheaf_spec_on_open_is_comm_ring)
	+ show "monoid_homomorphism_axioms (sheaf_spec_morphisms U V) (\<O> U)
	+ (add_sheaf_spec U) (zero_sheaf_spec U) (add_sheaf_spec V) (zero_sheaf_spec V)"
	+ proof
	+ fix x y
	+ assume xy: "x \<in> \<O> U" "y \<in> \<O> U"
	+ have "sheaf_spec_morphisms U V (add_sheaf_spec U x y) = restrict (add_sheaf_spec U x y) V"
	+ by (simp add: U add_sheaf_spec_in_sheaf_spec comm_ring.zariski_open_is_subset local.comm_ring_axioms sheaf_spec_morphisms_def xy)
	+ also have "... = add_sheaf_spec V (restrict x V) (restrict y V)"
	+ using add_sheaf_spec_def \<open>V \<subseteq> U\<close> by force
	+ also have "... = add_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)"
	+ by (simp add: sheaf_spec_morphisms_def xy)
	+ finally show "sheaf_spec_morphisms U V (add_sheaf_spec U x y) = add_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)" .
	+ next
	+ have "sheaf_spec_morphisms U V (zero_sheaf_spec U) = restrict (zero_sheaf_spec U) V"
	+ by (simp add: U comm_ring.sheaf_spec_morphisms_def local.comm_ring_axioms zero_sheaf_spec_in_sheaf_spec)
	+ also have "... = zero_sheaf_spec V"
	+ by (metis FuncSet.restrict_restrict assms(3) inf.absorb_iff2 zero_sheaf_spec_def)
	+ finally show "sheaf_spec_morphisms U V (zero_sheaf_spec U) = zero_sheaf_spec V" .
	+ qed
	+ show "monoid_homomorphism_axioms (sheaf_spec_morphisms U V) (\<O> U)
	+ (mult_sheaf_spec U) (one_sheaf_spec U) (mult_sheaf_spec V) (one_sheaf_spec V)"
	+ proof
	+ fix x y
	+ assume xy: "x \<in> \<O> U" "y \<in> \<O> U"
	+ have "sheaf_spec_morphisms U V (mult_sheaf_spec U x y) = restrict (mult_sheaf_spec U x y) V"
	+ by (simp add: U mult_sheaf_spec_in_sheaf_spec comm_ring.zariski_open_is_subset local.comm_ring_axioms sheaf_spec_morphisms_def xy)
	+ also have "... = mult_sheaf_spec V (restrict x V) (restrict y V)"
	+ using mult_sheaf_spec_def \<open>V \<subseteq> U\<close> by force
	+ also have "... = mult_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)"
	+ by (simp add: sheaf_spec_morphisms_def xy)
	+ finally show "sheaf_spec_morphisms U V (mult_sheaf_spec U x y) = mult_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)" .
	+ next
	+ have "sheaf_spec_morphisms U V (one_sheaf_spec U) = restrict (one_sheaf_spec U) V"
	+ by (simp add: U comm_ring.sheaf_spec_morphisms_def local.comm_ring_axioms one_sheaf_spec_in_sheaf_spec)
	+ also have "... = one_sheaf_spec V"
	+ by (metis FuncSet.restrict_restrict assms(3) inf.absorb_iff2 one_sheaf_spec_def)
	+ finally show "sheaf_spec_morphisms U V (one_sheaf_spec U) = one_sheaf_spec V" .
	+ qed
	+qed
	+
	+lemma sheaf_spec_is_presheaf:
	+ shows "presheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+proof intro_locales
	+ have "sheaf_spec {} = {\<O>b}"
	+ proof
	+ show "{\<O>b} \<subseteq> \<O> {}"
	+ using undefined_is_map_on_empty map_on_empty_is_regular sheaf_spec_def \<O>_on_emptyset by auto
	+ thus "\<O> {} \<subseteq> {\<O>b}"
	+ using sheaf_spec_def sheaf_spec_of_empty_is_singleton by auto
	+ qed
	+ moreover have "\<And>U. is_zariski_open U \<Longrightarrow> (\<And>s. s \<in> (\<O> U) \<Longrightarrow> sheaf_spec_morphisms U U s = s)"
	+ using sheaf_spec_morphisms_def sheaf_morphisms_sheaf_spec by simp
	+ moreover have "sheaf_spec_morphisms U W s = (sheaf_spec_morphisms V W \<circ> sheaf_spec_morphisms U V) s"
	+ if "is_zariski_open U" "is_zariski_open V" "is_zariski_open W" "V \<subseteq> U" "W \<subseteq> V" and "s \<in> \<O> U"
	+ for U V W s
	+ proof -
	+ have "restrict s V \<in> \<O> V"
	+ using that by (smt map.map_closed restrict_apply sheaf_spec_morphisms_are_maps sheaf_spec_morphisms_def)
	+ with that show ?thesis
	+ by (simp add: sheaf_spec_morphisms_def inf_absorb2)
	+ qed
	+ ultimately show "presheaf_of_rings_axioms is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+ unfolding presheaf_of_rings_def presheaf_of_rings_axioms_def using sheaf_spec_morphisms_are_ring_morphisms
	+ by blast
	+qed
	+
	+(* ex. 0.30 *)
	+lemma sheaf_spec_is_sheaf:
	+ shows "sheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+proof (intro sheaf_of_rings.intro sheaf_of_rings_axioms.intro)
	+ show "presheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+ add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+ using sheaf_spec_is_presheaf by simp
	+next
	+ fix U I V s assume H: "open_cover_of_open_subset Spec is_zariski_open U I V"
	+ "\<And>i. i \<in> I \<Longrightarrow> V i \<subseteq> U"
	+ "s \<in> \<O> U"
	+ "\<And>i. i \<in> I \<Longrightarrow> sheaf_spec_morphisms U (V i) s = zero_sheaf_spec (V i)"
	+ then have "s \<pp> = zero_sheaf_spec U \<pp>" if "\<pp> \<in> U" for \<pp>
	+ proof -
	+ from that obtain i where F: "i \<in> I" "\<pp> \<in> (V i)" "is_zariski_open (V i)"
	+ using H(1) unfolding open_cover_of_subset_def open_cover_of_open_subset_def
	+ by (metis cover_of_subset.cover_of_select_index cover_of_subset.select_index_belongs open_cover_of_subset_axioms_def)
	+ then have "sheaf_spec_morphisms U (V i) s \<pp> = quotient_ring.zero_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
	+ using H(2,4) F by (simp add: zero_sheaf_spec_def)
	+ thus "s \<pp> = zero_sheaf_spec U \<pp>"
	+ using sheaf_spec_morphisms_def zero_sheaf_spec_def F(2) by (simp add: H(3) \<open>\<pp> \<in> U\<close>)
	+ qed
	+ moreover have "s \<in> extensional U" " zero_sheaf_spec U \<in> extensional U"
	+ by (simp_all add: H(3))
	+ ultimately show "s = zero_sheaf_spec U" using extensionalityI by blast
	+next
	+ fix U I V s assume H: "open_cover_of_open_subset Spec is_zariski_open U I V"
	+ "\<forall>i. i \<in> I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> \<O> (V i)"
	+ "\<And>i j. i \<in> I \<Longrightarrow>
	+ j \<in> I \<Longrightarrow>
	+ sheaf_spec_morphisms (V i) (V i \<inter> V j) (s i) =
	+ sheaf_spec_morphisms (V j) (V i \<inter> V j) (s j)"
	+ define t where D: "t \<equiv> \<lambda>\<pp>\<in>U. s (cover_of_subset.select_index I V \<pp>) \<pp>"
	+ then have F1: "s i \<pp> = s j \<pp>" if "i \<in> I" "j \<in> I" "\<pp> \<in> V i" "\<pp> \<in> V j" for \<pp> i j
	+ proof -
	+ have "s i \<pp> = sheaf_spec_morphisms (V i) (V i \<inter> V j) (s i) \<pp>"
	+ using that sheaf_spec_morphisms_def by (simp add: H(2))
	+ moreover have "\<dots> = sheaf_spec_morphisms (V j) (V i \<inter> V j) (s j) \<pp>"
	+ using H(3) that by fastforce
	+ moreover have "\<dots> = s j \<pp>"
	+ using sheaf_spec_morphisms_def that by (simp add: H(2))
	+ ultimately show "s i \<pp> = s j \<pp>" by blast
	+ qed
	+ have "t \<in> \<O> U"
	+ proof-
	+ have "t \<pp> \<in> (R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)" if "\<pp>\<in>U" for \<pp>
	+ using D H(1) H(2) cover_of_subset.cover_of_select_index
	+ cover_of_subset.select_index_belongs open_cover_of_open_subset.axioms(1)
	+ open_cover_of_subset_def sec_has_right_codom that by fastforce
	+ moreover have "t \<in> extensional U"
	+ using D by blast
	+ moreover have "is_regular t U"
	+ unfolding is_regular_def
	+ proof (intro strip conjI)
	+ fix \<pp>
	+ assume "\<pp> \<in> U"
	+ show "\<exists>V. is_zariski_open V \<and> V \<subseteq> U \<and> \<pp> \<in> V \<and> is_locally_frac t V"
	+ proof -
	+ have cov_in_I: "cover_of_subset.select_index I V \<pp> \<in> I"
	+ by (meson H(1) \<open>\<pp> \<in> U\<close> cover_of_subset.select_index_belongs open_cover_of_open_subset_def open_cover_of_subset_def)
	+ have V: "V (cover_of_subset.select_index I V \<pp>) \<subseteq> U"
	+ using H(2) by (meson H(1) \<open>\<pp> \<in> U\<close> cover_of_subset.select_index_belongs open_cover_of_open_subset_def open_cover_of_subset_def)
	+ have V2: "\<exists>V'. is_zariski_open V' \<and> V'\<subseteq> V (cover_of_subset.select_index I V \<pp>) \<and> \<pp> \<in> V' \<and>
	+ is_locally_frac (s (cover_of_subset.select_index I V \<pp>)) V'"
	+ using H(1,2)
	+ unfolding sheaf_spec_def open_cover_of_open_subset_def open_cover_of_subset_def is_regular_def
	+ using \<open>\<pp> \<in> U\<close> cov_in_I cover_of_subset.cover_of_select_index by fastforce
	+ have "\<And>V' \<qq>. is_zariski_open V' \<and> V' \<subseteq> V (cover_of_subset.select_index I V \<pp>) \<Longrightarrow> \<qq> \<in> V' \<Longrightarrow> t \<qq> = s (cover_of_subset.select_index I V \<pp>) \<qq>"
	+ by (smt D F1 H(1) V \<open>\<pp> \<in> U\<close> cover_of_subset.cover_of_select_index cover_of_subset.select_index_belongs open_cover_of_open_subset_def open_cover_of_subset_def restrict_apply subsetD)
	+ with V V2 show ?thesis unfolding is_locally_frac_def
	+ by (smt subset_trans)
	+ qed
	+ qed
	+ ultimately show ?thesis unfolding sheaf_spec_def by (simp add:PiE_iff)
	+ qed
	+ have "sheaf_spec_morphisms U (V i) t = s i" if "i \<in> I" for i
	+ proof
	+ fix \<pp>
	+ have "sheaf_spec_morphisms U (V i) t \<pp> = s i \<pp>" if "\<pp> \<in> U"
	+ proof-
	+ from that H(1)
	+ obtain j where "j \<in> I \<and> \<pp> \<in> V j \<and> t \<pp> = s j \<pp>"
	+ unfolding D open_cover_of_subset_def open_cover_of_open_subset_def
	+ by (meson cover_of_subset.cover_of_select_index cover_of_subset.select_index_belongs restrict_apply')
	+ thus "sheaf_spec_morphisms U (V i) t \<pp> = s i \<pp>"
	+ using \<open>t \<in> \<O> U\<close> \<open>i \<in> I\<close> H(2) that
	+ unfolding sheaf_spec_morphisms_def
	+ apply (simp add: D split: if_split_asm)
	+ by (metis (mono_tags, hide_lams) F1 extensional_arb [OF sec_is_extensional])
	+ qed
	+ thus "sheaf_spec_morphisms U (V i) t \<pp> = s i \<pp>"
	+ using sheaf_spec_morphisms_def D F1
	+ by (smt H(2) \<open>i \<in> I\<close> \<open>t \<in> \<O> U\<close> comm_ring.sheaf_morphisms_sheaf_spec local.comm_ring_axioms restrict_apply subsetD)
	+ qed
	+ thus "\<exists>t. t \<in> (\<O> U) \<and> (\<forall>i. i \<in> I \<longrightarrow> sheaf_spec_morphisms U (V i) t = s i)"
	+ using \<open>t \<in> \<O> U\<close> by blast
	+qed
	+
	+lemma shrinking:
	+ assumes "is_zariski_open U" and "\<pp> \<in> U" and "s \<in> \<O> U" and "t \<in> \<O> U"
	+ obtains V a f b g where "is_zariski_open V" "V \<subseteq> U" "\<pp> \<in> V" "a \<in> R" "f \<in> R" "b \<in> R" "g \<in> R"
	+"f \<notin> \<pp>" "g \<notin> \<pp>"
	+"\<And>\<qq>. \<qq> \<in> V \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
	+"\<And>\<qq>. \<qq> \<in> V \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
	+proof-
	+ obtain Vs a f where "is_zariski_open Vs" "Vs \<subseteq> U" "\<pp> \<in> Vs" "a \<in> R" "f \<in> R"
	+"\<And>\<qq>. \<qq> \<in> Vs \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
	+ using assms(2,3) sheaf_spec_def is_regular_def is_locally_frac_def by auto
	+ obtain Vt b g where "is_zariski_open Vt" "Vt \<subseteq> U" "\<pp> \<in> Vt" "b \<in> R" "g \<in> R"
	+"\<And>\<qq>. \<qq> \<in> Vt \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
	+ using assms(2,4) sheaf_spec_def is_regular_def is_locally_frac_def by auto
	+ then have "is_zariski_open (Vs \<inter> Vt)" "Vs \<inter> Vt \<subseteq> U" "\<pp> \<in> Vs \<inter> Vt"
	+"\<And>\<qq>. \<qq> \<in> (Vs \<inter> Vt) \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
	+"\<And>\<qq>. \<qq> \<in> (Vs \<inter> Vt) \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
	+ using topological_space.open_inter apply (simp add: \<open>is_zariski_open Vs\<close>)
	+ using \<open>Vs \<subseteq> U\<close> apply auto[1] apply (simp add: \<open>\<pp> \<in> Vs\<close> \<open>\<pp> \<in> Vt\<close>)
	+ apply (simp add: \<open>\<And>\<qq>. \<qq> \<in> Vs \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f\<close>)
	+ by (simp add: \<open>\<And>\<qq>. \<qq> \<in> Vt \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g\<close>)
	+ thus ?thesis using \<open>a \<in> R\<close> \<open>b \<in> R\<close> \<open>f \<in> R\<close> \<open>g \<in> R\<close> that by presburger
	+qed
	+
	+end (* comm_ring *)
	+
	+
	+section \<open>Schemes\<close>
	+
	+subsection \<open>Ringed Spaces\<close>
	+
	+(* definition 0.32 *)
	+locale ringed_space = sheaf_of_rings
	+
	+context comm_ring
	+begin
	+
	+lemma spec_is_ringed_space:
	+ shows "ringed_space Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+proof (intro ringed_space.intro)
	+ show "sheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+ add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+ using sheaf_spec_is_sheaf by simp
	+qed
	+
	+end (* comm_ring *)
	+
	+(* definition 0.33 *)
	+locale morphism_ringed_spaces =
	+im_sheaf X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X b add_str\<^sub>X mult_str\<^sub>X zero_str\<^sub>X one_str\<^sub>X Y is_open\<^sub>Y f +
	+ codom: ringed_space Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
	+for X and is_open\<^sub>X and \<O>\<^sub>X and \<rho>\<^sub>X and b and add_str\<^sub>X and mult_str\<^sub>X and zero_str\<^sub>X and one_str\<^sub>X
	+and Y and is_open\<^sub>Y and \<O>\<^sub>Y and \<rho>\<^sub>Y and d and add_str\<^sub>Y and mult_str\<^sub>Y and zero_str\<^sub>Y and one_str\<^sub>Y
	+and f +
	+fixes \<phi>\<^sub>f:: "'c set \<Rightarrow> ('d \<Rightarrow> 'b)"
	+assumes is_morphism_of_sheaves: "morphism_sheaves_of_rings
	+Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
	+im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
	+\<phi>\<^sub>f"
	+
	+
	+subsection \<open>Direct Limits of Rings\<close>
	+
	+(* construction 0.34 *)
	+locale direct_lim = sheaf_of_rings +
	+ fixes I:: "'a set set"
	+ assumes subset_of_opens: "\<And>U. U \<in> I \<Longrightarrow> is_open U"
	+ and has_lower_bound: "\<And>U V. \<lbrakk> U\<in>I; V\<in>I \<rbrakk> \<Longrightarrow> \<exists>W\<in>I. W \<subseteq> U \<inter> V"
	+begin
	+
	+definition get_lower_bound:: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" where
	+ "get_lower_bound U V= (SOME W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> V)"
	+
	+lemma get_lower_bound[intro]:
	+ assumes "U \<in> I" "V \<in> I"
	+ shows "get_lower_bound U V \<in> I" "get_lower_bound U V \<subseteq> U" "get_lower_bound U V \<subseteq> V"
	+proof -
	+ have "\<exists>W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> V"
	+ using has_lower_bound[OF assms] by auto
	+ from someI_ex[OF this]
	+ show "get_lower_bound U V \<in> I" "get_lower_bound U V \<subseteq> U" "get_lower_bound U V \<subseteq> V"
	+ unfolding get_lower_bound_def by auto
	+qed
	+
	+lemma obtain_lower_bound_finite:
	+ assumes "finite Us" "Us \<noteq> {}" "Us \<subseteq> I"
	+ obtains W where "W \<in> I" "\<forall>U\<in>Us. W \<subseteq> U"
	+ using assms
	+proof (induct Us arbitrary:thesis)
	+ case (insert U F)
	+ have ?case when "F={}"
	+ using insert.prems(1) insert.prems(3) that by blast
	+ moreover have ?case when "F\<noteq>{}"
	+ proof -
	+ obtain W where "W \<in> I" "\<forall>U\<in>F. W \<subseteq> U"
	+ using insert.hyps(3) insert.prems(3) by auto
	+ obtain W1 where "W1 \<in>I" "W1 \<subseteq> U" "W1 \<subseteq> W"
	+ by (meson \<open>W \<in> I\<close> get_lower_bound(1) get_lower_bound(2) get_lower_bound(3)
	+ insert.prems(3) insert_subset)
	+ then have "\<forall>a\<in>insert U F. W1 \<subseteq> a"
	+ using \<open>\<forall>U\<in>F. W \<subseteq> U\<close> by auto
	+ with \<open>W1 \<in>I\<close> show ?thesis
	+ using insert(4) by auto
	+ qed
	+ ultimately show ?case by auto
	+qed simp
	+
	+definition principal_subs :: "'a set set \<Rightarrow> 'a set \<Rightarrow> 'a set filter" where
	+ "principal_subs As A = Abs_filter (\<lambda>P. \<forall>x. (x\<in>As \<and> x \<subseteq> A) \<longrightarrow> P x)"
	+
	+lemma eventually_principal_subs: "eventually P (principal_subs As A) \<longleftrightarrow> (\<forall>x. x\<in>As \<and> x\<subseteq>A \<longrightarrow> P x)"
	+ unfolding principal_subs_def
	+ by (rule eventually_Abs_filter, rule is_filter.intro) auto
	+
	+lemma principal_subs_UNIV[simp]: "principal_subs UNIV UNIV = top"
	+ by (auto simp: filter_eq_iff eventually_principal_subs)
	+
	+lemma principal_subs_empty[simp]: "principal_subs {} s = bot"
	+ ("principal_subs ss {} = bot")
	+ by (auto simp: filter_eq_iff eventually_principal_subs)
	+
	+lemma principal_subs_le_iff[iff]:
	+ "principal_subs As A \<le> principal_subs As' A'
	+ \<longleftrightarrow> {x. x\<in>As \<and> x \<subseteq> A} \<subseteq> {x. x\<in>As' \<and> x \<subseteq> A'}"
	+ unfolding le_filter_def eventually_principal_subs by blast
	+
	+lemma principal_subs_eq_iff[iff]:
	+ "principal_subs As A = principal_subs As' A' \<longleftrightarrow>{x. x\<in>As \<and> x \<subseteq> A} = {x. x\<in>As' \<and> x \<subseteq> A'}"
	+ unfolding eq_iff by simp
	+
	+lemma principal_subs_inj_on[simp]:"inj_on (principal_subs As) As"
	+ unfolding inj_on_def by auto
	+
	+definition lbound :: "'a set set \<Rightarrow> ('a set) filter" where
	+ "lbound Us = (INF S\<in>{S. S\<in>I \<and> (\<forall>u\<in>Us. S \<subseteq> u)}. principal_subs I S)"
	+
	+lemma eventually_lbound_finite:
	+ assumes "finite A" "A\<noteq>{}" "A\<subseteq>I"
	+ shows "(\<forall>\<^sub>F w in lbound A. P w) \<longleftrightarrow> (\<exists>w0. w0 \<in> I \<and> (\<forall>a\<in>A. w0 \<subseteq> a) \<and> (\<forall>w. (w\<subseteq>w0 \<and> w\<in>I) \<longrightarrow> P w))"
	+proof -
	+ have "\<exists>x. x \<in> I \<and> (\<forall>xa\<in>A. x \<subseteq> xa)"
	+ by (metis Int_iff assms inf.order_iff obtain_lower_bound_finite)
	+ moreover have " \<exists>x. x \<in> I \<and> Ball A ((\<subseteq>) x)
	+ \<and> {xa \<in> I. xa \<subseteq> x} \<subseteq> {x \<in> I. x \<subseteq> a}
	+ \<and> {xa \<in> I. xa \<subseteq> x} \<subseteq> {x \<in> I. x \<subseteq> b}"
	+ if "a \<in> I \<and> (\<forall>x\<in>A. a \<subseteq> x)" "b \<in> I \<and> (\<forall>x\<in>A. b \<subseteq> x)" for a b
	+ apply (rule exI[where x="get_lower_bound a b"])
	+ using that apply auto
	+ subgoal using get_lower_bound(2) by blast
	+ subgoal by (meson get_lower_bound(2) subsetD)
	+ subgoal by (meson get_lower_bound(3) subsetD)
	+ done
	+ moreover have "(\<exists>b\<in>{S \<in> I. Ball A ((\<subseteq>) S)}. eventually P (principal_subs I b)) =
	+ (\<exists>w0. w0 \<in> I \<and> Ball A ((\<subseteq>) w0) \<and> (\<forall>w. w \<subseteq> w0 \<and> w \<in> I \<longrightarrow> P w))"
	+ unfolding eventually_principal_subs by force
	+ ultimately show ?thesis unfolding lbound_def
	+ by (subst eventually_INF_base) auto
	+qed
	+
	+lemma lbound_eq:
	+ assumes A:"finite A" "A\<noteq>{}" "A\<subseteq>I"
	+ assumes B:"finite B" "B\<noteq>{}" "B\<subseteq>I"
	+ shows "lbound A = lbound B"
	+proof -
	+ have "eventually P (lbound A')" if "eventually P (lbound B')"
	+ and A':"finite A'" "A'\<noteq>{}" "A' \<subseteq> I"
	+ and B':"finite B'" "B'\<noteq>{}" "B' \<subseteq> I"
	+ for P A' B'
	+ proof -
	+ obtain w0 where w0:"w0 \<in> I" "(\<forall>a\<in>B'. w0 \<subseteq> a)" "(\<forall>w. w \<subseteq> w0 \<and> w \<in> I \<longrightarrow> P w)"
	+ using \<open>eventually P (lbound B')\<close> unfolding eventually_lbound_finite[OF B',of P]
	+ by auto
	+ obtain w1 where w1:"w1 \<in> I" "\<forall>U\<in>A'. w1 \<subseteq> U"
	+ using obtain_lower_bound_finite[OF A'] by auto
	+ define w2 where "w2=get_lower_bound w0 w1"
	+ have "w2 \<in> I" using \<open>w0 \<in> I\<close> \<open>w1 \<in> I\<close> unfolding w2_def by auto
	+ moreover have "\<forall>a\<in>A'. w2 \<subseteq> a"
	+ unfolding w2_def by (meson dual_order.trans get_lower_bound(3) w0(1) w1(1) w1(2))
	+ moreover have "\<forall>w. w \<subseteq> w2 \<and> w \<in> I \<longrightarrow> P w"
	+ unfolding w2_def by (meson dual_order.trans get_lower_bound(2) w0(1) w0(3) w1(1))
	+ ultimately show ?thesis unfolding eventually_lbound_finite[OF A',of P] by auto
	+ qed
	+ then have "eventually P (lbound A) = eventually P (lbound B)" for P
	+ using A B by auto
	+ then show ?thesis unfolding filter_eq_iff by auto
	+qed
	+
	+lemma lbound_leq:
	+ assumes "A \<subseteq> B"
	+ shows "lbound A \<le>lbound B"
	+ unfolding lbound_def
	+ apply (rule Inf_superset_mono)
	+ apply (rule image_mono)
	+ using assms by auto
	+
	+definition llbound::"('a set) filter" where
	+ "llbound = lbound {SOME a. a\<in>I}"
	+
	+lemma llbound_not_bot:
	+ assumes "I\<noteq> {}"
	+ shows "llbound \<noteq> bot"
	+ unfolding trivial_limit_def llbound_def
	+ apply (subst eventually_lbound_finite)
	+ using assms by (auto simp add: some_in_eq)
	+
	+lemma llbound_lbound:
	+ assumes "finite A" "A\<noteq>{}" "A\<subseteq>I"
	+ shows "lbound A = llbound"
	+ unfolding llbound_def
	+ apply (rule lbound_eq)
	+ using assms by (auto simp add: some_in_eq)
	+
	+definition rel:: "('a set \<times> 'b) \<Rightarrow> ('a set \<times> 'b) \<Rightarrow> bool" (infix "\<sim>" 80)
	+ where "x \<sim> y \<equiv> (fst x \<in> I \<and> fst y \<in> I) \<and> (snd x \<in> \<FF> (fst x) \<and> snd y \<in> \<FF> (fst y)) \<and>
	+(\<exists>W. (W \<in> I) \<and> (W \<subseteq> fst x \<inter> fst y) \<and> \<rho> (fst x) W (snd x) = \<rho> (fst y) W (snd y))"
	+
	+lemma rel_is_equivalence:
	+ shows "equivalence (Sigma I \<FF>) {(x, y). x \<sim> y}"
	+ unfolding equivalence_def
	+proof (intro conjI strip)
	+ show "(a, c) \<in> {(x, y). x \<sim> y}"
	+ if "(a, b) \<in> {(x, y). x \<sim> y}" "(b, c) \<in> {(x, y). x \<sim> y}" for a b c
	+ proof -
	+ obtain W1 where W1:"fst a \<in> I" "fst b \<in> I" "snd a \<in> \<FF> (fst a)" "snd b \<in> \<FF> (fst b)"
	+ "W1 \<in> I" "W1 \<subseteq> fst a" "W1 \<subseteq> fst b"
	+ "\<rho> (fst a) W1 (snd a) = \<rho> (fst b) W1 (snd b)"
	+ using \<open>(a, b) \<in> {(x, y). x \<sim> y}\<close> unfolding rel_def by auto
	+ obtain W2 where W2:"fst b \<in> I" "fst c \<in> I" "snd b \<in> \<FF> (fst b)" "snd c \<in> \<FF> (fst c)"
	+ "W2 \<in> I" "W2 \<subseteq> fst b" "W2 \<subseteq> fst c"
	+ "\<rho> (fst b) W2 (snd b) = \<rho> (fst c) W2 (snd c)"
	+ using \<open>(b, c) \<in> {(x, y). x \<sim> y}\<close> unfolding rel_def by auto
	+ obtain W3 where W3:"W3 \<in>I" "W3 \<subseteq> W1 \<inter> W2"
	+ using has_lower_bound[OF \<open>W1\<in>I\<close> \<open>W2\<in>I\<close>] by auto
	+ from \<open>W3 \<subseteq> W1 \<inter> W2\<close>
	+ have "W3 \<subseteq> fst a \<inter> fst c" using W1(6) W2(7) by blast
	+ moreover have "\<rho> (fst a) W3 (snd a) = \<rho> (fst c) W3 (snd c)"
	+ using W1 W2 by (metis W3(1) W3(2) eq_\<rho> le_inf_iff subset_of_opens)
	+ moreover note \<open>W3 \<in>I\<close> W1 W2
	+ ultimately show ?thesis
	+ unfolding rel_def by auto
	+ qed
	+qed (auto simp: rel_def Int_commute)
	+
	+interpretation rel:equivalence "(Sigma I \<FF>)" "{(x, y). x \<sim> y}"
	+ using rel_is_equivalence .
	+
	+definition class_of:: "'a set \<Rightarrow> 'b \<Rightarrow> ('a set \<times> 'b) set" ("\<lfloor>(_,/ _)\<rfloor>")
	+ where "\<lfloor>U,s\<rfloor> \<equiv> rel.Class (U, s)"
	+
	+lemma class_of_eqD:
	+ assumes "\<lfloor>U1,s1\<rfloor> = \<lfloor>U2,s2\<rfloor>" "(U1,s1) \<in> Sigma I \<FF>" "(U2,s2) \<in> Sigma I \<FF>"
	+ obtains W where "W \<in> I" "W \<subseteq> U1 \<inter> U2" "\<rho> U1 W s1 = \<rho> U2 W s2"
	+ using rel.Class_equivalence[OF assms(2,3)] assms(1)
	+ unfolding class_of_def rel_def by auto
	+
	+lemma class_of_eqI:
	+ assumes "(U1,s1) \<in> Sigma I \<FF>" "(U2,s2) \<in> Sigma I \<FF>"
	+ assumes "W \<in> I" "W \<subseteq> U1 \<inter> U2" "\<rho> U1 W s1 = \<rho> U2 W s2"
	+ shows "\<lfloor>U1,s1\<rfloor> = \<lfloor>U2,s2\<rfloor>"
	+ unfolding class_of_def
	+ apply (rule rel.Class_eq)
	+ using assms by (auto simp: rel_def)
	+
	+lemma class_of_0_in:
	+ assumes "U \<in> I"
	+ shows "\<zero>\<^bsub>U\<^esub> \<in> \<FF> U"
	+proof -
	+ have "ring (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
	+ using assms subset_of_opens is_ring_from_is_homomorphism by blast
	+ then show ?thesis
	+ unfolding ring_def abelian_group_def Group_Theory.group_def by (meson monoid.unit_closed)
	+qed
	+
	+lemma rel_Class_iff: "x \<sim> y \<longleftrightarrow> y \<in> Sigma I \<FF> \<and> x \<in> rel.Class y"
	+ by blast
	+
	+lemma class_of_0_eq:
	+ assumes "U \<in> I" "U' \<in> I"
	+ shows "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> = \<lfloor>U', \<zero>\<^bsub>U'\<^esub>\<rfloor>"
	+proof -
	+ obtain W where W: "W \<in> I" "W \<subseteq> U" "W \<subseteq> U'"
	+ by (metis Int_subset_iff assms has_lower_bound)
	+ then have "is_open W" "is_open U" "is_open U'"
	+ by (auto simp add: assms subset_of_opens)
	+ then have "\<rho> U W \<zero>\<^bsub>U\<^esub> = \<rho> U' W \<zero>\<^bsub>U'\<^esub>"
	+ using W is_ring_morphism [of U W] is_ring_morphism [of U' W]
	+ by (simp add: ring_homomorphism_def group_homomorphism_def monoid_homomorphism_def
	+ monoid_homomorphism_axioms_def)
	+ with W have "\<exists>W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> U' \<and> \<rho> U W \<zero>\<^bsub>U\<^esub> = \<rho> U' W \<zero>\<^bsub>U'\<^esub>" by blast
	+ moreover have "\<zero>\<^bsub>U\<^esub> \<in> \<FF> U" "\<zero>\<^bsub>U'\<^esub> \<in> \<FF> U'"
	+ by (auto simp add: assms class_of_0_in)
	+ ultimately have "(U, \<zero>\<^bsub>U\<^esub>) \<sim> (U', \<zero>\<^bsub>U'\<^esub>)"
	+ using assms by (auto simp: rel_def)
	+ then show ?thesis
	+ unfolding class_of_def by (simp add: rel.Class_eq)
	+qed
	+
	+lemma class_of_1_in:
	+ assumes "U \<in> I"
	+ shows "\<one>\<^bsub>U\<^esub> \<in> \<FF> U"
	+proof -
	+ have "ring (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
	+ using assms subset_of_opens is_ring_from_is_homomorphism by blast
	+ then show ?thesis
	+ unfolding ring_def by (meson monoid.unit_closed)
	+qed
	+
	+lemma class_of_1_eq:
	+ assumes "U \<in> I" and "U' \<in> I"
	+ shows "\<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = \<lfloor>U', \<one>\<^bsub>U'\<^esub>\<rfloor>"
	+proof -
	+ obtain W where W: "W \<in> I" "W \<subseteq> U" "W \<subseteq> U'"
	+ by (metis Int_subset_iff assms has_lower_bound)
	+ then have "is_open W" "is_open U" "is_open U'"
	+ by (auto simp add: assms subset_of_opens)
	+ then have "\<rho> U W \<one>\<^bsub>U\<^esub> = \<rho> U' W \<one>\<^bsub>U'\<^esub>"
	+ using W is_ring_morphism [of U W] is_ring_morphism [of U' W]
	+ by (simp add: ring_homomorphism_def group_homomorphism_def monoid_homomorphism_def
	+ monoid_homomorphism_axioms_def)
	+ with W have "\<exists>W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> U' \<and> \<rho> U W \<one>\<^bsub>U\<^esub> = \<rho> U' W \<one>\<^bsub>U'\<^esub>" by blast
	+ moreover
	+ have "\<one>\<^bsub>U\<^esub> \<in> \<FF> U" "\<one>\<^bsub>U'\<^esub> \<in> \<FF> U'"
	+ by (auto simp add: assms class_of_1_in)
	+ ultimately have "(U, \<one>\<^bsub>U\<^esub>) \<sim> (U', \<one>\<^bsub>U'\<^esub>)"
	+ using assms by (auto simp: rel_def)
	+ then show ?thesis
	+ unfolding class_of_def by (simp add: rel.Class_eq)
	+qed
	+
	+definition add_rel :: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
	+ where "add_rel X Y \<equiv> let
	+ x = (SOME x. x \<in> X);
	+ y = (SOME y. y \<in> Y);
	+ w = get_lower_bound (fst x) (fst y)
	+ in
	+ \<lfloor>w, add_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>"
	+
	+definition mult_rel :: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
	+ where "mult_rel X Y \<equiv> let
	+ x = (SOME x. x \<in> X);
	+ y = (SOME y. y \<in> Y);
	+ w = get_lower_bound (fst x) (fst y)
	+ in
	+ \<lfloor>w, mult_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>"
	+
	+definition carrier_direct_lim:: "('a set \<times> 'b) set set"
	+ where "carrier_direct_lim \<equiv> rel.Partition"
	+
	+lemma zero_rel_carrier[intro]:
	+ assumes "U \<in> I"
	+ shows "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim"
	+ unfolding carrier_direct_lim_def class_of_def
	+proof (rule rel.Block_closed)
	+ interpret ring "(\<FF> U)" "+\<^bsub>U\<^esub>" "\<cdot>\<^bsub>U\<^esub>" "\<zero>\<^bsub>U\<^esub>" "\<one>\<^bsub>U\<^esub>"
	+ by (simp add: assms is_ring_from_is_homomorphism subset_of_opens)
	+ show "(U, \<zero>\<^bsub>U\<^esub>) \<in> Sigma I \<FF>"
	+ by (simp add: assms)
	+qed
	+
	+lemma one_rel_carrier[intro]:
	+ assumes "U \<in> I"
	+ shows "\<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim"
	+ unfolding carrier_direct_lim_def class_of_def
	+ apply (rule rel.Block_closed)
	+ by (simp add: assms class_of_1_in)
	+
	+lemma rel_carrier_Eps_in:
	+ fixes X :: "('a set \<times> 'b) set"
	+ defines "a\<equiv>(SOME x. x \<in> X)"
	+ assumes "X \<in> carrier_direct_lim"
	+ shows "a \<in> X" "a \<in>Sigma I \<FF>" "X = \<lfloor>fst a, snd a\<rfloor>"
	+proof -
	+ have "\<exists>a\<in>Sigma I \<FF>. a \<in> X \<and> X = rel.Class a"
	+ using rel.representant_exists[OF \<open>X \<in> carrier_direct_lim\<close>[unfolded carrier_direct_lim_def]]
	+ by simp
	+ then have "a \<in> X \<and> a \<in>Sigma I \<FF> \<and> X = \<lfloor>fst a, snd a\<rfloor>"
	+ unfolding class_of_def
	+ by (metis a_def assms(2) carrier_direct_lim_def ex_in_conv prod.collapse rel.Block_self
	+ rel.Class_closed some_in_eq)
	+ then show "a \<in> X" "a \<in>Sigma I \<FF>" "X = \<lfloor>fst a, snd a\<rfloor>" by auto
	+qed
	+
	+lemma add_rel_carrier[intro]:
	+ assumes "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim"
	+ shows "add_rel X Y \<in> carrier_direct_lim"
	+proof -
	+ define x where "x=(SOME x. x \<in> X)"
	+ define y where "y=(SOME y. y \<in> Y)"
	+ define z where "z=get_lower_bound (fst x) (fst y)"
	+
	+ have "x\<in>X" "x\<in>Sigma I \<FF>"
	+ using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
	+ have "y\<in>Y" "y \<in> Sigma I \<FF>"
	+ using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
	+
	+ have "add_rel X Y = \<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor>"
	+ unfolding add_rel_def Let_def
	+ by (fold x_def y_def z_def,rule)
	+ also have "... \<in> carrier_direct_lim"
	+ unfolding carrier_direct_lim_def class_of_def
	+ proof (rule rel.Block_closed)
	+ have "z\<in>I" using \<open>x\<in>Sigma I \<FF>\<close> \<open>y\<in>Sigma I \<FF>\<close> unfolding z_def by auto
	+ then interpret ring "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
	+ using is_ring_from_is_homomorphism subset_of_opens by auto
	+ show "(z, +\<^bsub>z\<^esub> (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))) \<in> Sigma I \<FF>"
	+ using \<open>z\<in>I\<close>
	+ apply simp
	+ by (metis \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> additive.composition_closed
	+ direct_lim.subset_of_opens direct_lim_axioms get_lower_bound(2) get_lower_bound(3)
	+ is_map_from_is_homomorphism map.map_closed mem_Sigma_iff prod.exhaust_sel z_def)
	+ qed
	+ finally show ?thesis .
	+qed
	+
	+
	+lemma rel_eventually_llbound:
	+ assumes "x \<sim> y"
	+ shows "\<forall>\<^sub>F w in llbound. \<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y)"
	+proof -
	+ have xy:"fst x \<in> I" "fst y \<in> I" "snd x \<in> \<FF> (fst x)" "snd y \<in> \<FF> (fst y)"
	+ using \<open>x \<sim> y\<close> unfolding rel_def by auto
	+ obtain w0 where w0:"w0 \<in> I" "w0 \<subseteq> fst x \<inter> fst y" "\<rho> (fst x) w0 (snd x) = \<rho> (fst y) w0 (snd y)"
	+ using \<open>x \<sim> y\<close> unfolding rel_def by auto
	+
	+ interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
	+ "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ by (meson is_ring_morphism le_inf_iff subset_of_opens w0 xy(1))
	+ interpret yw0:ring_homomorphism "\<rho> (fst y) w0" "\<FF> (fst y)" "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>"
	+ "\<one>\<^bsub>fst y\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using w0 by (metis is_ring_morphism le_inf_iff subset_of_opens xy(2))
	+ have "\<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y)" if "w \<subseteq> w0" "w \<in> I" for w
	+ proof -
	+ interpret w0w:ring_homomorphism "\<rho> w0 w" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>" "\<FF> w"
	+ "+\<^bsub>w\<^esub>" "\<cdot>\<^bsub>w\<^esub>" "\<zero>\<^bsub>w\<^esub>" "\<one>\<^bsub>w\<^esub>"
	+ using is_ring_morphism subset_of_opens that w0(1) by presburger
	+
	+ have "\<rho> (fst x) w (snd x) = (\<rho> w0 w \<circ> \<rho> (fst x) w0) (snd x)"
	+ by (meson assoc_comp le_inf_iff subset_of_opens that w0 xy)
	+ also have "... = (\<rho> w0 w \<circ> \<rho> (fst y) w0) (snd y)"
	+ unfolding comp_def
	+ using w0(3) by auto
	+ also have "... = \<rho> (fst y) w (snd y)"
	+ using w0 xy by (metis Int_subset_iff assoc_comp subset_of_opens that)
	+ finally show ?thesis .
	+ qed
	+ with w0 have "\<exists>w0. w0 \<in> I \<and> w0 \<subseteq> fst x \<inter> fst y
	+ \<and> (\<forall>w. (w\<subseteq>w0 \<and> w\<in>I) \<longrightarrow> \<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y))"
	+ by auto
	+ then have "\<forall>\<^sub>F w in lbound {fst x,fst y}. \<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y)"
	+ apply (subst eventually_lbound_finite)
	+ using xy(1,2) by auto
	+ then show ?thesis
	+ using llbound_lbound[of "{fst x,fst y}"] xy(1,2) by auto
	+qed
	+
	+lemma
	+ fixes x y:: "'a set \<times> 'b" and z z':: "'a set"
	+ assumes xy:"x \<in> Sigma I \<FF>" "y \<in> Sigma I \<FF>"
	+ assumes z:"z\<in>I" "z \<subseteq> fst x" "z \<subseteq> fst y"
	+ assumes z':"z'\<in>I" "z' \<subseteq> fst x" "z' \<subseteq> fst y"
	+ shows add_rel_well_defined:"\<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
	+ \<lfloor>z', add_str z' (\<rho> (fst x) z' (snd x)) (\<rho> (fst y) z' (snd y))\<rfloor>" (is "?add")
	+ and mult_rel_well_defined:
	+ "\<lfloor>z, mult_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
	+ \<lfloor>z', mult_str z' (\<rho> (fst x) z' (snd x)) (\<rho> (fst y) z' (snd y))\<rfloor>" (is "?mult")
	+proof -
	+ interpret xz:ring_homomorphism "(\<rho> (fst x) z)" "(\<FF> (fst x))"
	+ "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>" "\<one>\<^bsub>fst x\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
	+ using is_ring_morphism \<open>x \<in> Sigma I \<FF>\<close> z subset_of_opens by force
	+ interpret yz:ring_homomorphism "(\<rho> (fst y) z)" "(\<FF> (fst y))"
	+ "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>" "\<one>\<^bsub>fst y\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
	+ using is_ring_morphism \<open>y \<in> Sigma I \<FF>\<close> z subset_of_opens by force
	+ interpret xz':ring_homomorphism "(\<rho> (fst x) z')" "(\<FF> (fst x))"
	+ "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>" "\<one>\<^bsub>fst x\<^esub>" "(\<FF> z')" "+\<^bsub>z'\<^esub>" "\<cdot>\<^bsub>z'\<^esub>" "\<zero>\<^bsub>z'\<^esub>" "\<one>\<^bsub>z'\<^esub>"
	+ using is_ring_morphism \<open>x \<in> Sigma I \<FF>\<close> z' subset_of_opens by force
	+ interpret yz':ring_homomorphism "(\<rho> (fst y) z')" "(\<FF> (fst y))"
	+ "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>" "\<one>\<^bsub>fst y\<^esub>" "(\<FF> z')" "+\<^bsub>z'\<^esub>" "\<cdot>\<^bsub>z'\<^esub>" "\<zero>\<^bsub>z'\<^esub>" "\<one>\<^bsub>z'\<^esub>"
	+ using is_ring_morphism \<open>y \<in> Sigma I \<FF>\<close> z' subset_of_opens by force
	+
	+ obtain w where w:"w \<in> I" "w \<subseteq> z \<inter> z'"
	+ using has_lower_bound \<open>z\<in>I\<close> \<open>z'\<in>I\<close> by meson
	+
	+ interpret zw:ring_homomorphism "\<rho> z w" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
	+ "\<FF> w" "+\<^bsub>w\<^esub>" "\<cdot>\<^bsub>w\<^esub>" "\<zero>\<^bsub>w\<^esub>" "\<one>\<^bsub>w\<^esub>"
	+ using w by (meson is_ring_morphism le_inf_iff subset_of_opens z(1))
	+ interpret z'w:ring_homomorphism "\<rho> z' w" "(\<FF> z')" "+\<^bsub>z'\<^esub>" "\<cdot>\<^bsub>z'\<^esub>" "\<zero>\<^bsub>z'\<^esub>" "\<one>\<^bsub>z'\<^esub>"
	+ "\<FF> w" "+\<^bsub>w\<^esub>" "\<cdot>\<^bsub>w\<^esub>" "\<zero>\<^bsub>w\<^esub>" "\<one>\<^bsub>w\<^esub>"
	+ using \<open>w \<in> I\<close> \<open>w \<subseteq> z \<inter> z'\<close> z' by (meson is_ring_morphism le_inf_iff subset_of_opens)
	+
	+ show ?add
	+ proof (rule class_of_eqI[OF _ _ \<open>w \<in> I\<close> \<open>w \<subseteq> z \<inter> z'\<close>])
	+ define xz yz where "xz = \<rho> (fst x) z (snd x)" and "yz = \<rho> (fst y) z (snd y)"
	+ define xz' yz' where "xz' = \<rho> (fst x) z' (snd x)" and "yz' = \<rho> (fst y) z' (snd y)"
	+ show "(z, +\<^bsub>z\<^esub> xz yz) \<in> Sigma I \<FF>" "(z', +\<^bsub>z'\<^esub> xz' yz') \<in> Sigma I \<FF>"
	+ subgoal using assms(1) assms(2) xz_def yz_def z(1) by fastforce
	+ subgoal using assms(1) assms(2) xz'_def yz'_def z'(1) by fastforce
	+ done
	+ have "\<rho> z w (+\<^bsub>z\<^esub> xz yz) = +\<^bsub>w\<^esub> (\<rho> z w xz) (\<rho> z w yz)"
	+ apply (rule zw.additive.commutes_with_composition)
	+ using assms(1,2) xz_def yz_def by force+
	+ also have "... = +\<^bsub>w\<^esub> (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))"
	+ unfolding xz_def yz_def
	+ using assoc_comp w z subset_of_opens assms
	+ by (metis SigmaE le_inf_iff o_def prod.sel)
	+ also have "... = +\<^bsub>w\<^esub> (\<rho> z' w xz') (\<rho> z' w yz')"
	+ unfolding xz'_def yz'_def
	+ using assoc_comp w z' subset_of_opens assms
	+ by (metis SigmaE le_inf_iff o_def prod.sel)
	+ also have "... = \<rho> z' w (+\<^bsub>z'\<^esub> xz' yz')"
	+ using assms(2) xy(1) xz'_def yz'_def z'w.additive.commutes_with_composition by force
	+ finally show "\<rho> z w (+\<^bsub>z\<^esub> xz yz) = \<rho> z' w (+\<^bsub>z'\<^esub> xz' yz')" .
	+ qed
	+
	+ show ?mult
	+ proof (rule class_of_eqI[OF _ _ \<open>w \<in> I\<close> \<open>w \<subseteq> z \<inter> z'\<close>])
	+ define xz yz where "xz = \<rho> (fst x) z (snd x)" and "yz = \<rho> (fst y) z (snd y)"
	+ define xz' yz' where "xz' = \<rho> (fst x) z' (snd x)" and "yz' = \<rho> (fst y) z' (snd y)"
	+ show "(z, \<cdot>\<^bsub>z\<^esub> xz yz) \<in> Sigma I \<FF>" "(z', \<cdot>\<^bsub>z'\<^esub> xz' yz') \<in> Sigma I \<FF>"
	+ unfolding xz_def yz_def xz'_def yz'_def
	+ using assms by auto
	+ have "\<rho> z w (\<cdot>\<^bsub>z\<^esub> xz yz) = \<cdot>\<^bsub>w\<^esub> (\<rho> z w xz) (\<rho> z w yz)"
	+ apply (rule zw.multiplicative.commutes_with_composition)
	+ using xy xz_def yz_def by force+
	+ also have "... = \<cdot>\<^bsub>w\<^esub> (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))"
	+ unfolding xz_def yz_def
	+ using xy w z assoc_comp
	+ by (metis SigmaE fst_conv le_inf_iff o_def snd_conv subset_of_opens)
	+ also have "... = \<cdot>\<^bsub>w\<^esub> (\<rho> z' w xz') (\<rho> z' w yz')"
	+ unfolding xz'_def yz'_def
	+ using xy w z' assoc_comp
	+ by (metis SigmaE fst_conv le_inf_iff o_def snd_conv subset_of_opens)
	+ also have "... = \<rho> z' w (\<cdot>\<^bsub>z'\<^esub> xz' yz')"
	+ unfolding xz'_def yz'_def
	+ using monoid_homomorphism.commutes_with_composition xy z'w.multiplicative.monoid_homomorphism_axioms by fastforce
	+ finally show "\<rho> z w (\<cdot>\<^bsub>z\<^esub> xz yz) = \<rho> z' w (\<cdot>\<^bsub>z'\<^esub> xz' yz')" .
	+ qed
	+qed
	+
	+lemma add_rel_well_defined_llbound:
	+ fixes x y:: "'a set \<times> 'b" and z z':: "'a set"
	+ assumes "x \<in> Sigma I \<FF>" "y \<in> Sigma I \<FF>"
	+ assumes z:"z\<in>I" "z \<subseteq> fst x" "z \<subseteq> fst y"
	+ shows "\<forall>\<^sub>F w in llbound. \<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
	+ \<lfloor>w, add_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>" (is "\<forall>\<^sub>F w in _. ?P w")
	+proof -
	+ have "\<forall>w. w \<subseteq> z \<and> w \<in> I \<longrightarrow>?P w "
	+ by (meson add_rel_well_defined assms(1) assms(2) dual_order.trans z(1) z(2) z(3))
	+ then have "\<forall>\<^sub>F w in lbound {fst x,fst y}. ?P w"
	+ apply (subst eventually_lbound_finite)
	+ using assms by auto
	+ then show ?thesis
	+ using llbound_lbound[of "{fst x,fst y}"] assms(1,2) by auto
	+qed
	+
	+lemma mult_rel_well_defined_llbound:
	+ fixes x y:: "'a set \<times> 'b" and z z':: "'a set"
	+ assumes "x \<in> Sigma I \<FF>" "y \<in> Sigma I \<FF>"
	+ assumes z:"z\<in>I" "z \<subseteq> fst x" "z \<subseteq> fst y"
	+ shows "\<forall>\<^sub>F w in llbound. \<lfloor>z, mult_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
	+ \<lfloor>w, mult_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>" (is "\<forall>\<^sub>F w in _. ?P w")
	+proof -
	+ have "\<forall>w. w \<subseteq> z \<and> w \<in> I \<longrightarrow>?P w "
	+ by (meson mult_rel_well_defined assms(1) assms(2) dual_order.trans z(1) z(2) z(3))
	+ then have "\<forall>\<^sub>F w in lbound {fst x,fst y}. ?P w"
	+ apply (subst eventually_lbound_finite)
	+ using assms by auto
	+ then show ?thesis
	+ using llbound_lbound[of "{fst x,fst y}"] assms(1,2) by auto
	+qed
	+
	+lemma add_rel_class_of:
	+ fixes U V W :: "'a set" and x y :: 'b
	+ assumes uv_sigma:"(U, x) \<in> Sigma I \<FF>" "(V, y) \<in> Sigma I \<FF>"
	+ assumes w:"W \<in> I" "W \<subseteq> U" "W \<subseteq> V"
	+ shows "add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
	+proof -
	+ define ux where "ux = (SOME ux. ux \<in> \<lfloor>U, x\<rfloor>)"
	+ define vy where "vy = (SOME ux. ux \<in> \<lfloor>V, y\<rfloor>)"
	+ have "ux \<in> \<lfloor>U, x\<rfloor>" "vy \<in> \<lfloor>V, y\<rfloor> "
	+ unfolding ux_def vy_def using uv_sigma class_of_def some_in_eq by blast+
	+ then have "ux \<in> Sigma I \<FF>" "vy \<in> Sigma I \<FF>"
	+ using class_of_def uv_sigma by blast+
	+ then have "fst ux \<in> I" "fst vy \<in> I" by auto
	+
	+ define w1 where "w1 = get_lower_bound (fst ux) (fst vy)"
	+ have w1:"w1 \<in> I" "w1 \<subseteq> fst ux" "w1 \<subseteq> fst vy"
	+ using get_lower_bound[OF \<open>fst ux \<in> I\<close> \<open>fst vy \<in> I\<close>] unfolding w1_def by auto
	+
	+ have "add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>w1, +\<^bsub>w1\<^esub> (\<rho> (fst ux) w1 (snd ux)) (\<rho> (fst vy) w1 (snd vy))\<rfloor>"
	+ unfolding add_rel_def
	+ apply (fold ux_def vy_def)
	+ by (simp add:Let_def w1_def)
	+ moreover have "\<forall>\<^sub>F w in llbound.
	+ ... = \<lfloor>w, add_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
	+ apply (rule add_rel_well_defined_llbound)
	+ using \<open>ux \<in> Sigma I \<FF>\<close> \<open>vy \<in> Sigma I \<FF>\<close> w1 by auto
	+ ultimately have "\<forall>\<^sub>F w in llbound. add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
	+ = \<lfloor>w, add_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
	+ by simp
	+ moreover have
	+ "\<forall>\<^sub>F w in llbound. \<rho> (fst ux) w (snd ux) = \<rho> (fst (U, x)) w (snd (U, x))"
	+ "\<forall>\<^sub>F w in llbound. \<rho> (fst vy) w (snd vy) = \<rho> (fst (V, y)) w (snd (V, y))"
	+ subgoal
	+ apply (rule rel_eventually_llbound)
	+ using \<open>ux \<in> \<lfloor>U, x\<rfloor>\<close> class_of_def uv_sigma(1) by auto
	+ subgoal
	+ apply (rule rel_eventually_llbound)
	+ using \<open>vy \<in> \<lfloor>V, y\<rfloor>\<close> class_of_def uv_sigma(2) by auto
	+ done
	+ ultimately have "\<forall>\<^sub>F w in llbound. add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
	+ = \<lfloor>w, add_str w (\<rho> U w x) (\<rho> V w y)\<rfloor>"
	+ apply eventually_elim
	+ by auto
	+ moreover have "\<forall>\<^sub>F w in llbound. \<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor> = \<lfloor>w, +\<^bsub>w\<^esub> (\<rho> U w x) (\<rho> V w y)\<rfloor>"
	+ apply (rule add_rel_well_defined_llbound[of "(U,x)" "(V,y)" W,simplified])
	+ using w uv_sigma by auto
	+ ultimately have "\<forall>\<^sub>F w in llbound.
	+ add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
	+ apply eventually_elim
	+ by auto
	+ moreover have "llbound\<noteq>bot" using llbound_not_bot w(1) by blast
	+ ultimately show ?thesis by auto
	+qed
	+
	+lemma mult_rel_class_of:
	+ fixes U V W :: "'a set" and x y :: 'b
	+ assumes uv_sigma:"(U, x) \<in> Sigma I \<FF>" "(V, y) \<in> Sigma I \<FF>"
	+ assumes w:"W \<in> I" "W \<subseteq> U" "W \<subseteq> V"
	+ shows "mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
	+proof -
	+ define ux where "ux = (SOME ux. ux \<in> \<lfloor>U, x\<rfloor>)"
	+ define vy where "vy = (SOME ux. ux \<in> \<lfloor>V, y\<rfloor>)"
	+ have "ux \<in> \<lfloor>U, x\<rfloor>" "vy \<in> \<lfloor>V, y\<rfloor> "
	+ unfolding ux_def vy_def using uv_sigma class_of_def some_in_eq by blast+
	+ then have "ux \<in> Sigma I \<FF>" "vy \<in> Sigma I \<FF>"
	+ using class_of_def uv_sigma by blast+
	+ then have "fst ux \<in> I" "fst vy \<in> I" by auto
	+
	+ define w1 where "w1 = get_lower_bound (fst ux) (fst vy)"
	+ have w1:"w1 \<in> I" "w1 \<subseteq> fst ux" "w1 \<subseteq> fst vy"
	+ using get_lower_bound[OF \<open>fst ux \<in> I\<close> \<open>fst vy \<in> I\<close>] unfolding w1_def by auto
	+
	+ have "mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>w1, \<cdot>\<^bsub>w1\<^esub> (\<rho> (fst ux) w1 (snd ux)) (\<rho> (fst vy) w1 (snd vy))\<rfloor>"
	+ unfolding mult_rel_def
	+ apply (fold ux_def vy_def)
	+ by (simp add:Let_def w1_def)
	+ moreover have "\<forall>\<^sub>F w in llbound.
	+ ... = \<lfloor>w, mult_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
	+ apply (rule mult_rel_well_defined_llbound)
	+ using \<open>ux \<in> Sigma I \<FF>\<close> \<open>vy \<in> Sigma I \<FF>\<close> w1 by auto
	+ ultimately have "\<forall>\<^sub>F w in llbound. mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
	+ = \<lfloor>w, mult_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
	+ by simp
	+ moreover have
	+ "\<forall>\<^sub>F w in llbound. \<rho> (fst ux) w (snd ux) = \<rho> (fst (U, x)) w (snd (U, x))"
	+ "\<forall>\<^sub>F w in llbound. \<rho> (fst vy) w (snd vy) = \<rho> (fst (V, y)) w (snd (V, y))"
	+ subgoal
	+ apply (rule rel_eventually_llbound)
	+ using \<open>ux \<in> \<lfloor>U, x\<rfloor>\<close> class_of_def uv_sigma(1) by auto
	+ subgoal
	+ apply (rule rel_eventually_llbound)
	+ using \<open>vy \<in> \<lfloor>V, y\<rfloor>\<close> class_of_def uv_sigma(2) by auto
	+ done
	+ ultimately have "\<forall>\<^sub>F w in llbound. mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
	+ = \<lfloor>w, mult_str w (\<rho> U w x) (\<rho> V w y)\<rfloor>"
	+ apply eventually_elim
	+ by auto
	+ moreover have "\<forall>\<^sub>F w in llbound. \<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor> = \<lfloor>w, \<cdot>\<^bsub>w\<^esub> (\<rho> U w x) (\<rho> V w y)\<rfloor>"
	+ apply (rule mult_rel_well_defined_llbound[of "(U,x)" "(V,y)" W,simplified])
	+ using w uv_sigma by auto
	+ ultimately have "\<forall>\<^sub>F w in llbound.
	+ mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
	+ apply eventually_elim
	+ by auto
	+ moreover have "llbound\<noteq>bot" using llbound_not_bot w(1) by blast
	+ ultimately show ?thesis by auto
	+qed
	+
	+lemma mult_rel_carrier[intro]:
	+ assumes "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim"
	+ shows "mult_rel X Y \<in> carrier_direct_lim"
	+proof -
	+ define x where "x=(SOME x. x \<in> X)"
	+ define y where "y=(SOME y. y \<in> Y)"
	+
	+ have "x\<in>X" "x\<in>Sigma I \<FF>"
	+ using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
	+ have "y\<in>Y" "y \<in> Sigma I \<FF>"
	+ using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
	+
	+ define z where "z=get_lower_bound (fst x) (fst y)"
	+ have "z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y"
	+ proof -
	+ have "fst x \<in> I" "fst y \<in> I"
	+ using \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> by auto
	+ then show "z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y"
	+ using get_lower_bound[of "fst x" "fst y",folded z_def] by auto
	+ qed
	+
	+ have "mult_rel X Y = \<lfloor>z, mult_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor>"
	+ unfolding mult_rel_def Let_def
	+ by (fold x_def y_def z_def,rule)
	+ also have "... \<in> carrier_direct_lim"
	+ unfolding carrier_direct_lim_def class_of_def
	+ proof (rule rel.Block_closed)
	+ interpret ring "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
	+ by (simp add: \<open>z \<in> I\<close> is_ring_from_is_homomorphism subset_of_opens)
	+ show "(z, \<cdot>\<^bsub>z\<^esub> (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))) \<in> Sigma I \<FF>"
	+ by (metis SigmaE SigmaI \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> \<open>z \<in> I\<close> \<open>z \<subseteq> fst x\<close> \<open>z \<subseteq> fst y\<close>
	+ direct_lim.subset_of_opens direct_lim_axioms fst_conv
	+ is_map_from_is_homomorphism map.map_closed multiplicative.composition_closed snd_conv)
	+ qed
	+ finally show ?thesis .
	+qed
	+
	+(* exercise 0.35 *)
	+lemma direct_lim_is_ring:
	+ assumes "U \<in> I"
	+ shows "ring carrier_direct_lim add_rel mult_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor>"
	+proof unfold_locales
	+ show add_rel: "add_rel a b \<in> carrier_direct_lim" and mult_rel: "mult_rel a b \<in> carrier_direct_lim"
	+ if "a \<in> carrier_direct_lim" "b \<in> carrier_direct_lim" for a b
	+ using \<open>U \<in> I\<close> that by auto
	+ show zero_rel: "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim" and one_rel: "\<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim"
	+ using \<open>U \<in> I\<close> by auto
	+
	+ show add_rel_0: "add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X = X"
	+ and "mult_rel \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> X = X"
	+ and "mult_rel X \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = X"
	+ if "X \<in> carrier_direct_lim" for X
	+ proof -
	+ define x where "x=(SOME x. x \<in> X)"
	+ have x:"x\<in>X" "x\<in>Sigma I \<FF>" "fst x\<in>I" and X_alt:"X= \<lfloor>fst x, snd x\<rfloor>"
	+ using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>]
	+ unfolding x_def by auto
	+
	+ obtain w0 where w0:"w0\<in>I" "w0 \<subseteq> U" "w0 \<subseteq> fst x"
	+ using has_lower_bound[OF \<open>U\<in>I\<close> \<open>fst x\<in>I\<close>] by blast
	+
	+ interpret uw0:ring_homomorphism "\<rho> U w0" "\<FF> U" "+\<^bsub>U\<^esub>" "\<cdot>\<^bsub>U\<^esub>" "\<zero>\<^bsub>U\<^esub>" "\<one>\<^bsub>U\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>"
	+ "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using is_ring_morphism \<open>U\<in>I\<close> w0 subset_of_opens by auto
	+ interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
	+ "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using is_ring_morphism \<open>fst x\<in>I\<close> w0 subset_of_opens by auto
	+
	+ have "add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<rho> U w0 \<zero>\<^bsub>U\<^esub>) (\<rho> (fst x) w0 (snd x))\<rfloor>"
	+ unfolding X_alt
	+ apply (subst add_rel_class_of)
	+ using \<open>U \<in> I\<close> w0 x by simp_all
	+ also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> \<zero>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))\<rfloor>"
	+ by (simp add:uw0.additive.commutes_with_unit )
	+ also have "... = \<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor>"
	+ apply (subst uw0.target.additive.left_unit)
	+ using carrier_direct_lim_def rel.block_closed that x(1) by auto
	+ also have "... = X"
	+ unfolding X_alt
	+ apply (rule class_of_eqI[where W=w0])
	+ using w0 x subset_of_opens by auto
	+ finally show "add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X = X" .
	+
	+ have "mult_rel \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> X = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> U w0 \<one>\<^bsub>U\<^esub>) (\<rho> (fst x) w0 (snd x))\<rfloor>"
	+ unfolding X_alt
	+ apply (subst mult_rel_class_of)
	+ using \<open>U \<in> I\<close> w0 x by simp_all
	+ also have "... = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> \<one>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))\<rfloor>"
	+ by (simp add: uw0.multiplicative.commutes_with_unit)
	+ also have "... = \<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor>"
	+ apply (subst uw0.target.multiplicative.left_unit)
	+ using carrier_direct_lim_def rel.block_closed that x(1) by auto
	+ also have "... = X"
	+ using X_alt \<open>\<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor> = X\<close> by force
	+ finally show "mult_rel \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> X = X" .
	+
	+ have "mult_rel X \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) (\<rho> U w0 \<one>\<^bsub>U\<^esub>)\<rfloor>"
	+ unfolding X_alt
	+ apply (subst mult_rel_class_of)
	+ using \<open>U \<in> I\<close> w0 x by simp_all
	+ also have "... = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) \<one>\<^bsub>w0\<^esub> \<rfloor>"
	+ by (simp add: uw0.multiplicative.commutes_with_unit)
	+ also have "... = \<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor>"
	+ apply (subst uw0.target.multiplicative.right_unit)
	+ using carrier_direct_lim_def rel.block_closed that x(1) by auto
	+ also have "... = X"
	+ using X_alt \<open>\<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor> = X\<close> by force
	+ finally show "mult_rel X \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = X" .
	+ qed
	+
	+ show add_rel_commute: "add_rel X Y = add_rel Y X"
	+ if "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim" for X Y
	+ proof -
	+ define x where "x=(SOME x. x \<in> X)"
	+ define y where "y=(SOME y. y \<in> Y)"
	+
	+ have x:"x\<in>X" "x\<in>Sigma I \<FF>"
	+ using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
	+ have y:"y\<in>Y" "y \<in> Sigma I \<FF>"
	+ using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
	+
	+ define z where "z=get_lower_bound (fst x) (fst y)"
	+ have z:"z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y" and z_alt:"z=get_lower_bound (fst y) (fst x) "
	+ proof -
	+ have "fst x \<in> I" "fst y \<in> I"
	+ using \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> by auto
	+ then show "z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y"
	+ using get_lower_bound[of "fst x" "fst y",folded z_def] by auto
	+ show "z=get_lower_bound (fst y) (fst x) "
	+ by (metis (no_types, lifting) Eps_cong get_lower_bound_def z_def)
	+ qed
	+
	+ interpret xz:ring_homomorphism "(\<rho> (fst x) z)" "(\<FF> (fst x))" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>"
	+ "\<zero>\<^bsub>fst x\<^esub>" "\<one>\<^bsub>fst x\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
	+ using is_ring_morphism z x subset_of_opens by force
	+
	+ interpret yz:ring_homomorphism "(\<rho> (fst y) z)" "(\<FF> (fst y))" "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>"
	+ "\<zero>\<^bsub>fst y\<^esub>" "\<one>\<^bsub>fst y\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
	+ using is_ring_morphism z y subset_of_opens by auto
	+
	+ have "add_rel X Y = \<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor>"
	+ unfolding add_rel_def Let_def by (fold x_def y_def z_def,rule)
	+ also have "... = add_rel Y X"
	+ unfolding add_rel_def Let_def
	+ apply (fold x_def y_def z_alt)
	+ using \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> xz.target.additive.commutative by auto
	+ finally show "add_rel X Y = add_rel Y X" .
	+ qed
	+
	+ show add_assoc:"add_rel (add_rel X Y) Z = add_rel X (add_rel Y Z)"
	+ "mult_rel (mult_rel X Y) Z = mult_rel X (mult_rel Y Z)"
	+ "mult_rel X (add_rel Y Z) = add_rel (mult_rel X Y) (mult_rel X Z)"
	+ "mult_rel (add_rel Y Z) X = add_rel (mult_rel Y X) (mult_rel Z X)"
	+ if "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim" "Z \<in> carrier_direct_lim" for X Y Z
	+ proof -
	+ define x where "x=(SOME x. x \<in> X)"
	+ define y where "y=(SOME y. y \<in> Y)"
	+ define z where "z=(SOME z. z \<in> Z)"
	+
	+ have x:"x\<in>X" "x\<in>Sigma I \<FF>" and x_alt:"X = \<lfloor>fst x,snd x\<rfloor>"
	+ using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
	+ have y:"y\<in>Y" "y \<in> Sigma I \<FF>" and y_alt:"Y = \<lfloor>fst y,snd y\<rfloor>"
	+ using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
	+ have z:"z\<in>Z" "z \<in> Sigma I \<FF>" and z_alt:"Z = \<lfloor>fst z,snd z\<rfloor>"
	+ using rel_carrier_Eps_in[OF \<open>Z \<in> carrier_direct_lim\<close>] unfolding z_def by auto
	+
	+ obtain w0 where w0:"w0 \<in> I" "w0 \<subseteq> fst x" "w0 \<subseteq> fst y" "w0 \<subseteq> fst z"
	+ using obtain_lower_bound_finite[of "{fst x,fst y,fst z}"] x y z
	+ by force
	+
	+ interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
	+ "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using is_ring_morphism x w0 subset_of_opens by auto
	+ interpret yw0:ring_homomorphism "\<rho> (fst y) w0" "\<FF> (fst y)" "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>"
	+ "\<one>\<^bsub>fst y\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using is_ring_morphism y w0 subset_of_opens by auto
	+ interpret zw0:ring_homomorphism "\<rho> (fst z) w0" "\<FF> (fst z)" "+\<^bsub>fst z\<^esub>" "\<cdot>\<^bsub>fst z\<^esub>" "\<zero>\<^bsub>fst z\<^esub>"
	+ "\<one>\<^bsub>fst z\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using is_ring_morphism z w0 subset_of_opens by auto
	+
	+ have "add_rel (add_rel X Y) Z = \<lfloor>w0, +\<^bsub>w0\<^esub> ((+\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
	+ (\<rho> (fst y) w0 (snd y)))) (\<rho> (fst z) w0 (snd z))\<rfloor>"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 subset_of_opens add_rel_class_of
	+ by (force simp add: add_rel_class_of)
	+ also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
	+ (+\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
	+ using x(2) xw0.target.additive.associative y(2) z(2) by force
	+ also have "... = add_rel X (add_rel Y Z)"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 add_rel_class_of subset_of_opens by force
	+ finally show "add_rel (add_rel X Y) Z = add_rel X (add_rel Y Z)" .
	+
	+ have "mult_rel (mult_rel X Y) Z = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> ((\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
	+ (\<rho> (fst y) w0 (snd y)))) (\<rho> (fst z) w0 (snd z))\<rfloor>"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 mult_rel_class_of subset_of_opens by force
	+ also have "... = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
	+ (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
	+ apply (subst xw0.target.multiplicative.associative)
	+ using w0 x y z by auto
	+ also have "... = mult_rel X (mult_rel Y Z)"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 mult_rel_class_of subset_of_opens by force
	+ finally show "mult_rel (mult_rel X Y) Z = mult_rel X (mult_rel Y Z)" .
	+
	+ have "mult_rel X (add_rel Y Z) = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
	+ (+\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
	+ also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) (\<rho> (fst y) w0 (snd y)))
	+ (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
	+ apply (subst xw0.target.distributive)
	+ using w0 x y z by auto
	+ also have "... = add_rel (mult_rel X Y) (mult_rel X Z)"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
	+ finally show "mult_rel X (add_rel Y Z) = add_rel (mult_rel X Y) (mult_rel X Z)" .
	+
	+ have "mult_rel (add_rel Y Z) X = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (+\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y))
	+ (\<rho> (fst z) w0 (snd z))) (\<rho> (fst x) w0 (snd x))\<rfloor>"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
	+ also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst x) w0 (snd x)))
	+ (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst z) w0 (snd z)) (\<rho> (fst x) w0 (snd x)))\<rfloor>"
	+ apply (subst xw0.target.distributive)
	+ using w0 x y z by auto
	+ also have "... = add_rel (mult_rel Y X) (mult_rel Z X)"
	+ unfolding x_alt y_alt z_alt
	+ using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
	+ finally show "mult_rel (add_rel Y Z) X = add_rel (mult_rel Y X) (mult_rel Z X)" .
	+ qed
	+
	+ show add_rel_0':"\<And>a. a \<in> carrier_direct_lim \<Longrightarrow> add_rel a \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> = a"
	+ using add_rel_0 add_rel_commute zero_rel by force
	+
	+ interpret Group_Theory.monoid carrier_direct_lim add_rel "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>"
	+ apply unfold_locales
	+ by (simp_all add: zero_rel add_rel_carrier add_assoc add_rel_0 add_rel_0')
	+
	+ show "monoid.invertible carrier_direct_lim add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X"
	+ if "X \<in> carrier_direct_lim" for X
	+ proof -
	+ define x where "x=(SOME x. x \<in> X)"
	+ have x:"x\<in>X" "x\<in>Sigma I \<FF>" "fst x\<in>I" and X_alt:"X= \<lfloor>fst x, snd x\<rfloor>"
	+ using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>]
	+ unfolding x_def by auto
	+
	+ obtain w0 where w0: "w0 \<in> I" "w0 \<subseteq> U" "w0 \<subseteq> fst x"
	+ using has_lower_bound[OF \<open>U\<in>I\<close> \<open>fst x\<in>I\<close>] by blast
	+
	+ interpret uw0:ring_homomorphism "\<rho> U w0" "\<FF> U" "+\<^bsub>U\<^esub>" "\<cdot>\<^bsub>U\<^esub>" "\<zero>\<^bsub>U\<^esub>" "\<one>\<^bsub>U\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>"
	+ "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using is_ring_morphism \<open>U\<in>I\<close> w0 subset_of_opens by auto
	+ interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
	+ "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
	+ using is_ring_morphism \<open>fst x\<in>I\<close> w0 subset_of_opens by auto
	+
	+ define Y where "Y=\<lfloor>fst x, xw0.source.additive.inverse (snd x)\<rfloor>"
	+
	+ have "add_rel X Y = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
	+ (\<rho> (fst x) w0 (xw0.source.additive.inverse (snd x)))\<rfloor>"
	+ unfolding X_alt Y_def
	+ proof (subst add_rel_class_of)
	+ show "(fst x, xw0.source.additive.inverse (snd x)) \<in> Sigma I \<FF>"
	+ using x(2) xw0.source.additive.invertible xw0.source.additive.invertible_inverse_closed
	+ by force
	+ qed (use x w0 in auto)
	+ also have "... = \<lfloor>w0, \<zero>\<^bsub>w0\<^esub>\<rfloor>"
	+ apply (subst xw0.additive.invertible_image_lemma)
	+ subgoal using x(2) xw0.source.additive.invertible by force
	+ using x(2) by auto
	+ also have "... = \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>"
	+ by (simp add: assms class_of_0_eq w0(1))
	+ finally have "add_rel X Y = \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>" .
	+ moreover have "Y \<in> carrier_direct_lim"
	+ using Group_Theory.group_def Y_def carrier_direct_lim_def class_of_def
	+ monoid.invertible_inverse_closed x(2) xw0.source.additive.group_axioms
	+ xw0.source.additive.invertible by fastforce
	+ moreover have "add_rel Y X = \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>"
	+ using \<open>Y \<in> carrier_direct_lim\<close> \<open>add_rel X Y = \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>\<close>
	+ by (simp add: add_rel_commute that)
	+ ultimately show ?thesis
	+ unfolding invertible_def[OF that] by auto
	+ qed
	+qed
	+
	+
	+(* The canonical function from \<FF> U into lim \<FF> for U \<in> I:*)
	+definition canonical_fun:: "'a set \<Rightarrow> 'b \<Rightarrow> ('a set \<times> 'b) set"
	+ where "canonical_fun U x = \<lfloor>U, x\<rfloor>"
	+
	+
	+lemma rel_I1:
	+ assumes "s \<in> \<FF> U" "x \<in> \<lfloor>U, s\<rfloor>" "U \<in> I"
	+ shows "(U, s) \<sim> x"
	+proof -
	+ have Us: "\<lfloor>U, s\<rfloor> \<in> carrier_direct_lim"
	+ using assms unfolding carrier_direct_lim_def class_of_def
	+ by (simp add: equivalence.Class_in_Partition rel_is_equivalence)
	+ then show ?thesis
	+ using rel_Class_iff assms
	+ by (metis carrier_direct_lim_def class_of_def mem_Sigma_iff rel.Block_self rel.Class_self rel.block_closed)
	+qed
	+
	+lemma rel_I2:
	+ assumes "s \<in> \<FF> U" "x \<in> \<lfloor>U, s\<rfloor>" "U \<in> I"
	+ shows "(U, s) \<sim> (SOME x. x \<in> \<lfloor>U, s\<rfloor>)"
	+ using carrier_direct_lim_def class_of_def rel_carrier_Eps_in(2) rel_carrier_Eps_in(3) assms
	+ by fastforce
	+
	+lemma carrier_direct_limE:
	+ assumes "X \<in> carrier_direct_lim"
	+ obtains U s where "U \<in> I" "s \<in> \<FF> U" "X = \<lfloor>U,s\<rfloor>"
	+ using assms carrier_direct_lim_def class_of_def by auto
	+
	+
	+
	+end (* direct_lim *)
	+
	+abbreviation "dlim \<equiv> direct_lim.carrier_direct_lim"
	+
	+
	+subsubsection \<open>Universal property of direct limits\<close>
	+
	+proposition (in direct_lim) universal_property:
	+ fixes A:: "'c set" and \<psi>:: "'a set \<Rightarrow> ('b \<Rightarrow> 'c)" and add:: "'c \<Rightarrow> 'c \<Rightarrow> 'c"
	+ and mult:: "'c \<Rightarrow> 'c \<Rightarrow> 'c" and zero:: "'c" and one:: "'c"
	+ assumes "ring A add mult zero one"
	+ and r_hom: "\<And>U. U \<in> I \<Longrightarrow> ring_homomorphism (\<psi> U) (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> A add mult zero one"
	+ and eq: "\<And>U V x. \<lbrakk>U \<in> I; V \<in> I; V \<subseteq> U; x \<in> (\<FF> U)\<rbrakk> \<Longrightarrow> (\<psi> V \<circ> \<rho> U V) x = \<psi> U x"
	+ shows "\<forall>V\<in>I. \<exists>!u. ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V,\<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V,\<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one
	+\<and> (\<forall>U\<in>I. \<forall>x\<in>(\<FF> U). (u \<circ> canonical_fun U) x = \<psi> U x)"
	+proof
	+ fix V assume "V \<in> I"
	+ interpret ring_V: ring carrier_direct_lim add_rel mult_rel "\<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor>" "\<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>"
	+ using \<open>V \<in> I\<close> direct_lim_is_ring by blast
	+ interpret ring_\<psi>V: ring_homomorphism "\<psi> V" "\<FF> V" "+\<^bsub>V\<^esub>" "\<cdot>\<^bsub>V\<^esub>" "\<zero>\<^bsub>V\<^esub>" "\<one>\<^bsub>V\<^esub>" A add mult zero one
	+ using \<open>V \<in> I\<close> r_hom by presburger
	+
	+ define u where "u \<equiv> \<lambda>X \<in> carrier_direct_lim. let x = (SOME x. x \<in> X) in \<psi> (fst x) (snd x)"
	+ \<comment>\<open>The proposition below proves that @{term u} is well defined.\<close>
	+ have \<psi>_eqI: "\<psi> x1 x2 = \<psi> y1 y2" if "(x1,x2) \<sim> (y1,y2)"
	+ for x1 x2 y1 y2
	+ by (smt (verit, best) Int_subset_iff assms(3) comp_apply fst_conv rel_def snd_conv that)
	+ have u_eval: "u \<lfloor>U,s\<rfloor> = \<psi> U s" if "U \<in> I" "s \<in> \<FF> U" for U s
	+ proof -
	+ have Us: "\<lfloor>U, s\<rfloor> \<in> carrier_direct_lim"
	+ using that unfolding carrier_direct_lim_def class_of_def
	+ by (simp add: equivalence.Class_in_Partition rel_is_equivalence)
	+ with that show ?thesis
	+ apply (simp add: u_def Let_def)
	+ by (metis \<psi>_eqI prod.exhaust_sel rel_I2 rel_carrier_Eps_in(1))
	+ qed
	+
	+ have u_PiE: "u \<in> carrier_direct_lim \<rightarrow>\<^sub>E A"
	+ proof
	+ fix X
	+ assume "X \<in> carrier_direct_lim" then show "u X \<in> A"
	+ by (metis carrier_direct_limE map.map_closed r_hom ring_homomorphism_def u_eval)
	+ qed (auto simp: u_def)
	+ have hom_u: "ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>
	+ A add mult zero one"
	+ proof
	+ have "u (add_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = add (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
	+ if "U \<in> I" "V \<in> I" "s \<in> \<FF> U" "t \<in> \<FF> V" for U V s t
	+ proof -
	+ obtain W where "W \<in> I" and Wsub: "W \<subseteq> U \<inter> V"
	+ using assms has_lower_bound by (metis \<open>U \<in> I\<close> \<open>V \<in> I\<close>)
	+ interpret ring_\<psi>W: ring_homomorphism "\<psi> W" "\<FF> W" "+\<^bsub>W\<^esub>" "\<cdot>\<^bsub>W\<^esub>" "\<zero>\<^bsub>W\<^esub>" "\<one>\<^bsub>W\<^esub>" A add mult zero one
	+ using \<open>W \<in> I\<close> r_hom by presburger
	+ have "u (add_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = u (\<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t)\<rfloor>)"
	+ using Wsub \<open>W \<in> I\<close> add_rel_class_of that by force
	+ also have "\<dots> = \<psi> W (+\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t))"
	+ by (metis Wsub \<open>W \<in> I\<close> direct_lim.subset_of_opens direct_lim_axioms is_map_from_is_homomorphism le_infE map.map_closed ring_\<psi>W.source.additive.composition_closed that u_eval)
	+ also have "\<dots> = add (\<psi> W ((\<rho> U W s))) (\<psi> W ((\<rho> V W t)))"
	+ using that
	+ by (meson \<open>W \<in> I\<close> \<open>W \<subseteq> U \<inter> V\<close> inf.bounded_iff is_ring_morphism map.map_closed ring_\<psi>W.additive.commutes_with_composition ring_homomorphism_def subset_of_opens)
	+ also have "\<dots> = add (\<psi> U s) (\<psi> V t)"
	+ using \<open>W \<in> I\<close> \<open>W \<subseteq> U \<inter> V\<close> eq that by force
	+ also have "... = add (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
	+ by (simp add: that u_eval)
	+ finally show "u (add_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = add (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)" .
	+ qed
	+ then show "u (add_rel X Y) = add (u X) (u Y)"
	+ if "X \<in> carrier_direct_lim" and "Y \<in> carrier_direct_lim" for X Y
	+ by (metis (no_types, lifting) carrier_direct_limE that)
	+ show "u \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> = zero"
	+ using \<open>V \<in> I\<close> ring_\<psi>V.additive.commutes_with_unit ring_\<psi>V.source.additive.unit_closed
	+ u_eval by presburger
	+ have "u (mult_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = mult (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
	+ if "U \<in> I" "V \<in> I" "s \<in> \<FF> U" "t \<in> \<FF> V" for U V s t
	+ proof -
	+ obtain W where "W \<in> I" and Wsub: "W \<subseteq> U \<inter> V"
	+ by (meson \<open>U \<in> I\<close> \<open>V \<in> I\<close> has_lower_bound)
	+ interpret ring_\<psi>W: ring_homomorphism "\<psi> W" "\<FF> W" "+\<^bsub>W\<^esub>" "\<cdot>\<^bsub>W\<^esub>" "\<zero>\<^bsub>W\<^esub>" "\<one>\<^bsub>W\<^esub>" A add mult zero one
	+ using \<open>W \<in> I\<close> r_hom by presburger
	+ have "u (mult_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = u (\<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t)\<rfloor>)"
	+ using Wsub \<open>W \<in> I\<close> mult_rel_class_of that by force
	+ also have "\<dots> = \<psi> W (\<cdot>\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t))"
	+ by (metis Wsub \<open>W \<in> I\<close> direct_lim.subset_of_opens direct_lim_axioms is_map_from_is_homomorphism
	+ le_infE map.map_closed ring_\<psi>W.source.multiplicative.composition_closed that u_eval)
	+ also have "\<dots> = mult (\<psi> W ((\<rho> U W s))) (\<psi> W ((\<rho> V W t)))"
	+ by (meson Wsub \<open>W \<in> I\<close> inf.boundedE is_ring_morphism map.map_closed ring_\<psi>W.multiplicative.commutes_with_composition ring_homomorphism_def subset_of_opens that)
	+ also have "\<dots> = mult (\<psi> U s) (\<psi> V t)"
	+ using Wsub \<open>W \<in> I\<close> eq that by force
	+ also have "... = mult (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
	+ using that u_eval by presburger
	+ finally show "u (mult_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = mult (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)" .
	+ qed
	+ then show "u (mult_rel X Y) = mult (u X) (u Y)"
	+ if "X \<in> carrier_direct_lim" and "Y \<in> carrier_direct_lim" for X Y
	+ by (metis (no_types, lifting) carrier_direct_limE that)
	+ show "u (\<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>) = one"
	+ by (simp add: \<open>V \<in> I\<close> ring_\<psi>V.multiplicative.commutes_with_unit u_eval)
	+ qed (simp add: u_PiE)
	+ show "\<exists>!u. ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>
	+ A add mult zero one \<and>
	+ (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (u \<circ> canonical_fun U) x = \<psi> U x)"
	+ proof
	+ show "ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one \<and> (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (u \<circ> canonical_fun U) x = \<psi> U x)"
	+ by (simp add: canonical_fun_def hom_u u_eval)
	+ fix v
	+ assume v: "ring_homomorphism v carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one \<and> (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (v \<circ> canonical_fun U) x = \<psi> U x)"
	+ have "u X = v X" if "X \<in> carrier_direct_lim" for X
	+ by (metis v canonical_fun_def carrier_direct_limE comp_apply that u_eval)
	+ moreover have "v \<in> carrier_direct_lim \<rightarrow>\<^sub>E A"
	+ by (metis v Set_Theory.map_def ring_homomorphism_def)
	+ ultimately show "v = u"
	+ using PiE_ext u_PiE by blast
	+ qed
	+qed
	+
	+
	+subsection \<open>Locally Ringed Spaces\<close>
	+
	+subsubsection \<open>Stalks of a Presheaf\<close>
	+
	+locale stalk = direct_lim +
	+ fixes x:: "'a"
	+ assumes is_elem: "x \<in> S" and index: "I = {U. is_open U \<and> x \<in> U}"
	+begin
	+
	+(* definition 0.37 *)
	+definition carrier_stalk:: "('a set \<times> 'b) set set"
	+ where "carrier_stalk \<equiv> dlim \<FF> \<rho> (neighborhoods x)"
	+
	+lemma neighborhoods_eq:"neighborhoods x = I"
	+ unfolding index neighborhoods_def by simp
	+
	+definition add_stalk:: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
	+ where "add_stalk \<equiv> add_rel"
	+
	+definition mult_stalk:: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
	+ where "mult_stalk \<equiv> mult_rel"
	+
	+definition zero_stalk:: "'a set \<Rightarrow> ('a set \<times> 'b) set"
	+ where "zero_stalk V \<equiv> class_of V \<zero>\<^bsub>V\<^esub>"
	+
	+definition one_stalk:: "'a set \<Rightarrow> ('a set \<times> 'b) set"
	+ where "one_stalk V \<equiv> class_of V \<one>\<^bsub>V\<^esub>"
	+
	+lemma class_of_in_stalk:
	+ assumes "A \<in> (neighborhoods x)" and "z \<in> \<FF> A"
	+ shows "class_of A z \<in> carrier_stalk"
	+proof -
	+ interpret equivalence "Sigma I \<FF>" "{(x, y). x \<sim> y}"
	+ using rel_is_equivalence by blast
	+ show ?thesis
	+ using assms unfolding carrier_stalk_def neighborhoods_def
	+ by (metis (no_types, lifting) carrier_direct_lim_def class_of_def index mem_Sigma_iff natural.map_closed)
	+qed
	+
	+lemma stalk_is_ring:
	+ assumes "is_open V" and "x \<in> V"
	+ shows "ring carrier_stalk add_stalk mult_stalk (zero_stalk V) (one_stalk V)"
	+proof -
	+ interpret r: ring carrier_direct_lim add_rel mult_rel "\<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor>" "\<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>"
	+ using assms direct_lim_is_ring index by blast
	+ show ?thesis
	+ using r.additive.monoid_axioms
	+ unfolding zero_stalk_def one_stalk_def add_stalk_def mult_stalk_def carrier_stalk_def
	+ using index neighborhoods_def r.ring_axioms by metis
	+qed
	+
	+
	+lemma in_zero_stalk [simp]:
	+ assumes "V \<in> I"
	+ shows "(V, zero_str V) \<in> zero_stalk V"
	+ by (simp add: assms zero_stalk_def class_of_def class_of_0_in equivalence.Class_self rel_is_equivalence)
	+
	+lemma in_one_stalk [simp]:
	+ assumes "V \<in> I"
	+ shows "(V, one_str V) \<in> one_stalk V"
	+ by (simp add: assms one_stalk_def class_of_def class_of_1_in equivalence.Class_self rel_is_equivalence)
	+
	+lemma universal_property_for_stalk:
	+ fixes A:: "'c set" and \<psi>:: "'a set \<Rightarrow> ('b \<Rightarrow> 'c)"
	+ assumes ringA: "ring A add mult zero one"
	+ and hom: "\<And>U. U \<in> neighborhoods x \<Longrightarrow> ring_homomorphism (\<psi> U) (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> A add mult zero one"
	+ and eq: "\<And>U V s. \<lbrakk>U \<in> neighborhoods x; V \<in> neighborhoods x; V\<subseteq>U; s \<in> \<FF> U\<rbrakk> \<Longrightarrow> (\<psi> V \<circ> \<rho> U V) s = \<psi> U s"
	+ shows "\<forall>V\<in>(neighborhoods x). \<exists>!u. ring_homomorphism u
	+carrier_stalk add_stalk mult_stalk (zero_stalk V) (one_stalk V) A add mult zero one
	+\<and> (\<forall>U\<in>(neighborhoods x). \<forall>s\<in>(\<FF> U). (u \<circ> canonical_fun U) s = \<psi> U s)"
	+proof -
	+ note neighborhoods_eq [simp]
	+ have "\<forall>V\<in>I. \<exists>!u. ring_homomorphism u carrier_direct_lim add_rel mult_rel
	+ \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one \<and>
	+ (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (u \<circ> canonical_fun U) x = \<psi> U x)"
	+ apply (rule universal_property[OF ringA hom])
	+ using eq by simp_all
	+ then show ?thesis
	+ unfolding carrier_stalk_def add_stalk_def mult_stalk_def zero_stalk_def one_stalk_def
	+ by simp
	+qed
	+
	+end (* stalk *)
	+
	+sublocale stalk \<subseteq> direct_lim by (simp add: direct_lim_axioms)
	+
	+
	+subsubsection \<open>Maximal Ideals\<close>
	+
	+(* definition 0.38 *)
	+locale max_ideal = comm_ring R "(+)" "(\<cdot>)" "\<zero>" "\<one>" + ideal I R "(+)" "(\<cdot>)" "\<zero>" "\<one>"
	+ for R and I and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and
	+unit ("\<one>") +
	+assumes neq_ring: "I \<noteq> R" and is_max: "\<And>\<aa>. ideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> \<aa> \<noteq> R \<Longrightarrow> I \<subseteq> \<aa> \<Longrightarrow> I = \<aa>"
	+begin
	+
	+lemma psubset_ring: "I \<subset> R"
	+ using neq_ring by blast
	+
	+lemma
	+ shows "\<not> (\<exists>\<aa>. ideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<and> \<aa> \<noteq> R \<and> I \<subset> \<aa>)"
	+ using is_max by blast
	+
	+text \<open>A maximal ideal is prime\<close>
	+proposition is_pr_ideal: "pr_ideal R I (+) (\<cdot>) \<zero> \<one>"
	+proof
	+ show "I \<noteq> R"
	+ using neq_ring by fastforce
	+ fix x y
	+ assume "x \<in> R" "y \<in> R" and dot: "x \<cdot> y \<in> I"
	+ then show "x \<in> I \<or> y \<in> I"
	+ proof-
	+ have "False" if "x \<notin> I" "y \<notin> I"
	+ proof-
	+ define J where "J \<equiv> {i + r \<cdot> x \|i r. i \<in> I \<and> r \<in> R}"
	+ have "J \<subseteq> R"
	+ using \<open>x \<in> R\<close> by (auto simp: J_def)
	+ have "x \<in> J"
	+ apply (simp add: J_def)
	+ by (metis \<open>x \<in> R\<close> additive.left_unit additive.sub_unit_closed multiplicative.left_unit multiplicative.unit_closed)
	+ interpret monJ: monoid J "(+)" \<zero>
	+ proof
	+ have "\<zero> = \<zero> + \<zero> \<cdot> x"
	+ by (simp add: \<open>x \<in> R\<close>)
	+ then show "\<zero> \<in> J"
	+ by (auto simp: J_def)
	+ next
	+ fix a b
	+ assume "a \<in> J" and "b \<in> J"
	+ then obtain ia ra ib rb where a: "a = ia + ra \<cdot> x" "ia \<in> I" "ra \<in> R"
	+ and b: "b = ib + rb \<cdot> x" "ib \<in> I" "rb \<in> R"
	+ by (auto simp: J_def)
	+ then have "ia + ra \<cdot> x + (ib + rb \<cdot> x) = ia + ib + (ra + rb) \<cdot> x"
	+ by (smt (z3) \<open>x \<in> R\<close> additive.commutative additive.composition_closed additive.monoid_axioms additive.submonoid_axioms distributive(2) monoid.associative multiplicative.composition_closed submonoid.sub)
	+ with a b show "a + b \<in> J"
	+ by (auto simp add: J_def)
	+ next
	+ fix a b c
	+ assume "a \<in> J" and "b \<in> J" and "c \<in> J"
	+ then show "a + b + c = a + (b + c)"
	+ by (meson \<open>J \<subseteq> R\<close> additive.associative subsetD)
	+ next
	+ fix a
	+ assume "a \<in> J"
	+ then show "\<zero> + a = a" "a + \<zero> = a"
	+ using \<open>J \<subseteq> R\<close> additive.left_unit additive.right_unit by blast+
	+ qed
	+ interpret idJ: ideal J R "(+)" "(\<cdot>)" \<zero> \<one>
	+ proof
	+ fix u
	+ assume "u \<in> J"
	+ then obtain i r where "u = i + r \<cdot> x" "i \<in> I" "r \<in> R"
	+ by (auto simp: J_def)
	+ then have "-u = -i + (-r) \<cdot> x"
	+ by (simp add: \<open>x \<in> R\<close> additive.commutative additive.inverse_composition_commute local.left_minus)
	+ with \<open>i \<in> I\<close> \<open>r \<in> R\<close> have "-u \<in> J"
	+ by (auto simp: J_def)
	+ with \<open>u \<in> J\<close> show "monoid.invertible J (+) \<zero> u"
	+ using monoid.invertibleI [where v = "-u"]
	+ by (simp add: \<open>u \<in> J\<close> monJ.monoid_axioms \<open>i \<in> I\<close> \<open>r \<in> R\<close> \<open>u = i + r \<cdot> x\<close> \<open>x \<in> R\<close>)
	+ next
	+ fix a b
	+ assume "a \<in> R" and "b \<in> J"
	+ then obtain i r where ir: "b = i + r \<cdot> x" "i \<in> I" "r \<in> R"
	+ by (auto simp: J_def)
	+ then have "a \<cdot> (i + r \<cdot> x) = a \<cdot> i + a \<cdot> r \<cdot> x"
	+ by (simp add: \<open>a \<in> R\<close> \<open>x \<in> R\<close> distributive(1) multiplicative.associative)
	+ then show "a \<cdot> b \<in> J"
	+ using \<open>a \<in> R\<close> ideal(1) ir by (force simp add: J_def)
	+ have "b \<cdot> a = i \<cdot> a + r \<cdot> a \<cdot> x"
	+ by (simp add: \<open>a \<in> R\<close> \<open>x \<in> R\<close> comm_mult distributive(1) ir mult_left_assoc)
	+ then show "b \<cdot> a \<in> J"
	+ by (metis \<open>J \<subseteq> R\<close> \<open>a \<cdot> b \<in> J\<close> \<open>a \<in> R\<close> \<open>b \<in> J\<close> comm_mult subsetD)
	+ qed (auto simp: \<open>J \<subseteq> R\<close>)
	+ have "I \<subset> J"
	+ proof
	+ show "I \<subseteq> J"
	+ unfolding J_def
	+ apply clarify
	+ by (metis \<open>x \<in> R\<close> additive.sub.right_unit additive.unit_closed left_zero)
	+ show "I \<noteq> J"
	+ using \<open>x \<in> J\<close> \<open>x \<notin> I\<close> by blast
	+ qed
	+ hence "J = R"
	+ using idJ.ideal_axioms is_max by auto
	+ hence "\<one> \<in> J"
	+ by fastforce
	+ then obtain a r where "a \<in> I" "r \<in> R" "\<one> = a + r\<cdot>x"
	+ unfolding J_def by blast
	+ then have "y = (a + r\<cdot>x) \<cdot> y"
	+ using \<open>y \<in> R\<close> multiplicative.left_unit by presburger
	+ also have "\<dots> = a \<cdot> y + r\<cdot>x\<cdot>y"
	+ by (simp add: \<open>a \<in> I\<close> \<open>r \<in> R\<close> \<open>x \<in> R\<close> \<open>y \<in> R\<close> distributive(2))
	+ also have "\<dots> \<in> I"
	+ by (simp add: \<open>a \<in> I\<close> \<open>r \<in> R\<close> \<open>x \<in> R\<close> \<open>y \<in> R\<close> dot ideal multiplicative.associative)
	+ finally have "y \<in> I" .
	+ thus ?thesis using that(2) by auto
	+ qed
	+ thus ?thesis by auto
	+ qed
	+qed
	+
	+end (* locale max_ideal *)
	+
	+
	+subsubsection \<open>Maximal Left Ideals\<close>
	+
	+locale lideal = subgroup_of_additive_group_of_ring +
	+ assumes lideal: "\<lbrakk> r \<in> R; a \<in> I \<rbrakk> \<Longrightarrow> r \<cdot> a \<in> I"
	+
	+begin
	+
	+lemma subset: "I \<subseteq> R"
	+ by simp
	+
	+lemma has_one_imp_equal:
	+ assumes "\<one> \<in> I"
	+ shows "I = R"
	+ by (metis assms lideal subset multiplicative.right_unit subsetI subset_antisym)
	+
	+end
	+
	+lemma (in comm_ring) ideal_iff_lideal:
	+ "ideal I R (+) (\<cdot>) \<zero> \<one> \<longleftrightarrow> lideal I R (+) (\<cdot>) \<zero> \<one>" (is "?lhs = ?rhs")
	+proof
	+ assume ?lhs
	+ then interpret I: ideal I R "(+)" "(\<cdot>)" \<zero> \<one> .
	+ show ?rhs
	+ proof qed (use I.ideal in presburger)
	+next
	+ assume ?rhs
	+ then interpret I: lideal I R "(+)" "(\<cdot>)" \<zero> \<one> .
	+ show ?lhs
	+ proof
	+ fix r a
	+ assume "r \<in> R" "a \<in> I"
	+ then show "r \<cdot> a \<in> I"
	+ using I.lideal by blast
	+ then show "a \<cdot> r \<in> I"
	+ by (simp add: \<open>a \<in> I\<close> \<open>r \<in> R\<close> comm_mult)
	+ qed
	+qed
	+
	+
	+locale max_lideal = lideal +
	+ assumes neq_ring: "I \<noteq> R" and is_max: "\<And>\<aa>. lideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> \<aa> \<noteq> R \<Longrightarrow> I \<subseteq> \<aa> \<Longrightarrow> I = \<aa>"
	+
	+(WHY ARE THE ARGUMENT ORDERS OF max_ideal vs max_lideal INCONSISTENT?)
	+lemma (in comm_ring) max_ideal_iff_max_lideal:
	+ "max_ideal R I (+) (\<cdot>) \<zero> \<one> \<longleftrightarrow> max_lideal I R (+) (\<cdot>) \<zero> \<one>" (is "?lhs = ?rhs")
	+proof
	+ assume ?lhs
	+ then interpret I: max_ideal R I "(+)" "(\<cdot>)" \<zero> \<one> .
	+ show ?rhs
	+ proof intro_locales
	+ show "lideal_axioms I R (\<cdot>)"
	+ by (simp add: I.ideal(1) lideal_axioms.intro)
	+ show "max_lideal_axioms I R (+) (\<cdot>) \<zero> \<one>"
	+ by (simp add: I.is_max I.neq_ring ideal_iff_lideal max_lideal_axioms.intro)
	+ qed
	+next
	+ assume ?rhs
	+ then interpret I: max_lideal I R "(+)" "(\<cdot>)" \<zero> \<one> .
	+ show ?lhs
	+ proof intro_locales
	+ show "ideal_axioms I R (\<cdot>)"
	+ by (meson I.lideal_axioms ideal_def ideal_iff_lideal)
	+ show "max_ideal_axioms R I (+) (\<cdot>) \<zero> \<one>"
	+ by (meson I.is_max I.neq_ring ideal_iff_lideal max_ideal_axioms.intro)
	+ qed
	+qed
	+
	+subsubsection \<open>Local Rings\<close>
	+
	+(* definition 0.39 *)
	+locale local_ring = ring +
	+ assumes is_unique: "\<And>I J. max_lideal I R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> max_lideal J R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> I = J"
	+ and has_max_lideal: "\<exists>\<ww>. max_lideal \<ww> R (+) (\<cdot>) \<zero> \<one>"
	+
	+(Can this be proved from the analogous result for left, right ideals?)
	+lemma im_of_ideal_is_ideal:
	+ assumes I: "ideal I A addA multA zeroA oneA"
	+ and f: "ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "ideal (f ` I) B addB multB zeroB oneB"
	+proof -
	+ interpret IA: ideal I A addA multA zeroA oneA
	+ using I by blast
	+ interpret fepi: ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using f by force
	+ show ?thesis
	+ proof intro_locales
	+ show sma: "submonoid_axioms (f ` I) B addB zeroB"
	+ proof
	+ show "f ` I \<subseteq> B"
	+ by blast
	+ have "zeroA \<in> I"
	+ by simp
	+ then show "zeroB \<in> f ` I"
	+ using fepi.additive.commutes_with_unit by blast
	+ next
	+ fix b1 b2
	+ assume "b1 \<in> f ` I" and "b2 \<in> f ` I"
	+ then show "addB b1 b2 \<in> f ` I"
	+ unfolding image_iff
	+ by (metis IA.additive.sub IA.additive.sub_composition_closed fepi.additive.commutes_with_composition)
	+ qed
	+ show "Group_Theory.monoid (f ` I) addB zeroB"
	+ proof
	+ fix a b
	+ assume "a \<in> f ` I" "b \<in> f ` I"
	+ then show "addB a b \<in> f ` I"
	+ by (meson sma submonoid_axioms_def)
	+ next
	+ show "zeroB \<in> f ` I"
	+ using fepi.additive.commutes_with_unit by blast
	+ qed auto
	+ show "Group_Theory.group_axioms (f ` I) addB zeroB"
	+ proof
	+ fix b
	+ assume "b \<in> f ` I"
	+ then obtain i where "b = f i" "i \<in> I"
	+ by blast
	+ then obtain j where "addA i j = zeroA" "j \<in> I"
	+ using IA.additive.sub.invertible_right_inverse by blast
	+ then show "monoid.invertible (f ` I) addB zeroB b"
	+ by (metis IA.additive.commutative IA.additive.sub \<open>Group_Theory.monoid (f ` I) addB zeroB\<close> \<open>b = f i\<close> \<open>i \<in> I\<close> fepi.additive.commutes_with_composition fepi.additive.commutes_with_unit image_eqI monoid.invertibleI)
	+ qed
	+ show "ideal_axioms (f ` I) B multB"
	+ proof
	+ fix b fi
	+ assume "b \<in> B" and "fi \<in> f ` I"
	+ then obtain i where i: "fi = f i" "i \<in> I"
	+ by blast
	+ obtain a where a: "a \<in> A" "f a = b"
	+ using \<open>b \<in> B\<close> fepi.surjective by blast
	+ then show "multB b fi \<in> f ` I"
	+ by (metis IA.additive.submonoid_axioms IA.ideal(1) \<open>fi = f i\<close> \<open>i \<in> I\<close> fepi.multiplicative.commutes_with_composition image_iff submonoid.sub)
	+ then show "multB fi b \<in> f ` I"
	+ by (metis IA.additive.sub IA.ideal(2) a i fepi.multiplicative.commutes_with_composition imageI)
	+ qed
	+ qed
	+qed
	+
	+lemma im_of_lideal_is_lideal:
	+ assumes I: "lideal I A addA multA zeroA oneA"
	+ and f: "ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "lideal (f ` I) B addB multB zeroB oneB"
	+proof -
	+ interpret IA: lideal I A addA multA zeroA oneA
	+ using I by blast
	+ interpret fepi: ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using f by force
	+ show ?thesis
	+ proof intro_locales
	+ show sma: "submonoid_axioms (f ` I) B addB zeroB"
	+ proof
	+ show "f ` I \<subseteq> B"
	+ by blast
	+ have "zeroA \<in> I"
	+ by simp
	+ then show "zeroB \<in> f ` I"
	+ using fepi.additive.commutes_with_unit by blast
	+ next
	+ fix b1 b2
	+ assume "b1 \<in> f ` I" and "b2 \<in> f ` I"
	+ then show "addB b1 b2 \<in> f ` I"
	+ unfolding image_iff
	+ by (metis IA.additive.sub IA.additive.sub_composition_closed fepi.additive.commutes_with_composition)
	+ qed
	+ show "Group_Theory.monoid (f ` I) addB zeroB"
	+ proof
	+ fix a b
	+ assume "a \<in> f ` I" "b \<in> f ` I"
	+ then show "addB a b \<in> f ` I"
	+ by (meson sma submonoid_axioms_def)
	+ next
	+ show "zeroB \<in> f ` I"
	+ using fepi.additive.commutes_with_unit by blast
	+ qed auto
	+ show "Group_Theory.group_axioms (f ` I) addB zeroB"
	+ proof
	+ fix b
	+ assume "b \<in> f ` I"
	+ then obtain i where "b = f i" "i \<in> I"
	+ by blast
	+ then obtain j where "addA i j = zeroA" "j \<in> I"
	+ using IA.additive.sub.invertible_right_inverse by blast
	+ then show "monoid.invertible (f ` I) addB zeroB b"
	+ by (metis IA.additive.commutative IA.additive.sub \<open>Group_Theory.monoid (f ` I) addB zeroB\<close> \<open>b = f i\<close> \<open>i \<in> I\<close> fepi.additive.commutes_with_composition fepi.additive.commutes_with_unit image_eqI monoid.invertibleI)
	+ qed
	+ show "lideal_axioms (f ` I) B multB"
	+ proof
	+ fix b fi
	+ assume "b \<in> B" and "fi \<in> f ` I"
	+ then obtain i where i: "fi = f i" "i \<in> I"
	+ by blast
	+ obtain a where a: "a \<in> A" "f a = b"
	+ using \<open>b \<in> B\<close> fepi.surjective by blast
	+ then show "multB b fi \<in> f ` I"
	+ by (metis IA.additive.submonoid_axioms IA.lideal(1) \<open>fi = f i\<close> \<open>i \<in> I\<close> fepi.multiplicative.commutes_with_composition image_iff submonoid.sub)
	+ qed
	+ qed
	+qed
	+
	+
	+lemma im_of_max_lideal_is_max:
	+ assumes I: "max_lideal I A addA multA zeroA oneA"
	+ and f: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "max_lideal (f ` I) B addB multB zeroB oneB"
	+proof -
	+ interpret maxI: max_lideal I A addA multA zeroA oneA
	+ using I by blast
	+ interpret fiso: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using f by force
	+ interpret fIB: lideal "f ` I" B addB multB zeroB oneB
	+ proof intro_locales
	+ show "submonoid_axioms (f ` I) B addB zeroB"
	+ proof
	+ show "addB a b \<in> f ` I"
	+ if "a \<in> f ` I" "b \<in> f ` I" for a b
	+ using that
	+ by (clarsimp simp: image_iff) (metis fiso.additive.commutes_with_composition maxI.additive.sub maxI.additive.sub_composition_closed)
	+ qed (use fiso.additive.commutes_with_unit in auto)
	+ then show "Group_Theory.monoid (f ` I) addB zeroB"
	+ using fiso.target.additive.monoid_axioms
	+ unfolding submonoid_axioms_def monoid_def
	+ by (meson subsetD)
	+ then show "Group_Theory.group_axioms (f ` I) addB zeroB"
	+ apply (clarsimp simp: Group_Theory.group_axioms_def image_iff monoid.invertible_def)
	+ by (metis fiso.additive.commutes_with_composition fiso.additive.commutes_with_unit maxI.additive.sub maxI.additive.sub.invertible maxI.additive.sub.invertible_def)
	+ have "\<And>r x. \<lbrakk>r \<in> B; x \<in> I\<rbrakk> \<Longrightarrow> \<exists>xa\<in>I. multB r (f x) = f xa"
	+ by (metis (no_types, lifting) fiso.multiplicative.commutes_with_composition fiso.surjective image_iff maxI.additive.sub maxI.lideal)
	+ then show "lideal_axioms (f ` I) B multB"
	+ by (force intro!: lideal_axioms.intro)
	+ qed
	+ show ?thesis
	+ proof unfold_locales
	+ show "f ` I \<noteq> B"
	+ using maxI.neq_ring fiso.bijective maxI.additive.submonoid_axioms
	+ unfolding submonoid_axioms_def submonoid_def
	+ by (metis bij_betw_imp_inj_on fiso.surjective inj_on_image_eq_iff subset_iff)
	+ next
	+ fix J
	+ assume "lideal J B addB multB zeroB oneB" and "J \<noteq> B" and fim: "f ` I \<subseteq> J"
	+ then interpret JB: lideal J B addB multB zeroB oneB
	+ by blast
	+ have \<section>: "lideal (f \<^sup>\<inverse> A J) A addA multA zeroA oneA"
	+ proof intro_locales
	+ show sma: "submonoid_axioms (f \<^sup>\<inverse> A J) A addA zeroA"
	+ proof
	+ show "addA a b \<in> f \<^sup>\<inverse> A J" if "a \<in> f \<^sup>\<inverse> A J" and "b \<in> f \<^sup>\<inverse> A J" for a b
	+ using that
	+ apply clarsimp
	+ using JB.additive.sub_composition_closed fiso.additive.commutes_with_composition by presburger
	+ qed blast+
	+ show "Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA"
	+ by (smt (verit, ccfv_threshold) Group_Theory.monoid.intro IntD2 sma maxI.additive.associative maxI.additive.left_unit maxI.additive.right_unit submonoid_axioms_def)
	+ show "Group_Theory.group_axioms (f \<^sup>\<inverse> A J) addA zeroA"
	+ proof
	+ fix x
	+ assume "x \<in> f \<^sup>\<inverse> A J"
	+ then show "monoid.invertible (f \<^sup>\<inverse> A J) addA zeroA x"
	+ apply clarify
	+ by (smt (verit, best) JB.additive.sub.invertible JB.additive.submonoid_inverse_closed IntI \<open>Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA\<close> fiso.additive.invertible_commutes_with_inverse maxI.additive.inverse_equality maxI.additive.invertible maxI.additive.invertibleE monoid.invertible_def vimageI)
	+ qed
	+ show "lideal_axioms (f \<^sup>\<inverse> A J) A multA"
	+ proof
	+ fix a j
	+ assume \<section>: "a \<in> A" "j \<in> f \<^sup>\<inverse> A J"
	+ then show "multA a j \<in> f \<^sup>\<inverse> A J"
	+ using JB.lideal(1) fiso.map_closed fiso.multiplicative.commutes_with_composition
	+ by simp
	+ qed
	+ qed
	+ have "I = f \<^sup>\<inverse> A J"
	+ proof (rule maxI.is_max [OF \<section>])
	+ show "f \<^sup>\<inverse> A J \<noteq> A"
	+ using JB.additive.sub \<open>J \<noteq> B\<close> fiso.surjective by blast
	+ show "I \<subseteq> f \<^sup>\<inverse> A J"
	+ by (meson fim image_subset_iff_subset_vimage inf_greatest maxI.additive.sub subset_iff)
	+ qed
	+ then have "J \<subseteq> f ` I"
	+ using JB.additive.sub fiso.surjective by blast
	+ with fim show "f ` I = J" ..
	+ qed
	+qed
	+
	+lemma im_of_max_ideal_is_max:
	+ assumes I: "max_ideal A I addA multA zeroA oneA"
	+ and f: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "max_ideal B (f ` I) addB multB zeroB oneB"
	+proof -
	+ interpret maxI: max_ideal A I addA multA zeroA oneA
	+ using I by blast
	+ interpret fiso: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using f by force
	+ interpret fIB: ideal "f ` I" B addB multB zeroB oneB
	+ using maxI.ideal_axioms fiso.ring_homomorphism_axioms
	+ by (meson fiso.ring_epimorphism_axioms im_of_ideal_is_ideal)
	+ show ?thesis
	+ proof intro_locales
	+ show "comm_ring_axioms B multB"
	+ proof
	+ fix b1 b2
	+ assume "b1 \<in> B" and "b2 \<in> B"
	+ then obtain a1 a2 where a1: "a1 \<in> A" "f a1 = b1" and a2: "a2 \<in> A" "f a2 = b2"
	+ using fiso.surjective by blast
	+ then have "multA a1 a2 = multA a2 a1"
	+ using maxI.comm_mult by presburger
	+ then show "multB b1 b2 = multB b2 b1"
	+ by (metis a1 a2 fiso.multiplicative.commutes_with_composition)
	+ qed
	+ show "max_ideal_axioms B (f ` I) addB multB zeroB oneB"
	+ proof
	+ obtain i where "i \<in> A" "i \<notin> I"
	+ using maxI.neq_ring by blast
	+ then have "f i \<notin> f ` I"
	+ unfolding image_iff
	+ by (metis fiso.injective inj_on_def maxI.additive.sub)
	+ then show "f ` I \<noteq> B"
	+ using \<open>i \<in> A\<close> fiso.map_closed by blast
	+ next
	+ fix J
	+ assume "ideal J B addB multB zeroB oneB" and "J \<noteq> B" and fim: "f ` I \<subseteq> J"
	+ then interpret JB: ideal J B addB multB zeroB oneB
	+ by blast
	+ have \<section>: "ideal (f \<^sup>\<inverse> A J) A addA multA zeroA oneA"
	+ proof intro_locales
	+ show sma: "submonoid_axioms (f \<^sup>\<inverse> A J) A addA zeroA"
	+ proof
	+ show "addA a b \<in> f \<^sup>\<inverse> A J" if "a \<in> f \<^sup>\<inverse> A J" and "b \<in> f \<^sup>\<inverse> A J" for a b
	+ using that
	+ apply clarsimp
	+ using JB.additive.sub_composition_closed fiso.additive.commutes_with_composition by presburger
	+ qed blast+
	+ show "Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA"
	+ by (smt (verit, ccfv_threshold) Group_Theory.monoid.intro IntD2 sma maxI.additive.associative maxI.additive.left_unit maxI.additive.right_unit submonoid_axioms_def)
	+ show "Group_Theory.group_axioms (f \<^sup>\<inverse> A J) addA zeroA"
	+ proof
	+ fix x
	+ assume "x \<in> f \<^sup>\<inverse> A J"
	+ then show "monoid.invertible (f \<^sup>\<inverse> A J) addA zeroA x"
	+ apply clarify
	+ by (smt (verit, best) JB.additive.sub.invertible JB.additive.submonoid_inverse_closed IntI \<open>Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA\<close> fiso.additive.invertible_commutes_with_inverse maxI.additive.inverse_equality maxI.additive.invertible maxI.additive.invertibleE monoid.invertible_def vimageI)
	+ qed
	+ show "ideal_axioms (f \<^sup>\<inverse> A J) A multA"
	+ proof
	+ fix a j
	+ assume \<section>: "a \<in> A" "j \<in> f \<^sup>\<inverse> A J"
	+ then show "multA a j \<in> f \<^sup>\<inverse> A J"
	+ using JB.ideal(1) fiso.map_closed fiso.multiplicative.commutes_with_composition
	+ by simp
	+ then show "multA j a \<in> f \<^sup>\<inverse> A J"
	+ by (metis Int_iff \<section> maxI.comm_mult)
	+ qed
	+ qed
	+ have "I = f \<^sup>\<inverse> A J"
	+ by (metis "\<section>" JB.additive.sub \<open>J \<noteq> B\<close> fim fiso.surjective image_subset_iff_subset_vimage
	+ le_inf_iff maxI.is_max maxI.psubset_ring psubsetE subsetI subset_antisym)
	+ then show "f ` I = J"
	+ using JB.additive.sub fiso.surjective
	+ by blast
	+ qed
	+ qed
	+qed
	+
	+
	+lemma preim_of_ideal_is_ideal:
	+ fixes f :: "'a\<Rightarrow>'b"
	+ assumes J: "ideal J B addB multB zeroB oneB"
	+ and "ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "ideal (f\<^sup>\<inverse> A J) A addA multA zeroA oneA"
	+proof -
	+ interpret JB: ideal J B addB multB zeroB oneB
	+ using J by blast
	+ interpret f: ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using assms by force
	+ interpret preB: ring "f \<^sup>\<inverse> A B" addA multA zeroA oneA
	+ using f.ring_preimage by blast
	+ show ?thesis
	+ proof intro_locales
	+ show "submonoid_axioms (f \<^sup>\<inverse> A J) A addA zeroA"
	+ by (auto simp add: submonoid_axioms_def f.additive.commutes_with_composition f.additive.commutes_with_unit)
	+ then show grp_fAJ: "Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA"
	+ by (auto simp: submonoid_axioms_def Group_Theory.monoid_def)
	+ show "Group_Theory.group_axioms (f \<^sup>\<inverse> A J) addA zeroA"
	+ unfolding group_def
	+ proof
	+ fix x
	+ assume x: "x \<in> f \<^sup>\<inverse> A J"
	+ then have "f x \<in> J" "x \<in> A"
	+ by auto
	+ then obtain v where "f v \<in> J \<and> v \<in> A \<and> addA x v = zeroA"
	+ by (metis JB.additive.sub.invertible JB.additive.submonoid_inverse_closed f.additive.invertible_commutes_with_inverse
	+ f.source.additive.invertible f.source.additive.invertible_inverse_closed f.source.additive.invertible_right_inverse)
	+ then show "monoid.invertible (f \<^sup>\<inverse> A J) addA zeroA x"
	+ by (metis Int_iff f.source.additive.commutative grp_fAJ monoid.invertibleI vimageI x)
	+ qed
	+ show "ideal_axioms (f \<^sup>\<inverse> A J) A multA"
	+ proof
	+ fix a j
	+ assume \<section>: "a \<in> A" "j \<in> f \<^sup>\<inverse> A J"
	+ then show "multA j a \<in> f \<^sup>\<inverse> A J" "multA a j \<in> f \<^sup>\<inverse> A J"
	+ using JB.ideal f.map_closed f.multiplicative.commutes_with_composition by force+
	+ qed
	+ qed
	+qed
	+
	+lemma preim_of_max_ideal_is_max:
	+ fixes f:: "'a \<Rightarrow> 'b"
	+ assumes J: "max_ideal B J addB multB zeroB oneB"
	+ and f: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "max_ideal A (f\<^sup>\<inverse> A J) addA multA zeroA oneA"
	+proof -
	+ interpret maxJ: max_ideal B J addB multB zeroB oneB
	+ using J by blast
	+ interpret fiso: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using f by force
	+ interpret fAJ: ideal "f\<^sup>\<inverse> A J" A addA multA zeroA oneA
	+ using maxJ.ideal_axioms fiso.ring_homomorphism_axioms by (blast intro: preim_of_ideal_is_ideal)
	+ show ?thesis
	+ proof intro_locales
	+ show "comm_ring_axioms A multA"
	+ proof
	+ fix a b
	+ assume "a \<in> A" and "b \<in> A"
	+ then have "multB (f a) (f b) = multB (f b) (f a)"
	+ using fiso.map_closed maxJ.comm_mult by presburger
	+ then show "multA a b = multA b a"
	+ by (metis bij_betw_iff_bijections \<open>a \<in> A\<close> \<open>b \<in> A\<close> fiso.bijective fiso.multiplicative.commutes_with_composition fiso.source.multiplicative.composition_closed)
	+ qed
	+ show "max_ideal_axioms A (f \<^sup>\<inverse> A J) addA multA zeroA oneA"
	+ proof
	+ show "f \<^sup>\<inverse> A J \<noteq> A"
	+ using fiso.surjective maxJ.additive.sub maxJ.neq_ring by blast
	+ fix I
	+ assume "ideal I A addA multA zeroA oneA"
	+ and "I \<noteq> A" and "f \<^sup>\<inverse> A J \<subseteq> I"
	+ then interpret IA: ideal I A addA multA zeroA oneA
	+ by blast
	+ have mon_fI: "Group_Theory.monoid (f ` I) addB zeroB"
	+ proof
	+ fix a b
	+ assume "a \<in> f ` I" "b \<in> f ` I"
	+ then show "addB a b \<in> f ` I"
	+ unfolding image_iff
	+ by (metis IA.additive.sub IA.additive.sub_composition_closed fiso.additive.commutes_with_composition)
	+ next
	+ show "zeroB \<in> f ` I"
	+ using fiso.additive.commutes_with_unit by blast
	+ qed blast+
	+ have ideal_fI: "ideal (f ` I) B addB multB zeroB oneB"
	+ proof
	+ show "f ` I \<subseteq> B"
	+ by blast
	+ show "zeroB \<in> f ` I"
	+ using fiso.additive.commutes_with_unit by blast
	+ next
	+ fix a b
	+ assume "a \<in> f ` I" and "b \<in> f ` I"
	+ then show "addB a b \<in> f ` I"
	+ unfolding image_iff
	+ by (metis IA.additive.sub IA.additive.sub_composition_closed fiso.additive.commutes_with_composition)
	+ next
	+ fix b
	+ assume "b \<in> f ` I"
	+ then obtain i where i: "b = f i" "i \<in> I"
	+ by blast
	+ then obtain j where "addA i j = zeroA" "j \<in> I"
	+ by (meson IA.additive.sub.invertible IA.additive.sub.invertibleE)
	+ then have "addB b (f j) = zeroB"
	+ by (metis IA.additive.sub i fiso.additive.commutes_with_composition fiso.additive.commutes_with_unit)
	+ then show "monoid.invertible (f ` I) addB zeroB b"
	+ by (metis IA.additive.sub i \<open>j \<in> I\<close> fiso.map_closed imageI maxJ.additive.commutative mon_fI monoid.invertibleI)
	+ next
	+ fix a b
	+ assume "a \<in> B" and "b \<in> f ` I"
	+ with IA.ideal show "multB a b \<in> f ` I" "multB b a \<in> f ` I"
	+ by (smt (verit, best) IA.additive.sub fiso.multiplicative.commutes_with_composition fiso.surjective image_iff)+
	+ qed blast+
	+ have "J = f ` I"
	+ proof (rule maxJ.is_max [OF ideal_fI])
	+ show "f ` I \<noteq> B"
	+ by (metis IA.additive.sub \<open>I \<noteq> A\<close> fiso.injective fiso.surjective inj_on_image_eq_iff subsetI)
	+ show "J \<subseteq> f ` I"
	+ unfolding image_def
	+ apply clarify
	+ by (smt (verit, ccfv_threshold) Int_iff \<open>f \<^sup>\<inverse> A J \<subseteq> I\<close> fiso.surjective imageE maxJ.additive.sub subset_eq vimageI)
	+ qed
	+ then show "f \<^sup>\<inverse> A J = I"
	+ using \<open>f \<^sup>\<inverse> A J \<subseteq> I\<close> by blast
	+ qed
	+ qed
	+qed
	+
	+lemma preim_of_lideal_is_lideal:
	+ assumes "lideal I B addB multB zeroB oneB"
	+ and "ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "lideal (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
	+proof -
	+ interpret A: ring A addA multA zeroA oneA
	+ by (meson assms ring_homomorphism_def)
	+ interpret B: ring B addB multB zeroB oneB
	+ by (meson assms ring_homomorphism_def)
	+ interpret f: ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using assms by blast
	+ interpret preB: ring "f \<^sup>\<inverse> A B" addA multA zeroA oneA
	+ using f.ring_preimage by blast
	+ interpret IB: lideal I B addB multB zeroB oneB
	+ by (simp add: assms)
	+ show ?thesis
	+ proof intro_locales
	+ show "submonoid_axioms (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA zeroA"
	+ by (auto simp add: submonoid_axioms_def f.additive.commutes_with_composition f.additive.commutes_with_unit)
	+ have "(A.additive.inverse u) \<in> f \<^sup>\<inverse> A I" if "f u \<in> I" and "u \<in> A" for u
	+ proof -
	+ have "f (A.additive.inverse u) = B.additive.inverse (f u)"
	+ using A.additive.invertible f.additive.invertible_commutes_with_inverse that by presburger
	+ then show ?thesis
	+ using A.additive.invertible_inverse_closed that by blast
	+ qed
	+ moreover have "addA (A.additive.inverse u) u = zeroA" "addA u (A.additive.inverse u) = zeroA" if "u \<in> A" for u
	+ by (auto simp add: that)
	+ moreover
	+ show "Group_Theory.monoid (f \<^sup>\<inverse> A I) addA zeroA"
	+ by (auto simp: monoid_def f.additive.commutes_with_composition f.additive.commutes_with_unit)
	+ ultimately show "Group_Theory.group_axioms (f \<^sup>\<inverse> A I) addA zeroA"
	+ unfolding group_axioms_def by (metis IntE monoid.invertibleI vimage_eq)
	+ show "lideal_axioms (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) multA"
	+ unfolding lideal_axioms_def
	+ using IB.lideal f.map_closed f.multiplicative.commutes_with_composition by force
	+ qed
	+qed
	+
	+lemma preim_of_max_lideal_is_max:
	+ assumes "max_lideal I B addB multB zeroB oneB"
	+ and "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "max_lideal (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
	+proof -
	+ interpret f: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ using assms by blast
	+ interpret MI: max_lideal I B addB multB zeroB oneB
	+ by (simp add: assms)
	+ interpret pre: lideal "f \<^sup>\<inverse> A I" "f \<^sup>\<inverse> A B" addA multA zeroA oneA
	+ by (meson preim_of_lideal_is_lideal MI.lideal_axioms f.ring_homomorphism_axioms)
	+ show ?thesis
	+ proof intro_locales
	+ show "max_lideal_axioms (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
	+ proof
	+ show "f \<^sup>\<inverse> A I \<noteq> f \<^sup>\<inverse> A B"
	+ using MI.neq_ring MI.subset f.surjective by blast
	+ fix \<aa>
	+ assume "lideal \<aa> (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
	+ and "\<aa> \<noteq> f \<^sup>\<inverse> A B"
	+ and "f \<^sup>\<inverse> A I \<subseteq> \<aa>"
	+ then interpret lideal \<aa> "f \<^sup>\<inverse> A B" addA multA zeroA oneA
	+ by metis
	+ have "f ` \<aa> \<noteq> B"
	+ by (metis Int_absorb1 \<open>\<aa> \<noteq> f \<^sup>\<inverse> A B\<close> f.injective f.surjective image_subset_iff_subset_vimage inj_on_image_eq_iff subset subset_iff)
	+ moreover have "I \<subseteq> f ` \<aa>"
	+ by (smt (verit, ccfv_threshold) Int_iff MI.subset \<open>f \<^sup>\<inverse> A I \<subseteq> \<aa>\<close> f.surjective image_iff subset_iff vimageI)
	+ moreover have "lideal (f ` \<aa>) B addB multB zeroB oneB"
	+ by (metis f.multiplicative.image.subset f.ring_epimorphism_axioms im_of_lideal_is_lideal image_subset_iff_subset_vimage inf.orderE inf_sup_aci(1) lideal_axioms)
	+ ultimately show "f \<^sup>\<inverse> A I = \<aa>"
	+ by (metis MI.is_max \<open>f \<^sup>\<inverse> A I \<subseteq> \<aa>\<close> image_subset_iff_subset_vimage le_inf_iff subset subset_antisym)
	+ qed
	+ qed
	+qed
	+
	+lemma isomorphic_to_local_is_local:
	+ assumes lring: "local_ring B addB multB zeroB oneB"
	+ and iso: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "local_ring A addA multA zeroA oneA"
	+proof intro_locales
	+ interpret ring A addA multA zeroA oneA
	+ by (meson iso ring_homomorphism.axioms(2) ring_isomorphism.axioms(1))
	+
	+ show "Group_Theory.monoid A addA zeroA"
	+ by (simp add: additive.monoid_axioms)
	+ show "Group_Theory.group_axioms A addA zeroA"
	+ by (meson Group_Theory.group_def additive.group_axioms)
	+ show "commutative_monoid_axioms A addA"
	+ by (simp add: additive.commutative commutative_monoid_axioms_def)
	+ show "Group_Theory.monoid A multA oneA"
	+ by (simp add: multiplicative.monoid_axioms)
	+ show "ring_axioms A addA multA"
	+ by (meson local.ring_axioms ring.axioms(3))
	+ have hom: "monoid_homomorphism f A multA oneA B multB oneB"
	+ by (meson iso ring_homomorphism_def ring_isomorphism.axioms(1))
	+ have "bij_betw f A B"
	+ using iso map.graph
	+ by (simp add: bijective.bijective ring_isomorphism_def bijective_map_def)
	+ show "local_ring_axioms A addA multA zeroA oneA"
	+ proof
	+ fix I J
	+ assume I: "max_lideal I A addA multA zeroA oneA" and J: "max_lideal J A addA multA zeroA oneA"
	+ show "I = J"
	+ proof-
	+ have "max_lideal (f ` I) B addB multB zeroB oneB"
	+ by (meson I im_of_max_lideal_is_max iso)
	+ moreover have "max_lideal (f ` J) B addB multB zeroB oneB"
	+ by (meson J im_of_max_lideal_is_max iso)
	+ ultimately have "f ` I = f ` J"
	+ by (meson local_ring.is_unique lring)
	+ thus ?thesis
	+ using bij_betw_imp_inj_on [OF \<open>bij_betw f A B\<close>]
	+ by (meson I J inj_on_image_eq_iff lideal.subset max_lideal.axioms(1))
	+ qed
	+ next
	+ show "\<exists>\<ww>. max_lideal \<ww> A addA multA zeroA oneA"
	+ by (meson im_of_max_lideal_is_max iso local_ring.has_max_lideal lring ring_isomorphism.inverse_ring_isomorphism)
	+ qed
	+qed
	+
	+
	+(* ex. 0.40 *)
	+lemma (in pr_ideal) local_ring_at_is_local:
	+ shows "local_ring carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at"
	+proof-
	+ interpret cq: quotient_ring "R\<setminus>I" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ by (simp add: Comm_Ring.quotient_ring_def comm.comm_ring_axioms submonoid_pr_ideal)
	+ define \<ww> where "\<ww> \<equiv> {quotient_ring.frac (R\<setminus>I) R (+) (\<cdot>) \<zero> r s\| r s. r \<in> I \<and> s \<in> (R \<setminus> I)}"
	+ \<comment>\<open>Now every proper ideal of @{term "R\<setminus>I"} is included in @{term \<ww>}, and the result follows trivially\<close>
	+ have maximal: "\<aa> \<subseteq> \<ww>"
	+ if "lideal \<aa> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at"
	+ and ne: "\<aa> \<noteq> carrier_local_ring_at" for \<aa>
	+ proof
	+ fix x
	+ interpret \<aa>: lideal \<aa> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at
	+ using that by blast
	+ assume "x \<in> \<aa>"
	+ have "False" if "x \<notin> \<ww>"
	+ proof -
	+ obtain r s where "r \<in> R" "s \<in> R" "s \<notin> I" "r \<notin> I" "x = cq.frac r s"
	+ using frac_from_carrier_local \<open>x \<in> \<aa>\<close> \<open>x \<notin> \<ww>\<close> [unfolded \<ww>_def, simplified]
	+ by (metis \<aa>.additive.sub)
	+ then have sr: "cq.frac s r \<in> carrier_local_ring_at"
	+ by (simp add: \<open>r \<in> R\<close> \<open>s \<in> R\<close> carrier_local_ring_at_def)
	+ have [simp]: "r \<cdot> s \<notin> I"
	+ using \<open>r \<in> R\<close> \<open>r \<notin> I\<close> \<open>s \<in> R\<close> \<open>s \<notin> I\<close> absorbent by blast
	+ have "one_local_ring_at = cq.frac \<one> \<one>"
	+ by (simp add: one_local_ring_at_def cq.one_rel_def)
	+ also have "... = cq.frac (s \<cdot> r) (r \<cdot> s)"
	+ using \<open>r \<in> R\<close> \<open>r \<notin> I\<close> \<open>s \<in> R\<close> \<open>s \<notin> I\<close>
	+ by (intro cq.frac_eqI [of \<one>]) (auto simp: comm.comm_mult)
	+ also have "... = cq.mult_rel (cq.frac s r) (cq.frac r s)"
	+ using \<open>r \<in> R\<close> \<open>r \<notin> I\<close> \<open>s \<in> R\<close> \<open>s \<notin> I\<close> by (simp add: cq.mult_rel_frac)
	+ also have "\<dots> = mult_local_ring_at (cq.frac s r) (cq.frac r s)"
	+ using mult_local_ring_at_def by force
	+ also have "... \<in> \<aa>"
	+ using \<aa>.lideal \<open>x = cq.frac r s\<close> \<open>x \<in> \<aa>\<close> sr by blast
	+ finally have "one_local_ring_at \<in> \<aa>" .
	+ thus ?thesis
	+ using ne \<aa>.has_one_imp_equal by force
	+ qed
	+ thus "x \<in> \<ww>" by auto
	+ qed
	+ have uminus_closed: "uminus_local_ring_at u \<in> \<ww>" if "u \<in> \<ww>" for u
	+ using that by (force simp: \<ww>_def cq.uminus_rel_frac uminus_local_ring_at_def)
	+ have add_closed: "add_local_ring_at a b \<in> \<ww>" if "a \<in> \<ww>" "b \<in> \<ww>" for a b
	+ proof -
	+ obtain ra sa rb sb where ab: "a = cq.frac ra sa" "b = cq.frac rb sb"
	+ and "ra \<in> I" "rb \<in> I" "sa \<in> R" "sa \<notin> I" "sb \<in> R" "sb \<notin> I"
	+ using \<open>a \<in> \<ww>\<close> \<open>b \<in> \<ww>\<close> by (auto simp: \<ww>_def)
	+ then have "add_local_ring_at (cq.frac ra sa) (cq.frac rb sb) = cq.frac (ra \<cdot> sb + rb \<cdot> sa) (sa \<cdot> sb)"
	+ by (force simp add: cq.add_rel_frac add_local_ring_at_def)
	+ moreover have "ra \<cdot> sb + rb \<cdot> sa \<in> I"
	+ by (simp add: \<open>ra \<in> I\<close> \<open>rb \<in> I\<close> \<open>sa \<in> R\<close> \<open>sb \<in> R\<close> ideal(2))
	+ ultimately show ?thesis
	+ unfolding \<ww>_def using \<open>sa \<in> R\<close> \<open>sa \<notin> I\<close> \<open>sb \<in> R\<close> \<open>sb \<notin> I\<close> ab absorbent by blast
	+ qed
	+ interpret \<ww>: lideal \<ww> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at
	+ proof intro_locales
	+ show subm: "submonoid_axioms \<ww> carrier_local_ring_at add_local_ring_at zero_local_ring_at"
	+ proof
	+ show "\<ww> \<subseteq> carrier_local_ring_at"
	+ using \<ww>_def comm.comm_ring_axioms comm.frac_in_carrier_local comm_ring.spectrum_def pr_ideal_axioms by fastforce
	+ show "zero_local_ring_at \<in> \<ww>"
	+ using \<ww>_def comm.spectrum_def comm.spectrum_imp_cxt_quotient_ring not_1 pr_ideal_axioms quotient_ring.zero_rel_def zero_local_ring_at_def by fastforce
	+ qed (auto simp: add_closed)
	+ show mon: "Group_Theory.monoid \<ww> add_local_ring_at zero_local_ring_at"
	+ proof
	+ show "zero_local_ring_at \<in> \<ww>"
	+ by (meson subm submonoid_axioms_def)
	+ next
	+ fix a b c
	+ assume "a \<in> \<ww>" "b \<in> \<ww>" "c \<in> \<ww>"
	+ then show "add_local_ring_at (add_local_ring_at a b) c = add_local_ring_at a (add_local_ring_at b c)"
	+ by (meson additive.associative in_mono subm submonoid_axioms_def)
	+ next
	+ fix a assume "a \<in> \<ww>"
	+ show "add_local_ring_at zero_local_ring_at a = a"
	+ by (meson \<open>a \<in> \<ww>\<close> subm additive.left_unit in_mono submonoid_axioms_def)
	+ show "add_local_ring_at a zero_local_ring_at = a"
	+ by (meson \<open>a \<in> \<ww>\<close> additive.right_unit in_mono subm submonoid_axioms_def)
	+ qed (auto simp: add_closed)
	+ show "Group_Theory.group_axioms \<ww> add_local_ring_at zero_local_ring_at"
	+ proof unfold_locales
	+ fix u
	+ assume "u \<in> \<ww>"
	+ show "monoid.invertible \<ww> add_local_ring_at zero_local_ring_at u"
	+ proof (rule monoid.invertibleI [OF mon])
	+ show "add_local_ring_at u (uminus_local_ring_at u) = zero_local_ring_at"
	+ using \<open>u \<in> \<ww>\<close>
	+ apply (clarsimp simp add: \<ww>_def add_local_ring_at_def zero_local_ring_at_def uminus_local_ring_at_def)
	+ by (metis Diff_iff additive.submonoid_axioms cq.add_minus_zero_rel cq.valid_frac_def submonoid.sub)
	+ then show "add_local_ring_at (uminus_local_ring_at u) u = zero_local_ring_at"
	+ using subm unfolding submonoid_axioms_def
	+ by (simp add: \<open>u \<in> \<ww>\<close> additive.commutative subset_iff uminus_closed)
	+ qed (use \<open>u \<in> \<ww>\<close> uminus_closed in auto)
	+ qed
	+ show "lideal_axioms \<ww> carrier_local_ring_at mult_local_ring_at"
	+ proof
	+ fix a b
	+ assume a: "a \<in> carrier_local_ring_at"
	+ then obtain ra sa where a: "a = cq.frac ra sa" and "ra \<in> R" and sa: "sa \<in> R" "sa \<notin> I"
	+ by (meson frac_from_carrier_local)
	+ then have "a \<in> carrier_local_ring_at"
	+ by (simp add: comm.frac_in_carrier_local comm.spectrum_def pr_ideal_axioms)
	+ assume "b \<in> \<ww>"
	+ then obtain rb sb where b: "b = cq.frac rb sb" and "rb \<in> I" and sb: "sb \<in> R" "sb \<notin> I"
	+ using \<ww>_def by blast
	+ have "cq.mult_rel (cq.frac ra sa) (cq.frac rb sb) = cq.frac (ra \<cdot> rb) (sa \<cdot> sb)"
	+ using \<open>ra \<in> R\<close> sa \<open>rb \<in> I\<close> sb
	+ by (force simp: cq.mult_rel_frac)
	+ then show "mult_local_ring_at a b \<in> \<ww>"
	+ apply (clarsimp simp add: mult_local_ring_at_def \<ww>_def a b)
	+ by (metis Diff_iff \<open>ra \<in> R\<close> \<open>rb \<in> I\<close> cq.sub_composition_closed ideal(1) sa sb)
	+ qed
	+ qed
	+ have max: "max_lideal \<ww> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at"
	+ proof
	+ have False
	+ if "s \<in> R\<setminus>I" "r \<in> I" and eq: "cq.frac \<one> \<one> = cq.frac r s" for r s
	+ using that eq_from_eq_frac [OF eq] \<open>r \<in> I\<close> comm.additive.abelian_group_axioms
	+ unfolding abelian_group_def
	+ by (metis Diff_iff absorbent additive.sub comm.additive.cancel_imp_equal comm.inverse_distributive(1) comm.multiplicative.composition_closed cq.sub_unit_closed ideal(1))
	+ then have "cq.frac \<one> \<one> \<notin> \<ww>"
	+ using \<ww>_def by blast
	+ moreover have "cq.frac \<one> \<one> \<in> carrier_local_ring_at"
	+ using carrier_local_ring_at_def cq.multiplicative.unit_closed cq.one_rel_def by force
	+ ultimately show "\<ww> \<noteq> carrier_local_ring_at"
	+ by blast
	+ qed (use maximal in blast)
	+ have "\<And>J. max_lideal J carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at
	+\<Longrightarrow> J = \<ww>"
	+ by (metis maximal max max_lideal.axioms(1) max_lideal.is_max max_lideal.neq_ring)
	+ with max show ?thesis
	+ by (metis local.ring_axioms local_ring_axioms_def local_ring_def)
	+qed
	+
	+definition (in stalk) is_local:: "'a set \<Rightarrow> bool" where
	+"is_local U \<equiv> local_ring carrier_stalk add_stalk mult_stalk (zero_stalk U) (one_stalk U)"
	+
	+(* def. 0.41 *)
	+locale local_ring_morphism =
	+source: local_ring A "(+)" "(\<cdot>)" \<zero> \<one> + target: local_ring B "(+')" "(\<cdot>')" "\<zero>'" "\<one>'"
	++ ring_homomorphism f A "(+)" "(\<cdot>)" "\<zero>" "\<one>" B "(+')" "(\<cdot>')" "\<zero>'" "\<one>'"
	+for f and
	+A and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and unit ("\<one>") and
	+B and addition' (infixl "+''" 65) and multiplication' (infixl "\<cdot>''" 70) and zero' ("\<zero>''") and unit' ("\<one>''")
	++ assumes preimage_of_max_lideal:
	+"\<And>\<ww>\<^sub>A \<ww>\<^sub>B. max_lideal \<ww>\<^sub>A A (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> max_lideal \<ww>\<^sub>B B (+') (\<cdot>') \<zero>' \<one>' \<Longrightarrow> (f\<^sup>\<inverse> A \<ww>\<^sub>B) = \<ww>\<^sub>A"
	+
	+lemma id_is_local_ring_morphism:
	+ assumes "local_ring A add mult zero one"
	+ shows "local_ring_morphism (identity A) A add mult zero one A add mult zero one"
	+proof -
	+ interpret local_ring A add mult zero one
	+ by (simp add: assms)
	+ show ?thesis
	+ proof intro_locales
	+ show "Set_Theory.map (identity A) A A"
	+ by (simp add: Set_Theory.map_def)
	+ show "monoid_homomorphism_axioms (identity A) A add zero add zero"
	+ by (simp add: monoid_homomorphism_axioms_def)
	+ show "monoid_homomorphism_axioms (identity A) A mult one mult one"
	+ by (simp add: monoid_homomorphism_axioms_def)
	+ show "local_ring_morphism_axioms (identity A) A add mult zero one A add mult zero one"
	+ proof
	+ fix \<ww>\<^sub>A \<ww>\<^sub>B
	+ assume "max_lideal \<ww>\<^sub>A A add mult zero one" "max_lideal \<ww>\<^sub>B A add mult zero one"
	+ then have "\<ww>\<^sub>B \<inter> A = \<ww>\<^sub>A"
	+ by (metis Int_absorb2 is_unique lideal.subset max_lideal.axioms(1))
	+ then show "identity A \<^sup>\<inverse> A \<ww>\<^sub>B = \<ww>\<^sub>A"
	+ by (simp add: preimage_identity_self)
	+ qed
	+ qed
	+qed
	+
	+lemma (in ring_epimorphism) preim_subset_imp_subset:
	+ assumes "\<eta> \<^sup>\<inverse> R I \<subseteq> \<eta> \<^sup>\<inverse> R J" and "I \<subseteq> R'"
	+ shows "I \<subseteq> J"
	+ using Int_absorb1 assms surjective
	+ by blast
	+
	+
	+lemma iso_is_local_ring_morphism:
	+ assumes "local_ring A addA multA zeroA oneA"
	+ and "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ shows "local_ring_morphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+proof -
	+ interpret A: local_ring A addA multA zeroA oneA
	+ using assms(1) by blast
	+ interpret B: ring B addB multB zeroB oneB
	+ by (meson assms(2) ring_homomorphism_def ring_isomorphism_def)
	+ interpret f: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ by (simp add: assms)
	+ interpret preB: ring "f \<^sup>\<inverse> A B" addA multA zeroA oneA
	+ by (metis (no_types) A.ring_axioms f.multiplicative.image.subset image_subset_iff_subset_vimage inf.absorb2)
	+ show ?thesis
	+ proof
	+ fix I J
	+ assume "max_lideal I B addB multB zeroB oneB"
	+ then interpret MI: max_lideal I B addB multB zeroB oneB
	+ by simp
	+ assume "max_lideal J B addB multB zeroB oneB"
	+ then interpret MJ: max_lideal J B addB multB zeroB oneB
	+ by simp
	+ interpret GI: subgroup I B addB zeroB
	+ by unfold_locales
	+ have "max_lideal (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
	+ by (metis (no_types) MI.max_lideal_axioms f.ring_isomorphism_axioms preim_of_max_lideal_is_max)
	+ moreover have "max_lideal (f \<^sup>\<inverse> A J) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
	+ by (meson MJ.max_lideal_axioms f.ring_isomorphism_axioms preim_of_max_lideal_is_max)
	+ ultimately have "f \<^sup>\<inverse> A I = f \<^sup>\<inverse> A J"
	+ by (metis A.is_unique Int_absorb1 f.multiplicative.image.subset image_subset_iff_subset_vimage)
	+ then show "I = J"
	+ by (metis MI.lideal_axioms MI.neq_ring MJ.max_lideal_axioms MJ.subset f.preim_subset_imp_subset max_lideal.is_max subset_refl)
	+ next
	+ show "\<exists>\<ww>. max_lideal \<ww> B addB multB zeroB oneB"
	+ by (meson A.has_max_lideal assms(2) im_of_max_lideal_is_max)
	+ next
	+ fix \<ww>\<^sub>A \<ww>\<^sub>B
	+ assume "max_lideal \<ww>\<^sub>A A addA multA zeroA oneA"
	+ and "max_lideal \<ww>\<^sub>B B addB multB zeroB oneB"
	+ then show "f \<^sup>\<inverse> A \<ww>\<^sub>B = \<ww>\<^sub>A"
	+ by (metis A.is_unique f.multiplicative.image.subset f.ring_isomorphism_axioms image_subset_iff_subset_vimage inf.absorb2 preim_of_max_lideal_is_max)
	+ qed
	+qed
	+
	+(these epimorphism aren't actually used)
	+lemma (in monoid_homomorphism) monoid_epimorphism_image:
	+ "monoid_epimorphism \<eta> M (\<cdot>) \<one> (\<eta> ` M) (\<cdot>') \<one>'"
	+proof -
	+ interpret monoid "\<eta> ` M" "(\<cdot>')" "\<one>'"
	+ using image.sub.monoid_axioms by force
	+ show ?thesis
	+ proof qed (auto simp: bij_betw_def commutes_with_unit commutes_with_composition)
	+qed
	+
	+lemma (in group_homomorphism) group_epimorphism_image:
	+ "group_epimorphism \<eta> G (\<cdot>) \<one> (\<eta> ` G) (\<cdot>') \<one>'"
	+proof -
	+ interpret group "\<eta> ` G" "(\<cdot>')" "\<one>'"
	+ using image.sub.group_axioms by blast
	+ show ?thesis
	+ proof qed (auto simp: bij_betw_def commutes_with_composition)
	+qed
	+
	+lemma (in ring_homomorphism) ring_epimorphism_preimage:
	+ "ring_epimorphism \<eta> R (+) (\<cdot>) \<zero> \<one> (\<eta> ` R) (+') (\<cdot>') \<zero>' \<one>'"
	+proof -
	+ interpret ring "\<eta> ` R" "(+')" "(\<cdot>')" "\<zero>'" "\<one>'"
	+ proof qed (auto simp add: target.distributive target.additive.commutative)
	+ show ?thesis
	+ proof qed (auto simp: additive.commutes_with_composition additive.commutes_with_unit
	+ multiplicative.commutes_with_composition multiplicative.commutes_with_unit)
	+qed
	+
	+lemma comp_of_local_ring_morphisms:
	+ assumes "local_ring_morphism f A addA multA zeroA oneA B addB multB zeroB oneB"
	+ and "local_ring_morphism g B addB multB zeroB oneB C addC multC zeroC oneC"
	+ shows "local_ring_morphism (compose A g f) A addA multA zeroA oneA C addC multC zeroC oneC"
	+proof -
	+ interpret f: local_ring_morphism f A addA multA zeroA oneA B addB multB zeroB oneB
	+ by (simp add: assms)
	+ interpret g: local_ring_morphism g B addB multB zeroB oneB C addC multC zeroC oneC
	+ by (simp add: assms)
	+ interpret gf: ring_homomorphism "compose A g f" A addA multA zeroA oneA C addC multC zeroC oneC
	+ using comp_ring_morphisms f.ring_homomorphism_axioms g.ring_homomorphism_axioms
	+ by fastforce
	+ obtain \<ww>\<^sub>B where \<ww>\<^sub>B: "max_lideal \<ww>\<^sub>B B addB multB zeroB oneB"
	+ using f.target.has_max_lideal by force
	+ show ?thesis
	+ proof intro_locales
	+ show "local_ring_morphism_axioms (compose A g f) A addA multA zeroA oneA C addC multC zeroC oneC"
	+ proof
	+ fix \<ww>\<^sub>A \<ww>\<^sub>C
	+ assume max: "max_lideal \<ww>\<^sub>A A addA multA zeroA oneA"
	+ "max_lideal \<ww>\<^sub>C C addC multC zeroC oneC"
	+ interpret maxA: max_lideal \<ww>\<^sub>A A addA multA zeroA oneA
	+ using max by blast
	+ interpret maxC: max_lideal \<ww>\<^sub>C C addC multC zeroC oneC
	+ using max by blast
	+ have "B \<subseteq> g -` C"
	+ by blast
	+ with max interpret maxg: max_lideal "g \<^sup>\<inverse> B \<ww>\<^sub>C" "g \<^sup>\<inverse> B C" addB multB zeroB oneB
	+ by (metis Int_absorb1 \<ww>\<^sub>B g.preimage_of_max_lideal)
	+ interpret maxgf: Group_Theory.monoid "(g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C" addA zeroA
	+ by (simp add: monoid_def vimage_def gf.additive.commutes_with_composition
	+ gf.additive.commutes_with_unit f.source.additive.associative)
	+ show "(g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C = \<ww>\<^sub>A"
	+ proof (rule maxA.is_max [symmetric])
	+ show "lideal ((g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C) A addA multA zeroA oneA"
	+ proof
	+ fix u
	+ assume u: "u \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
	+ then have "u \<in> A"
	+ by auto
	+ show "maxgf.invertible u"
	+ proof (rule maxgf.invertibleI)
	+ show "addA u (f.source.additive.inverse u) = zeroA"
	+ using f.source.additive.invertible_right_inverse \<open>u \<in> A\<close> by blast
	+ have "(g \<circ> f \<down> A) (f.source.additive.inverse u) = g.target.additive.inverse (g (f u))"
	+ by (metis f.source.additive.invertible \<open>u \<in> A\<close> compose_eq
	+ gf.additive.invertible_commutes_with_inverse)
	+ then show "(f.source.additive.inverse u) \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
	+ by (metis f.source.additive.invertible f.source.additive.invertible_inverse_closed
	+ g.target.additive.group_axioms Int_iff compose_eq
	+ maxC.additive.subgroup_inverse_iff f.map_closed g.map_axioms group.invertible
	+ map.map_closed u vimage_eq)
	+ qed (use u \<open>u \<in> A\<close> in auto)
	+ next
	+ fix r a
	+ assume "r \<in> A" and "a \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
	+ then show "multA r a \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
	+ by (simp add: maxC.lideal gf.multiplicative.commutes_with_composition)
	+ qed (use maxgf.unit_closed maxgf.composition_closed in auto)
	+ show "(g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C \<noteq> A"
	+ by (metis f.source.multiplicative.unit_closed f.target.multiplicative.unit_closed Int_iff
	+ compose_eq f.multiplicative.commutes_with_unit maxg.has_one_imp_equal maxg.neq_ring
	+ vimage_eq)
	+ show "\<ww>\<^sub>A \<subseteq> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
	+ apply clarsimp
	+ using f.preimage_of_max_lideal g.preimage_of_max_lideal \<ww>\<^sub>B
	+ by (metis IntD1 maxA.additive.sub compose_eq max vimageD)
	+ qed
	+ qed
	+ qed
	+qed
	+
	+subsubsection \<open>Locally Ringed Spaces\<close>
	+
	+(* The key map from the stalk at a prime ideal \<pp> to the local ring at \<pp> *)
	+locale key_map = comm_ring +
	+ fixes \<pp>:: "'a set" assumes is_prime: "\<pp> \<in> Spec"
	+begin
	+
	+interpretation pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ by (simp add: is_prime spectrum_imp_pr)
	+
	+interpretation top: topological_space Spec is_zariski_open
	+
	+ by simp
	+
	+interpretation pr:presheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms
	+ \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
	+ by (fact local.sheaf_spec_is_presheaf)
	+
	+interpretation local:quotient_ring "(R \<setminus> \<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
	+ using is_prime spectrum_imp_cxt_quotient_ring by presburger
	+
	+interpretation st: stalk "Spec" is_zariski_open sheaf_spec sheaf_spec_morphisms
	+\<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec "{U. is_zariski_open U \<and> \<pp>\<in>U}" \<pp>
	+proof
	+ fix U I V s
	+ assume "open_cover_of_open_subset Spec is_zariski_open U I V"
	+ and "\<And>i. i \<in> I \<Longrightarrow> V i \<subseteq> U"
	+ and "s \<in> \<O> U"
	+ and "\<And>i. i \<in> I \<Longrightarrow> sheaf_spec_morphisms U (V i) s = zero_sheaf_spec (V i)"
	+ then show "s = zero_sheaf_spec U"
	+ by (metis sheaf_of_rings.locality sheaf_spec_is_sheaf)
	+next
	+fix U I V s
	+ assume "open_cover_of_open_subset Spec is_zariski_open U I V"
	+ and "\<forall>i. i \<in> I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> \<O> V i"
	+ and "\<And>i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> sheaf_spec_morphisms (V i) (V i \<inter> V j) (s i) = sheaf_spec_morphisms (V j) (V i \<inter> V j) (s j)"
	+ then show "\<exists>t. t \<in> \<O> U \<and> (\<forall>i. i \<in> I \<longrightarrow> sheaf_spec_morphisms U (V i) t = s i)"
	+ by (smt (verit, ccfv_threshold) sheaf_of_rings.glueing sheaf_spec_is_sheaf)
	+qed (use is_prime in auto)
	+
	+declare st.subset_of_opens [simp del, rule del] \<comment>\<open>because it loops!\<close>
	+
	+definition key_map:: "'a set set \<Rightarrow> (('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a \<times> 'a) set)"
	+ where "key_map U \<equiv> \<lambda>s\<in>(\<O> U). s \<pp>"
	+
	+lemma key_map_is_map:
	+ assumes "\<pp> \<in> U"
	+ shows "Set_Theory.map (key_map U) (\<O> U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+proof
	+ have "\<And>s. s \<in> \<O> U \<Longrightarrow> s \<pp> \<in> (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ using sheaf_spec_def assms is_regular_def by blast
	+ thus "key_map U \<in> (\<O> U) \<rightarrow>\<^sub>E (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ using key_map_def extensional_funcset_def by simp
	+qed
	+
	+lemma key_map_is_ring_morphism:
	+ assumes "\<pp> \<in> U" and "is_zariski_open U"
	+ shows "ring_homomorphism (key_map U)
	+(\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+proof (intro ring_homomorphism.intro)
	+ show "Set_Theory.map (key_map U) (\<O> U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)" using key_map_is_map assms(1) by simp
	+next
	+ show "ring (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)"
	+ using \<open>is_zariski_open U\<close> pr.is_ring_from_is_homomorphism by blast
	+next
	+ show "ring (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+ by (simp add: pi.ring_axioms)
	+next
	+ show "group_homomorphism (key_map U) (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.zero_local_ring_at)"
	+ proof intro_locales
	+ show "Set_Theory.map (local.key_map U) (\<O> U) pi.carrier_local_ring_at"
	+ by (simp add: assms(1) key_map_is_map)
	+ show "Group_Theory.monoid (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
	+ "Group_Theory.group_axioms (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
	+ using pr.is_ring_from_is_homomorphism [OF \<open>is_zariski_open U\<close>]
	+ unfolding ring_def Group_Theory.group_def abelian_group_def
	+ by blast+
	+ have 1: "(key_map U) (zero_sheaf_spec U) = pi.zero_local_ring_at"
	+ using assms
	+ unfolding key_map_def pi.zero_local_ring_at_def
	+ by (metis (no_types, lifting) restrict_apply' zero_sheaf_spec_def zero_sheaf_spec_in_sheaf_spec)
	+ have 2: "\<And>x y. \<lbrakk>x \<in> \<O> U; y \<in> \<O> U\<rbrakk> \<Longrightarrow>
	+ (key_map U) (add_sheaf_spec U x y) = pi.add_local_ring_at (key_map U x) (key_map U y)"
	+ using add_sheaf_spec_in_sheaf_spec key_map_def assms pi.add_local_ring_at_def
	+ add_sheaf_spec_def spectrum_def zariski_open_is_subset
	+ by fastforce
	+ show "monoid_homomorphism_axioms (local.key_map U) (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U) pi.add_local_ring_at pi.zero_local_ring_at"
	+ unfolding monoid_homomorphism_axioms_def
	+ by (auto simp: 1 2)
	+ qed
	+next
	+ have "(key_map U) (one_sheaf_spec U) = pi.one_local_ring_at"
	+ using one_sheaf_spec_def key_map_def pi.one_local_ring_at_def assms one_sheaf_spec_in_sheaf_spec spectrum_def by fastforce
	+ moreover have "\<And>x y. \<lbrakk>x \<in> \<O> U; y \<in> \<O> U\<rbrakk> \<Longrightarrow>
	+ (key_map U) (mult_sheaf_spec U x y) = pi.mult_local_ring_at (key_map U x) (key_map U y)"
	+ using mult_sheaf_spec_in_sheaf_spec key_map_def assms pi.mult_local_ring_at_def
	+ mult_sheaf_spec_def spectrum_def zariski_open_is_subset by fastforce
	+ ultimately show "monoid_homomorphism (key_map U) (\<O> U) (mult_sheaf_spec U) (one_sheaf_spec U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.mult_local_ring_at) (pi.one_local_ring_at)"
	+ using pr.is_ring_from_is_homomorphism [OF \<open>is_zariski_open U\<close>] \<open>\<pp> \<in> U\<close>
	+ unfolding monoid_homomorphism_def monoid_homomorphism_axioms_def ring_def
	+ using key_map_is_map pi.multiplicative.monoid_axioms by presburger
	+qed
	+
	+lemma key_map_is_coherent:
	+ assumes "V \<subseteq> U" and "is_zariski_open U" and "is_zariski_open V" and "\<pp> \<in> V" and "s \<in> \<O> U"
	+ shows "(key_map V \<circ> sheaf_spec_morphisms U V) s = key_map U s"
	+proof-
	+ have "sheaf_spec_morphisms U V s \<in> \<O> V"
	+ using assms sheaf_spec_morphisms_are_maps map.map_closed
	+ by (metis (mono_tags, hide_lams))
	+ thus "(key_map V \<circ> sheaf_spec_morphisms U V) s = key_map U s"
	+ by (simp add: \<open>s \<in> \<O> U\<close> assms(4) key_map_def sheaf_spec_morphisms_def)
	+qed
	+
	+lemma key_ring_morphism:
	+ assumes "is_zariski_open V" and "\<pp> \<in> V"
	+ shows "\<exists>\<phi>. ring_homomorphism \<phi>
	+st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)
	+\<and>
	+(\<forall>U\<in>(top.neighborhoods \<pp>). \<forall>s\<in>\<O> U. (\<phi> \<circ> st.canonical_fun U) s = key_map U s)"
	+proof -
	+ have "ring (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+ by (simp add: pi.ring_axioms)
	+ moreover have "V \<in> top.neighborhoods \<pp>"
	+ using assms top.neighborhoods_def sheaf_spec_is_presheaf by fastforce
	+ moreover have "\<And>U. U \<in> top.neighborhoods \<pp> \<Longrightarrow>
	+ ring_homomorphism (key_map U)
	+(\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+ using key_map_is_ring_morphism top.neighborhoods_def sheaf_spec_is_presheaf by force
	+ moreover have "\<And>U V x. \<lbrakk>U \<in> top.neighborhoods \<pp>; V \<in> top.neighborhoods \<pp>; V \<subseteq> U; x \<in> \<O> U\<rbrakk>
	+ \<Longrightarrow> (key_map V \<circ> sheaf_spec_morphisms U V) x = key_map U x"
	+ using key_map_is_coherent
	+ by (metis (no_types, lifting) mem_Collect_eq top.neighborhoods_def)
	+ ultimately show ?thesis
	+ using assms local.sheaf_spec_is_presheaf zariski_open_is_subset
	+ st.universal_property_for_stalk[of "R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" "pi.add_local_ring_at" "pi.mult_local_ring_at"
	+ "pi.zero_local_ring_at" "pi.one_local_ring_at" "key_map"]
	+ by auto
	+qed
	+
	+lemma class_from_belongs_stalk:
	+ assumes "s \<in> st.carrier_stalk"
	+ obtains U s' where "is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "s = st.class_of U s'"
	+proof -
	+ interpret dl: direct_lim Spec is_zariski_open sheaf_spec sheaf_spec_morphisms "\<O>b"
	+ add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec "top.neighborhoods \<pp>"
	+ by (simp add: st.direct_lim_axioms top.neighborhoods_def)
	+ interpret eq: equivalence "Sigma (top.neighborhoods \<pp>) sheaf_spec" "{(x, y). dl.rel x y}"
	+ using dl.rel_is_equivalence by force
	+ note dl.subset_of_opens [simp del]
	+ obtain U s' where seq: "s = eq.Class (U, s')" and U: "U \<in> top.neighborhoods \<pp>" and s': "s' \<in> \<O> U"
	+ using assms
	+ unfolding st.carrier_stalk_def dl.carrier_direct_lim_def
	+ by (metis SigmaD1 SigmaD2 eq.representant_exists old.prod.exhaust)
	+ show thesis
	+ proof
	+ show "is_zariski_open U"
	+ using U dl.subset_of_opens by blast
	+ show "\<pp> \<in> U"
	+ using U top.neighborhoods_def by force
	+ show "s' \<in> \<O> U"
	+ using s' by blast
	+ show "s = st.class_of U s'"
	+ using seq st.class_of_def top.neighborhoods_def by presburger
	+ qed
	+qed
	+
	+lemma same_class_from_restrict:
	+ assumes "is_zariski_open U" "is_zariski_open V" "U \<subseteq> V" "s \<in> \<O> V" "\<pp> \<in> U"
	+ shows "st.class_of V s = st.class_of U (sheaf_spec_morphisms V U s)"
	+proof -
	+ interpret eq: equivalence "Sigma {U. is_zariski_open U \<and> \<pp> \<in> U} sheaf_spec" "{(x, y). st.rel x y}"
	+ using st.rel_is_equivalence by blast
	+ show ?thesis
	+ unfolding st.class_of_def
	+ proof (rule eq.Class_eq)
	+ have \<section>:"sheaf_spec_morphisms V U s \<in> \<O> U"
	+ using assms map.map_closed pr.is_map_from_is_homomorphism by fastforce
	+ then have "\<exists>W. is_zariski_open W \<and> \<pp> \<in> W \<and> W \<subseteq> V \<and> W \<subseteq> U \<and> sheaf_spec_morphisms V W s = sheaf_spec_morphisms U W (sheaf_spec_morphisms V U s)"
	+ using assms(1) assms(3) assms(5) by auto
	+ then show "((V, s), U, sheaf_spec_morphisms V U s) \<in> {(x, y). st.rel x y}"
	+ using \<section> assms by (auto simp: st.rel_def)
	+ qed
	+qed
	+
	+lemma shrinking_from_belong_stalk:
	+ assumes "s \<in> st.carrier_stalk" and "t \<in> st.carrier_stalk"
	+ obtains U s' t' where "is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "s = st.class_of U s'"
	+ "t' \<in> \<O> U" "t = st.class_of U t'"
	+proof -
	+ obtain U s' where HU:"is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "s = st.class_of U s'"
	+ using assms(1) class_from_belongs_stalk by blast
	+ obtain V t' where HV:"is_zariski_open V" "\<pp> \<in> V" "t' \<in> \<O> V" "t = st.class_of V t'"
	+ using assms(2) class_from_belongs_stalk by blast
	+ show thesis
	+ proof
	+ have "U \<inter> V \<subseteq> Spec"
	+ using zariski_open_is_subset HU(1) by blast
	+ show "\<pp> \<in> U \<inter> V"
	+ by (simp add: \<open>\<pp> \<in> U\<close> \<open>\<pp> \<in> V\<close>)
	+ show UV: "is_zariski_open (U \<inter> V)" using topological_space.open_inter
	+ by (simp add: \<open>is_zariski_open U\<close> \<open>is_zariski_open V\<close>)
	+ show "s = st.class_of (U \<inter> V) (sheaf_spec_morphisms U (U \<inter> V) s')"
	+ using HU UV \<open>\<pp> \<in> U \<inter> V\<close> same_class_from_restrict by blast
	+ show "t = st.class_of (U \<inter> V) (sheaf_spec_morphisms V (U \<inter> V) t')"
	+ using HV UV \<open>\<pp> \<in> U \<inter> V\<close> same_class_from_restrict by blast
	+ show "sheaf_spec_morphisms U (U \<inter> V) s' \<in> \<O> (U \<inter> V)"
	+ using HU(3) UV map.map_closed sheaf_spec_morphisms_are_maps by fastforce
	+ show "sheaf_spec_morphisms V (U \<inter> V) t' \<in> \<O> (U \<inter> V)"
	+ using HV(3) UV map.map_closed sheaf_spec_morphisms_are_maps by fastforce
	+ qed
	+qed
	+
	+
	+lemma stalk_at_prime_is_iso_to_local_ring_at_prime_aux:
	+ assumes "is_zariski_open V" and "\<pp> \<in> V" and
	+ \<phi>: "ring_homomorphism \<phi>
	+ st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+ and all_eq: "\<forall>U\<in>(top.neighborhoods \<pp>). \<forall>s\<in>\<O> U. (\<phi> \<circ> st.canonical_fun U) s = key_map U s"
	+ shows "ring_isomorphism \<phi>
	+st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+proof (intro ring_isomorphism.intro bijective_map.intro bijective.intro)
	+ show "ring_homomorphism \<phi>
	+st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+ using assms(3) by simp
	+next
	+ show "Set_Theory.map \<phi> st.carrier_stalk (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ using assms(3) by (simp add: ring_homomorphism_def)
	+next
	+ show "bij_betw \<phi> st.carrier_stalk (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ proof-
	+ have "inj_on \<phi> st.carrier_stalk"
	+ proof
	+ fix s t assume "s \<in> st.carrier_stalk" "t \<in> st.carrier_stalk" "\<phi> s = \<phi> t"
	+ obtain U s' t' a f b g where FU [simp]: "is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "t' \<in> \<O> U"
	+ and s: "s = st.class_of U s'" "t = st.class_of U t'"
	+ and s': "s' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f)"
	+ and t': "t' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g)"
	+ and "a \<in> R" "b \<in> R" "f \<in> R" "g \<in> R" "f \<notin> \<pp>" "g \<notin> \<pp>"
	+ proof-
	+ obtain V s' t' where HV: "s = st.class_of V s'" "t = st.class_of V t'"
	+ "s' \<in> \<O> V" "t' \<in> \<O> V" "is_zariski_open V" "\<pp> \<in> V"
	+ using shrinking_from_belong_stalk by (metis (no_types, lifting) \<open>s \<in> st.carrier_stalk\<close> \<open>t \<in> st.carrier_stalk\<close>)
	+ then obtain U a f b g where HU: "is_zariski_open U" "U \<subseteq> V" "\<pp> \<in> U" "a \<in> R" "f \<in> R" "b \<in> R" "g \<in> R"
	+ "f \<notin> \<pp>" "g \<notin> \<pp>"
	+ "\<And>\<qq>. \<qq> \<in> U \<Longrightarrow> f \<notin> \<qq> \<and> s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
	+ "\<And>\<qq>. \<qq> \<in> U \<Longrightarrow> g \<notin> \<qq> \<and> t' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
	+ using shrinking[of V \<pp> s' t'] by blast
	+ show ?thesis
	+ proof
	+ show "sheaf_spec_morphisms V U s' \<in> \<O> U"
	+ by (metis (mono_tags, hide_lams) HU(1,2) HV(3) map.map_closed sheaf_spec_morphisms_are_maps)
	+ show "sheaf_spec_morphisms V U t' \<in> \<O> U"
	+ by (metis (mono_tags, hide_lams) HU(1,2) HV(4) map.map_closed sheaf_spec_morphisms_are_maps)
	+ show "s = st.class_of U (sheaf_spec_morphisms V U s')"
	+ by (simp add: HU(1-3) HV same_class_from_restrict)
	+ show "t = st.class_of U (sheaf_spec_morphisms V U t')"
	+ by (simp add: HU(1-3) HV same_class_from_restrict)
	+ show "sheaf_spec_morphisms V U s' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f)"
	+ using HV(3) sheaf_spec_morphisms_def HU(10) by fastforce
	+ show "sheaf_spec_morphisms V U t' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g)"
	+ using HV(4) HU(11) sheaf_spec_morphisms_def by fastforce
	+ qed (use HU in auto)
	+ qed
	+ hence fact:"local.frac a f = local.frac b g"
	+ proof-
	+ have "local.frac a f = key_map U s'"
	+ using key_map_def \<open>\<pp> \<in> U\<close> \<open>s' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f)\<close> \<open>s' \<in> \<O> U\<close> by auto
	+ also have "\<dots> = \<phi> (st.canonical_fun U s')"
	+ using \<open>\<pp> \<in> U\<close> \<open>is_zariski_open U\<close> \<open>s' \<in> \<O> U\<close> assms(4) pr.presheaf_of_rings_axioms top.neighborhoods_def by fastforce
	+ also have "\<dots> = \<phi> (st.class_of U s')" using direct_lim.canonical_fun_def is_prime st.canonical_fun_def st.class_of_def by fastforce
	+ also have "\<dots> = \<phi> s" by (simp add: \<open>s = st.class_of U s'\<close>)
	+ also have "\<dots> = \<phi> t" using \<open>\<phi> s = \<phi> t\<close> by simp
	+ also have "\<dots> = \<phi> (st.class_of U t')" using \<open>t = st.class_of U t'\<close> by auto
	+ also have "\<dots> = \<phi> (st.canonical_fun U t')"
	+ using direct_lim.canonical_fun_def is_prime st.canonical_fun_def st.class_of_def by fastforce
	+ also have "\<dots> = key_map U t'"
	+ using \<open>\<pp> \<in> U\<close> \<open>is_zariski_open U\<close> \<open>t' \<in> \<O> U\<close> assms(4) top.neighborhoods_def by auto
	+ also have "\<dots> = local.frac b g"
	+ using FU(4) local.key_map_def t' by force
	+ finally show ?thesis .
	+ qed
	+ then obtain h where Hh: "h \<in> R" "h \<notin> \<pp>" "h \<cdot> (g \<cdot> a - f \<cdot> b) = \<zero>"
	+ using pi.eq_from_eq_frac by (metis Diff_iff \<open>a \<in> R\<close> \<open>b \<in> R\<close> \<open>f \<in> R\<close> \<open>f \<notin> \<pp>\<close> \<open>g \<in> R\<close> \<open>g \<notin> \<pp>\<close>)
	+ have izo: "is_zariski_open (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h))"
	+ using local.standard_open_is_zariski_open
	+ by (simp add: Hh(1) \<open>f \<in> R\<close> \<open>g \<in> R\<close> standard_open_is_zariski_open)
	+ have ssm_s': "sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s'
	+ \<in> \<O> (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h))"
	+ by (metis (no_types, hide_lams) FU(3) Int_assoc inf_le1 izo map.map_closed sheaf_spec_morphisms_are_maps)
	+ have ssm_t': "sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t'
	+ \<in> \<O> (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h))"
	+ by (metis (no_types, hide_lams) FU(4) Int_assoc inf_le1 izo map.map_closed sheaf_spec_morphisms_are_maps) have [simp]: "\<pp> \<in> \<D>(f)" "\<pp> \<in> \<D>(g)" "\<pp> \<in> \<D>(h)"
	+ using Hh \<open>f \<in> R\<close> \<open>f \<notin> \<pp>\<close> \<open>g \<in> R\<close> \<open>g \<notin> \<pp>\<close> belongs_standard_open_iff st.is_elem by blast+
	+ have eq: "s' \<qq> = t' \<qq>" if "\<qq> \<in> U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)" for \<qq>
	+ proof -
	+ have "\<qq> \<in> Spec"
	+ using standard_open_def that by auto
	+ then interpret q: quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
	+ using spectrum_imp_cxt_quotient_ring by force
	+ note local.q.sub [simp del] \<comment>\<open>Because it definitely loops\<close>
	+ define RR where "RR \<equiv> {(x, y). (x, y) \<in> (R \<times> (R\<setminus>\<qq>)) \<times> R \<times> (R\<setminus>\<qq>) \<and> q.rel x y}"
	+ interpret eq: equivalence "R \<times> (R\<setminus>\<qq>)" "RR"
	+ unfolding RR_def by (blast intro: equivalence.intro q.rel_refl q.rel_sym q.rel_trans)
	+ have Fq [simp]: "f \<notin> \<qq>" "g \<notin> \<qq>" "h \<notin> \<qq>"
	+ using belongs_standard_open_iff that
	+ apply (meson Int_iff \<open>\<qq> \<in> Spec\<close> \<open>f \<in> R\<close>)
	+ apply (meson Int_iff \<open>\<qq> \<in> Spec\<close> \<open>g \<in> R\<close> belongs_standard_open_iff that)
	+ by (meson Hh(1) IntD2 \<open>\<qq> \<in> Spec\<close> belongs_standard_open_iff that)
	+ moreover have "eq.Class (a, f) = eq.Class (b, g)"
	+ proof (rule eq.Class_eq)
	+ have "\<exists>s1. s1 \<in> R \<and> s1 \<notin> \<qq> \<and> s1 \<cdot> (g \<cdot> a - f \<cdot> b) = \<zero>"
	+ using Hh \<open>h \<notin> \<qq>\<close> by blast
	+ then show "((a,f), b,g) \<in> RR"
	+ by (simp add: RR_def q.rel_def \<open>a \<in> R\<close> \<open>b \<in> R\<close> \<open>f \<in> R\<close> \<open>g \<in> R\<close>)
	+ qed
	+ ultimately have "q.frac a f = q.frac b g"
	+ using RR_def q.frac_def by metis
	+ thus "s' \<qq> = t' \<qq>"
	+ by (simp add: s' t')
	+ qed
	+ show "s = t"
	+ proof-
	+ have "s = st.class_of (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s')"
	+ using \<open>\<pp> \<in> \<D>(f)\<close> \<open>\<pp> \<in> \<D>(g)\<close> \<open>\<pp> \<in> \<D>(h)\<close>
	+ by (smt (verit, ccfv_threshold) FU(1-3) IntE IntI izo s(1) same_class_from_restrict subsetI)
	+ also have "\<dots> = st.class_of (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t')"
	+ proof (rule local.st.class_of_eqI)
	+ show "sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s') = sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t')"
	+ proof (rule local.pr.eq_\<rho>)
	+ show "sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s') =
	+ sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t')"
	+ using eq FU(3) FU(4)
	+ apply (simp add: sheaf_spec_morphisms_def)
	+ apply (metis eq restrict_ext)
	+ done
	+ qed (use izo ssm_s' ssm_t' in auto)
	+ qed (auto simp: izo ssm_s' ssm_t')
	+ also have "\<dots> = t"
	+ using \<open>\<pp> \<in> \<D>(f)\<close> \<open>\<pp> \<in> \<D>(g)\<close> \<open>\<pp> \<in> \<D>(h)\<close>
	+ by (smt (verit, ccfv_threshold) FU(1-4) IntE IntI izo s(2) same_class_from_restrict subsetI)
	+ finally show ?thesis .
	+ qed
	+ qed
	+ moreover have "\<phi> ` st.carrier_stalk = (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ proof
	+ show "\<phi> ` st.carrier_stalk \<subseteq> pi.carrier_local_ring_at"
	+ using assms(3) by (simp add: image_subset_of_target ring_homomorphism_def)
	+ next
	+ show "pi.carrier_local_ring_at \<subseteq> \<phi> ` st.carrier_stalk"
	+ proof
	+ fix x assume H:"x \<in> (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
	+ obtain a f where F:"a \<in> R" "f \<in> R" "f \<notin> \<pp>" "x = local.frac a f"
	+ using pi.frac_from_carrier_local H by blast
	+ define s where sec_def:"s \<equiv> \<lambda>\<qq>\<in>\<D>(f). quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
	+ then have sec:"s \<in> \<O>(\<D>(f))"
	+ proof-
	+ have "s \<qq> \<in> (R\<^bsub>\<qq> (+) (\<cdot>) \<zero>\<^esub>)" if "\<qq> \<in> \<D>(f)" for \<qq>
	+ proof -
	+ have "f \<notin> \<qq>" using that belongs_standard_open_iff F(2) standard_open_is_subset by blast
	+ then have "quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f \<in> (R\<^bsub>\<qq> (+) (\<cdot>) \<zero>\<^esub>)"
	+ using F(1,2) frac_in_carrier_local \<open>\<qq> \<in> \<D>(f)\<close> standard_open_is_subset by blast
	+ thus "s \<qq> \<in> (R\<^bsub>\<qq> (+) (\<cdot>) \<zero>\<^esub>)" using sec_def by (simp add: \<open>\<qq> \<in> \<D>(f)\<close>)
	+ qed
	+ moreover have "s \<in> extensional (\<D>(f))"
	+ using sec_def by auto
	+ moreover have "is_regular s \<D>(f)"
	+ using F(1,2) standard_open_is_subset belongs_standard_open_iff is_regular_def[of s "\<D>(f)"] standard_open_is_zariski_open
	+ by (smt is_locally_frac_def restrict_apply sec_def subsetD subsetI)
	+ ultimately show ?thesis unfolding sheaf_spec_def[of "\<D>(f)"]
	+ by (simp add:PiE_iff)
	+ qed
	+ then have im:"\<phi> (st.class_of \<D>(f) s) = local.frac a f"
	+ proof-
	+ have "\<phi> (st.class_of \<D>(f) s) = \<phi> (st.canonical_fun \<D>(f) s)"
	+ using st.canonical_fun_def direct_lim.canonical_fun_def st.class_of_def is_prime by fastforce
	+ also have "\<dots> = key_map \<D>(f) s"
	+ using all_eq st.is_elem F(2) F(3) sec
	+ apply (simp add: top.neighborhoods_def)
	+ by (meson belongs_standard_open_iff standard_open_is_zariski_open)
	+ also have "... = local.frac a f"
	+ by (metis (mono_tags, lifting) F(2,3) belongs_standard_open_iff is_prime key_map_def restrict_apply sec sec_def)
	+ finally show ?thesis .
	+ qed
	+ thus "x \<in> \<phi> ` st.carrier_stalk"
	+ proof-
	+ have "st.class_of \<D>(f) s \<in> st.carrier_stalk"
	+ proof-
	+ have "\<pp> \<in> Spec" using is_prime by simp
	+ also have "\<D>(f) \<in> (top.neighborhoods \<pp>)"
	+ using top.neighborhoods_def belongs_standard_open_iff F(2,3) is_prime standard_open_is_zariski_open standard_open_is_subset
	+ by (metis (no_types, lifting) mem_Collect_eq)
	+ moreover have "s \<in> \<O> \<D>(f)" using sec by simp
	+ ultimately show ?thesis using st.class_of_in_stalk by auto
	+ qed
	+ thus ?thesis using F(4) im by blast
	+ qed
	+ qed
	+ qed
	+ ultimately show ?thesis by (simp add: bij_betw_def)
	+ qed
	+qed
	+
	+lemma stalk_at_prime_is_iso_to_local_ring_at_prime:
	+ assumes "is_zariski_open V" and "\<pp> \<in> V"
	+ shows "\<exists>\<phi>. ring_isomorphism \<phi>
	+st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
	+ using key_ring_morphism stalk_at_prime_is_iso_to_local_ring_at_prime_aux assms by meson
	+
	+end (* key_map *)
	+
	+(* def. 0.42 *)
	+locale locally_ringed_space = ringed_space +
	+ assumes stalks_are_local: "\<And>x U. x \<in> U \<Longrightarrow> is_open U \<Longrightarrow>
	+stalk.is_local is_open \<FF> \<rho> add_str mult_str zero_str one_str (neighborhoods x) x U"
	+
	+context comm_ring
	+begin
	+
	+interpretation pr: presheaf_of_rings "Spec" is_zariski_open sheaf_spec sheaf_spec_morphisms
	+ \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
	+ by (simp add: comm_ring.sheaf_spec_is_presheaf local.comm_ring_axioms)
	+
	+(* ex. 0.43 *)
	+lemma spec_is_locally_ringed_space:
	+ shows "locally_ringed_space Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+proof (intro locally_ringed_space.intro locally_ringed_space_axioms.intro)
	+ interpret sh: sheaf_of_rings Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec
	+ zero_sheaf_spec one_sheaf_spec
	+ using sheaf_spec_is_sheaf .
	+
	+ show "ringed_space Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
	+ using spec_is_ringed_space by simp
	+ show "stalk.is_local is_zariski_open sheaf_spec sheaf_spec_morphisms add_sheaf_spec mult_sheaf_spec
	+zero_sheaf_spec one_sheaf_spec (pr.neighborhoods \<pp>) \<pp> U"
	+ if "\<pp> \<in> U" "is_zariski_open U" for \<pp> U
	+ proof -
	+ interpret st: stalk Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec
	+ mult_sheaf_spec zero_sheaf_spec one_sheaf_spec "pr.neighborhoods \<pp>" \<pp>
	+ proof
	+ show "\<pp> \<in> Spec"
	+ by (meson in_mono that zariski_open_is_subset)
	+ qed (auto simp: pr.neighborhoods_def)
	+ interpret pri: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
	+ by (simp add: spectrum_imp_pr st.is_elem)
	+ interpret km: key_map R "(+)" "(\<cdot>)" \<zero> \<one> \<pp>
	+ proof qed (simp add: st.is_elem)
	+ have "ring st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk U) (st.one_stalk U)"
	+ using st.stalk_is_ring sheaf_spec_is_presheaf \<open>is_zariski_open U\<close> \<open>\<pp> \<in> U\<close> by blast
	+ also have "local_ring pri.carrier_local_ring_at pri.add_local_ring_at pri.mult_local_ring_at
	+ pri.zero_local_ring_at pri.one_local_ring_at"
	+ using pr_ideal.local_ring_at_is_local
	+ by (simp add: pr_ideal.local_ring_at_is_local spectrum_imp_pr st.is_elem)
	+ moreover
	+ note st.subset_of_opens [simp del]
	+ have "\<exists>f. ring_isomorphism f
	+st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk U) (st.one_stalk U)
	+(R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pr_ideal.add_local_ring_at R \<pp> (+) (\<cdot>) \<zero>) (pr_ideal.mult_local_ring_at R \<pp> (+) (\<cdot>) \<zero>) (pr_ideal.zero_local_ring_at R \<pp> (+) (\<cdot>) \<zero> \<one>) (pr_ideal.one_local_ring_at R \<pp> (+) (\<cdot>) \<zero> \<one>)"
	+ by (simp add: km.stalk_at_prime_is_iso_to_local_ring_at_prime st.index that)
	+ ultimately show "stalk.is_local is_zariski_open sheaf_spec sheaf_spec_morphisms add_sheaf_spec mult_sheaf_spec
	+zero_sheaf_spec one_sheaf_spec (pr.neighborhoods \<pp>) \<pp> U"
	+ using isomorphic_to_local_is_local \<open>\<pp> \<in> U\<close> \<open>is_zariski_open U\<close> st.is_local_def by fastforce
	+ qed
	+qed
	+
	+end (* comm_ring *)
	+
	+(* Construction 0.44: induced morphism between direct limits *)
	+locale ind_mor_btw_stalks = morphism_ringed_spaces +
	+ fixes x::"'a"
	+ assumes is_elem: "x \<in> X"
	+begin
	+
	+interpretation stx:stalk X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X b add_str\<^sub>X mult_str\<^sub>X zero_str\<^sub>X one_str\<^sub>X
	+ "{U. is_open\<^sub>X U \<and> x \<in> U}" "x"
	+proof qed (auto simp: is_elem)
	+
	+interpretation stfx: stalk Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
	+ "{U. is_open\<^sub>Y U \<and> (f x) \<in> U}" "f x"
	+proof qed (auto simp: is_elem)
	+
	+definition induced_morphism:: "('c set \<times> 'd) set \<Rightarrow> ('a set \<times> 'b) set" where
	+"induced_morphism \<equiv> \<lambda>C \<in> stfx.carrier_stalk. let r = (SOME r. r \<in> C) in stx.class_of (f\<^sup>\<inverse> X (fst r)) (\<phi>\<^sub>f (fst r) (snd r))"
	+
	+(* One should think of fst r as a V in index, and snd r as a d in \<O>\<^sub>Y V. *)
	+
	+lemma phi_in_O:
	+ assumes "is_open\<^sub>Y V" "q \<in> \<O>\<^sub>Y V"
	+ shows "\<phi>\<^sub>f V q \<in> \<O>\<^sub>X (f \<^sup>\<inverse> X (V))"
	+ using is_morphism_of_sheaves morphism_presheaves_of_rings.fam_morphisms_are_maps
	+ unfolding morphism_sheaves_of_rings_def
	+ by (metis assms local.im_sheaf_def map.map_closed)
	+
	+lemma induced_morphism_is_well_defined:
	+ assumes "stfx.rel (V,q) (V',q')"
	+ shows "stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V q) = stx.class_of (f\<^sup>\<inverse> X V') (\<phi>\<^sub>f V' q')"
	+proof -
	+ obtain W where W: "is_open\<^sub>Y W" "f x \<in> W" "W \<subseteq> V" "W \<subseteq> V'"
	+ and eq: "\<rho>\<^sub>Y V W q = \<rho>\<^sub>Y V' W q'"
	+ using assms stfx.rel_def by auto
	+ show ?thesis
	+ proof (rule stx.class_of_eqI)
	+ show "(f \<^sup>\<inverse> X V, \<phi>\<^sub>f V q) \<in> Sigma {U. is_open\<^sub>X U \<and> x \<in> U} \<O>\<^sub>X"
	+ using is_continuous phi_in_O assms stfx.rel_def stx.is_elem by auto
	+ show "(f \<^sup>\<inverse> X V', \<phi>\<^sub>f V' q') \<in> Sigma {U. is_open\<^sub>X U \<and> x \<in> U} \<O>\<^sub>X"
	+ using is_continuous phi_in_O assms stfx.rel_def stx.is_elem by auto
	+ show "f \<^sup>\<inverse> X W \<in> {U. is_open\<^sub>X U \<and> x \<in> U}"
	+ using W is_continuous stx.is_elem by auto
	+ show "f \<^sup>\<inverse> X W \<subseteq> f \<^sup>\<inverse> X V \<inter> f \<^sup>\<inverse> X V'"
	+ using W by blast
	+ interpret Y: morphism_sheaves_of_rings Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y
	+ d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
	+ local.im_sheaf im_sheaf_morphisms b
	+ add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf \<phi>\<^sub>f
	+ by (rule is_morphism_of_sheaves)
	+ have "\<rho>\<^sub>X (f\<^sup>\<inverse> X V) (f\<^sup>\<inverse> X W) (\<phi>\<^sub>f V q) = \<phi>\<^sub>f W (\<rho>\<^sub>Y V W q)"
	+ using assms Y.comm_diagrams W
	+ by (simp add: stfx.rel_def im_sheaf_morphisms_def o_def)
	+ also have "\<dots> = \<phi>\<^sub>f W (\<rho>\<^sub>Y V' W q')"
	+ by (simp add: eq)
	+ also have "\<dots> = \<rho>\<^sub>X (f\<^sup>\<inverse> X V') (f\<^sup>\<inverse> X W) (\<phi>\<^sub>f V' q')"
	+ using assms Y.comm_diagrams W
	+ by (simp add: stfx.rel_def im_sheaf_morphisms_def o_def)
	+ finally show "\<rho>\<^sub>X (f \<^sup>\<inverse> X V) (f \<^sup>\<inverse> X W) (\<phi>\<^sub>f V q) = \<rho>\<^sub>X (f \<^sup>\<inverse> X V') (f \<^sup>\<inverse> X W) (\<phi>\<^sub>f V' q')" .
	+ qed
	+qed
	+
	+lemma induced_morphism_eq:
	+ assumes "C \<in> stfx.carrier_stalk"
	+ obtains V q where "(V,q) \<in> C" "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V q)"
	+ by (metis (mono_tags, lifting) assms induced_morphism_def prod.exhaust_sel restrict_apply
	+ stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.rel_carrier_Eps_in(1))
	+
	+lemma induced_morphism_eval:
	+ assumes "C \<in> stfx.carrier_stalk" and "r \<in> C"
	+ shows "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X (fst r)) (\<phi>\<^sub>f (fst r) (snd r))"
	+ by (smt (verit, best) assms induced_morphism_eq induced_morphism_is_well_defined
	+ prod.exhaust_sel stfx.carrier_direct_limE stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.rel_I1)
	+
	+
	+proposition ring_homomorphism_induced_morphism:
	+ assumes "is_open\<^sub>Y V" and "f x \<in> V"
	+ shows "ring_homomorphism induced_morphism
	+stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk (stfx.zero_stalk V) (stfx.one_stalk V)
	+stx.carrier_stalk stx.add_stalk stx.mult_stalk (stx.zero_stalk (f\<^sup>\<inverse> X V)) (stx.one_stalk (f\<^sup>\<inverse> X V))"
	+proof intro_locales
	+ interpret phif: ring_homomorphism "\<phi>\<^sub>f V" "\<O>\<^sub>Y V"
	+ "add_str\<^sub>Y V" "mult_str\<^sub>Y V" "zero_str\<^sub>Y V" "one_str\<^sub>Y V" "local.im_sheaf V"
	+ "add_im_sheaf V" "mult_im_sheaf V" "zero_im_sheaf V" "one_im_sheaf V"
	+ by (metis assms(1) is_morphism_of_sheaves morphism_presheaves_of_rings.is_ring_morphism morphism_sheaves_of_rings_def)
	+ interpret V: ring stfx.carrier_direct_lim stfx.add_rel stfx.mult_rel "stfx.class_of V (zero_str\<^sub>Y V)"
	+ "stfx.class_of V (one_str\<^sub>Y V)"
	+ using assms stfx.direct_lim_is_ring by force
	+ interpret X: ring stx.carrier_direct_lim stx.add_rel stx.mult_rel "stx.class_of X (zero_str\<^sub>X X)"
	+ "stx.class_of X (one_str\<^sub>X X)"
	+ using stx.direct_lim_is_ring stx.is_elem by auto
	+ interpret dlY: direct_lim Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y
	+ mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y "target.neighborhoods (f x)"
	+ using stfx.direct_lim_axioms stfx.neighborhoods_eq by force
	+ interpret eqY: equivalence "Sigma {U. is_open\<^sub>Y U \<and> f x \<in> U} \<O>\<^sub>Y" "{(x, y). stfx.rel x y}"
	+ using stfx.rel_is_equivalence by blast
	+ interpret morphY: morphism_sheaves_of_rings Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y
	+ d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
	+ local.im_sheaf im_sheaf_morphisms b
	+ add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf \<phi>\<^sub>f
	+ by (rule is_morphism_of_sheaves)
	+
	+ have 0 [iff]: "stfx.zero_stalk V \<in> stfx.carrier_stalk"
	+ using stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.zero_stalk_def by auto
	+ have 1 [iff]: "stfx.one_stalk V \<in> stfx.carrier_stalk"
	+ using stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.one_stalk_def by auto
	+
	+ show "Set_Theory.map induced_morphism stfx.carrier_stalk stx.carrier_stalk"
	+ proof
	+ show "induced_morphism \<in> stfx.carrier_stalk \<rightarrow>\<^sub>E stx.carrier_stalk"
	+ proof
	+ fix C
	+ assume C: "C \<in> stfx.carrier_stalk"
	+ then obtain r where "r \<in> C"
	+ by (metis stfx.carrier_stalk_def stfx.rel_carrier_Eps_in(1) target.neighborhoods_def)
	+ moreover have "is_open\<^sub>X (f \<^sup>\<inverse> X (fst r))"
	+ by (metis (no_types, lifting) C SigmaD1 \<open>r \<in> C\<close> eqY.block_closed is_continuous prod.exhaust_sel stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.subset_of_opens)
	+ ultimately have "stx.class_of (f \<^sup>\<inverse> X (fst r)) (\<phi>\<^sub>f (fst r) (snd r)) \<in> stx.carrier_stalk"
	+ by (smt (verit, best) C IntI dlY.carrier_direct_limE mem_Collect_eq phi_in_O stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.rel_I1 stfx.rel_def stx.class_of_in_stalk stx.is_elem stx.neighborhoods_eq vimage_def)
	+ then show "induced_morphism C \<in> stx.carrier_stalk"
	+ using C \<open>r \<in> C\<close> induced_morphism_eval by presburger
	+ qed (simp add: induced_morphism_def)
	+ qed
	+ show "Group_Theory.monoid stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V)"
	+ by (simp add: V.additive.monoid_axioms stfx.add_stalk_def stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.zero_stalk_def)
	+ show "Group_Theory.group_axioms stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V)"
	+ using Group_Theory.group_def V.additive.group_axioms stfx.add_stalk_def stfx.carrier_stalk_def stfx.zero_stalk_def target.neighborhoods_def by fastforce
	+ show "commutative_monoid_axioms stfx.carrier_stalk stfx.add_stalk"
	+ using V.additive.commutative_monoid_axioms commutative_monoid_def stfx.add_stalk_def stfx.carrier_stalk_def target.neighborhoods_def by fastforce
	+ show "Group_Theory.monoid stfx.carrier_stalk stfx.mult_stalk (stfx.one_stalk V)"
	+ by (simp add: V.multiplicative.monoid_axioms stfx.carrier_stalk_def stfx.mult_stalk_def stfx.neighborhoods_eq stfx.one_stalk_def)
	+ show "ring_axioms stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk"
	+ by (metis (no_types, lifting) V.additive.unit_closed mem_Collect_eq ring_def stfx.carrier_direct_limE stfx.stalk_is_ring)
	+ show "Group_Theory.monoid stx.carrier_stalk stx.add_stalk (stx.zero_stalk (f \<^sup>\<inverse> X V))"
	+ using abelian_group_def assms commutative_monoid_def is_continuous ring_def stx.is_elem stx.stalk_is_ring by fastforce
	+ show "Group_Theory.group_axioms stx.carrier_stalk stx.add_stalk (stx.zero_stalk (f \<^sup>\<inverse> X V))"
	+ using Group_Theory.group_def abelian_group_def assms is_continuous ring_def stx.is_elem stx.stalk_is_ring by fastforce
	+ show "commutative_monoid_axioms stx.carrier_stalk stx.add_stalk"
	+ using X.additive.commutative_monoid_axioms commutative_monoid_def neighborhoods_def stx.add_stalk_def stx.carrier_stalk_def by fastforce
	+ show "Group_Theory.monoid stx.carrier_stalk stx.mult_stalk (stx.one_stalk (f \<^sup>\<inverse> X V))"
	+ using assms is_continuous ring_def stx.is_elem stx.stalk_is_ring by fastforce
	+ show "ring_axioms stx.carrier_stalk stx.add_stalk stx.mult_stalk"
	+ using X.ring_axioms ring_def stx.add_stalk_def stx.carrier_stalk_def stx.mult_stalk_def stx.neighborhoods_eq by fastforce
	+ show "monoid_homomorphism_axioms induced_morphism stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V) stx.add_stalk (stx.zero_stalk (f \<^sup>\<inverse> X V))"
	+ proof
	+ fix C C'
	+ assume CC: "C \<in> stfx.carrier_stalk" "C' \<in> stfx.carrier_stalk"
	+ show "induced_morphism (stfx.add_stalk C C') = stx.add_stalk (induced_morphism C) (induced_morphism C')"
	+ proof -
	+ obtain U q U' q' where Uq: "(U,q) \<in> C" "(U',q') \<in> C'"
	+ and eq: "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X U) (\<phi>\<^sub>f U q)"
	+ and eq': "induced_morphism C' = stx.class_of (f\<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q')"
	+ by (metis (no_types, lifting) CC induced_morphism_eq)
	+ then obtain cc [simp]: "is_open\<^sub>Y (U \<inter> U')" "f x \<in> U" "f x \<in> U'"
	+ using CC eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq target.open_inter by force
	+ then interpret cc_rh: ring_homomorphism "\<phi>\<^sub>f (U \<inter> U')" "\<O>\<^sub>Y (U \<inter> U')"
	+ "add_str\<^sub>Y (U \<inter> U')" "mult_str\<^sub>Y (U \<inter> U')" "zero_str\<^sub>Y (U \<inter> U')"
	+ "one_str\<^sub>Y (U \<inter> U')" "local.im_sheaf (U \<inter> U')"
	+ "add_im_sheaf (U \<inter> U')" "mult_im_sheaf (U \<inter> U')"
	+ "zero_im_sheaf (U \<inter> U')" "one_im_sheaf (U \<inter> U')"
	+ by (metis is_morphism_of_sheaves morphism_presheaves_of_rings.is_ring_morphism morphism_sheaves_of_rings_def)
	+ obtain opeU [simp]: "is_open\<^sub>Y U" "is_open\<^sub>Y U'"
	+ by (metis (no_types, lifting) CC SigmaD1 Uq dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
	+ obtain [simp]: "q \<in> \<O>\<^sub>Y U" "q' \<in> \<O>\<^sub>Y U'"
	+ using CC Uq stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
	+
	+ define add where "add \<equiv> add_str\<^sub>Y (U \<inter> U') (\<rho>\<^sub>Y U (U \<inter> U') q) (\<rho>\<^sub>Y U' (U \<inter> U') q')"
	+ have add_stalk_eq_class: "stfx.add_stalk C C' = stfx.class_of (U \<inter> U') add"
	+ using CC
	+ unfolding add_def stfx.add_stalk_def stfx.carrier_stalk_def dlY.carrier_direct_lim_def
	+ by (smt (verit, best) IntI Int_commute Uq cc eqY.Block_self eqY.block_closed inf.cobounded1 mem_Collect_eq stfx.add_rel_class_of stfx.class_of_def stfx.neighborhoods_eq)
	+ then have C: "(stfx.class_of (U \<inter> U') add) \<in> stfx.carrier_stalk"
	+ using CC \<open>Group_Theory.monoid stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V)\<close> monoid.composition_closed by fastforce
	+ have add_in: "add \<in> \<O>\<^sub>Y (U \<inter> U')"
	+ apply (simp add: add_def)
	+ using cc_rh.source.additive.composition_closed\<open>q \<in> \<O>\<^sub>Y U\<close> \<open>q' \<in> \<O>\<^sub>Y U'\<close>
	+ by (metis Int_commute cc(1) codom.is_map_from_is_homomorphism inf.cobounded1 map.map_closed opeU)
	+ obtain V r where Vr: "(V,r) \<in> stfx.add_stalk C C'"
	+ and eq: "induced_morphism (stfx.add_stalk C C') = stx.class_of (f \<^sup>\<inverse> X V) (\<phi>\<^sub>f V r)"
	+ using induced_morphism_eq add_stalk_eq_class C by auto
	+ have "is_open\<^sub>Y V"
	+ by (smt (verit, best) C SigmaD1 Vr add_stalk_eq_class dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
	+ have "r \<in> \<O>\<^sub>Y V"
	+ by (smt (verit, best) IntI Vr add_stalk_eq_class add_in cc fst_conv mem_Collect_eq snd_conv stfx.rel_I1 stfx.rel_def)
	+ have fxV: "f x \<in> V"
	+ using C Vr add_stalk_eq_class stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
	+ have fXUU: "is_open\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))"
	+ using cc(1) is_continuous by presburger
	+ have "(U \<inter> U', add) \<in> stfx.class_of V r"
	+ by (metis (no_types, lifting) IntI Vr add_stalk_eq_class add_in cc mem_Collect_eq stfx.class_of_def stfx.rel_Class_iff stfx.rel_I1)
	+ then have "stfx.rel (V, r) (U \<inter> U', add)"
	+ by (simp add: fxV \<open>is_open\<^sub>Y V\<close> \<open>r \<in> \<O>\<^sub>Y V\<close> stfx.rel_I1)
	+ then have "induced_morphism (stfx.add_stalk C C') = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U \<inter> U') add)"
	+ using eq induced_morphism_is_well_defined by presburger
	+ moreover have "stx.add_stalk (induced_morphism C) (induced_morphism C') =
	+ stx.add_stalk (stx.class_of (f \<^sup>\<inverse> X U) (\<phi>\<^sub>f U q))
	+ (stx.class_of (f \<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q'))"
	+ using CC(1) Uq(1) eq' induced_morphism_eval by auto
	+ moreover have "\<dots> = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (add_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (\<rho>\<^sub>X (f\<^sup>\<inverse> X (U)) (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U) (q)))
	+ (\<rho>\<^sub>X (f\<^sup>\<inverse> X (U')) (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U') (q')))
	+ )"
	+ unfolding stx.add_stalk_def
	+ using is_continuous phi_in_O stx.is_elem fXUU
	+ by (intro stx.add_rel_class_of) auto
	+ moreover have "\<phi>\<^sub>f (U \<inter> U') add = add_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y (U) (U \<inter> U') (q)))
	+ (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y (U') (U \<inter> U') (q')))"
	+ unfolding add_def
	+ proof (subst cc_rh.additive.commutes_with_composition)
	+ show "\<rho>\<^sub>Y U (U \<inter> U') q \<in> \<O>\<^sub>Y (U \<inter> U')"
	+ by (metis \<open>q \<in> \<O>\<^sub>Y U\<close> cc(1) codom.is_map_from_is_homomorphism inf.cobounded1 map.map_closed opeU(1))
	+ show "\<rho>\<^sub>Y U' (U \<inter> U') q' \<in> \<O>\<^sub>Y (U \<inter> U')"
	+ by (metis \<open>q' \<in> \<O>\<^sub>Y U'\<close> cc(1) codom.is_map_from_is_homomorphism inf.commute inf_le1 map.map_closed opeU(2))
	+ qed (auto simp: add_im_sheaf_def)
	+ moreover have "\<dots> = add_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (\<rho>\<^sub>X (f\<^sup>\<inverse> X (U)) (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U) (q)))
	+ (\<rho>\<^sub>X (f\<^sup>\<inverse> X U') (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U') (q')))"
	+ using assms
	+ apply (simp add: stfx.rel_def morphY.comm_diagrams [symmetric, unfolded o_def])
	+ using im_sheaf_morphisms_def by fastforce
	+ ultimately show ?thesis
	+ by simp
	+ qed
	+ next
	+ have "induced_morphism (stfx.zero_stalk V) = stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V (zero_str\<^sub>Y V))"
	+ using induced_morphism_eval [OF 0, where r = "(V, zero_str\<^sub>Y V)"] assms by force
	+ also have "\<dots> = stx.zero_stalk (f \<^sup>\<inverse> X V)"
	+ by (simp add: phif.additive.commutes_with_unit zero_im_sheaf_def stx.zero_stalk_def)
	+ finally show "induced_morphism (stfx.zero_stalk V) = stx.zero_stalk (f \<^sup>\<inverse> X V)" .
	+ qed
	+ show "monoid_homomorphism_axioms induced_morphism stfx.carrier_stalk stfx.mult_stalk (stfx.one_stalk V) stx.mult_stalk (stx.one_stalk (f \<^sup>\<inverse> X V))"
	+ proof
	+ fix C C'
	+ assume CC: "C \<in> stfx.carrier_stalk" "C' \<in> stfx.carrier_stalk"
	+ show "induced_morphism (stfx.mult_stalk C C') = stx.mult_stalk (induced_morphism C) (induced_morphism C')"
	+ proof -
	+ obtain U q U' q' where Uq: "(U,q) \<in> C" "(U',q') \<in> C'"
	+ and eq: "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X U) (\<phi>\<^sub>f U q)"
	+ and eq': "induced_morphism C' = stx.class_of (f\<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q')"
	+ by (metis (no_types, lifting) CC induced_morphism_eq)
	+ then obtain cc [simp]: "is_open\<^sub>Y (U \<inter> U')" "f x \<in> U" "f x \<in> U'"
	+ using CC eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq target.open_inter by force
	+ then interpret cc_rh: ring_homomorphism "\<phi>\<^sub>f (U \<inter> U')" "\<O>\<^sub>Y (U \<inter> U')"
	+ "add_str\<^sub>Y (U \<inter> U')" "mult_str\<^sub>Y (U \<inter> U')" "zero_str\<^sub>Y (U \<inter> U')"
	+ "one_str\<^sub>Y (U \<inter> U')" "local.im_sheaf (U \<inter> U')"
	+ "add_im_sheaf (U \<inter> U')" "mult_im_sheaf (U \<inter> U')"
	+ "zero_im_sheaf (U \<inter> U')" "one_im_sheaf (U \<inter> U')"
	+ by (metis is_morphism_of_sheaves morphism_presheaves_of_rings.is_ring_morphism morphism_sheaves_of_rings_def)
	+ obtain opeU [simp]: "is_open\<^sub>Y U" "is_open\<^sub>Y U'"
	+ by (metis (no_types, lifting) CC SigmaD1 Uq dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
	+ obtain [simp]: "q \<in> \<O>\<^sub>Y U" "q' \<in> \<O>\<^sub>Y U'"
	+ using CC Uq stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
	+
	+ define mult where "mult \<equiv> mult_str\<^sub>Y (U \<inter> U') (\<rho>\<^sub>Y U (U \<inter> U') q) (\<rho>\<^sub>Y U' (U \<inter> U') q')"
	+ have mult_stalk_eq_class: "stfx.mult_stalk C C' = stfx.class_of (U \<inter> U') mult"
	+ using CC
	+ unfolding mult_def stfx.mult_stalk_def stfx.carrier_stalk_def dlY.carrier_direct_lim_def
	+ by (smt (verit, best) IntI Int_commute Uq cc eqY.Block_self eqY.block_closed inf.cobounded1 mem_Collect_eq stfx.mult_rel_class_of stfx.class_of_def stfx.neighborhoods_eq)
	+ then have C: "(stfx.class_of (U \<inter> U') mult) \<in> stfx.carrier_stalk"
	+ by (metis CC V.multiplicative.monoid_axioms monoid.composition_closed stfx.carrier_stalk_def stfx.mult_stalk_def stfx.neighborhoods_eq)
	+ have mult_in: "mult \<in> \<O>\<^sub>Y (U \<inter> U')"
	+ apply (simp add: mult_def)
	+ using cc_rh.source.additive.composition_closed\<open>q \<in> \<O>\<^sub>Y U\<close> \<open>q' \<in> \<O>\<^sub>Y U'\<close>
	+ by (meson cc(1) cc_rh.source.multiplicative.composition_closed codom.is_map_from_is_homomorphism inf_le1 inf_le2 map.map_closed opeU)
	+ obtain V r where Vr: "(V,r) \<in> stfx.mult_stalk C C'"
	+ and eq: "induced_morphism (stfx.mult_stalk C C') = stx.class_of (f \<^sup>\<inverse> X V) (\<phi>\<^sub>f V r)"
	+ using induced_morphism_eq mult_stalk_eq_class C by auto
	+ have "is_open\<^sub>Y V"
	+ by (smt (verit, best) C SigmaD1 Vr mult_stalk_eq_class dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
	+ have "r \<in> \<O>\<^sub>Y V"
	+ by (smt (verit, best) IntI Vr mult_stalk_eq_class mult_in cc fst_conv mem_Collect_eq snd_conv stfx.rel_I1 stfx.rel_def)
	+ have fxV: "f x \<in> V"
	+ using C Vr mult_stalk_eq_class stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
	+ have fXUU: "is_open\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))"
	+ using cc(1) is_continuous by presburger
	+ have "(U \<inter> U', mult) \<in> stfx.class_of V r"
	+ by (metis (no_types, lifting) IntI Vr mult_stalk_eq_class mult_in cc mem_Collect_eq stfx.class_of_def stfx.rel_Class_iff stfx.rel_I1)
	+ then have "stfx.rel (V, r) (U \<inter> U', mult)"
	+ by (simp add: fxV \<open>is_open\<^sub>Y V\<close> \<open>r \<in> \<O>\<^sub>Y V\<close> stfx.rel_I1)
	+ then have "induced_morphism (stfx.mult_stalk C C') = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U \<inter> U') mult)"
	+ using eq induced_morphism_is_well_defined by presburger
	+ moreover have "stx.mult_stalk (induced_morphism C) (induced_morphism C') =
	+ stx.mult_stalk (stx.class_of (f \<^sup>\<inverse> X U) (\<phi>\<^sub>f U q))
	+ (stx.class_of (f \<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q'))"
	+ using CC(1) Uq(1) eq' induced_morphism_eval by auto
	+ moreover have "\<dots> = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (mult_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (\<rho>\<^sub>X (f \<^sup>\<inverse> X U) (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U q))
	+ (\<rho>\<^sub>X (f \<^sup>\<inverse> X U') (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U' q')))"
	+ unfolding stx.mult_stalk_def
	+ using is_continuous phi_in_O stx.is_elem fXUU
	+ by (intro stx.mult_rel_class_of) auto
	+ moreover have "\<phi>\<^sub>f (U \<inter> U') mult = mult_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y U (U \<inter> U') q))
	+ (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y U' (U \<inter> U') q'))"
	+ unfolding mult_def
	+ proof (subst cc_rh.multiplicative.commutes_with_composition)
	+ show "\<rho>\<^sub>Y U (U \<inter> U') q \<in> \<O>\<^sub>Y (U \<inter> U')"
	+ by (metis \<open>q \<in> \<O>\<^sub>Y U\<close> cc(1) codom.is_map_from_is_homomorphism inf.cobounded1 map.map_closed opeU(1))
	+ show "\<rho>\<^sub>Y U' (U \<inter> U') q' \<in> \<O>\<^sub>Y (U \<inter> U')"
	+ by (metis \<open>q' \<in> \<O>\<^sub>Y U'\<close> cc(1) codom.is_map_from_is_homomorphism inf.commute inf_le1 map.map_closed opeU(2))
	+ qed (auto simp: mult_im_sheaf_def)
	+ moreover have "\<dots> = mult_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
	+ (\<rho>\<^sub>X (f \<^sup>\<inverse> X U) (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U q))
	+ (\<rho>\<^sub>X (f \<^sup>\<inverse> X U') (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U' q'))"
	+ using assms im_sheaf_morphisms_def
	+ by (fastforce simp: stfx.rel_def morphY.comm_diagrams [symmetric, unfolded o_def])
	+ ultimately show ?thesis
	+ by simp
	+ qed
	+ next
	+ have "induced_morphism (stfx.one_stalk V) = stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V (one_str\<^sub>Y V))"
	+ using induced_morphism_eval [OF 1, where r = "(V, one_str\<^sub>Y V)"] assms by force
	+ also have "\<dots> = stx.one_stalk (f \<^sup>\<inverse> X V)"
	+ by (simp add: phif.multiplicative.commutes_with_unit one_im_sheaf_def stx.one_stalk_def)
	+ finally show "induced_morphism (stfx.one_stalk V) = stx.one_stalk (f \<^sup>\<inverse> X V)" .
	+ qed
	+qed
	+
	+
	+definition is_local:: "'c set \<Rightarrow> (('c set \<times> 'd) set \<Rightarrow> ('a set \<times> 'b) set) \<Rightarrow> bool" where
	+ "is_local V \<phi> \<equiv>
	+ local_ring_morphism \<phi>
	+ stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk (stfx.zero_stalk V) (stfx.one_stalk V)
	+ stx.carrier_stalk stx.add_stalk stx.mult_stalk (stx.zero_stalk (f\<^sup>\<inverse> X V)) (stx.one_stalk (f\<^sup>\<inverse> X V))"
	+
	+end (* ind_mor_btw_stalks *)
	+
	+notation ind_mor_btw_stalks.induced_morphism ("\<phi>\<^bsub>(3_ _ _ _/ _ _ _/ _ _ _)\<^esub>"
	+ [1000,1000,1000,1000,1000,1000,1000,1000,1000,1000]1000)
	+
	+lemma (in sheaf_of_rings) induced_morphism_with_id_is_id:
	+ assumes "x \<in> S"
	+ shows "\<phi>\<^bsub>S is_open \<FF> \<rho> is_open \<FF> \<rho> (identity S) (\<lambda>U. identity (\<FF> U)) x\<^esub>
	+ = (\<lambda>C\<in>(stalk.carrier_stalk is_open \<FF> \<rho> x). C)"
	+proof -
	+ interpret im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
	+ by (metis homeomorphism.axioms(3) id_is_homeomorphism im_sheaf_def inverse_map_identity
	+ sheaf_of_rings_axioms)
	+ interpret codom: ringed_space S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ by (meson im_sheaf.axioms(1) im_sheaf_axioms ringed_space_def)
	+
	+ interpret ind_mor_btw_stalks S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S
	+ is_open \<FF> \<rho> b add_str mult_str zero_str one_str "identity S" "\<lambda>U. identity (\<FF> U)" x
	+ apply intro_locales
	+ subgoal
	+ proof -
	+ have "ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (local.im_sheaf U) (add_im_sheaf U)
	+ (mult_im_sheaf U) (zero_im_sheaf U) (one_im_sheaf U)" if "is_open U" for U
	+ by (smt (z3) id_is_mor_pr_rngs im_sheaf.add_im_sheaf_def im_sheaf.im_sheaf_def
	+ im_sheaf.mult_im_sheaf_def im_sheaf_axioms local.topological_space_axioms
	+ morphism_presheaves_of_rings.is_ring_morphism one_im_sheaf_def that
	+ topological_space.open_preimage_identity zero_im_sheaf_def)
	+ moreover have "\<forall>U V. is_open U \<longrightarrow>
	+ is_open V \<longrightarrow>
	+ V \<subseteq> U \<longrightarrow> (\<forall>x. x \<in> \<FF> U \<longrightarrow> (im_sheaf_morphisms U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> \<rho> U V) x)"
	+ by (smt (verit, best) comp_apply im_sheaf_morphisms_def is_map_from_is_homomorphism
	+ local.im_sheaf_def map.map_closed open_preimage_identity restrict_apply')
	+ ultimately have "morphism_presheaves_of_rings_axioms is_open \<FF> \<rho> add_str mult_str
	+ zero_str one_str local.im_sheaf im_sheaf_morphisms add_im_sheaf mult_im_sheaf
	+ zero_im_sheaf one_im_sheaf (\<lambda>U. identity (\<FF> U))"
	+ unfolding morphism_presheaves_of_rings_axioms_def by auto
	+ then show ?thesis
	+ unfolding morphism_ringed_spaces_axioms_def
	+ by intro_locales
	+
	+ qed
	+ subgoal by (meson assms ind_mor_btw_stalks_axioms.intro)
	+ done
	+
	+ have "(let r = SOME r. r \<in> C
	+ in direct_lim.class_of \<FF> \<rho> (neighborhoods x) (identity S \<^sup>\<inverse> S (fst r))
	+ (identity (\<FF> (fst r)) (snd r))) = C"
	+ (is "?L= _")
	+ if "C\<in>stalk.carrier_stalk is_open \<FF> \<rho> x" for C
	+ proof -
	+ interpret stk:stalk S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ "neighborhoods x" x
	+ apply unfold_locales
	+ using is_elem neighborhoods_def by auto
	+ define r where "r=(SOME x. x \<in> C)"
	+ have r:"r \<in> C" "r \<in> Sigma (neighborhoods x) \<FF>" and "C = stk.class_of (fst r) (snd r)"
	+ using stk.rel_carrier_Eps_in[OF that[unfolded stk.carrier_stalk_def]] unfolding r_def by auto
	+
	+ have "?L = stk.class_of (identity S \<^sup>\<inverse> S (fst r)) (identity (\<FF> (fst r)) (snd r))"
	+ unfolding r_def Let_def by simp
	+ also have "... = stk.class_of (fst r) (snd r)"
	+ by (metis open_preimage_identity r(1) restrict_apply stk.carrier_direct_limE
	+ stk.carrier_stalk_def stk.rel_I1 stk.rel_def stk.subset_of_opens that)
	+ also have "... = C"
	+ using \<open>C = stk.class_of (fst r) (snd r)\<close> by simp
	+ finally show ?thesis .
	+ qed
	+ then show ?thesis
	+ unfolding induced_morphism_def
	+ using is_elem neighborhoods_def by fastforce
	+qed
	+
	+lemma (in locally_ringed_space) induced_morphism_with_id_is_local:
	+ assumes "x \<in> S" and V: "x \<in> V" "is_open V"
	+ shows "ind_mor_btw_stalks.is_local
	+S is_open \<FF> \<rho> add_str mult_str zero_str one_str is_open \<FF> \<rho> add_str mult_str zero_str one_str
	+(identity S) x V (\<phi>\<^bsub>S is_open \<FF> \<rho> is_open \<FF> \<rho> (identity S) (\<lambda>U. identity (\<FF> U)) x\<^esub>)"
	+proof-
	+ have [simp]: "(identity S)\<^sup>\<inverse> S V = V"
	+ using assms by auto
	+ interpret stfx: stalk S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ "{U. is_open U \<and> (identity S x) \<in> U}" "identity S x"
	+ proof qed (use assms in auto)
	+ have "local_ring stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk (stfx.zero_stalk V) (stfx.one_stalk V)"
	+ by (smt (verit, best) assms restrict_apply' stalks_are_local stfx.is_local_def stfx.neighborhoods_eq)
	+ interpret stx: stalk S is_open \<FF> \<rho> b add_str mult_str zero_str one_str "{U. is_open U \<and> x \<in> U}" "x"
	+ using \<open>x \<in> S\<close> stfx.stalk_axioms by fastforce
	+ interpret local_ring stx.carrier_stalk stx.add_stalk stx.mult_stalk
	+ "stx.zero_stalk ((identity S)\<^sup>\<inverse> S V)" "stx.one_stalk ((identity S)\<^sup>\<inverse> S V)"
	+ using V stalks_are_local stx.is_local_def stx.neighborhoods_eq by fastforce
	+ interpret imS: im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
	+ by (metis homeomorphism.axioms(3) id_is_homeomorphism im_sheaf_def inverse_map_identity
	+ sheaf_of_rings_axioms)
	+ have rh: "\<And>U. is_open U \<Longrightarrow>
	+ ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (imS.im_sheaf U)
	+ (imS.add_im_sheaf U) (imS.mult_im_sheaf U) (imS.zero_im_sheaf U) (imS.one_im_sheaf U)"
	+ unfolding imS.add_im_sheaf_def imS.mult_im_sheaf_def imS.one_im_sheaf_def
	+ imS.zero_im_sheaf_def imS.im_sheaf_def
	+ using id_is_mor_pr_rngs morphism_presheaves_of_rings.is_ring_morphism by fastforce
	+ interpret ind_mor_btw_stalks S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S
	+ is_open \<FF> \<rho> b add_str mult_str zero_str one_str "identity S" "\<lambda>U. identity (\<FF> U)" x
	+ proof intro_locales
	+ show "morphism_ringed_spaces_axioms S \<FF> \<rho> b add_str mult_str zero_str one_str
	+ S is_open \<FF> \<rho> b add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
	+ unfolding morphism_ringed_spaces_axioms_def morphism_sheaves_of_rings_def
	+ morphism_presheaves_of_rings_def morphism_presheaves_of_rings_axioms_def
	+ using rh
	+ by (auto simp add: presheaf_of_rings_axioms imS.presheaf_of_rings_axioms
	+ map.map_closed [OF is_map_from_is_homomorphism] imS.im_sheaf_morphisms_def)
	+ show "ind_mor_btw_stalks_axioms S x"
	+ by (simp add: assms(1) ind_mor_btw_stalks_axioms_def)
	+ qed
	+ have "\<phi>\<^bsub>S is_open \<FF> \<rho> is_open \<FF> \<rho> (identity S) (\<lambda>U. identity (\<FF> U)) x\<^esub> = identity stx.carrier_stalk"
	+ using induced_morphism_with_id_is_id stx.is_elem by simp
	+ then show ?thesis
	+ using id_is_local_ring_morphism is_local_def local_ring_axioms stx.is_elem by fastforce
	+qed
	+
	+(* definition 0.45 *)
	+
	+locale morphism_locally_ringed_spaces = morphism_ringed_spaces +
	+ assumes are_local_morphisms:
	+ "\<And>x V. \<lbrakk>x \<in> X; is_open\<^sub>Y V; f x \<in> V\<rbrakk> \<Longrightarrow>
	+ind_mor_btw_stalks.is_local X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X add_str\<^sub>X mult_str\<^sub>X zero_str\<^sub>X one_str\<^sub>X
	+ is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y f
	+ x V \<phi>\<^bsub>X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y f \<phi>\<^sub>f x\<^esub>"
	+
	+lemma (in locally_ringed_space) id_to_mor_locally_ringed_spaces:
	+ shows "morphism_locally_ringed_spaces
	+ S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ (identity S) (\<lambda>U. identity (\<FF> U))"
	+proof intro_locales
	+ interpret idim: im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
	+ proof
	+ fix U assume "is_open U"
	+ then show "is_open (identity S \<^sup>\<inverse> S U)"
	+ by (simp add: open_inter preimage_identity_self)
	+ qed auto
	+ show "Set_Theory.map (identity S) S S"
	+ by (simp add: Set_Theory.map_def)
	+ show "continuous_map_axioms S is_open is_open (identity S)"
	+ by (simp add: continuous_map_axioms_def open_inter preimage_identity_self)
	+ have gh: "group_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub>
	+ \<zero>\<^bsub>U\<^esub> (idim.im_sheaf U) (idim.add_im_sheaf U) (idim.zero_im_sheaf U)"
	+ if "is_open U" for U
	+ using that id_is_mor_pr_rngs idim.add_im_sheaf_def idim.im_sheaf_def idim.zero_im_sheaf_def morphism_presheaves_of_rings.is_ring_morphism ring_homomorphism_def by fastforce
	+ have "morphism_presheaves_of_rings_axioms is_open \<FF> \<rho> add_str mult_str zero_str one_str idim.im_sheaf idim.im_sheaf_morphisms idim.add_im_sheaf idim.mult_im_sheaf idim.zero_im_sheaf idim.one_im_sheaf (\<lambda>U. identity (\<FF> U))"
	+ unfolding morphism_presheaves_of_rings_axioms_def
	+ proof (intro conjI strip)
	+ fix U
	+ assume "is_open U"
	+ then show "ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (idim.im_sheaf U) (idim.add_im_sheaf U) (idim.mult_im_sheaf U) (idim.zero_im_sheaf U) (idim.one_im_sheaf U)"
	+ using id_is_mor_pr_rngs idim.add_im_sheaf_def idim.im_sheaf_def idim.mult_im_sheaf_def idim.one_im_sheaf_def idim.zero_im_sheaf_def morphism_presheaves_of_rings.is_ring_morphism by fastforce
	+ fix V x
	+ assume "is_open V" and "V \<subseteq> U" and "x \<in> \<FF> U"
	+ then show "(idim.im_sheaf_morphisms U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> \<rho> U V) x"
	+ using \<open>is_open U\<close>
	+ by (simp add: idim.im_sheaf_morphisms_def map.map_closed [OF is_map_from_is_homomorphism])
	+ qed
	+ then show mrs: "morphism_ringed_spaces_axioms S \<FF> \<rho> b add_str mult_str zero_str one_str
	+ S is_open \<FF> \<rho> b add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
	+ by (simp add: idim.im_sheaf_is_presheaf morphism_presheaves_of_rings_def morphism_ringed_spaces_axioms.intro morphism_sheaves_of_rings.intro presheaf_of_rings_axioms)
	+ show "morphism_locally_ringed_spaces_axioms S is_open \<FF> \<rho> add_str mult_str zero_str one_str
	+ is_open \<FF> \<rho> add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
	+ using induced_morphism_with_id_is_local
	+ by (simp add: morphism_locally_ringed_spaces_axioms_def)
	+qed
	+
	+locale iso_locally_ringed_spaces = morphism_locally_ringed_spaces +
	+ assumes is_homeomorphism: "homeomorphism X is_open\<^sub>X Y is_open\<^sub>Y f" and
	+is_iso_of_sheaves: "iso_sheaves_of_rings Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
	+im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
	+\<phi>\<^sub>f"
	+
	+lemma (in locally_ringed_space) id_to_iso_locally_ringed_spaces:
	+ shows "iso_locally_ringed_spaces
	+ S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ (identity S) (\<lambda>U. identity (\<FF> U))"
	+proof -
	+ interpret morphism_ringed_spaces S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ S is_open \<FF> \<rho> b add_str mult_str zero_str one_str "identity S" "\<lambda>U. identity (\<FF> U)"
	+ by (metis id_to_mor_locally_ringed_spaces morphism_locally_ringed_spaces_def)
	+ show ?thesis
	+ proof intro_locales
	+ show "morphism_locally_ringed_spaces_axioms S is_open \<FF> \<rho> add_str mult_str zero_str one_str is_open \<FF> \<rho> add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
	+ by (metis id_to_mor_locally_ringed_spaces morphism_locally_ringed_spaces_def)
	+ show "iso_locally_ringed_spaces_axioms S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open \<FF> \<rho> b add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
	+ unfolding iso_locally_ringed_spaces_axioms_def iso_sheaves_of_rings_def iso_presheaves_of_rings_def iso_presheaves_of_rings_axioms_def
	+ proof (intro conjI)
	+ show "homeomorphism S is_open S is_open (identity S)"
	+ using id_is_homeomorphism by blast
	+ show mor:"morphism_presheaves_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
	+ local.im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
	+ (\<lambda>U. identity (\<FF> U))"
	+ by (simp add: is_morphism_of_sheaves morphism_sheaves_of_rings.axioms)
	+ have "morphism_presheaves_of_rings S is_open
	+ local.im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
	+ \<FF> \<rho> b add_str mult_str zero_str one_str (\<lambda>U. identity (\<FF> U))"
	+ unfolding morphism_presheaves_of_rings_def morphism_presheaves_of_rings_axioms_def
	+ proof (intro conjI strip)
	+ show "presheaf_of_rings S is_open local.im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
	+ using im_sheaf_is_presheaf by blast
	+ show "presheaf_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str"
	+ by (metis mor morphism_presheaves_of_rings_def)
	+ next
	+ fix U assume "is_open U"
	+ then have "ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
	+ by (smt (z3) im_sheaf.add_im_sheaf_def im_sheaf.mult_im_sheaf_def im_sheaf_axioms
	+ local.im_sheaf_def mor morphism_presheaves_of_rings.is_ring_morphism one_im_sheaf_def
	+ open_preimage_identity zero_im_sheaf_def)
	+ then show "ring_homomorphism (identity (\<FF> U)) (local.im_sheaf U) (add_im_sheaf U) (mult_im_sheaf U) (zero_im_sheaf U) (one_im_sheaf U) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
	+ using \<open>is_open U \<close> im_sheaf.add_im_sheaf_def im_sheaf_axioms local.im_sheaf_def mult_im_sheaf_def one_im_sheaf_def zero_im_sheaf_def
	+ by fastforce
	+ fix V x
	+ assume "is_open V" and "V \<subseteq> U" and "x \<in> local.im_sheaf U"
	+ then show "(\<rho> U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> im_sheaf_morphisms U V) x"
	+ using map.map_closed [OF is_map_from_is_homomorphism] \<open>is_open U\<close>
	+ by (simp add: im_sheaf_morphisms_def local.im_sheaf_def)
	+ qed
	+ then show "\<exists>\<psi>. morphism_presheaves_of_rings S is_open (im_sheaf.im_sheaf S \<FF> (identity S)) (im_sheaf.im_sheaf_morphisms S \<rho> (identity S)) b
	+ (im_sheaf.add_im_sheaf S add_str (identity S)) (im_sheaf.mult_im_sheaf S mult_str (identity S)) (im_sheaf.zero_im_sheaf S zero_str (identity S)) (im_sheaf.one_im_sheaf S one_str (identity S)) \<FF> \<rho> b add_str mult_str zero_str one_str \<psi> \<and> (\<forall>U. is_open U \<longrightarrow> (\<forall>x\<in>im_sheaf.im_sheaf S \<FF> (identity S) U. (identity (\<FF> U) \<circ> \<psi> U) x = x) \<and> (\<forall>x\<in>\<FF> U. (\<psi> U \<circ> identity (\<FF> U)) x = x))"
	+ using local.im_sheaf_def by auto
	+ qed
	+ qed
	+qed
	+
	+end
	diff --git a/thys/Grothendieck_Schemes/Group_Extras.thy b/thys/Grothendieck_Schemes/Group_Extras.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/Group_Extras.thy
	@@ -0,0 +1,411 @@
	+
	+text \<open>Authors: Anthony Bordg and Lawrence Paulson\<close>
	+
	+theory Group_Extras
	+ imports Main
	+ "Jacobson_Basic_Algebra.Group_Theory"
	+ "Set_Extras"
	+
	+begin
	+
	+section \<open>Fold operator with a subdomain\<close>
	+
	+inductive_set
	+ foldSetD :: "['a set, 'b \<Rightarrow> 'a \<Rightarrow> 'a, 'a] \<Rightarrow> ('b set * 'a) set"
	+ for D :: "'a set" and f :: "'b \<Rightarrow> 'a \<Rightarrow> 'a" and e :: 'a
	+ where
	+ emptyI [intro]: "e \<in> D \<Longrightarrow> ({}, e) \<in> foldSetD D f e"
	+ \| insertI [intro]: "\<lbrakk>x \<notin> A; f x y \<in> D; (A, y) \<in> foldSetD D f e\<rbrakk> \<Longrightarrow>
	+ (insert x A, f x y) \<in> foldSetD D f e"
	+
	+inductive_cases empty_foldSetDE [elim!]: "({}, x) \<in> foldSetD D f e"
	+
	+definition
	+ foldD :: "['a set, 'b \<Rightarrow> 'a \<Rightarrow> 'a, 'a, 'b set] \<Rightarrow> 'a"
	+ where "foldD D f e A = (THE x. (A, x) \<in> foldSetD D f e)"
	+
	+lemma foldSetD_closed: "(A, z) \<in> foldSetD D f e \<Longrightarrow> z \<in> D"
	+ by (erule foldSetD.cases) auto
	+
	+lemma Diff1_foldSetD:
	+ "\<lbrakk>(A - {x}, y) \<in> foldSetD D f e; x \<in> A; f x y \<in> D\<rbrakk> \<Longrightarrow>
	+ (A, f x y) \<in> foldSetD D f e"
	+ by (metis Diff_insert_absorb foldSetD.insertI mk_disjoint_insert)
	+
	+lemma foldSetD_imp_finite [simp]: "(A, x) \<in> foldSetD D f e \<Longrightarrow> finite A"
	+ by (induct set: foldSetD) auto
	+
	+lemma finite_imp_foldSetD:
	+ "\<lbrakk>finite A; e \<in> D; \<And>x y. \<lbrakk>x \<in> A; y \<in> D\<rbrakk> \<Longrightarrow> f x y \<in> D\<rbrakk>
	+ \<Longrightarrow> \<exists>x. (A, x) \<in> foldSetD D f e"
	+proof (induct set: finite)
	+ case empty then show ?case by auto
	+next
	+ case (insert x F)
	+ then obtain y where y: "(F, y) \<in> foldSetD D f e" by auto
	+ with insert have "y \<in> D" by (auto dest: foldSetD_closed)
	+ with y and insert have "(insert x F, f x y) \<in> foldSetD D f e"
	+ by (intro foldSetD.intros) auto
	+ then show ?case ..
	+qed
	+
	+lemma foldSetD_backwards:
	+ assumes "A \<noteq> {}" "(A, z) \<in> foldSetD D f e"
	+ shows "\<exists>x y. x \<in> A \<and> (A - { x }, y) \<in> foldSetD D f e \<and> z = f x y"
	+ using assms(2) by (cases) (simp add: assms(1), metis Diff_insert_absorb insertI1)
	+
	+subsection \<open>Left-Commutative Operations\<close>
	+
	+locale LCD =
	+ fixes B :: "'b set"
	+ and D :: "'a set"
	+ and f :: "'b \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<cdot>" 70)
	+ assumes left_commute:
	+ "\<lbrakk>x \<in> B; y \<in> B; z \<in> D\<rbrakk> \<Longrightarrow> x \<cdot> (y \<cdot> z) = y \<cdot> (x \<cdot> z)"
	+ and f_closed [simp, intro!]: "!!x y. \<lbrakk>x \<in> B; y \<in> D\<rbrakk> \<Longrightarrow> f x y \<in> D"
	+
	+lemma (in LCD) foldSetD_closed [dest]: "(A, z) \<in> foldSetD D f e \<Longrightarrow> z \<in> D"
	+ by (erule foldSetD.cases) auto
	+
	+lemma (in LCD) Diff1_foldSetD:
	+ "\<lbrakk>(A - {x}, y) \<in> foldSetD D f e; x \<in> A; A \<subseteq> B\<rbrakk> \<Longrightarrow>
	+ (A, f x y) \<in> foldSetD D f e"
	+ by (meson Diff1_foldSetD f_closed local.foldSetD_closed subsetCE)
	+
	+lemma (in LCD) finite_imp_foldSetD:
	+ "\<lbrakk>finite A; A \<subseteq> B; e \<in> D\<rbrakk> \<Longrightarrow> \<exists>x. (A, x) \<in> foldSetD D f e"
	+proof (induct set: finite)
	+ case empty then show ?case by auto
	+next
	+ case (insert x F)
	+ then obtain y where y: "(F, y) \<in> foldSetD D f e" by auto
	+ with insert have "y \<in> D" by auto
	+ with y and insert have "(insert x F, f x y) \<in> foldSetD D f e"
	+ by (intro foldSetD.intros) auto
	+ then show ?case ..
	+qed
	+
	+
	+lemma (in LCD) foldSetD_determ_aux:
	+ assumes "e \<in> D" and A: "card A < n" "A \<subseteq> B" "(A, x) \<in> foldSetD D f e" "(A, y) \<in> foldSetD D f e"
	+ shows "y = x"
	+ using A
	+proof (induction n arbitrary: A x y)
	+ case 0
	+ then show ?case
	+ by auto
	+next
	+ case (Suc n)
	+ then consider "card A = n" \| "card A < n"
	+ by linarith
	+ then show ?case
	+ proof cases
	+ case 1
	+ show ?thesis
	+ using foldSetD.cases [OF \<open>(A,x) \<in> foldSetD D (\<cdot>) e\<close>]
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ using \<open>(A,y) \<in> foldSetD D (\<cdot>) e\<close> by auto
	+ next
	+ case (2 x' A' y')
	+ note A' = this
	+ show ?thesis
	+ using foldSetD.cases [OF \<open>(A,y) \<in> foldSetD D (\<cdot>) e\<close>]
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ using \<open>(A,x) \<in> foldSetD D (\<cdot>) e\<close> by auto
	+ next
	+ case (2 x'' A'' y'')
	+ note A'' = this
	+ show ?thesis
	+ proof (cases "x' = x''")
	+ case True
	+ show ?thesis
	+ proof (cases "y' = y''")
	+ case True
	+ then show ?thesis
	+ using A' A'' \<open>x' = x''\<close> by (blast elim!: equalityE)
	+ next
	+ case False
	+ then show ?thesis
	+ using A' A'' \<open>x' = x''\<close>
	+ by (metis \<open>card A = n\<close> Suc.IH Suc.prems(2) card_insert_disjoint foldSetD_imp_finite insert_eq_iff insert_subset lessI)
	+ qed
	+ next
	+ case False
	+ then have *: "A' - {x''} = A'' - {x'}" "x'' \<in> A'" "x' \<in> A''"
	+ using A' A'' by fastforce+
	+ then have "A' = insert x'' A'' - {x'}"
	+ using \<open>x' \<notin> A'\<close> by blast
	+ then have card: "card A' \<le> card A''"
	+ using A' A'' * by (metis card_Suc_Diff1 eq_refl foldSetD_imp_finite)
	+ obtain u where u: "(A' - {x''}, u) \<in> foldSetD D (\<cdot>) e"
	+ using finite_imp_foldSetD [of "A' - {x''}"] A' Diff_insert \<open>A \<subseteq> B\<close> \<open>e \<in> D\<close> by fastforce
	+ have "y' = f x'' u"
	+ using Diff1_foldSetD [OF u] \<open>x'' \<in> A'\<close> \<open>card A = n\<close> A' Suc.IH \<open>A \<subseteq> B\<close> by auto
	+ then have "(A'' - {x'}, u) \<in> foldSetD D f e"
	+ using "*"(1) u by auto
	+ then have "y'' = f x' u"
	+ using A'' by (metis * \<open>card A = n\<close> A'(1) Diff1_foldSetD Suc.IH \<open>A \<subseteq> B\<close>
	+ card card_Suc_Diff1 card_insert_disjoint foldSetD_imp_finite insert_subset le_imp_less_Suc)
	+ then show ?thesis
	+ using A' A''
	+ by (metis \<open>A \<subseteq> B\<close> \<open>y' = x'' \<cdot> u\<close> insert_subset left_commute local.foldSetD_closed u)
	+ qed
	+ qed
	+ qed
	+ next
	+ case 2 with Suc show ?thesis by blast
	+ qed
	+qed
	+
	+lemma (in LCD) foldSetD_determ:
	+ "\<lbrakk>(A, x) \<in> foldSetD D f e; (A, y) \<in> foldSetD D f e; e \<in> D; A \<subseteq> B\<rbrakk>
	+ \<Longrightarrow> y = x"
	+ by (blast intro: foldSetD_determ_aux [rule_format])
	+
	+lemma (in LCD) foldD_equality:
	+ "\<lbrakk>(A, y) \<in> foldSetD D f e; e \<in> D; A \<subseteq> B\<rbrakk> \<Longrightarrow> foldD D f e A = y"
	+ by (unfold foldD_def) (blast intro: foldSetD_determ)
	+
	+lemma foldD_empty [simp]:
	+ "e \<in> D \<Longrightarrow> foldD D f e {} = e"
	+ by (unfold foldD_def) blast
	+
	+lemma (in LCD) foldD_insert_aux:
	+ "\<lbrakk>x \<notin> A; x \<in> B; e \<in> D; A \<subseteq> B\<rbrakk>
	+ \<Longrightarrow> ((insert x A, v) \<in> foldSetD D f e) \<longleftrightarrow> (\<exists>y. (A, y) \<in> foldSetD D f e \<and> v = f x y)"
	+ apply auto
	+ by (metis Diff_insert_absorb f_closed finite_Diff foldSetD.insertI foldSetD_determ foldSetD_imp_finite insert_subset local.finite_imp_foldSetD local.foldSetD_closed)
	+
	+lemma (in LCD) foldD_insert:
	+ assumes "finite A" "x \<notin> A" "x \<in> B" "e \<in> D" "A \<subseteq> B"
	+ shows "foldD D f e (insert x A) = f x (foldD D f e A)"
	+proof -
	+ have "(THE v. \<exists>y. (A, y) \<in> foldSetD D (\<cdot>) e \<and> v = x \<cdot> y) = x \<cdot> (THE y. (A, y) \<in> foldSetD D (\<cdot>) e)"
	+ by (rule the_equality) (use assms foldD_def foldD_equality foldD_def finite_imp_foldSetD in \<open>metis+\<close>)
	+ then show ?thesis
	+ unfolding foldD_def using assms by (simp add: foldD_insert_aux)
	+qed
	+
	+lemma (in LCD) foldD_closed [simp]:
	+ "\<lbrakk>finite A; e \<in> D; A \<subseteq> B\<rbrakk> \<Longrightarrow> foldD D f e A \<in> D"
	+proof (induct set: finite)
	+ case empty then show ?case by simp
	+next
	+ case insert then show ?case by (simp add: foldD_insert)
	+qed
	+
	+lemma (in LCD) foldD_commute:
	+ "\<lbrakk>finite A; x \<in> B; e \<in> D; A \<subseteq> B\<rbrakk> \<Longrightarrow>
	+ f x (foldD D f e A) = foldD D f (f x e) A"
	+ by (induct set: finite) (auto simp add: left_commute foldD_insert)
	+
	+lemma Int_mono2:
	+ "\<lbrakk>A \<subseteq> C; B \<subseteq> C\<rbrakk> \<Longrightarrow> A Int B \<subseteq> C"
	+ by blast
	+
	+lemma (in LCD) foldD_nest_Un_Int:
	+ "\<lbrakk>finite A; finite C; e \<in> D; A \<subseteq> B; C \<subseteq> B\<rbrakk> \<Longrightarrow>
	+ foldD D f (foldD D f e C) A = foldD D f (foldD D f e (A Int C)) (A Un C)"
	+proof (induction set: finite)
	+ case (insert x F)
	+ then show ?case
	+ by (simp add: foldD_insert foldD_commute Int_insert_left insert_absorb Int_mono2)
	+qed simp
	+
	+lemma (in LCD) foldD_nest_Un_disjoint:
	+ "\<lbrakk>finite A; finite B; A Int B = {}; e \<in> D; A \<subseteq> B; C \<subseteq> B\<rbrakk>
	+ \<Longrightarrow> foldD D f e (A Un B) = foldD D f (foldD D f e B) A"
	+ by (simp add: foldD_nest_Un_Int)
	+
	+\<comment> \<open>Delete rules to do with \<open>foldSetD\<close> relation.\<close>
	+
	+declare foldSetD_imp_finite [simp del]
	+ empty_foldSetDE [rule del]
	+ foldSetD.intros [rule del]
	+declare (in LCD)
	+ foldSetD_closed [rule del]
	+
	+section \<open>Monoids\<close>
	+
	+lemma comp_monoid_morphisms:
	+ assumes "monoid_homomorphism \<eta> A multA oneA B multB oneB" and
	+ "monoid_homomorphism \<theta> B multB oneB C multC oneC"
	+shows "monoid_homomorphism (\<theta> \<circ> \<eta> \<down> A) A multA oneA C multC oneC"
	+proof-
	+ have "map (\<theta> \<circ> \<eta> \<down> A) A C" using assms comp_maps by (metis monoid_homomorphism.axioms(1))
	+ moreover have "(\<theta> \<circ> \<eta> \<down> A) oneA = oneC"
	+ using assms
	+ by (metis compose_eq monoid.unit_closed monoid_homomorphism.axioms(2) monoid_homomorphism.commutes_with_unit)
	+ moreover have "(\<theta> \<circ> \<eta> \<down> A) (multA x y) = multC ((\<theta> \<circ> \<eta> \<down> A) x) ((\<theta> \<circ> \<eta> \<down> A) y)"
	+ if "x \<in> A" "y \<in> A" for x y
	+ using that assms monoid_homomorphism.commutes_with_composition
	+ by (smt compose_eq map.map_closed monoid.composition_closed monoid_homomorphism.axioms)
	+ ultimately show ?thesis
	+ using monoid_homomorphism_def assms comp_maps by (smt monoid_homomorphism_axioms.intro)
	+qed
	+
	+text \<open>Commutative Monoids\<close>
	+
	+text \<open>
	+ We enter a more restrictive context, with \<open>f :: 'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>
	+ instead of \<open>'b \<Rightarrow> 'a \<Rightarrow> 'a\<close>.
	+\<close>
	+
	+locale ACeD =
	+ fixes D :: "'a set"
	+ and f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<cdot>" 70)
	+ and e :: 'a
	+ assumes ident [simp]: "x \<in> D \<Longrightarrow> x \<cdot> e = x"
	+ and commute: "\<lbrakk>x \<in> D; y \<in> D\<rbrakk> \<Longrightarrow> x \<cdot> y = y \<cdot> x"
	+ and assoc: "\<lbrakk>x \<in> D; y \<in> D; z \<in> D\<rbrakk> \<Longrightarrow> (x \<cdot> y) \<cdot> z = x \<cdot> (y \<cdot> z)"
	+ and e_closed [simp]: "e \<in> D"
	+ and f_closed [simp]: "\<lbrakk>x \<in> D; y \<in> D\<rbrakk> \<Longrightarrow> x \<cdot> y \<in> D"
	+
	+lemma (in ACeD) left_commute:
	+ "\<lbrakk>x \<in> D; y \<in> D; z \<in> D\<rbrakk> \<Longrightarrow> x \<cdot> (y \<cdot> z) = y \<cdot> (x \<cdot> z)"
	+proof -
	+ assume D: "x \<in> D" "y \<in> D" "z \<in> D"
	+ then have "x \<cdot> (y \<cdot> z) = (y \<cdot> z) \<cdot> x" by (simp add: commute)
	+ also from D have "... = y \<cdot> (z \<cdot> x)" by (simp add: assoc)
	+ also from D have "z \<cdot> x = x \<cdot> z" by (simp add: commute)
	+ finally show ?thesis .
	+qed
	+
	+lemmas (in ACeD) AC = assoc commute left_commute
	+
	+lemma (in ACeD) left_ident [simp]: "x \<in> D \<Longrightarrow> e \<cdot> x = x"
	+proof -
	+ assume "x \<in> D"
	+ then have "x \<cdot> e = x" by (rule ident)
	+ with \<open>x \<in> D\<close> show ?thesis by (simp add: commute)
	+qed
	+
	+lemma (in ACeD) foldD_Un_Int:
	+ "\<lbrakk>finite A; finite B; A \<subseteq> D; B \<subseteq> D\<rbrakk> \<Longrightarrow>
	+ foldD D f e A \<cdot> foldD D f e B =
	+ foldD D f e (A Un B) \<cdot> foldD D f e (A Int B)"
	+proof (induction set: finite)
	+ case empty
	+ then show ?case
	+ by(simp add: left_commute LCD.foldD_closed [OF LCD.intro [of D]])
	+next
	+ case (insert x F)
	+ then show ?case
	+ by(simp add: AC insert_absorb Int_insert_left Int_mono2
	+ LCD.foldD_insert [OF LCD.intro [of D]]
	+ LCD.foldD_closed [OF LCD.intro [of D]])
	+qed
	+
	+lemma (in ACeD) foldD_Un_disjoint:
	+ "\<lbrakk>finite A; finite B; A Int B = {}; A \<subseteq> D; B \<subseteq> D\<rbrakk> \<Longrightarrow>
	+ foldD D f e (A Un B) = foldD D f e A \<cdot> foldD D f e B"
	+ by (simp add: foldD_Un_Int
	+ left_commute LCD.foldD_closed [OF LCD.intro [of D]])
	+
	+
	+subsection \<open>Finite Products\<close>
	+
	+context monoid
	+begin
	+
	+definition finprod:: "'b set => ('b => 'a) \<Rightarrow> 'a"
	+ where "finprod I f \<equiv> if finite I then foldD M (composition \<circ> f) \<one> I else \<one>"
	+
	+end (* monoid *)
	+
	+
	+section \<open>Groups\<close>
	+
	+lemma comp_group_morphisms:
	+ assumes "group_homomorphism \<eta> A multA oneA B multB oneB" and
	+"group_homomorphism \<theta> B multB oneB C multC oneC"
	+shows "group_homomorphism (\<theta> \<circ> \<eta> \<down> A) A multA oneA C multC oneC"
	+ using assms group_homomorphism_def comp_monoid_morphisms by metis
	+
	+subsection \<open>Subgroup Generated by a Subset\<close>
	+
	+context group
	+begin
	+
	+inductive_set generate :: "'a set \<Rightarrow> 'a set"
	+ for H where
	+ unit: "\<one> \<in> generate H"
	+ \| incl: "a \<in> H \<Longrightarrow> a \<in> generate H"
	+ \| inv: "a \<in> H \<Longrightarrow> inverse a \<in> generate H"
	+ \| mult: "a \<in> generate H \<Longrightarrow> b \<in> generate H \<Longrightarrow> a \<cdot> b \<in> generate H"
	+
	+lemma generate_into_G: "a \<in> generate (G \<inter> H) \<Longrightarrow> a \<in> G"
	+ by (induction rule: generate.induct) auto
	+
	+
	+definition subgroup_generated :: "'a set \<Rightarrow> 'a set"
	+ where "subgroup_generated S = generate (G \<inter> S)"
	+
	+lemma inverse_in_subgroup_generated: "a \<in> subgroup_generated H \<Longrightarrow> inverse a \<in> subgroup_generated H"
	+ unfolding subgroup_generated_def
	+proof (induction rule: generate.induct)
	+ case (mult a b)
	+ then show ?case
	+ by (simp add: generate.mult generate_into_G inverse_composition_commute)
	+qed (auto simp add: generate.unit generate.incl generate.inv)
	+
	+lemma subgroup_generated_is_monoid:
	+ fixes H
	+ shows "Group_Theory.monoid (subgroup_generated H) (\<cdot>) \<one>"
	+ unfolding subgroup_generated_def
	+proof qed (auto simp: generate.unit generate.mult associative generate_into_G)
	+
	+lemma subgroup_generated_is_subset:
	+ fixes H
	+ shows "subgroup_generated H \<subseteq> G"
	+ using generate_into_G subgroup_generated_def by blast
	+
	+lemma subgroup_generated_is_subgroup:
	+ fixes H
	+ shows "subgroup (subgroup_generated H) G (\<cdot>) \<one>"
	+proof
	+ show "subgroup_generated H \<subseteq> G"
	+ by (simp add: subgroup_generated_is_subset)
	+ show "a \<cdot> b \<in> subgroup_generated H"
	+ if "a \<in> subgroup_generated H" "b \<in> subgroup_generated H" for a b
	+ using that by (meson monoid.composition_closed subgroup_generated_is_monoid)
	+ show "a \<cdot> b \<cdot> c = a \<cdot> (b \<cdot> c)"
	+ if "a \<in> subgroup_generated H" "b \<in> subgroup_generated H" "c \<in> subgroup_generated H"
	+ for a b c
	+ using that by (meson monoid.associative subgroup_generated_is_monoid)
	+ show "monoid.invertible (subgroup_generated H) (\<cdot>) \<one> u"
	+ if "u \<in> subgroup_generated H" for u
	+ proof (rule monoid.invertibleI )
	+ show "Group_Theory.monoid (subgroup_generated H) (\<cdot>) \<one>"
	+ by (simp add: subgroup_generated_is_monoid)
	+ show "u \<cdot> local.inverse u = \<one>" "local.inverse u \<cdot> u = \<one>" "u \<in> subgroup_generated H"
	+ using \<open>subgroup_generated H \<subseteq> G\<close> that by auto
	+ show "local.inverse u \<in> subgroup_generated H"
	+ using inverse_in_subgroup_generated that by blast
	+ qed
	+qed (auto simp: generate_into_G generate.unit subgroup_generated_def)
	+
	+
	+end (* group *)
	+
	+
	+section \<open>Abelian Groups\<close>
	+
	+context abelian_group
	+begin
	+
	+definition minus:: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "\<hyphen>" 70)
	+ where "x \<hyphen> y \<equiv> x \<cdot> inverse y "
	+
	+definition finsum:: "'b set \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a"
	+ where "finsum I f \<equiv> finprod I f"
	+
	+(* A notation "\<Sum>i\<in>I. f i" should be introduced for a sum of a family of elements of an abelian group *)
	+
	+end (* abelian_group*)
	+
	+end
	diff --git a/thys/Grothendieck_Schemes/ROOT b/thys/Grothendieck_Schemes/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/ROOT
	@@ -0,0 +1,11 @@
	+chapter AFP
	+
	+session "Grothendieck_Schemes" (AFP) = HOL +
	+ options [timeout = 600]
	+ sessions
	+ "Jacobson_Basic_Algebra"
	+ theories
	+ Scheme
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/Grothendieck_Schemes/Scheme.thy b/thys/Grothendieck_Schemes/Scheme.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/Scheme.thy
	@@ -0,0 +1,850 @@
	+
	+text \<open>Authors: Anthony Bordg and Lawrence Paulson,
	+with some contributions from Wenda Li\<close>
	+
	+theory Scheme
	+imports "Comm_Ring"
	+
	+begin
	+
	+section \<open>Misc\<close>
	+
	+lemma (in Set_Theory.map) set_map_\<alpha>_cong:
	+ assumes \<alpha>_eq:"\<And>x. x\<in>S \<Longrightarrow> \<alpha>' x = \<alpha> x" and \<alpha>_ext:"\<alpha>' \<in> extensional S"
	+ shows "Set_Theory.map \<alpha>' S T"
	+using map_axioms \<alpha>_eq \<alpha>_ext
	+unfolding Set_Theory.map_def by (auto simp:extensional_def)
	+
	+lemma (in monoid_homomorphism) monoid_homomorphism_\<eta>_cong:
	+ assumes \<eta>_eq:"\<And>x. x\<in>M \<Longrightarrow> \<eta>' x = \<eta> x" and \<eta>_ext:"\<eta>' \<in> extensional M"
	+ shows "monoid_homomorphism \<eta>' M (\<cdot>) \<one> M' (\<cdot>') \<one>'"
	+proof -
	+ have "Set_Theory.map \<eta>' M M'"
	+ using set_map_\<alpha>_cong \<eta>_eq \<eta>_ext by auto
	+ moreover have "monoid_homomorphism_axioms \<eta>' M (\<cdot>) \<one> (\<cdot>') \<one>'"
	+ unfolding monoid_homomorphism_axioms_def
	+ by (simp add: \<eta>_eq commutes_with_composition commutes_with_unit)
	+ ultimately show ?thesis
	+ unfolding monoid_homomorphism_def
	+ using source.monoid_axioms target.monoid_axioms by blast
	+qed
	+
	+lemma (in group_homomorphism) group_homomorphism_\<eta>_cong:
	+ assumes \<eta>_eq:"\<And>x. x\<in>G \<Longrightarrow> \<eta>' x = \<eta> x" and \<eta>_ext:"\<eta>' \<in> extensional G"
	+ shows "group_homomorphism \<eta>' G (\<cdot>) \<one> G' (\<cdot>') \<one>'"
	+ by (simp add: \<eta>_eq \<eta>_ext group_homomorphism_def monoid_homomorphism_\<eta>_cong source.group_axioms
	+ target.group_axioms)
	+
	+lemma (in ring_homomorphism) ring_homomorphism_\<eta>_cong:
	+ assumes \<eta>_eq:"\<And>x. x\<in>R \<Longrightarrow> \<eta>' x = \<eta> x" and \<eta>_ext:"\<eta>' \<in> extensional R"
	+ shows "ring_homomorphism \<eta>' R (+) (\<cdot>) \<zero> \<one> R' (+') (\<cdot>') \<zero>' \<one>'"
	+ unfolding ring_homomorphism_def
	+ using \<eta>_eq \<eta>_ext additive.group_homomorphism_\<eta>_cong multiplicative.monoid_homomorphism_\<eta>_cong
	+ set_map_\<alpha>_cong source.ring_axioms target.ring_axioms by presburger
	+
	+lemma (in morphism_presheaves_of_rings) morphism_presheaves_of_rings_fam_cong:
	+ assumes fam_eq:"\<And>U x. \<lbrakk> is_open U; x\<in>\<FF> U\<rbrakk> \<Longrightarrow> fam_morphisms' U x= fam_morphisms U x"
	+ and fam_ext:"\<And>U. is_open U \<Longrightarrow> fam_morphisms' U \<in> extensional (\<FF> U)"
	+ shows "morphism_presheaves_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str \<FF>' \<rho>' b'
	+ add_str' mult_str'
	+ zero_str' one_str' fam_morphisms'"
	+proof -
	+ have " presheaf_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str"
	+ using source.presheaf_of_rings_axioms .
	+ moreover have "presheaf_of_rings X is_open \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str'"
	+ using target.presheaf_of_rings_axioms .
	+ moreover have "
	+ morphism_presheaves_of_rings_axioms is_open \<FF> \<rho> add_str mult_str zero_str one_str \<FF>' \<rho>' add_str' mult_str'
	+ zero_str' one_str' fam_morphisms'"
	+ proof -
	+ have "ring_homomorphism (fam_morphisms' U) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (\<FF>' U) +'\<^bsub>U\<^esub> \<cdot>'\<^bsub>U\<^esub> \<zero>'\<^bsub>U\<^esub> \<one>'\<^bsub>U\<^esub>"
	+ if "is_open U" for U
	+ apply (rule is_ring_morphism[OF that,THEN ring_homomorphism.ring_homomorphism_\<eta>_cong])
	+ using fam_eq fam_ext
	+ by (auto simp add: that)
	+ moreover have "(\<rho>' U V \<circ> fam_morphisms' U) x = (fam_morphisms' V \<circ> \<rho> U V) x"
	+ if "is_open U" "is_open V" "V \<subseteq> U" "x \<in> \<FF> U" for U V x
	+ by (metis calculation comm_diagrams fam_eq fam_morphisms_are_maps map_eq ring_homomorphism_def
	+ that(1) that(2) that(3) that(4))
	+ ultimately show ?thesis
	+ using comm_diagrams is_ring_morphism
	+ unfolding morphism_presheaves_of_rings_axioms_def by auto
	+ qed
	+ ultimately show ?thesis
	+ unfolding morphism_presheaves_of_rings_def by auto
	+qed
	+
	+
	+section \<open>Affine Schemes\<close>
	+
	+text \<open>Computational affine schemes take the isomorphism with Spec as part of their data,
	+while in the locale for affine schemes we merely assert the existence of such an isomorphism.\<close>
	+
	+locale affine_scheme = comm_ring +
	+locally_ringed_space X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str +
	+iso_locally_ringed_spaces X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str
	+"Spec" is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b "\<lambda>U. add_sheaf_spec U"
	+"\<lambda>U. mult_sheaf_spec U" "\<lambda>U. zero_sheaf_spec U" "\<lambda>U. one_sheaf_spec U" f \<phi>\<^sub>f
	+for X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str f \<phi>\<^sub>f
	+
	+section \<open>Schemes\<close>
	+
	+(* def. 0.47 *)
	+locale scheme = comm_ring +
	+locally_ringed_space X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str
	+for X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str +
	+ assumes are_affine_schemes: "\<And>x. x \<in> X \<Longrightarrow> (\<exists>U. x\<in>U \<and> is_open U \<and>
	+(\<exists>f \<phi>\<^sub>f. affine_scheme R (+) (\<cdot>) \<zero> \<one> U (ind_topology.ind_is_open X is_open U) (ind_sheaf.ind_sheaf \<O>\<^sub>X U)
	+(ind_sheaf.ind_ring_morphisms \<rho> U) b (ind_sheaf.ind_add_str add_str U)
	+(ind_sheaf.ind_mult_str mult_str U) (ind_sheaf.ind_zero_str zero_str U)
	+(ind_sheaf.ind_one_str one_str U) f \<phi>\<^sub>f))"
	+
	+locale iso_stalks =
	+ stk1:stalk S is_open \<FF>1 \<rho>1 b add_str1 mult_str1 zero_str1 one_str1 I x +
	+ stk2:stalk S is_open \<FF>2 \<rho>2 b add_str2 mult_str2 zero_str2 one_str2 I x
	+ for S is_open \<FF>1 \<rho>1 b add_str1 mult_str1 zero_str1 one_str1 I x
	+ \<FF>2 \<rho>2 add_str2 mult_str2 zero_str2 one_str2 +
	+ assumes
	+ stalk_eq:"\<forall>U\<in>I. \<FF>1 U = \<FF>2 U \<and> add_str1 U = add_str2 U \<and> mult_str1 U = mult_str2 U
	+ \<and> zero_str1 U = zero_str2 U \<and> one_str1 U = one_str2 U"
	+ and stalk\<rho>_eq:"\<forall>U V. U\<in>I \<and> V \<in>I \<longrightarrow> \<rho>1 U V = \<rho>2 U V"
	+begin
	+
	+lemma
	+ assumes "U \<in> I"
	+ shows has_ring_isomorphism:"ring_isomorphism (identity stk1.carrier_stalk) stk1.carrier_stalk
	+ stk1.add_stalk stk1.mult_stalk (stk1.zero_stalk U) (stk1.one_stalk U)
	+ stk2.carrier_stalk stk2.add_stalk stk2.mult_stalk (stk2.zero_stalk U) (stk2.one_stalk U)"
	+ and carrier_stalk_eq:"stk1.carrier_stalk = stk2.carrier_stalk"
	+ and class_of_eq:"stk1.class_of = stk2.class_of"
	+proof -
	+ have "is_open U" "x \<in> U"
	+ using stk1.index assms by auto
	+ interpret ring1:ring stk1.carrier_stalk stk1.add_stalk stk1.mult_stalk "stk1.zero_stalk U"
	+ "stk1.one_stalk U"
	+ using stk1.stalk_is_ring[OF \<open>is_open U\<close> \<open>x \<in> U\<close>] .
	+ interpret ring2:ring stk2.carrier_stalk stk2.add_stalk stk2.mult_stalk "stk2.zero_stalk U"
	+ "stk2.one_stalk U"
	+ using stk2.stalk_is_ring[OF \<open>is_open U\<close> \<open>x \<in> U\<close>] .
	+
	+ interpret e1:equivalence "Sigma I \<FF>1" "{(x, y). stk1.rel x y}"
	+ using stk1.rel_is_equivalence .
	+ interpret e2:equivalence "Sigma I \<FF>2" "{(x, y). stk2.rel x y}"
	+ using stk2.rel_is_equivalence .
	+
	+ have Sigma_eq:"Sigma I \<FF>1 = Sigma I \<FF>2"
	+ proof (rule Sigma_cong[OF refl])
	+ fix x assume "x \<in> I"
	+ from stalk_eq[rule_format,OF this]
	+ show "\<FF>1 x = \<FF>2 x" by simp
	+ qed
	+ moreover have "stk1.rel xx yy \<longleftrightarrow> stk2.rel xx yy"
	+ if "xx\<in>Sigma I \<FF>1" "yy\<in>Sigma I \<FF>2"
	+ for xx yy
	+ unfolding stk1.rel_def stk2.rel_def
	+ by (metis stalk\<rho>_eq stalk_eq)
	+ ultimately have Class_eq: "e1.Class = e2.Class"
	+ unfolding e1.Class_def e2.Class_def
	+ by (auto intro!:ext)
	+ then show class_of_eq:"stk1.class_of = stk2.class_of"
	+ unfolding stk1.class_of_def stk2.class_of_def by auto
	+
	+ show "stk1.carrier_stalk = stk2.carrier_stalk"
	+ using Class_eq Sigma_eq e1.natural.surjective e2.natural.surjective
	+ stk1.carrier_direct_lim_def stk1.carrier_stalk_def stk2.carrier_direct_lim_def
	+ stk2.carrier_stalk_def stk2.neighborhoods_eq by force
	+
	+ let ?id = "identity stk1.carrier_stalk"
	+ show "ring_isomorphism (identity stk1.carrier_stalk) stk1.carrier_stalk
	+ stk1.add_stalk stk1.mult_stalk (stk1.zero_stalk U) (stk1.one_stalk U)
	+ stk2.carrier_stalk stk2.add_stalk stk2.mult_stalk (stk2.zero_stalk U) (stk2.one_stalk U)"
	+ proof
	+ show "?id (stk1.one_stalk U) = stk2.one_stalk U"
	+ proof -
	+ have "stk1.one_stalk U \<in> stk1.carrier_stalk" by blast
	+ then have "?id (stk1.one_stalk U) = stk1.one_stalk U" by auto
	+ also have "... = stk2.one_stalk U"
	+ unfolding stk1.one_stalk_def stk2.one_stalk_def class_of_eq
	+ by (simp add: assms stalk_eq)
	+ finally show ?thesis .
	+ qed
	+ show "?id (stk1.zero_stalk U) = stk2.zero_stalk U"
	+ proof -
	+ have "stk1.zero_stalk U \<in> stk1.carrier_stalk" by blast
	+ then have "?id (stk1.zero_stalk U) = stk1.zero_stalk U" by auto
	+ also have "... = stk2.zero_stalk U"
	+ unfolding stk1.zero_stalk_def stk2.zero_stalk_def class_of_eq
	+ by (simp add: assms stalk_eq)
	+ finally show ?thesis .
	+ qed
	+
	+
	+ show "?id (stk1.add_stalk X' Y') = stk2.add_stalk (?id X') (?id Y')"
	+ "?id (stk1.mult_stalk X' Y') = stk2.mult_stalk (?id X') (?id Y')"
	+ if "X' \<in> stk1.carrier_stalk" "Y' \<in> stk1.carrier_stalk" for X' Y'
	+ proof -
	+ define x where "x=(SOME x. x \<in> X')"
	+ define y where "y=(SOME y. y \<in> Y')"
	+ have x:"x\<in>X'" "x\<in>Sigma I \<FF>1" and x_alt:"X' = stk1.class_of (fst x) (snd x)"
	+ using stk1.rel_carrier_Eps_in that(1) stk1.carrier_stalk_def stk2.neighborhoods_eq x_def
	+ by auto
	+ have y:"y\<in>Y'" "y\<in>Sigma I \<FF>1" and y_alt:"Y' = stk1.class_of (fst y) (snd y)"
	+ using stk1.rel_carrier_Eps_in that(2) stk1.carrier_stalk_def stk2.neighborhoods_eq y_def
	+ by auto
	+ obtain "fst x \<subseteq> S" "fst y \<subseteq> S"
	+ using x(2) y(2) stk1.index
	+ by (metis mem_Sigma_iff prod.collapse stk1.open_imp_subset stk2.subset_of_opens)
	+ obtain w where w: "w\<in>I" "w \<subseteq> fst x" "w \<subseteq> fst y"
	+ using stk1.has_lower_bound x(2) y(2) by force
	+ have "w \<subseteq> S"
	+ by (simp add: stk1.open_imp_subset stk1.subset_of_opens w(1))
	+
	+ have "stk1.add_stalk X' Y' = stk1.class_of w (add_str1 w (\<rho>1 (fst x) w (snd x))
	+ (\<rho>1 (fst y) w (snd y)))"
	+ unfolding x_alt y_alt stk1.add_stalk_def
	+ apply (subst stk1.add_rel_class_of[where W=w])
	+ using x y w by auto
	+ also have "... = stk2.class_of w (add_str2 w (\<rho>2 (fst x) w (snd x)) (\<rho>2 (fst y) w (snd y)))"
	+ using class_of_eq stalk\<rho>_eq stalk_eq w(1) x(2) y(2) by force
	+ also have "... = stk2.add_stalk X' Y'"
	+ unfolding stk2.add_stalk_def x_alt y_alt class_of_eq
	+ apply (subst stk2.add_rel_class_of[where W=w])
	+ using x y w by (auto simp add: Sigma_eq)
	+ finally have "stk1.add_stalk X' Y' = stk2.add_stalk X' Y'" .
	+ moreover have "stk1.add_stalk X' Y' \<in> stk1.carrier_stalk"
	+ by (simp add: that(1) that(2))
	+ ultimately show "?id (stk1.add_stalk X' Y') = stk2.add_stalk (?id X') (?id Y')"
	+ using that by simp
	+
	+ have "stk1.mult_stalk X' Y' = stk1.class_of w (mult_str1 w (\<rho>1 (fst x) w (snd x))
	+ (\<rho>1 (fst y) w (snd y)))"
	+ unfolding x_alt y_alt stk1.mult_stalk_def
	+ apply (subst stk1.mult_rel_class_of[where W=w])
	+ using x y w by auto
	+ also have "... = stk2.class_of w (mult_str2 w (\<rho>2 (fst x) w (snd x)) (\<rho>2 (fst y) w (snd y)))"
	+ using class_of_eq stalk\<rho>_eq stalk_eq w(1) x(2) y(2) by force
	+ also have "... = stk2.mult_stalk X' Y'"
	+ unfolding stk2.mult_stalk_def x_alt y_alt class_of_eq
	+ apply (subst stk2.mult_rel_class_of[where W=w])
	+ using x y w by (auto simp add: Sigma_eq)
	+ finally have "stk1.mult_stalk X' Y' = stk2.mult_stalk X' Y'" .
	+ moreover have "stk1.mult_stalk X' Y' \<in> stk1.carrier_stalk"
	+ by (simp add: that(1) that(2))
	+ ultimately show "?id (stk1.mult_stalk X' Y') = stk2.mult_stalk (?id X') (?id Y')"
	+ using that by simp
	+ qed
	+
	+ from \<open>stk1.carrier_stalk = stk2.carrier_stalk\<close>
	+ show "?id \<in> stk1.carrier_stalk \<rightarrow>\<^sub>E stk2.carrier_stalk"
	+ "bij_betw ?id stk1.carrier_stalk stk2.carrier_stalk"
	+ by (auto simp flip: id_def)
	+ qed
	+qed
	+end
	+
	+lemma (in affine_scheme) affine_scheme_is_scheme:
	+ shows "scheme R (+) (\<cdot>) \<zero> \<one> X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str"
	+proof -
	+ interpret ind_sheaf X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str X
	+ by (metis ind_sheaf_axioms_def ind_sheaf_def open_space ringed_space_axioms ringed_space_def)
	+ have ind_is_open[simp]: "ind_topology.ind_is_open X is_open X = is_open"
	+ by (rule ext) (meson ind_is_open_iff_open open_imp_subset)
	+
	+ interpret sheaf_of_rings X is_open local.ind_sheaf ind_ring_morphisms b ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str
	+ using ind_sheaf_is_sheaf by force
	+
	+ have eq_\<O>\<^sub>X: "local.ind_sheaf U = \<O>\<^sub>X U" if "U \<subseteq> X" for U
	+ using that by (simp add: Int_absorb2 Int_commute local.ind_sheaf_def)
	+ have eq_\<rho>: "\<And>U V. U \<subseteq> X \<and> V \<subseteq> X \<Longrightarrow> ind_ring_morphisms U V = \<rho> U V"
	+ by (simp add: ind_ring_morphisms_def inf.absorb_iff2)
	+ have eq_add_str: "\<And>U. U \<subseteq> X \<Longrightarrow> ind_add_str U = add_str U"
	+ by (simp add: ind_add_str_def inf.absorb_iff2)
	+ have eq_mult_str : "\<And>U. U \<subseteq> X \<Longrightarrow> ind_mult_str U = mult_str U"
	+ by (simp add: ind_mult_str_def inf.absorb_iff2)
	+ have eq_zero_str : "\<And>U. U \<subseteq> X \<Longrightarrow> ind_zero_str U = zero_str U"
	+ by (simp add: Int_absorb2 Int_commute ind_zero_str_def)
	+ have eq_one_str : "\<And>U. U \<subseteq> X \<Longrightarrow> ind_one_str U = one_str U"
	+ by (simp add: ind_one_str_def inf.absorb_iff2)
	+
	+ have "affine_scheme R (+) (\<cdot>) \<zero> \<one> X is_open local.ind_sheaf ind_ring_morphisms b
	+ ind_add_str ind_mult_str ind_zero_str ind_one_str f \<phi>\<^sub>f"
	+ proof -
	+ have "locally_ringed_space X is_open local.ind_sheaf ind_ring_morphisms b ind_add_str ind_mult_str ind_zero_str
	+ ind_one_str"
	+ proof -
	+ have "stalk.is_local is_open local.ind_sheaf ind_ring_morphisms ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str
	+ (neighborhoods u) u U"
	+ if "u \<in> U" and opeU: "is_open U" for u U
	+ proof -
	+ have UX: "U \<subseteq> X" by (simp add: opeU open_imp_subset)
	+
	+ interpret stX: stalk X is_open local.ind_sheaf ind_ring_morphisms b ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str "neighborhoods u" u
	+ apply (unfold_locales)
	+ unfolding neighborhoods_def using \<open>U \<subseteq> X\<close> \<open>u\<in>U\<close> by auto
	+ interpret stalk X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str "neighborhoods u" u
	+ by (meson direct_lim_def ind_sheaf.axioms(1) ind_sheaf_axioms stX.stalk_axioms stalk_def)
	+
	+ have "local_ring carrier_stalk add_stalk mult_stalk (zero_stalk U) (one_stalk U)"
	+ using is_local_def opeU stalks_are_local that(1) by blast
	+ moreover have "ring_isomorphism (identity stX.carrier_stalk)
	+ stX.carrier_stalk stX.add_stalk stX.mult_stalk (stX.zero_stalk U) (stX.one_stalk U)
	+ carrier_stalk add_stalk mult_stalk (zero_stalk U) (one_stalk U)"
	+ proof -
	+ interpret iso_stalks X is_open local.ind_sheaf ind_ring_morphisms b ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str "neighborhoods u" u \<O>\<^sub>X \<rho> add_str mult_str
	+ zero_str one_str
	+ apply unfold_locales
	+ subgoal
	+ by (simp add: eq_\<O>\<^sub>X eq_add_str eq_mult_str eq_one_str eq_zero_str open_imp_subset
	+ subset_of_opens)
	+ subgoal using eq_\<rho> open_imp_subset subset_of_opens by auto
	+ done
	+ have "U \<in> neighborhoods u"
	+ by (simp add: opeU stX.index that(1))
	+ from has_ring_isomorphism[OF this]
	+ show ?thesis .
	+ qed
	+ ultimately show ?thesis unfolding stX.is_local_def
	+ using isomorphic_to_local_is_local by fast
	+ qed
	+ then show ?thesis
	+ by (simp add: locally_ringed_space_axioms_def locally_ringed_space_def
	+ ringed_space_def sheaf_of_rings_axioms)
	+ qed
	+ moreover have "iso_locally_ringed_spaces X is_open local.ind_sheaf ind_ring_morphisms b
	+ ind_add_str ind_mult_str ind_zero_str ind_one_str Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec f \<phi>\<^sub>f"
	+ proof-
	+ interpret im_sheafXS: Comm_Ring.im_sheaf X is_open local.ind_sheaf
	+ ind_ring_morphisms b ind_add_str ind_mult_str ind_zero_str ind_one_str Spec
	+ is_zariski_open f
	+ by intro_locales
	+ interpret iso_sheaves_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+ add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec local.im_sheaf
	+ im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf \<phi>\<^sub>f
	+ using is_iso_of_sheaves by blast
	+
	+ have ring_homoU:"ring_homomorphism (\<phi>\<^sub>f U) (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U)
	+ (one_sheaf_spec U) (im_sheafXS.im_sheaf U) (im_sheafXS.add_im_sheaf U) (im_sheafXS.mult_im_sheaf U)
	+ (im_sheafXS.zero_im_sheaf U) (im_sheafXS.one_im_sheaf U)"
	+ if "is_zariski_open U " for U
	+ using mor.is_ring_morphism
	+ by (metis Int_commute Int_left_absorb add_im_sheaf_def im_sheafXS.add_im_sheaf_def
	+ im_sheafXS.im_sheaf_def im_sheafXS.mult_im_sheaf_def im_sheafXS.one_im_sheaf_def
	+ im_sheafXS.zero_im_sheaf_def ind_add_str_def ind_mult_str_def ind_one_str_def
	+ ind_zero_str_def local.im_sheaf_def local.ind_sheaf_def
	+ mult_im_sheaf_def one_im_sheaf_def that zero_im_sheaf_def)
	+
	+ note ring_homoU
	+ moreover have "(\<forall>U V. is_zariski_open U \<longrightarrow>
	+ is_zariski_open V \<longrightarrow>
	+ V \<subseteq> U \<longrightarrow>
	+ (\<forall>x. x \<in> \<O> U \<longrightarrow> (im_sheafXS.im_sheaf_morphisms U V \<circ> \<phi>\<^sub>f U) x = (\<phi>\<^sub>f V \<circ> sheaf_spec_morphisms U V) x))"
	+ using eq_\<rho> im_sheafXS.im_sheaf_morphisms_def im_sheaf_morphisms_def mor.comm_diagrams by auto
	+ ultimately interpret morphism_ringed_spaces X is_open local.ind_sheaf ind_ring_morphisms b
	+ ind_add_str ind_mult_str ind_zero_str ind_one_str Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec
	+ zero_sheaf_spec one_sheaf_spec f \<phi>\<^sub>f
	+ apply intro_locales
	+ unfolding morphism_ringed_spaces_axioms_def morphism_ringed_spaces_def
	+ apply intro_locales
	+ unfolding morphism_presheaves_of_rings_axioms_def
	+ by auto
	+
	+ have "iso_locally_ringed_spaces X is_open local.ind_sheaf ind_ring_morphisms b
	+ ind_add_str ind_mult_str ind_zero_str ind_one_str
	+ Spec is_zariski_open sheaf_spec sheaf_spec_morphisms
	+ \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec f \<phi>\<^sub>f"
	+ apply intro_locales
	+ subgoal
	+ proof -
	+ have "ind_mor_btw_stalks.is_local X is_open local.ind_sheaf ind_ring_morphisms ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str is_zariski_open sheaf_spec sheaf_spec_morphisms
	+ add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec f x U
	+ \<phi>\<^bsub>X is_open local.ind_sheaf ind_ring_morphisms is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms f \<phi>\<^sub>f x\<^esub>"
	+ if "x \<in> X" "is_zariski_open U" "f x \<in> U" for x U
	+ proof -
	+ interpret ind_btw:ind_mor_btw_stalks X is_open local.ind_sheaf ind_ring_morphisms b ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec
	+ zero_sheaf_spec one_sheaf_spec f \<phi>\<^sub>f x
	+ apply intro_locales
	+ using \<open>x \<in> X\<close> by (simp add: ind_mor_btw_stalks_axioms.intro)
	+
	+ interpret ind_mor_btw_stalks X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str
	+ Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec
	+ zero_sheaf_spec one_sheaf_spec f \<phi>\<^sub>f x
	+ apply intro_locales
	+ using \<open>x \<in> X\<close> by (simp add: ind_mor_btw_stalks_axioms.intro)
	+
	+ interpret stk1:stalk X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str
	+ "{U. is_open U \<and> x \<in> U}" x
	+ apply unfold_locales
	+ using \<open>x \<in> X\<close> by auto
	+ interpret stk2:stalk X is_open local.ind_sheaf ind_ring_morphisms b ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str "{U. is_open U \<and> x \<in> U}" x
	+ apply unfold_locales
	+ using \<open>x \<in> X\<close> by auto
	+ interpret stk3:stalk Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec
	+ zero_sheaf_spec one_sheaf_spec "{U. is_zariski_open U \<and> f x \<in> U}" "f x"
	+ apply unfold_locales
	+ by (auto simp add: stk2.is_elem)
	+ interpret ring31:ring_homomorphism induced_morphism stk3.carrier_stalk stk3.add_stalk
	+ stk3.mult_stalk "stk3.zero_stalk U" "stk3.one_stalk U" stk1.carrier_stalk
	+ stk1.add_stalk stk1.mult_stalk "stk1.zero_stalk (f \<^sup>\<inverse> X U)" "stk1.one_stalk (f \<^sup>\<inverse> X U)"
	+ using ring_homomorphism_induced_morphism[OF \<open>is_zariski_open U\<close> \<open>f x \<in> U\<close>] .
	+ interpret ring32:ring_homomorphism ind_btw.induced_morphism stk3.carrier_stalk
	+ stk3.add_stalk
	+ stk3.mult_stalk "stk3.zero_stalk U" "stk3.one_stalk U" stk2.carrier_stalk
	+ stk2.add_stalk stk2.mult_stalk "stk2.zero_stalk (f \<^sup>\<inverse> X U)" "stk2.one_stalk (f \<^sup>\<inverse> X U)"
	+ using ind_btw.ring_homomorphism_induced_morphism[OF \<open>is_zariski_open U\<close> \<open>f x \<in> U\<close>] .
	+
	+ interpret iso:iso_stalks X is_open \<O>\<^sub>X \<rho> b add_str mult_str zero_str one_str
	+ "{U. is_open U \<and> x \<in> U}" x local.ind_sheaf ind_ring_morphisms
	+ ind_add_str
	+ ind_mult_str ind_zero_str ind_one_str
	+ apply unfold_locales
	+ subgoal
	+ by (metis eq_\<O>\<^sub>X eq_add_str eq_mult_str eq_one_str eq_zero_str open_imp_subset
	+ stk2.subset_of_opens)
	+ subgoal
	+ using eq_\<rho> open_imp_subset stk2.subset_of_opens by presburger
	+ done
	+ have fU:"f \<^sup>\<inverse> X U \<in> {U. is_open U \<and> x \<in> U}"
	+ using is_continuous[OF \<open>is_zariski_open U\<close>]
	+ using stk2.is_elem that(3) by blast
	+
	+ have is_local:"is_local U induced_morphism"
	+ using are_local_morphisms[of x U] using that by auto
	+ from this[unfolded is_local_def]
	+ have "local_ring_morphism (identity stk2.carrier_stalk \<circ> induced_morphism \<down> stk3.carrier_stalk)
	+ stk3.carrier_stalk stk3.add_stalk stk3.mult_stalk (stk3.zero_stalk U)
	+ (stk3.one_stalk U) stk2.carrier_stalk stk2.add_stalk stk2.mult_stalk
	+ (stk2.zero_stalk (f \<^sup>\<inverse> X U)) (stk2.one_stalk (f \<^sup>\<inverse> X U))"
	+ proof (elim comp_of_local_ring_morphisms)
	+ interpret local_ring_morphism induced_morphism stk3.carrier_stalk stk3.add_stalk
	+ stk3.mult_stalk "stk3.zero_stalk U" "stk3.one_stalk U" stk1.carrier_stalk
	+ stk1.add_stalk stk1.mult_stalk "stk1.zero_stalk (f \<^sup>\<inverse> X U)"
	+ "stk1.one_stalk (f \<^sup>\<inverse> X U)"
	+ using is_local[unfolded is_local_def] .
	+
	+ have "local_ring stk1.carrier_stalk stk1.add_stalk stk1.mult_stalk
	+ (stk1.zero_stalk (f \<^sup>\<inverse> X U)) (stk1.one_stalk (f \<^sup>\<inverse> X U))"
	+ using target.local_ring_axioms .
	+ moreover have "ring_isomorphism (identity stk1.carrier_stalk) stk1.carrier_stalk
	+ stk1.add_stalk stk1.mult_stalk (stk1.zero_stalk (f \<^sup>\<inverse> X U))
	+ (stk1.one_stalk (f \<^sup>\<inverse> X U)) stk2.carrier_stalk stk2.add_stalk stk2.mult_stalk
	+ (stk2.zero_stalk (f \<^sup>\<inverse> X U)) (stk2.one_stalk (f \<^sup>\<inverse> X U))"
	+ using iso.has_ring_isomorphism[OF fU] .
	+ ultimately have "local_ring_morphism (identity stk1.carrier_stalk) stk1.carrier_stalk
	+ stk1.add_stalk stk1.mult_stalk (stk1.zero_stalk (f \<^sup>\<inverse> X U))
	+ (stk1.one_stalk (f \<^sup>\<inverse> X U)) stk2.carrier_stalk stk2.add_stalk stk2.mult_stalk
	+ (stk2.zero_stalk (f \<^sup>\<inverse> X U)) (stk2.one_stalk (f \<^sup>\<inverse> X U))"
	+ by (rule iso_is_local_ring_morphism)
	+ then show "local_ring_morphism (identity stk2.carrier_stalk) stk1.carrier_stalk
	+ stk1.add_stalk stk1.mult_stalk (stk1.zero_stalk (f \<^sup>\<inverse> X U))
	+ (stk1.one_stalk (f \<^sup>\<inverse> X U)) stk2.carrier_stalk stk2.add_stalk stk2.mult_stalk
	+ (stk2.zero_stalk (f \<^sup>\<inverse> X U)) (stk2.one_stalk (f \<^sup>\<inverse> X U))"
	+ using iso.carrier_stalk_eq[OF fU] by simp
	+ qed
	+ moreover have "identity stk2.carrier_stalk \<circ> induced_morphism \<down> stk3.carrier_stalk
	+ = ind_btw.induced_morphism"
	+ proof -
	+ have "(identity stk2.carrier_stalk \<circ> induced_morphism \<down> stk3.carrier_stalk) x
	+ = ind_btw.induced_morphism x" (is "?L=?R") if "x\<in>stk3.carrier_stalk" for x
	+ proof -
	+ have "?L = identity stk2.carrier_stalk (induced_morphism x)"
	+ unfolding compose_def using that by simp
	+ also have "... = induced_morphism x"
	+ using that iso.carrier_stalk_eq[OF fU] by auto
	+ also have "... = ?R"
	+ unfolding induced_morphism_def ind_btw.induced_morphism_def
	+ using iso.class_of_eq[OF fU] by auto
	+ finally show ?thesis .
	+ qed
	+ then show ?thesis unfolding ind_btw.induced_morphism_def
	+ by (smt (z3) compose_def restrict_apply' restrict_ext)
	+ qed
	+ ultimately show ?thesis unfolding is_local_def ind_btw.is_local_def
	+ by auto
	+ qed
	+ then show ?thesis
	+ by (simp add: morphism_locally_ringed_spaces_axioms_def)
	+ qed
	+ subgoal
	+ proof -
	+ obtain \<psi> where \<psi>_morph:"morphism_presheaves_of_rings Spec is_zariski_open local.im_sheaf
	+ im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec \<psi>"
	+ and \<psi>_comp:"(\<forall>U. is_zariski_open U \<longrightarrow> (\<forall>x\<in>local.im_sheaf U. (\<phi>\<^sub>f U \<circ> \<psi> U) x = x)
	+ \<and> (\<forall>x\<in>\<O> U. (\<psi> U \<circ> \<phi>\<^sub>f U) x = x))"
	+ using is_inv by auto
	+
	+ interpret \<psi>_morph:morphism_presheaves_of_rings Spec is_zariski_open local.im_sheaf
	+ im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec \<psi>
	+ using \<psi>_morph .
	+
	+ have "morphism_presheaves_of_rings Spec is_zariski_open
	+ im_sheafXS.im_sheaf im_sheafXS.im_sheaf_morphisms b im_sheafXS.add_im_sheaf
	+ im_sheafXS.mult_im_sheaf im_sheafXS.zero_im_sheaf im_sheafXS.one_im_sheaf
	+ im_sheaf im_sheaf_morphisms b add_im_sheaf
	+ mult_im_sheaf zero_im_sheaf one_im_sheaf (\<lambda>U. identity (im_sheafXS.im_sheaf U))"
	+ proof -
	+ have "ring_homomorphism (identity (im_sheafXS.im_sheaf U)) (im_sheafXS.im_sheaf U)
	+ (im_sheafXS.add_im_sheaf U) (im_sheafXS.mult_im_sheaf U) (im_sheafXS.zero_im_sheaf U)
	+ (im_sheafXS.one_im_sheaf U) (local.im_sheaf U) (add_im_sheaf U) (mult_im_sheaf U)
	+ (zero_im_sheaf U) (one_im_sheaf U)"
	+ if "is_zariski_open U" for U
	+ proof -
	+ have "bijective_map (\<phi>\<^sub>f U \<circ> \<psi> U \<down> local.im_sheaf U) (local.im_sheaf U)
	+ (im_sheafXS.im_sheaf U)"
	+ apply unfold_locales
	+ subgoal
	+ by (smt (verit, ccfv_threshold) Int_commute Int_left_absorb Pi_I \<psi>_comp
	+ compose_def im_sheafXS.im_sheaf_def local.im_sheaf_def local.ind_sheaf_def
	+ o_apply restrict_PiE that)
	+ subgoal
	+ by (smt (verit, best) \<psi>_comp bij_betw_iff_bijections comp_apply compose_eq eq_\<O>\<^sub>X
	+ im_sheafXS.im_sheaf_def is_continuous local.im_sheaf_def open_imp_subset that)
	+ done
	+ with comp_ring_morphisms[OF \<psi>_morph.is_ring_morphism[OF that] ring_homoU[OF that]]
	+ interpret ring_isomorphism "\<phi>\<^sub>f U \<circ> \<psi> U \<down> local.im_sheaf U" "local.im_sheaf U"
	+ "add_im_sheaf U" "mult_im_sheaf U" "zero_im_sheaf U" "one_im_sheaf U"
	+ "im_sheafXS.im_sheaf U" "im_sheafXS.add_im_sheaf U" "im_sheafXS.mult_im_sheaf U"
	+ "im_sheafXS.zero_im_sheaf U" "im_sheafXS.one_im_sheaf U"
	+ using ring_isomorphism.intro by fast
	+
	+ have "ring_homomorphism (restrict (inv_into (local.im_sheaf U)
	+ (\<phi>\<^sub>f U \<circ> \<psi> U \<down> local.im_sheaf U)) (im_sheafXS.im_sheaf U))
	+ (im_sheafXS.im_sheaf U) (im_sheafXS.add_im_sheaf U)
	+ (im_sheafXS.mult_im_sheaf U) (im_sheafXS.zero_im_sheaf U)
	+ (im_sheafXS.one_im_sheaf U) (local.im_sheaf U) (add_im_sheaf U)
	+ (mult_im_sheaf U) (zero_im_sheaf U) (one_im_sheaf U)"
	+ using inverse_ring_isomorphism[unfolded ring_isomorphism_def] by auto
	+ moreover have "(restrict (inv_into (local.im_sheaf U)
	+ (\<phi>\<^sub>f U \<circ> \<psi> U \<down> local.im_sheaf U)) (im_sheafXS.im_sheaf U))
	+ = identity (im_sheafXS.im_sheaf U)"
	+ by (smt (verit, best) Int_commute Int_left_absorb \<psi>_comp compose_eq
	+ im_sheafXS.im_sheaf_def injective inv_into_f_f local.im_sheaf_def
	+ local.ind_sheaf_def o_apply restrict_ext that)
	+ ultimately show ?thesis by auto
	+ qed
	+ moreover have "(im_sheaf_morphisms U V \<circ> identity (im_sheafXS.im_sheaf U)) x =
	+ (identity (im_sheafXS.im_sheaf V) \<circ> im_sheafXS.im_sheaf_morphisms U V) x"
	+ (is "?L=?R")
	+ if "is_zariski_open U" "is_zariski_open V" "V \<subseteq> U" "x \<in> im_sheafXS.im_sheaf U"
	+ for U V x
	+ proof -
	+ have "?L = im_sheaf_morphisms U V x"
	+ by (simp add: that(4))
	+ also have "... = im_sheafXS.im_sheaf_morphisms U V x"
	+ by (simp add: eq_\<rho> im_sheafXS.im_sheaf_morphisms_def im_sheaf_morphisms_def)
	+ also have "... = ?R"
	+ using im_sheafXS.is_map_from_is_homomorphism[OF that(1,2,3)] map.map_closed that(4)
	+ by fastforce
	+ finally show ?thesis .
	+ qed
	+ ultimately show ?thesis
	+ apply intro_locales
	+ unfolding morphism_presheaves_of_rings_axioms_def by auto
	+ qed
	+ from comp_of_presheaves[OF this \<psi>_morph]
	+ have "morphism_presheaves_of_rings Spec is_zariski_open im_sheafXS.im_sheaf
	+ im_sheafXS.im_sheaf_morphisms b im_sheafXS.add_im_sheaf im_sheafXS.mult_im_sheaf
	+ im_sheafXS.zero_im_sheaf im_sheafXS.one_im_sheaf sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
	+ (\<lambda>U. \<psi> U \<circ> identity (im_sheafXS.im_sheaf U) \<down> im_sheafXS.im_sheaf U)"
	+ by simp
	+ then have "morphism_presheaves_of_rings Spec is_zariski_open im_sheafXS.im_sheaf
	+ im_sheafXS.im_sheaf_morphisms b im_sheafXS.add_im_sheaf im_sheafXS.mult_im_sheaf
	+ im_sheafXS.zero_im_sheaf im_sheafXS.one_im_sheaf sheaf_spec sheaf_spec_morphisms \<O>b
	+ add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec \<psi>"
	+ proof (elim morphism_presheaves_of_rings.morphism_presheaves_of_rings_fam_cong)
	+ fix U x assume "is_zariski_open U" "x \<in> im_sheafXS.im_sheaf U"
	+ then show " \<psi> U x = (\<psi> U \<circ> identity (im_sheafXS.im_sheaf U) \<down> im_sheafXS.im_sheaf U) x"
	+ by (simp add: compose_eq)
	+ next
	+ show "\<And>U. is_zariski_open U \<Longrightarrow> \<psi> U \<in> extensional (im_sheafXS.im_sheaf U)"
	+ by (metis PiE_iff \<psi>_morph.fam_morphisms_are_maps eq_\<O>\<^sub>X im_sheafXS.im_sheaf_def
	+ is_continuous local.im_sheaf_def map.graph open_imp_subset)
	+ qed
	+ moreover have " (\<forall>U. is_zariski_open U \<longrightarrow> (\<forall>x\<in>im_sheafXS.im_sheaf U. (\<phi>\<^sub>f U \<circ> \<psi> U) x = x)
	+ \<and> (\<forall>x\<in>\<O> U. (\<psi> U \<circ> \<phi>\<^sub>f U) x = x))"
	+ using \<psi>_comp
	+ by (metis Int_commute Int_left_absorb im_sheafXS.im_sheaf_def local.im_sheaf_def
	+ local.ind_sheaf_def)
	+ moreover have "homeomorphism X is_open Spec is_zariski_open f"
	+ using is_homeomorphism by blast
	+ ultimately show ?thesis
	+ unfolding iso_locally_ringed_spaces_axioms_def
	+ apply clarify
	+ apply (auto intro!: iso_presheaves_of_rings.intro iso_sheaves_of_rings.intro
	+ simp:iso_presheaves_of_rings_axioms_def)
	+ by (meson is_morphism_of_sheaves morphism_sheaves_of_rings.axioms)
	+ qed
	+ done
	+ then show ?thesis by (simp add: iso_locally_ringed_spaces_def)
	+ qed
	+ ultimately show ?thesis
	+ unfolding affine_scheme_def using comm_ring_axioms by auto
	+ qed
	+ moreover have "is_open X" by simp
	+ ultimately show ?thesis
	+ by unfold_locales fastforce
	+qed
	+
	+lemma (in comm_ring) spec_is_affine_scheme:
	+ shows "affine_scheme R (+) (\<cdot>) \<zero> \<one> Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+(\<lambda>U. add_sheaf_spec U) (\<lambda>U. mult_sheaf_spec U) (\<lambda>U. zero_sheaf_spec U) (\<lambda>U. one_sheaf_spec U)
	+(identity Spec) (\<lambda>U. identity (\<O> U))"
	+proof (intro affine_scheme.intro)
	+ show "comm_ring R (+) (\<cdot>) \<zero> \<one>" by (simp add: local.comm_ring_axioms)
	+next
	+ show "locally_ringed_space Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec
	+ zero_sheaf_spec one_sheaf_spec" using spec_is_locally_ringed_space by simp
	+next
	+ have [simp]: "\<And>x A. x \<in> A \<Longrightarrow> inv_into A (identity A) x = x"
	+ by (metis bij_betw_def bij_betw_restrict_eq inj_on_id2 inv_into_f_f restrict_apply')
	+ interpret zar: topological_space Spec is_zariski_open
	+ by blast
	+ interpret im_sheaf Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec Spec
	+ is_zariski_open "identity Spec"
	+ by (metis homeomorphism_def im_sheaf_def sheaf_spec_is_sheaf zar.id_is_homeomorphism)
	+ have rh: "\<And>U V. \<lbrakk>is_zariski_open U; is_zariski_open V; V \<subseteq> U\<rbrakk>
	+ \<Longrightarrow> ring_homomorphism
	+ (im_sheaf_morphisms U V)
	+ (local.im_sheaf U) (add_sheaf_spec U)
	+ (mult_sheaf_spec U) (zero_sheaf_spec U)
	+ (one_sheaf_spec U) (local.im_sheaf V)
	+ (add_sheaf_spec V) (mult_sheaf_spec V)
	+ (zero_sheaf_spec V) (one_sheaf_spec V)"
	+ using im_sheaf_morphisms_def local.im_sheaf_def sheaf_spec_morphisms_are_ring_morphisms zar.open_preimage_identity by presburger
	+ interpret F: presheaf_of_rings Spec is_zariski_open
	+ "im_sheaf.im_sheaf Spec sheaf_spec (identity Spec)"
	+ "im_sheaf.im_sheaf_morphisms Spec sheaf_spec_morphisms (identity Spec)" \<O>b
	+ "\<lambda>V. add_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)" "\<lambda>V. mult_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)"
	+ "\<lambda>V. zero_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)" "\<lambda>V. one_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)"
	+ unfolding presheaf_of_rings_def presheaf_of_rings_axioms_def
	+ proof (intro conjI strip)
	+ show "im_sheaf_morphisms U W x = (im_sheaf_morphisms V W \<circ> im_sheaf_morphisms U V) x"
	+ if "is_zariski_open U" "is_zariski_open V" "is_zariski_open W" "V \<subseteq> U"
	+ and "W \<subseteq> V" "x \<in> local.im_sheaf U" for U V W x
	+ using that assoc_comp by blast
	+ qed (auto simp: rh ring_of_empty)
	+
	+ show "iso_locally_ringed_spaces Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+ add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec Spec is_zariski_open sheaf_spec
	+ sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
	+ (identity Spec) (\<lambda>U. identity (\<O> U))"
	+ proof -
	+ have "iso_sheaves_of_rings
	+ Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
	+ (im_sheaf.im_sheaf Spec sheaf_spec (identity Spec))
	+ (im_sheaf.im_sheaf_morphisms Spec sheaf_spec_morphisms (identity Spec))
	+ \<O>b
	+ (\<lambda>V x y. add_sheaf_spec ((identity Spec)\<^sup>\<inverse> Spec V) x y)
	+ (\<lambda>V x y. mult_sheaf_spec ((identity Spec)\<^sup>\<inverse> Spec V) x y)
	+ (\<lambda>V. zero_sheaf_spec ((identity Spec)\<^sup>\<inverse> Spec V))
	+ (\<lambda>V. one_sheaf_spec ((identity Spec)\<^sup>\<inverse> Spec V))
	+ (\<lambda>U. identity (\<O> U))"
	+ proof intro_locales
	+ show "morphism_presheaves_of_rings_axioms is_zariski_open sheaf_spec sheaf_spec_morphisms add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec (im_sheaf.im_sheaf Spec sheaf_spec (identity Spec)) (im_sheaf.im_sheaf_morphisms Spec sheaf_spec_morphisms (identity Spec)) (\<lambda>V. add_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>V. mult_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>V. zero_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>V. one_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>U. identity (\<O> U))"
	+ using F.id_is_mor_pr_rngs
	+ by (simp add: local.im_sheaf_def morphism_presheaves_of_rings_def morphism_presheaves_of_rings_axioms_def im_sheaf_morphisms_def)
	+ then show "iso_presheaves_of_rings_axioms Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec (im_sheaf.im_sheaf Spec sheaf_spec (identity Spec)) (im_sheaf.im_sheaf_morphisms Spec sheaf_spec_morphisms (identity Spec)) \<O>b (\<lambda>V. add_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>V. mult_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>V. zero_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>V. one_sheaf_spec (identity Spec \<^sup>\<inverse> Spec V)) (\<lambda>U. identity (\<O> U))"
	+ unfolding iso_presheaves_of_rings_axioms_def
	+ apply (rule_tac x="(\<lambda>U. identity (\<O> U))" in exI)
	+ using F.presheaf_of_rings_axioms
	+ by (simp add: im_sheaf_morphisms_def local.im_sheaf_def morphism_presheaves_of_rings.intro morphism_presheaves_of_rings_axioms_def sheaf_spec_is_presheaf)
	+ qed
	+ moreover have "morphism_locally_ringed_spaces
	+ Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
	+ Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
	+ (identity Spec)
	+ (\<lambda>U. identity (\<O> U))"
	+ by (simp add: locally_ringed_space.id_to_mor_locally_ringed_spaces spec_is_locally_ringed_space)
	+ ultimately show ?thesis
	+ by (metis locally_ringed_space.id_to_iso_locally_ringed_spaces spec_is_locally_ringed_space)
	+ qed
	+qed
	+
	+lemma (in comm_ring) spec_is_scheme:
	+ shows "scheme R (+) (\<cdot>) \<zero> \<one> Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
	+(\<lambda>U. add_sheaf_spec U) (\<lambda>U. mult_sheaf_spec U) (\<lambda>U. zero_sheaf_spec U) (\<lambda>U. one_sheaf_spec U)"
	+ by (metis spec_is_affine_scheme affine_scheme.affine_scheme_is_scheme)
	+
	+lemma empty_scheme_is_affine_scheme:
	+ shows "affine_scheme {0::nat} (\<lambda>x y. 0) (\<lambda>x y. 0) 0 0
	+{} (\<lambda>U. U={}) (\<lambda>U. {0::nat}) (\<lambda>U V. identity{0}) 0 (\<lambda>U x y. 0) (\<lambda>U x y. 0) (\<lambda>U. 0) (\<lambda>U. 0)
	+(\<lambda>\<pp>\<in>Spec. undefined) (\<lambda>U. \<lambda>s \<in> cring0.sheaf_spec U. 0)"
	+proof -
	+ interpret im0: im_sheaf "{}" "\<lambda>U. U = {}" "\<lambda>U. {0}" "\<lambda>U V. identity {0}"
	+ "0" "\<lambda>U x y. 0" "\<lambda>U x y. 0" "\<lambda>U. 0" "\<lambda>U. 0" "{}" "\<lambda>U. U = {}" "\<lambda>\<pp>\<in>Spec. undefined"
	+ proof qed (use invertible_0 in auto)
	+ note im0.target.open_space [simp del] im0.ring_of_empty [simp del] im0.open_space [simp del]
	+ have cring0_open [simp]: "\<And>N. cring0.is_zariski_open N \<longleftrightarrow> N = {}"
	+ by (metis comm_ring.cring0_is_zariski_open cring0.comm_ring_axioms)
	+ have ring_im: "ring (im0.im_sheaf V) (im0.add_im_sheaf V) (im0.mult_im_sheaf V) (im0.zero_im_sheaf V) (im0.one_im_sheaf V)"
	+ for V :: "nat set set"
	+ proof intro_locales
	+ show "Group_Theory.monoid (im0.im_sheaf V) (im0.add_im_sheaf V) (im0.zero_im_sheaf V)"
	+ unfolding im0.add_im_sheaf_def im0.im_sheaf_def im0.zero_im_sheaf_def monoid_def
	+ by force
	+ then show "Group_Theory.group_axioms (im0.im_sheaf V) (im0.add_im_sheaf V) (im0.zero_im_sheaf V)"
	+ unfolding Group_Theory.group_axioms_def im0.im_sheaf_def im0.zero_im_sheaf_def im0.add_im_sheaf_def
	+ by (simp add: invertible_0)
	+ show "commutative_monoid_axioms (im0.im_sheaf V) (im0.add_im_sheaf V)"
	+ by (metis im0.add_im_sheaf_def commutative_monoid_axioms.intro)
	+ qed (auto simp: im0.im_sheaf_def im0.add_im_sheaf_def im0.mult_im_sheaf_def im0.one_im_sheaf_def monoid_def ring_axioms_def)
	+ have rh0: "ring_homomorphism (cring0.sheaf_spec_morphisms {} {}) {\<lambda>x. undefined}
	+ (cring0.add_sheaf_spec {}) (cring0.mult_sheaf_spec {}) (cring0.zero_sheaf_spec {}) (cring0.one_sheaf_spec {}) {\<lambda>x. undefined}
	+ (cring0.add_sheaf_spec {}) (cring0.mult_sheaf_spec {}) (cring0.zero_sheaf_spec {}) (cring0.one_sheaf_spec {})"
	+ by (metis cring0.cring0_sheaf_spec_empty cring0.is_zariski_open_empty cring0.sheaf_spec_morphisms_are_ring_morphisms im0.target.open_imp_subset)
	+ show ?thesis
	+ proof intro_locales
	+ show "locally_ringed_space_axioms (\<lambda>U. U={}) (\<lambda>U. {0::nat}) (\<lambda>U V. identity{0}) (\<lambda>U x y. 0) (\<lambda>U x y. 0) (\<lambda>U. 0) (\<lambda>U. 0)"
	+ by (metis (mono_tags, lifting) empty_iff locally_ringed_space_axioms_def)
	+ show "topological_space cring0.spectrum cring0.is_zariski_open"
	+ by blast
	+ show [simp]: "Set_Theory.map (\<lambda>\<pp>\<in>Spec. undefined) {} cring0.spectrum"
	+ by (metis cring0.cring0_spectrum_eq im0.map_axioms)
	+ show "continuous_map_axioms {} (\<lambda>U. U={}) cring0.is_zariski_open (\<lambda>\<pp>\<in>Spec. undefined)"
	+ unfolding continuous_map_axioms_def by fastforce
	+ show "presheaf_of_rings_axioms cring0.is_zariski_open cring0.sheaf_spec
	+ cring0.sheaf_spec_morphisms cring0.\<O>b cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec"
	+ using cring0.\<O>_on_emptyset cring0.sheaf_morphisms_sheaf_spec
	+ by (metis cring0.sheaf_spec_is_presheaf presheaf_of_rings_def)
	+ show "sheaf_of_rings_axioms cring0.spectrum cring0.is_zariski_open cring0.sheaf_spec cring0.sheaf_spec_morphisms cring0.zero_sheaf_spec"
	+ using cring0.sheaf_spec_is_sheaf sheaf_of_rings_def by metis
	+ have im_sheaf_0[simp]: "im_sheaf.im_sheaf {} (\<lambda>U. {0}) (\<lambda>\<pp>\<in>Spec. undefined) U = {0}" for U :: "nat set set"
	+ using im0.im_sheaf_def by blast
	+ have rh: "ring_homomorphism (im0.im_sheaf_morphisms U V) (im0.im_sheaf U) (im0.add_im_sheaf U)
	+ (im0.mult_im_sheaf U) (im0.zero_im_sheaf U) (im0.one_im_sheaf U) (im0.im_sheaf V)
	+ (im0.add_im_sheaf V) (im0.mult_im_sheaf V) (im0.zero_im_sheaf V) (im0.one_im_sheaf V)"
	+ if "cring0.is_zariski_open U" "cring0.is_zariski_open V" "V \<subseteq> U" for U V
	+ using that by (metis cring0.cring0_is_zariski_open im0.is_ring_morphism)
	+ show "morphism_ringed_spaces_axioms {} (\<lambda>U. {0})
	+ (\<lambda>U V. identity {0}) 0 (\<lambda>U x y. 0) (\<lambda>U x y. 0)
	+ (\<lambda>U. 0) (\<lambda>U. 0) cring0.spectrum cring0.is_zariski_open cring0.sheaf_spec
	+ cring0.sheaf_spec_morphisms cring0.\<O>b cring0.add_sheaf_spec
	+ cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec
	+ (\<lambda>\<pp>\<in>Spec. undefined) (\<lambda>U. \<lambda>s\<in>cring0.sheaf_spec U. 0)"
	+ unfolding morphism_ringed_spaces_axioms_def morphism_sheaves_of_rings_def
	+ morphism_presheaves_of_rings_def
	+ proof (intro conjI)
	+ show "presheaf_of_rings cring0.spectrum cring0.is_zariski_open cring0.sheaf_spec
	+ cring0.sheaf_spec_morphisms cring0.\<O>b cring0.add_sheaf_spec
	+ cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec"
	+ using cring0.sheaf_spec_is_presheaf by force
	+ show "presheaf_of_rings cring0.spectrum cring0.is_zariski_open im0.im_sheaf im0.im_sheaf_morphisms
	+ 0 im0.add_im_sheaf im0.mult_im_sheaf im0.zero_im_sheaf im0.one_im_sheaf"
	+ by (smt (z3) comm_ring.cring0_is_zariski_open cring0.comm_ring_axioms cring0.cring0_spectrum_eq im0.presheaf_of_rings_axioms)
	+ show "morphism_presheaves_of_rings_axioms cring0.is_zariski_open cring0.sheaf_spec cring0.sheaf_spec_morphisms
	+ cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec
	+ im0.im_sheaf im0.im_sheaf_morphisms im0.add_im_sheaf im0.mult_im_sheaf im0.zero_im_sheaf im0.one_im_sheaf (\<lambda>U. \<lambda>s\<in>cring0.sheaf_spec U. 0)"
	+ unfolding morphism_presheaves_of_rings_axioms_def
	+ proof (intro conjI strip)
	+ fix U
	+ assume "cring0.is_zariski_open U"
	+ interpret rU: ring "cring0.sheaf_spec U" "cring0.add_sheaf_spec U" "cring0.mult_sheaf_spec U" "cring0.zero_sheaf_spec U" "cring0.one_sheaf_spec U"
	+ by (metis \<open>cring0.is_zariski_open U\<close> comm_ring.axioms(1) cring0.sheaf_spec_on_open_is_comm_ring)
	+ interpret rU': ring "im0.im_sheaf U" "im0.add_im_sheaf U" "im0.mult_im_sheaf U" "im0.zero_im_sheaf U" "im0.one_im_sheaf U"
	+ using ring_im by blast
	+ show "ring_homomorphism (\<lambda>s\<in>cring0.sheaf_spec U. 0) (cring0.sheaf_spec U) (cring0.add_sheaf_spec U) (cring0.mult_sheaf_spec U) (cring0.zero_sheaf_spec U) (cring0.one_sheaf_spec U)
	+ (im0.im_sheaf U) (im0.add_im_sheaf U) (im0.mult_im_sheaf U) (im0.zero_im_sheaf U) (im0.one_im_sheaf U)"
	+ proof intro_locales
	+ show "Set_Theory.map (\<lambda>s\<in>cring0.sheaf_spec U. 0) (cring0.sheaf_spec U) (im0.im_sheaf U)"
	+ unfolding Set_Theory.map_def by (metis ext_funcset_to_sing_iff im0.im_sheaf_def singletonI)
	+ show "monoid_homomorphism_axioms (\<lambda>s\<in>cring0.sheaf_spec U. 0) (cring0.sheaf_spec U) (cring0.add_sheaf_spec U) (cring0.zero_sheaf_spec U) (im0.add_im_sheaf U) (im0.zero_im_sheaf U)"
	+ unfolding monoid_homomorphism_axioms_def im0.zero_im_sheaf_def im0.add_im_sheaf_def
	+ by (metis rU.additive.unit_closed rU.additive.composition_closed restrict_apply)
	+ show "monoid_homomorphism_axioms (\<lambda>s\<in>cring0.sheaf_spec U. 0) (cring0.sheaf_spec U) (cring0.mult_sheaf_spec U) (cring0.one_sheaf_spec U) (im0.mult_im_sheaf U) (im0.one_im_sheaf U)"
	+ unfolding monoid_homomorphism_axioms_def im0.mult_im_sheaf_def im0.one_im_sheaf_def
	+ by (metis rU.multiplicative.composition_closed rU.multiplicative.unit_closed restrict_apply)
	+ qed
	+ show "(im0.im_sheaf_morphisms U V \<circ> (\<lambda>s\<in>cring0.sheaf_spec U. 0)) x = ((\<lambda>s\<in>cring0.sheaf_spec V. 0) \<circ> cring0.sheaf_spec_morphisms U V) x"
	+ if "cring0.is_zariski_open U" "cring0.is_zariski_open V" "V \<subseteq> U" "x \<in> cring0.sheaf_spec U"
	+ for U V x
	+ using that cring0.sheaf_morphisms_sheaf_spec
	+ unfolding im0.im_sheaf_morphisms_def o_def
	+ by (metis cring0.cring0_is_zariski_open insertI1 restrict_apply')
	+ qed
	+ qed
	+ interpret monoid0: Group_Theory.monoid "{\<lambda>x. undefined}"
	+ "cring0.add_sheaf_spec {}"
	+ "(\<lambda>\<pp>\<in>{}. quotient_ring.zero_rel ({0}\<setminus>\<pp>) {0} ring0.subtraction ring0.subtraction 0 0)"
	+ by (smt (verit, best) Group_Theory.monoid.intro cring0.add_sheaf_spec_extensional extensional_empty restrict_extensional singletonD)
	+
	+ show "iso_locally_ringed_spaces_axioms {} (\<lambda>U. U = {})
	+ (\<lambda>U. {0}) (\<lambda>U V. identity {0}) 0 (\<lambda>U x y. 0)
	+ (\<lambda>U x y. 0) (\<lambda>U. 0) (\<lambda>U. 0) cring0.spectrum
	+ cring0.is_zariski_open cring0.sheaf_spec
	+ cring0.sheaf_spec_morphisms cring0.\<O>b
	+ cring0.add_sheaf_spec cring0.mult_sheaf_spec
	+ cring0.zero_sheaf_spec cring0.one_sheaf_spec
	+ (\<lambda>\<pp>\<in>Spec. undefined)
	+ (\<lambda>U. \<lambda>s\<in>cring0.sheaf_spec U. 0::nat)"
	+ unfolding iso_locally_ringed_spaces_axioms_def
	+ proof (intro conjI)
	+ show "homeomorphism {} (\<lambda>U. U = {}) cring0.spectrum cring0.is_zariski_open (\<lambda>\<pp>\<in>Spec. undefined)"
	+ proof intro_locales
	+ show "bijective (\<lambda>\<pp>\<in>Spec. undefined) {} cring0.spectrum"
	+ unfolding bijective_def bij_betw_def
	+ using cring0.cring0_spectrum_eq by blast
	+ show "Set_Theory.map (inverse_map (\<lambda>\<pp>\<in>Spec. undefined) {} cring0.spectrum) cring0.spectrum {}"
	+ unfolding Set_Theory.map_def inverse_map_def restrict_def
	+ by (smt (verit, best) PiE_I cring0.cring0_spectrum_eq empty_iff)
	+ qed (use im0.map_axioms continuous_map_axioms_def in \<open>force+\<close>)
	+ show "iso_sheaves_of_rings cring0.spectrum cring0.is_zariski_open cring0.sheaf_spec
	+ cring0.sheaf_spec_morphisms cring0.\<O>b cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec
	+ im0.im_sheaf im0.im_sheaf_morphisms (0::nat) im0.add_im_sheaf im0.mult_im_sheaf im0.zero_im_sheaf im0.one_im_sheaf (\<lambda>U. \<lambda>s\<in>cring0.sheaf_spec U. 0::nat)"
	+ proof intro_locales
	+ show "topological_space cring0.spectrum cring0.is_zariski_open"
	+ by force
	+ show "presheaf_of_rings_axioms cring0.is_zariski_open cring0.sheaf_spec cring0.sheaf_spec_morphisms cring0.\<O>b cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec"
	+ using \<open>presheaf_of_rings_axioms cring0.is_zariski_open cring0.sheaf_spec cring0.sheaf_spec_morphisms cring0.\<O>b cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec\<close> by force
	+ show "presheaf_of_rings_axioms cring0.is_zariski_open im0.im_sheaf im0.im_sheaf_morphisms (0::nat) im0.add_im_sheaf im0.mult_im_sheaf im0.zero_im_sheaf im0.one_im_sheaf"
	+ using im0.presheaf_of_rings_axioms presheaf_of_rings_def by force
	+ show "morphism_presheaves_of_rings_axioms cring0.is_zariski_open cring0.sheaf_spec cring0.sheaf_spec_morphisms cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec im0.im_sheaf im0.im_sheaf_morphisms im0.add_im_sheaf im0.mult_im_sheaf im0.zero_im_sheaf im0.one_im_sheaf (\<lambda>U. \<lambda>s\<in>cring0.sheaf_spec U. 0::nat)"
	+ proof qed (auto simp: cring0.zero_sheaf_spec_def cring0.one_sheaf_spec_def cring0.add_sheaf_spec_def cring0.mult_sheaf_spec_def
	+ im0.zero_im_sheaf_def im0.one_im_sheaf_def im0.add_im_sheaf_def im0.mult_im_sheaf_def
	+ im0.im_sheaf_morphisms_def cring0.sheaf_morphisms_sheaf_spec monoid0.invertible_def)
	+ have morph_empty: "morphism_presheaves_of_rings {} (\<lambda>U. U = {})
	+ im0.im_sheaf im0.im_sheaf_morphisms 0 (\<lambda>V. ring0.subtraction) (\<lambda>V. ring0.subtraction)
	+ (\<lambda>V. 0) (\<lambda>V. 0) cring0.sheaf_spec cring0.sheaf_spec_morphisms cring0.\<O>b
	+ cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec
	+ (\<lambda>S. \<lambda>n\<in>{0}. \<lambda>x. undefined)"
	+ proof qed (auto simp: im0.im_sheaf_morphisms_def cring0.sheaf_spec_morphisms_def
	+ cring0.zero_sheaf_spec_def cring0.one_sheaf_spec_def cring0.add_sheaf_spec_def cring0.mult_sheaf_spec_def
	+ cring0.\<O>b_def monoid0.invertible_def)
	+ then show "iso_presheaves_of_rings_axioms cring0.spectrum cring0.is_zariski_open cring0.sheaf_spec
	+ cring0.sheaf_spec_morphisms cring0.\<O>b cring0.add_sheaf_spec cring0.mult_sheaf_spec cring0.zero_sheaf_spec cring0.one_sheaf_spec
	+ im0.im_sheaf im0.im_sheaf_morphisms (0::nat) im0.add_im_sheaf im0.mult_im_sheaf im0.zero_im_sheaf im0.one_im_sheaf (\<lambda>U. \<lambda>s\<in>cring0.sheaf_spec U. 0)"
	+ by unfold_locales (auto simp add: im0.zero_im_sheaf_def im0.one_im_sheaf_def im0.add_im_sheaf_def im0.mult_im_sheaf_def)
	+ qed
	+ qed
	+ show "morphism_locally_ringed_spaces_axioms {}
	+ (\<lambda>U. U = {}) (\<lambda>U. {0}) (\<lambda>U V. identity {0})
	+ (\<lambda>U x y. 0) (\<lambda>U x y. 0) (\<lambda>U. 0) (\<lambda>U. 0)
	+ cring0.is_zariski_open cring0.sheaf_spec
	+ cring0.sheaf_spec_morphisms cring0.add_sheaf_spec
	+ cring0.mult_sheaf_spec cring0.zero_sheaf_spec
	+ cring0.one_sheaf_spec (\<lambda>\<pp>\<in>Spec. undefined)
	+ (\<lambda>U. \<lambda>s\<in>cring0.sheaf_spec U. 0)"
	+ by (meson equals0D morphism_locally_ringed_spaces_axioms.intro)
	+ qed
	+qed
	+
	+lemma empty_scheme_is_scheme:
	+ shows "scheme {0::nat} (\<lambda>x y. 0) (\<lambda>x y. 0) 0 0 {} (\<lambda>U. U={}) (\<lambda>U. {0}) (\<lambda>U V. identity{0::nat}) 0 (\<lambda>U x y. 0) (\<lambda>U x y. 0) (\<lambda>U. 0) (\<lambda>U. 0)"
	+ by (metis affine_scheme.affine_scheme_is_scheme empty_scheme_is_affine_scheme)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Grothendieck_Schemes/Set_Extras.thy b/thys/Grothendieck_Schemes/Set_Extras.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/Set_Extras.thy
	@@ -0,0 +1,88 @@
	+
	+text \<open>Authors: Anthony Bordg and Lawrence Paulson\<close>
	+
	+theory Set_Extras
	+ imports "Jacobson_Basic_Algebra.Set_Theory"
	+
	+begin
	+
	+text \<open>Some new notation for built-in primitives\<close>
	+
	+section \<open>Sets\<close>
	+
	+abbreviation complement_in_of:: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" ("_\<setminus>_" [65,65]65)
	+ where "A \<setminus> B \<equiv> A-B"
	+
	+section \<open>Functions\<close>
	+
	+abbreviation preimage:: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> 'a set" ("_ \<^sup>\<inverse> _ _" [90,90,1000]90)
	+ where "f\<^sup>\<inverse> X V \<equiv> (vimage f V) \<inter> X"
	+
	+lemma preimage_of_inter:
	+ fixes f::"'a \<Rightarrow> 'b" and X::"'a set" and V::"'b set" and V'::"'b set"
	+ shows "f\<^sup>\<inverse> X (V \<inter> V') = (f\<^sup>\<inverse> X V) \<inter> (f\<^sup>\<inverse> X V')"
	+ by blast
	+
	+lemma preimage_identity_self: "identity A \<^sup>\<inverse> A B = B \<inter> A"
	+ by (simp add: vimage_inter_cong)
	+
	+text \<open>Simplification actually replaces the RHS by the LHS\<close>
	+lemma preimage_vimage_eq: "(f \<^sup>\<inverse> (f -` U') U) \<inter> X = f\<^sup>\<inverse> X (U \<inter> U')"
	+ by simp
	+
	+definition inverse_map:: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> ('b \<Rightarrow> 'a)"
	+ where "inverse_map f S T \<equiv> restrict (inv_into S f) T"
	+
	+lemma bijective_map_preimage:
	+ assumes "bijective_map f S T"
	+ shows "bijective_map (inverse_map f S T) T S"
	+proof
	+ show "inverse_map f S T \<in> T \<rightarrow>\<^sub>E S"
	+ by (simp add: assms bij_betw_imp_funcset bij_betw_inv_into bijective.bijective bijective_map.axioms(2) inverse_map_def)
	+ show "bij_betw (inverse_map f S T) T S"
	+ using assms by (simp add: bij_betw_inv_into bijective_def bijective_map_def inverse_map_def)
	+qed
	+
	+lemma inverse_map_identity [simp]:
	+ "inverse_map (identity S) S S = identity S"
	+ by (metis Id_compose compose_id_inv_into image_ident image_restrict_eq inv_into_funcset inverse_map_def restrict_extensional)
	+
	+abbreviation composing ("_ \<circ> _ \<down> _" [60,0,60]59)
	+ where "g \<circ> f \<down> D \<equiv> compose D g f"
	+
	+lemma comp_maps:
	+ assumes "Set_Theory.map \<eta> A B" and "Set_Theory.map \<theta> B C"
	+ shows "Set_Theory.map (\<theta> \<circ> \<eta> \<down> A) A C"
	+proof-
	+ have "(\<theta> \<circ> \<eta> \<down> A) \<in> A \<rightarrow>\<^sub>E C"
	+ using assms by (metis Int_iff PiE_def compose_def funcset_compose map.graph restrict_extensional)
	+ thus ?thesis by (simp add: Set_Theory.map_def)
	+qed
	+
	+lemma undefined_is_map_on_empty:
	+ fixes f:: "'a set \<Rightarrow> 'b set"
	+ assumes "f = (\<lambda>x. undefined)"
	+ shows "map f {} {}"
	+ using assms by (simp add: map.intro)
	+
	+lemma restrict_on_source:
	+ assumes "map f S T"
	+ shows "restrict f S = f"
	+ using assms by (meson PiE_restrict map.graph)
	+
	+lemma restrict_further:
	+ assumes "map f S T" and "U \<subseteq> S" and "V \<subseteq> U"
	+ shows "restrict (restrict f U) V = restrict f V"
	+ using assms by (simp add: inf.absorb_iff2)
	+
	+lemma map_eq:
	+ assumes "map f S T" and "map g S T" and "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
	+ shows "f = g"
	+ using assms by (metis restrict_ext restrict_on_source)
	+
	+lemma image_subset_of_target:
	+ assumes "map f S T"
	+ shows "f ` S \<subseteq> T"
	+ using assms by (meson image_subsetI map.map_closed)
	+
	+end
	diff --git a/thys/Grothendieck_Schemes/Topological_Space.thy b/thys/Grothendieck_Schemes/Topological_Space.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/Topological_Space.thy
	@@ -0,0 +1,256 @@
	+
	+text \<open>Authors: Anthony Bordg and Lawrence Paulson,
	+with some contributions from Wenda Li\<close>
	+
	+theory Topological_Space
	+ imports Complex_Main
	+ "Jacobson_Basic_Algebra.Set_Theory"
	+ Set_Extras
	+
	+begin
	+
	+section \<open>Topological Spaces\<close>
	+
	+locale topological_space = fixes S :: "'a set" and is_open :: "'a set \<Rightarrow> bool"
	+ assumes open_space [simp, intro]: "is_open S" and open_empty [simp, intro]: "is_open {}"
	+ and open_imp_subset: "is_open U \<Longrightarrow> U \<subseteq> S"
	+ and open_inter [intro]: "\<lbrakk>is_open U; is_open V\<rbrakk> \<Longrightarrow> is_open (U \<inter> V)"
	+ and open_union [intro]: "\<And>F::('a set) set. (\<And>x. x \<in> F \<Longrightarrow> is_open x) \<Longrightarrow> is_open (\<Union>x\<in>F. x)"
	+
	+begin
	+
	+definition is_closed :: "'a set \<Rightarrow> bool"
	+ where "is_closed U \<equiv> U \<subseteq> S \<and> is_open (S - U)"
	+
	+definition neighborhoods:: "'a \<Rightarrow> ('a set) set"
	+ where "neighborhoods x \<equiv> {U. is_open U \<and> x \<in> U}"
	+
	+text \<open>Note that by a neighborhood we mean what some authors call an open neighborhood.\<close>
	+
	+lemma open_union' [intro]: "\<And>F::('a set) set. (\<And>x. x \<in> F \<Longrightarrow> is_open x) \<Longrightarrow> is_open (\<Union>F)"
	+ using open_union by auto
	+
	+lemma open_preimage_identity [simp]: "is_open B \<Longrightarrow> identity S \<^sup>\<inverse> S B = B"
	+ by (metis inf.orderE open_imp_subset preimage_identity_self)
	+
	+
	+definition is_connected:: "bool" where
	+"is_connected \<equiv> \<not> (\<exists>U V. is_open U \<and> is_open V \<and> (U \<noteq> {}) \<and> (V \<noteq> {}) \<and> (U \<inter> V = {}) \<and> (U \<union> V = S))"
	+
	+definition is_hausdorff:: "bool" where
	+"is_hausdorff \<equiv>
	+\<forall>x y. (x \<in> S \<and> y \<in> S \<and> x \<noteq> y) \<longrightarrow> (\<exists>U V. U \<in> neighborhoods x \<and> V \<in> neighborhoods y \<and> U \<inter> V = {})"
	+
	+end (* topological_space *)
	+
	+text \<open>T2 spaces are also known as Hausdorff spaces.\<close>
	+
	+locale t2_space = topological_space +
	+ assumes hausdorff: "is_hausdorff"
	+
	+
	+subsection \<open>Topological Basis\<close>
	+
	+inductive generated_topology :: "'a set \<Rightarrow> 'a set set \<Rightarrow> 'a set \<Rightarrow> bool"
	+ for S :: "'a set" and B :: "'a set set"
	+ where
	+ UNIV: "generated_topology S B S"
	+ \| Int: "generated_topology S B (U \<inter> V)"
	+ if "generated_topology S B U" and "generated_topology S B V"
	+ \| UN: "generated_topology S B (\<Union>K)" if "(\<And>U. U \<in> K \<Longrightarrow> generated_topology S B U)"
	+ \| Basis: "generated_topology S B b" if "b \<in> B \<and> b \<subseteq> S"
	+
	+lemma generated_topology_empty [simp]: "generated_topology S B {}"
	+ by (metis UN Union_empty empty_iff)
	+
	+lemma generated_topology_subset: "generated_topology S B U \<Longrightarrow> U \<subseteq> S"
	+ by (induct rule:generated_topology.induct) auto
	+
	+lemma generated_topology_is_topology:
	+ fixes S:: "'a set" and B:: "'a set set"
	+ shows "topological_space S (generated_topology S B)"
	+ by (simp add: Int UN UNIV generated_topology_subset topological_space_def)
	+
	+
	+subsection \<open>Covers\<close>
	+
	+locale cover_of_subset =
	+ fixes X:: "'a set" and U:: "'a set" and index:: "real set" and cover:: "real \<Rightarrow> 'a set"
	+(* We use real instead of index::"'b set" otherwise we get some troubles with locale sheaf_of_rings
	+in Comm_Ring_Theory.thy *)
	+ assumes is_subset: "U \<subseteq> X" and are_subsets: "\<And>i. i \<in> index \<Longrightarrow> cover i \<subseteq> X"
	+and covering: "U \<subseteq> (\<Union>i\<in>index. cover i)"
	+begin
	+
	+lemma
	+ assumes "x \<in> U"
	+ shows "\<exists>i\<in>index. x \<in> cover i"
	+ using assms covering by auto
	+
	+definition select_index:: "'a \<Rightarrow> real"
	+ where "select_index x \<equiv> SOME i. i \<in> index \<and> x \<in> cover i"
	+
	+lemma cover_of_select_index:
	+ assumes "x \<in> U"
	+ shows "x \<in> cover (select_index x)"
	+ using assms by (metis (mono_tags, lifting) UN_iff covering select_index_def someI_ex subset_iff)
	+
	+lemma select_index_belongs:
	+ assumes "x \<in> U"
	+ shows "select_index x \<in> index"
	+ using assms by (metis (full_types, lifting) UN_iff covering in_mono select_index_def tfl_some)
	+
	+end (* cover_of_subset *)
	+
	+locale open_cover_of_subset = topological_space X is_open + cover_of_subset X U I C
	+ for X and is_open and U and I and C +
	+ assumes are_open_subspaces: "\<And>i. i\<in>I \<Longrightarrow> is_open (C i)"
	+begin
	+
	+lemma cover_of_select_index_is_open:
	+ assumes "x \<in> U"
	+ shows "is_open (C (select_index x))"
	+ using assms by (simp add: are_open_subspaces select_index_belongs)
	+
	+end (* open_cover_of_subset *)
	+
	+locale open_cover_of_open_subset = open_cover_of_subset X is_open U I C
	+ for X and is_open and U and I and C +
	+ assumes is_open_subset: "is_open U"
	+
	+
	+subsection \<open>Induced Topology\<close>
	+
	+locale ind_topology = topological_space X is_open for X and is_open +
	+ fixes S:: "'a set"
	+ assumes is_subset: "S \<subseteq> X"
	+begin
	+
	+definition ind_is_open:: "'a set \<Rightarrow> bool"
	+ where "ind_is_open U \<equiv> U \<subseteq> S \<and> (\<exists>V. V \<subseteq> X \<and> is_open V \<and> U = S \<inter> V)"
	+
	+lemma ind_is_open_S [iff]: "ind_is_open S"
	+ by (metis ind_is_open_def inf.orderE is_subset open_space order_refl)
	+
	+lemma ind_is_open_empty [iff]: "ind_is_open {}"
	+ using ind_is_open_def by auto
	+
	+lemma ind_space_is_top_space:
	+ shows "topological_space S (ind_is_open)"
	+proof
	+ fix U V
	+ assume "ind_is_open U" then obtain UX where "UX \<subseteq> X" "is_open UX" "U = S \<inter> UX"
	+ using ind_is_open_def by auto
	+ moreover
	+ assume "ind_is_open V" then obtain VX where "VX \<subseteq> X" "is_open VX" "V = S \<inter> VX"
	+ using ind_is_open_def by auto
	+ ultimately have "is_open (UX \<inter> VX) \<and> (U \<inter> V = S \<inter> (UX \<inter> VX))" using open_inter by auto
	+ then show "ind_is_open (U \<inter> V)"
	+ by (metis \<open>UX \<subseteq> X\<close> ind_is_open_def le_infI1 subset_refl)
	+next
	+ fix F
	+ assume F: "\<And>x. x \<in> F \<Longrightarrow> ind_is_open x"
	+ obtain F' where F': "\<And>x. x \<in> F \<and> ind_is_open x \<Longrightarrow> is_open (F' x) \<and> x = S \<inter> (F' x)"
	+ using ind_is_open_def by metis
	+ have "is_open (\<Union> (F' ` F))"
	+ by (metis (mono_tags, lifting) F F' imageE image_ident open_union)
	+ moreover
	+ have "(\<Union>x\<in>F. x) = S \<inter> \<Union> (F' ` F)"
	+ using F' \<open>\<And>x. x \<in> F \<Longrightarrow> ind_is_open x\<close> by fastforce
	+ ultimately show "ind_is_open (\<Union>x\<in>F. x)"
	+ by (metis ind_is_open_def inf_sup_ord(1) open_imp_subset)
	+next
	+ show "\<And>U. ind_is_open U \<Longrightarrow> U \<subseteq> S"
	+ by (simp add: ind_is_open_def)
	+qed auto
	+
	+lemma is_open_from_ind_is_open:
	+ assumes "is_open S" and "ind_is_open U"
	+ shows "is_open U"
	+ using assms open_inter ind_is_open_def is_subset by auto
	+
	+lemma open_cover_from_ind_open_cover:
	+ assumes "is_open S" and "open_cover_of_open_subset S ind_is_open U I C"
	+ shows "open_cover_of_open_subset X is_open U I C"
	+proof
	+ show "is_open U"
	+ using assms is_open_from_ind_is_open open_cover_of_open_subset.is_open_subset by blast
	+ show "\<And>i. i \<in> I \<Longrightarrow> is_open (C i)"
	+ using assms is_open_from_ind_is_open open_cover_of_open_subset_def open_cover_of_subset.are_open_subspaces by blast
	+ show "\<And>i. i \<in> I \<Longrightarrow> C i \<subseteq> X"
	+ using assms(2) is_subset
	+ by (meson cover_of_subset_def open_cover_of_open_subset_def open_cover_of_subset_def subset_trans)
	+ show "U \<subseteq> X"
	+ by (simp add: \<open>is_open U\<close> open_imp_subset)
	+ show "U \<subseteq> \<Union> (C ` I)"
	+ by (meson assms(2) cover_of_subset_def open_cover_of_open_subset_def open_cover_of_subset_def)
	+qed
	+
	+end (* induced topology *)
	+
	+lemma (in topological_space) ind_topology_is_open_self [iff]: "ind_topology S is_open S"
	+ by (simp add: ind_topology_axioms_def ind_topology_def topological_space_axioms)
	+
	+lemma (in topological_space) ind_topology_is_open_empty [iff]: "ind_topology S is_open {}"
	+ by (simp add: ind_topology_axioms_def ind_topology_def topological_space_axioms)
	+
	+lemma (in topological_space) ind_is_open_iff_open:
	+ shows "ind_topology.ind_is_open S is_open S U \<longleftrightarrow> is_open U \<and> U \<subseteq> S"
	+ by (metis ind_topology.ind_is_open_def ind_topology_is_open_self inf.absorb_iff2)
	+
	+subsection \<open>Continuous Maps\<close>
	+
	+locale continuous_map = source: topological_space S is_open + target: topological_space S' is_open'
	++ map f S S'
	+ for S and is_open and S' and is_open' and f +
	+ assumes is_continuous: "\<And>U. is_open' U \<Longrightarrow> is_open (f\<^sup>\<inverse> S U)"
	+begin
	+
	+lemma open_cover_of_open_subset_from_target_to_source:
	+ assumes "open_cover_of_open_subset S' is_open' U I C"
	+ shows "open_cover_of_open_subset S is_open (f\<^sup>\<inverse> S U) I (\<lambda>i. f\<^sup>\<inverse> S (C i))"
	+proof
	+ show "f \<^sup>\<inverse> S U \<subseteq> S" by simp
	+ show "f \<^sup>\<inverse> S (C i) \<subseteq> S" if "i \<in> I" for i
	+ using that by simp
	+ show "is_open (f \<^sup>\<inverse> S U)"
	+ by (meson assms is_continuous open_cover_of_open_subset.is_open_subset)
	+ show "\<And>i. i \<in> I \<Longrightarrow> is_open (f \<^sup>\<inverse> S (C i))"
	+ by (meson assms is_continuous open_cover_of_open_subset_def open_cover_of_subset.are_open_subspaces)
	+ show "f \<^sup>\<inverse> S U \<subseteq> (\<Union>i\<in>I. f \<^sup>\<inverse> S (C i))"
	+ using assms unfolding open_cover_of_open_subset_def cover_of_subset_def open_cover_of_subset_def
	+ by blast
	+qed
	+
	+end (* continuous map *)
	+
	+
	+subsection \<open>Homeomorphisms\<close>
	+
	+text \<open>The topological isomorphisms between topological spaces are called homeomorphisms.\<close>
	+
	+locale homeomorphism =
	+ continuous_map + bijective_map f S S' +
	+ continuous_map S' is_open' S is_open "inverse_map f S S'"
	+
	+lemma (in topological_space) id_is_homeomorphism:
	+ shows "homeomorphism S is_open S is_open (identity S)"
	+proof
	+ show "inverse_map (identity S) S S \<in> S \<rightarrow>\<^sub>E S"
	+ by (simp add: inv_into_into inverse_map_def)
	+qed (auto simp: open_inter bij_betwI')
	+
	+
	+subsection \<open>Topological Filters\<close> (* Imported from HOL.Topological_Spaces *)
	+
	+definition (in topological_space) nhds :: "'a \<Rightarrow> 'a filter"
	+ where "nhds a = (INF S\<in>{S. is_open S \<and> a \<in> S}. principal S)"
	+
	+abbreviation (in topological_space)
	+ tendsto :: "('b \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b filter \<Rightarrow> bool" (infixr "\<longlongrightarrow>" 55)
	+ where "(f \<longlongrightarrow> l) F \<equiv> filterlim f (nhds l) F"
	+
	+definition (in t2_space) Lim :: "'f filter \<Rightarrow> ('f \<Rightarrow> 'a) \<Rightarrow> 'a"
	+ where "Lim A f = (THE l. (f \<longlongrightarrow> l) A)"
	+
	+end
	diff --git a/thys/Grothendieck_Schemes/document/root.bib b/thys/Grothendieck_Schemes/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/document/root.bib
	@@ -0,0 +1,33 @@
	+%% This BibTeX bibliography file was created using BibDesk.
	+%% http://bibdesk.sourceforge.net/
	+
	+
	+%% Created for Larry Paulson at 2021-03-29 15:18:40 +0100
	+
	+
	+%% Saved with string encoding Unicode (UTF-8)
	+
	+
	+
	+@book{hartshorne2013algebraic,
	+ author = {Hartshorne, R.},
	+ date-added = {2021-03-29 15:17:18 +0100},
	+ date-modified = {2021-03-29 15:17:53 +0100},
	+ isbn = {9781475738490},
	+ publisher = {Springer},
	+ title = {Algebraic Geometry},
	+ url = {https://books.google.co.uk/books?id=7z4mBQAAQBAJ},
	+ year = {2013},
	+ Bdsk-Url-1 = {https://books.google.co.uk/books?id=7z4mBQAAQBAJ}}
	+
	+@book{lang2005algebra,
	+ author = {Lang, S.},
	+ date-added = {2021-03-29 15:17:18 +0100},
	+ date-modified = {2021-03-29 15:18:17 +0100},
	+ isbn = {9780387953854},
	+ lccn = {01054916},
	+ publisher = {Springer},
	+ title = {Algebra},
	+ url = {https://books.google.co.uk/books?id=Fge-BwqhqIYC},
	+ year = {2005},
	+ Bdsk-Url-1 = {https://books.google.co.uk/books?id=Fge-BwqhqIYC}}
	diff --git a/thys/Grothendieck_Schemes/document/root.tex b/thys/Grothendieck_Schemes/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Grothendieck_Schemes/document/root.tex
	@@ -0,0 +1,34 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[T1]{fontenc}
	+\usepackage{isabelle,isabellesym}
	+\usepackage{amsfonts,amsmath,amssymb}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+\addtolength{\hoffset}{-1,5cm}
	+\addtolength{\textwidth}{3cm}
	+
	+\begin{document}
	+
	+\title{Grothendieck's Schemes in Algebraic Geometry}
	+\author{Anthony Bordg, Lawrence Paulson and Wenda Li}
	+\maketitle
	+
	+\begin{abstract}
	+ We formalize mainstream structures in algebraic geometry \cite{hartshorne2013algebraic,lang2005algebra} culminating in Grothendieck's schemes: presheaves of rings, sheaves of rings, ringed spaces, locally ringed spaces, affine schemes and schemes. We prove that the spectrum of a ring is a locally ringed space, hence an affine scheme. Finally, we prove that any affine scheme is a scheme.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+\parindent 0pt\parskip 0.5ex
	+
	+% include generated text of all theories
	+\input{session}
	+
	+\section{Acknowledgements}
	+The work was supported by the ERC Advanced Grant ALEXANDRIA (Project 742178), funded by the European Research Council.
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+\end{document}
	diff --git a/thys/IFC_Tracking/IFC.thy b/thys/IFC_Tracking/IFC.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/IFC_Tracking/IFC.thy
	@@ -0,0 +1,4580 @@
	+section \<open>Definitions\<close>
	+
	+text \<open>
	+This section contains all necessary definitions of this development. Section~\ref{sec:pm} contains
	+the structural definition of our program model which includes the security specification as well
	+as abstractions of control flow and data. Executions of our program model are defined in
	+section~\ref{sec:ex}. Additional well-formedness properties are defined in section~\ref{sec:wf}.
	+Our security property is defined in section~\ref{sec:sec}. Our characterisation of how information
	+is propagated by executions of our program model is defined in section~\ref{sec:char-cp}, for which
	+the correctness result can be found in section~\ref{sec:cor-cp}. Section~\ref{sec:char-scp} contains
	+an additional approximation of this characterisation whose correctness result can be found in
	+section~\ref{sec:cor-scp}.
	+\<close>
	+
	+
	+theory IFC
	+imports Main
	+begin
	+
	+subsection \<open>Program Model\<close>
	+text_raw \<open>\label{sec:pm}\<close>
	+
	+text \<open>Our program model contains all necessary components for the remaining development and consists of:\<close>
	+
	+record ('n, 'var, 'val, 'obs) ifc_problem =
	+\<comment> \<open>A set of nodes representing program locations:\<close>
	+ nodes :: \<open>'n set\<close>
	+\<comment> \<open>An initial node where all executions start:\<close>
	+ entry :: \<open>'n\<close>
	+\<comment> \<open>A final node where executions can terminate:\<close>
	+ return :: \<open>'n\<close>
	+\<comment> \<open>An abstraction of control flow in the form of an edge relation:\<close>
	+ edges :: \<open>('n \<times> 'n) set\<close>
	+\<comment> \<open>An abstraction of variables written at program locations:\<close>
	+ writes :: \<open>'n \<Rightarrow> 'var set\<close>
	+\<comment> \<open>An abstraction of variables read at program locations:\<close>
	+ reads :: \<open>'n \<Rightarrow> 'var set\<close>
	+\<comment> \<open>A set of variables containing the confidential information in the initial state:\<close>
	+ hvars :: \<open>'var set\<close>
	+\<comment> \<open>A step function on location state pairs:\<close>
	+ step :: \<open>('n \<times> ('var \<Rightarrow> 'val)) \<Rightarrow> ('n \<times> ('var \<Rightarrow> 'val))\<close>
	+\<comment> \<open>An attacker model producing observations based on the reached state at certain locations:\<close>
	+ att :: \<open>'n \<rightharpoonup> (('var \<Rightarrow> 'val) \<Rightarrow> 'obs)\<close>
	+
	+text \<open>We fix a program in the following in order to define the central concepts.
	+The necessary well-formedness assumptions will be made in section~\ref{sec:wf}.\<close>
	+locale IFC_def =
	+fixes prob :: \<open>('n, 'var, 'val, 'obs) ifc_problem\<close>
	+begin
	+
	+text \<open>Some short hands to the components of the program which we will utilise exclusively in the following.\<close>
	+definition nodes where \<open>nodes = ifc_problem.nodes prob\<close>
	+definition entry where \<open>entry = ifc_problem.entry prob\<close>
	+definition return where \<open>return = ifc_problem.return prob\<close>
	+definition edges where \<open>edges = ifc_problem.edges prob\<close>
	+definition writes where \<open>writes = ifc_problem.writes prob\<close>
	+definition reads where \<open>reads = ifc_problem.reads prob\<close>
	+definition hvars where \<open>hvars = ifc_problem.hvars prob\<close>
	+definition step where \<open>step = ifc_problem.step prob\<close>
	+definition att where \<open>att = ifc_problem.att prob\<close>
	+
	+text \<open>The components of the step function for convenience.\<close>
	+definition suc where \<open>suc n \<sigma> = fst (step (n, \<sigma>))\<close>
	+definition sem where \<open>sem n \<sigma> = snd (step (n, \<sigma>))\<close>
	+
	+lemma step_suc_sem: \<open>step (n,\<sigma>) = (suc n \<sigma>, sem n \<sigma>)\<close> unfolding suc_def sem_def by auto
	+
	+
	+subsubsection \<open>Executions\<close>
	+text \<open>\label{sec:ex}\<close>
	+text \<open>In order to define what it means for a program to be well-formed, we first require concepts
	+of executions and program paths.\<close>
	+
	+text \<open>The sequence of nodes visited by the execution corresponding to an input state.\<close>
	+definition path where
	+\<open>path \<sigma> k= fst ((step^^k) (entry,\<sigma>))\<close>
	+
	+text \<open>The sequence of states visited by the execution corresponding to an input state.\<close>
	+definition kth_state ( \<open>_\<^bsup>_\<^esup>\<close> [111,111] 110) where
	+\<open>\<sigma>\<^bsup>k\<^esup> = snd ((step^^k) (entry,\<sigma>))\<close>
	+
	+text \<open>A predicate asserting that a sequence of nodes is a valid program path according to the
	+control flow graph.\<close>
	+
	+definition is_path where
	+\<open>is_path \<pi> = (\<forall> n. (\<pi> n, \<pi> (Suc n)) \<in> edges)\<close>
	+end
	+
	+subsubsection \<open>Well-formed Programs\<close>
	+text_raw \<open>\label{sec:wf}\<close>
	+
	+text \<open>The following assumptions define our notion of valid programs.\<close>
	+locale IFC = IFC_def \<open>prob\<close> for prob:: \<open>('n, 'var, 'val, 'out) ifc_problem\<close> +
	+assumes ret_is_node[simp,intro]: \<open>return \<in> nodes\<close>
	+and entry_is_node[simp,intro]: \<open>entry \<in> nodes\<close>
	+and writes: \<open>\<And> v n. (\<exists>\<sigma>. \<sigma> v \<noteq> sem n \<sigma> v) \<Longrightarrow> v \<in> writes n\<close>
	+and writes_return: \<open>writes return = {}\<close>
	+and uses_writes: \<open>\<And> n \<sigma> \<sigma>'. (\<forall> v \<in> reads n. \<sigma> v = \<sigma>' v) \<Longrightarrow> \<forall> v \<in> writes n. sem n \<sigma> v = sem n \<sigma>' v\<close>
	+and uses_suc: \<open>\<And> n \<sigma> \<sigma>'. (\<forall> v \<in> reads n. \<sigma> v = \<sigma>' v) \<Longrightarrow> suc n \<sigma> = suc n \<sigma>'\<close>
	+and uses_att: \<open>\<And> n f \<sigma> \<sigma>'. att n = Some f \<Longrightarrow> (\<forall> v \<in> reads n. \<sigma> v = \<sigma>' v) \<Longrightarrow> f \<sigma> = f \<sigma>'\<close>
	+and edges_complete[intro,simp]: \<open>\<And>m \<sigma>. m \<in> nodes \<Longrightarrow> (m,suc m \<sigma>) \<in> edges\<close>
	+and edges_return : \<open>\<And>x. (return,x) \<in> edges \<Longrightarrow> x = return \<close>
	+and edges_nodes: \<open>edges \<subseteq> nodes \<times> nodes\<close>
	+and reaching_ret: \<open>\<And> x. x \<in> nodes \<Longrightarrow> \<exists> \<pi> n. is_path \<pi> \<and> \<pi> 0 = x \<and> \<pi> n = return\<close>
	+
	+
	+subsection \<open>Security\<close>
	+text_raw \<open>\label{sec:sec}\<close>
	+
	+text \<open>We define our notion of security, which corresponds to what Bohannon et al.~\cite{Bohannon:2009:RN:1653662.1653673}
	+refer to as indistinguishable security. In order to do so we require notions of observations made
	+by the attacker, termination and equivalence of input states.\<close>
	+
	+context IFC_def
	+begin
	+
	+subsubsection \<open>Observations\<close>
	+text_raw \<open>\label{sec:obs}\<close>
	+
	+text \<open>The observation made at a given index within an execution.\<close>
	+definition obsp where
	+\<open>obsp \<sigma> k = (case att(path \<sigma> k) of Some f \<Rightarrow> Some (f (\<sigma>\<^bsup>k\<^esup>)) \| None \<Rightarrow> None)\<close>
	+
	+text \<open>The indices within a path where an observation is made.\<close>
	+definition obs_ids :: \<open>(nat \<Rightarrow> 'n) \<Rightarrow> nat set\<close> where
	+\<open>obs_ids \<pi> = {k. att (\<pi> k) \<noteq> None}\<close>
	+
	+text \<open>A predicate relating an observable index to the number of observations made before.\<close>
	+definition is_kth_obs :: \<open>(nat \<Rightarrow> 'n) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool\<close>where
	+\<open>is_kth_obs \<pi> k i = (card (obs_ids \<pi> \<inter> {..<i}) = k \<and> att (\<pi> i) \<noteq> None)\<close>
	+
	+text \<open>The final sequence of observations made for an execution.\<close>
	+definition obs where
	+\<open>obs \<sigma> k = (if (\<exists>i. is_kth_obs (path \<sigma>) k i) then obsp \<sigma> (THE i. is_kth_obs (path \<sigma>) k i) else None)\<close>
	+
	+text \<open>Comparability of observations.\<close>
	+definition obs_prefix :: \<open>(nat \<Rightarrow> 'obs option) \<Rightarrow> (nat \<Rightarrow> 'obs option) \<Rightarrow> bool\<close> (infix \<open>\<lesssim>\<close> 50) where
	+\<open>a \<lesssim> b \<equiv> \<forall> i. a i \<noteq> None \<longrightarrow> a i = b i\<close>
	+
	+definition obs_comp (infix \<open>\<approx>\<close> 50) where
	+\<open>a \<approx> b \<equiv> a \<lesssim> b \<or> b \<lesssim> a\<close>
	+
	+subsubsection \<open>Low equivalence of input states\<close>
	+
	+definition restrict (infix \<open>\<restriction>\<close> 100 ) where
	+\<open>f\<restriction>U = (\<lambda> n. if n \<in> U then f n else undefined)\<close>
	+
	+text \<open>Two input states are low equivalent if they coincide on the non high variables.\<close>
	+definition loweq (infix \<open>=\<^sub>L\<close> 50)
	+where \<open>\<sigma> =\<^sub>L \<sigma>' = (\<sigma>\<restriction>(-hvars) = \<sigma>'\<restriction>(-hvars))\<close>
	+
	+subsubsection \<open>Termination\<close>
	+
	+text \<open>An execution terminates iff it reaches the terminal node at any point.\<close>
	+definition terminates where
	+\<open>terminates \<sigma> \<equiv> \<exists> i. path \<sigma> i = return\<close>
	+
	+
	+subsubsection \<open>Security Property\<close>
	+text \<open>The fixed program is secure if and only if for all pairs of low equivalent inputs the observation
	+sequences are comparable and if the execution for an input state terminates then the observation sequence
	+is not missing any observations.\<close>
	+
	+definition secure where
	+\<open>secure \<equiv> \<forall> \<sigma> \<sigma>'. \<sigma> =\<^sub>L \<sigma>' \<longrightarrow> (obs \<sigma> \<approx> obs \<sigma>' \<and> (terminates \<sigma> \<longrightarrow> obs \<sigma>' \<lesssim> obs \<sigma>))\<close>
	+
	+
	+
	+subsection \<open>Characterisation of Information Flows\<close>
	+text \<open>We now define our characterisation of information flows which tracks data and control dependencies
	+within executions. To do so we first require some additional concepts.\<close>
	+
	+subsubsection \<open>Post Dominance\<close>
	+text \<open>We utilise the post dominance relation in order to define control dependence.\<close>
	+
	+text \<open>The basic post dominance relation.\<close>
	+definition is_pd (infix \<open>pd\<rightarrow>\<close> 50) where
	+\<open>y pd\<rightarrow> x \<longleftrightarrow> x \<in> nodes \<and> (\<forall> \<pi> n. is_path \<pi> \<and> \<pi> (0::nat) = x \<and> \<pi> n = return \<longrightarrow> (\<exists>k\<le>n. \<pi> k = y))\<close>
	+
	+text \<open>The immediate post dominance relation.\<close>
	+definition is_ipd (infix \<open>ipd\<rightarrow>\<close> 50)where
	+\<open>y ipd\<rightarrow> x \<longleftrightarrow> x \<noteq> y \<and> y pd\<rightarrow> x \<and> (\<forall> z. z\<noteq>x \<and> z pd\<rightarrow> x \<longrightarrow> z pd\<rightarrow> y)\<close>
	+
	+definition ipd where
	+\<open>ipd x = (THE y. y ipd\<rightarrow> x)\<close>
	+
	+text \<open>The post dominance tree.\<close>
	+definition pdt where
	+\<open>pdt = {(x,y). x\<noteq>y \<and> y pd\<rightarrow> x}\<close>
	+
	+
	+subsubsection \<open>Control Dependence\<close>
	+
	+text \<open>An index on an execution path is control dependent upon another if the path does not visit
	+the immediate post domiator of the node reached by the smaller index.\<close>
	+definition is_cdi (\<open>_ cd\<^bsup>_\<^esup>\<rightarrow> _\<close> [51,51,51]50) where
	+\<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k \<longleftrightarrow> is_path \<pi> \<and> k < i \<and> \<pi> i \<noteq> return \<and> (\<forall> j \<in> {k..i}. \<pi> j \<noteq> ipd (\<pi> k))\<close>
	+
	+text \<open>The largest control dependency of an index is the immediate control dependency.\<close>
	+definition is_icdi (\<open>_ icd\<^bsup>_\<^esup>\<rightarrow> _\<close> [51,51,51]50) where
	+\<open>n icd\<^bsup>\<pi>\<^esup>\<rightarrow> n' \<longleftrightarrow> is_path \<pi> \<and> n cd\<^bsup>\<pi>\<^esup>\<rightarrow> n' \<and> (\<forall> m \<in> {n'<..<n}.\<not> n cd\<^bsup>\<pi>\<^esup>\<rightarrow> m)\<close>
	+
	+text \<open>For the definition of the control slice, which we will define next, we require the uniqueness
	+of the immediate control dependency.\<close>
	+
	+lemma icd_uniq: assumes \<open>m icd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> \<open> m icd\<^bsup>\<pi>\<^esup>\<rightarrow> n'\<close> shows \<open>n = n'\<close>
	+proof -
	+ {
	+ fix n n' assume *: \<open>m icd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> \<open> m icd\<^bsup>\<pi>\<^esup>\<rightarrow> n'\<close> \<open>n < n'\<close>
	+ have \<open>n'<m\<close> using * unfolding is_icdi_def is_cdi_def by auto
	+ hence \<open>\<not> m cd\<^bsup>\<pi>\<^esup>\<rightarrow> n'\<close> using * unfolding is_icdi_def by auto
	+ with *(2) have \<open>False\<close> unfolding is_icdi_def by auto
	+ }
	+ thus ?thesis using assms by (metis linorder_neqE_nat)
	+qed
	+
	+
	+subsubsection \<open>Control Slice\<close>
	+text \<open>We utilise the control slice, that is the sequence of nodes visited by the control dependencies
	+of an index, to match indices between executions.\<close>
	+
	+function cs:: \<open>(nat \<Rightarrow> 'n) \<Rightarrow> nat \<Rightarrow> 'n list\<close> (\<open>cs\<^bsup>_\<^esup> _\<close> [51,70] 71) where
	+\<open>cs\<^bsup>\<pi>\<^esup> n = (if (\<exists> m. n icd\<^bsup>\<pi>\<^esup>\<rightarrow> m) then (cs \<pi> (THE m. n icd\<^bsup>\<pi>\<^esup>\<rightarrow> m))@[\<pi> n] else [\<pi> n])\<close>
	+by pat_completeness auto
	+termination \<open>cs\<close> proof
	+ show \<open>wf (measure snd)\<close> by simp
	+ fix \<pi> n
	+ define m where \<open>m == (The (is_icdi n \<pi>))\<close>
	+ assume \<open>Ex (is_icdi n \<pi>)\<close>
	+ hence \<open>n icd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> unfolding m_def by (metis (full_types) icd_uniq theI')
	+ hence \<open>m < n\<close> unfolding is_icdi_def is_cdi_def by simp
	+ thus \<open>((\<pi>, The (is_icdi n \<pi>)), \<pi>, n) \<in> measure snd\<close> by (metis in_measure m_def snd_conv)
	+qed
	+
	+inductive cs_less (infix \<open>\<prec>\<close> 50) where
	+\<open>length xs < length ys \<Longrightarrow> take (length xs) ys = xs \<Longrightarrow> xs \<prec> ys\<close>
	+
	+definition cs_select (infix \<open>\<exclamdown>\<close> 50) where
	+\<open>\<pi>\<exclamdown>xs = (THE k. cs\<^bsup>\<pi>\<^esup> k = xs)\<close>
	+
	+
	+subsubsection \<open>Data Dependence\<close>
	+
	+text \<open>Data dependence is defined straight forward. An index is data dependent upon another,
	+if the index reads a variable written by the earlier index and the variable in question has not
	+been written by any index in between.\<close>
	+definition is_ddi (\<open>_ dd\<^bsup>_,_\<^esup>\<rightarrow> _\<close> [51,51,51,51] 50) where
	+\<open>n dd\<^bsup>\<pi>,v\<^esup>\<rightarrow> m \<longleftrightarrow> is_path \<pi> \<and> m < n \<and> v \<in> reads (\<pi> n) \<inter> (writes (\<pi> m)) \<and> (\<forall> l \<in> {m<..<n}. v \<notin> writes (\<pi> l))\<close>
	+
	+
	+
	+subsubsection \<open>Characterisation via Critical Paths\<close>
	+text_raw \<open>\label{sec:char-cp}\<close>
	+text \<open>With the above we define the set of critical paths which as we will prove characterise the matching
	+points in executions where diverging data is read.\<close>
	+
	+inductive_set cp where
	+
	+\<comment> \<open>Any pair of low equivalent input states and indices where a diverging high variable is first
	+read is critical.\<close>
	+
	+\<open>\<lbrakk>\<sigma> =\<^sub>L \<sigma>';
	+ cs\<^bsup>path \<sigma>\<^esup> n = cs\<^bsup>path \<sigma>'\<^esup> n';
	+ h \<in> reads(path \<sigma> n);
	+ (\<sigma>\<^bsup>n\<^esup>) h \<noteq> (\<sigma>'\<^bsup>n'\<^esup>) h;
	+ \<forall> k<n. h\<notin>writes(path \<sigma> k);
	+ \<forall> k'<n'. h\<notin>writes(path \<sigma>' k')
	+ \<rbrakk> \<Longrightarrow> ((\<sigma>,n),(\<sigma>',n')) \<in> cp\<close> \|
	+
	+\<comment> \<open>If from a pair of critical indices in two executions there exist data dependencies from both
	+indices to a pair of matching indices where the variable diverges, the later pair of indices is critical.\<close>
	+
	+\<open>\<lbrakk>((\<sigma>,k),(\<sigma>',k')) \<in> cp;
	+ n dd\<^bsup>path \<sigma>,v\<^esup>\<rightarrow> k;
	+ n' dd\<^bsup>path \<sigma>',v\<^esup>\<rightarrow> k';
	+ cs\<^bsup>path \<sigma>\<^esup> n = cs\<^bsup>path \<sigma>'\<^esup> n';
	+ (\<sigma>\<^bsup>n\<^esup>) v \<noteq> (\<sigma>'\<^bsup>n'\<^esup>) v
	+ \<rbrakk> \<Longrightarrow> ((\<sigma>,n),(\<sigma>',n')) \<in> cp\<close> \|
	+
	+\<comment> \<open>If from a pair of critical indices the executions take different branches and one of the critical
	+indices is a control dependency of an index that is data dependency of a matched index where diverging
	+data is read and the variable in question is not written by the other execution after the executions
	+first reached matching indices again, then the later matching pair of indices is critical.\<close>
	+
	+\<open>\<lbrakk>((\<sigma>,k),(\<sigma>',k')) \<in> cp;
	+ n dd\<^bsup>path \<sigma>,v\<^esup>\<rightarrow> l;
	+ l cd\<^bsup>path \<sigma>\<^esup>\<rightarrow> k;
	+ cs\<^bsup>path \<sigma>\<^esup> n = cs\<^bsup>path \<sigma>'\<^esup> n';
	+ path \<sigma> (Suc k) \<noteq> path \<sigma>' (Suc k');
	+ (\<sigma>\<^bsup>n\<^esup>) v \<noteq> (\<sigma>'\<^bsup>n'\<^esup>) v;
	+ \<forall>j'\<in>{(LEAST i'. k' < i' \<and> (\<exists>i. cs\<^bsup>path \<sigma>\<^esup> i = cs\<^bsup>path \<sigma>'\<^esup> i'))..<n'}. v\<notin>writes (path \<sigma>' j')
	+ \<rbrakk> \<Longrightarrow> ((\<sigma>,n),(\<sigma>',n')) \<in> cp\<close> \|
	+
	+\<comment> \<open>The relation is symmetric.\<close>
	+
	+\<open>\<lbrakk>((\<sigma>,k),(\<sigma>',k')) \<in> cp\<rbrakk> \<Longrightarrow> ((\<sigma>',k'),(\<sigma>,k)) \<in> cp\<close>
	+
	+
	+text \<open>Based on the set of critical paths, the critical observable paths are those that either directly
	+reach observable nodes or are diverging control dependencies of an observable index.\<close>
	+
	+inductive_set cop where
	+\<open>\<lbrakk>((\<sigma>,n),(\<sigma>',n')) \<in> cp;
	+ path \<sigma> n \<in> dom att
	+ \<rbrakk> \<Longrightarrow> ((\<sigma>,n),(\<sigma>',n')) \<in> cop\<close> \|
	+
	+\<open>\<lbrakk>((\<sigma>,k),(\<sigma>',k')) \<in> cp;
	+ n cd\<^bsup>path \<sigma>\<^esup>\<rightarrow> k;
	+ path \<sigma> (Suc k) \<noteq> path \<sigma>' (Suc k');
	+ path \<sigma> n \<in> dom att
	+ \<rbrakk> \<Longrightarrow> ((\<sigma>,n),(\<sigma>',k')) \<in> cop\<close>
	+
	+
	+
	+subsubsection \<open>Approximation via Single Critical Paths\<close>
	+text_raw \<open>\label{sec:char-scp}\<close>
	+
	+text \<open>For applications we also define a single execution approximation.\<close>
	+
	+definition is_dcdi_via (\<open>_ dcd\<^bsup>_,_\<^esup>\<rightarrow> _ via _ _\<close> [51,51,51,51,51,51] 50) where
	+\<open>n dcd\<^bsup>\<pi>,v\<^esup>\<rightarrow> m via \<pi>' m' = (is_path \<pi> \<and> m < n \<and> (\<exists> l' n'. cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m' \<and> cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n' \<and> n' dd\<^bsup>\<pi>',v\<^esup>\<rightarrow> l' \<and> l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> m') \<and> (\<forall> l \<in> {m..<n}. v\<notin> writes(\<pi> l)))\<close>
	+
	+inductive_set scp where
	+\<open>\<lbrakk>h \<in> hvars; h \<in> reads (path \<sigma> n); (\<forall> k<n. h\<notin> writes(path \<sigma> k))\<rbrakk> \<Longrightarrow> (path \<sigma>,n) \<in> scp\<close> \|
	+\<open>\<lbrakk>(\<pi>,m) \<in> scp; n cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<rbrakk> \<Longrightarrow> (\<pi>,n) \<in> scp\<close>\|
	+\<open>\<lbrakk>(\<pi>,m) \<in> scp; n dd\<^bsup>\<pi>,v\<^esup>\<rightarrow> m\<rbrakk> \<Longrightarrow> (\<pi>,n) \<in> scp\<close>\|
	+\<open>\<lbrakk>(\<pi>,m) \<in> scp; (\<pi>',m') \<in> scp; n dcd\<^bsup>\<pi>,v\<^esup>\<rightarrow> m via \<pi>' m'\<rbrakk> \<Longrightarrow> (\<pi>,n) \<in> scp\<close>
	+
	+inductive_set scop where
	+\<open>\<lbrakk>(\<pi>,n) \<in> scp; \<pi> n \<in> dom att\<rbrakk> \<Longrightarrow> (\<pi>,n) \<in> scop\<close>
	+
	+
	+
	+subsubsection \<open>Further Definitions\<close>
	+text \<open>The following concepts are utilised by the proofs.\<close>
	+
	+inductive contradicts (infix \<open>\<cc>\<close> 50) where
	+\<open>\<lbrakk>cs\<^bsup>\<pi>'\<^esup> k' \<prec> cs\<^bsup>\<pi>\<^esup> k ; \<pi> = path \<sigma>; \<pi>' = path \<sigma>' ; \<pi> (Suc (\<pi>\<exclamdown>cs\<^bsup>\<pi>'\<^esup> k')) \<noteq> \<pi>' (Suc k')\<rbrakk> \<Longrightarrow> (\<sigma>', k') \<cc> (\<sigma>, k)\<close>\|
	+\<open>\<lbrakk>cs\<^bsup>\<pi>'\<^esup> k' = cs\<^bsup>\<pi>\<^esup> k ; \<pi> = path \<sigma>; \<pi>' = path \<sigma>' ; \<sigma>\<^bsup>k\<^esup> \<restriction> (reads (\<pi> k)) \<noteq> \<sigma>'\<^bsup>k'\<^esup> \<restriction> (reads (\<pi> k))\<rbrakk> \<Longrightarrow> (\<sigma>',k') \<cc> (\<sigma>,k)\<close>
	+
	+definition path_shift (infixl \<open>\<guillemotleft>\<close> 51) where
	+[simp]: \<open>\<pi>\<guillemotleft>m = (\<lambda> n. \<pi> (m+n))\<close>
	+
	+definition path_append :: \<open>(nat \<Rightarrow> 'n) \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> 'n) \<Rightarrow> (nat \<Rightarrow> 'n)\<close> (\<open>_ @\<^bsup>_\<^esup> _\<close> [0,0,999] 51) where
	+[simp]: \<open>\<pi> @\<^bsup>m\<^esup> \<pi>' = (\<lambda>n.(if n \<le> m then \<pi> n else \<pi>' (n-m)))\<close>
	+
	+definition eq_up_to :: \<open>(nat \<Rightarrow> 'n) \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> 'n) \<Rightarrow> bool\<close> (\<open>_ =\<^bsub>_\<^esub> _\<close> [55,55,55] 50) where
	+\<open>\<pi> =\<^bsub>k\<^esub> \<pi>' = (\<forall> i \<le> k. \<pi> i = \<pi>' i)\<close>
	+
	+end (* End of locale IFC_def *)
	+
	+
	+
	+
	+section \<open>Proofs\<close>
	+text_raw \<open>\label{sec:proofs}\<close>
	+
	+subsection \<open>Miscellaneous Facts\<close>
	+
	+lemma option_neq_cases: assumes \<open>x \<noteq> y\<close> obtains (none1) a where \<open>x = None\<close> \<open>y = Some a\<close> \| (none2) a where \<open>x = Some a\<close> \<open>y = None\<close> \| (some) a b where \<open>x = Some a\<close> \<open>y = Some b\<close> \<open>a \<noteq> b\<close> using assms by fastforce
	+
	+lemmas nat_sym_cases[case_names less sym eq] = linorder_less_wlog
	+
	+lemma mod_bound_instance: assumes \<open>j < (i::nat)\<close> obtains j' where \<open>k < j'\<close> and \<open>j' mod i = j\<close> proof -
	+ have \<open>k < Suc k * i + j\<close> using assms less_imp_Suc_add by fastforce
	+ moreover
	+ have \<open>(Suc k * i + j) mod i = j\<close> by (metis assms mod_less mod_mult_self3)
	+ ultimately show \<open>thesis\<close> using that by auto
	+qed
	+
	+lemma list_neq_prefix_cases: assumes \<open>ls \<noteq> ls'\<close> and \<open>ls \<noteq> Nil\<close> and \<open>ls' \<noteq> Nil\<close>
	+ obtains (diverge) xs x x' ys ys' where \<open>ls = xs@[x]@ys\<close> \<open>ls' = xs@[x']@ys'\<close> \<open>x \<noteq> x'\<close> \|
	+ (prefix1) xs where \<open>ls = ls'@xs\<close> and \<open>xs \<noteq> Nil\<close> \|
	+ (prefix2) xs where \<open>ls@xs = ls'\<close> and \<open>xs \<noteq> Nil\<close>
	+using assms proof (induct \<open>length ls\<close> arbitrary: \<open>ls\<close> \<open>ls'\<close> rule: less_induct)
	+ case (less ls ls')
	+ obtain z zs z' zs' where
	+ lz: \<open>ls = z#zs\<close> \<open>ls' = z'#zs'\<close> by (metis list.exhaust less(6,7))
	+ show \<open>?case\<close> proof cases
	+ assume zz: \<open>z = z'\<close>
	+ hence zsz: \<open>zs \<noteq> zs'\<close> using less(5) lz by auto
	+ have lenz: \<open>length zs < length ls\<close> using lz by auto
	+ show \<open>?case\<close> proof(cases \<open>zs = Nil\<close>)
	+ assume zs: \<open>zs = Nil\<close>
	+ hence \<open>zs' \<noteq> Nil\<close> using zsz by auto
	+ moreover
	+ have \<open>ls@zs' = ls'\<close> using zs lz zz by auto
	+ ultimately
	+ show \<open>thesis\<close> using less(4) by blast
	+ next
	+ assume zs: \<open>zs \<noteq> Nil\<close>
	+ show \<open>thesis\<close> proof (cases \<open>zs' = Nil\<close>)
	+ assume \<open>zs' = Nil\<close>
	+ hence \<open>ls = ls'@zs\<close> using lz zz by auto
	+ thus \<open>thesis\<close> using zs less(3) by blast
	+ next
	+ assume zs': \<open>zs' \<noteq> Nil\<close>
	+ { fix xs x ys x' ys'
	+ assume \<open>zs = xs @ [x] @ ys\<close> \<open>zs' = xs @ [x'] @ ys'\<close> and xx: \<open>x \<noteq> x'\<close>
	+ hence \<open>ls = (z#xs) @ [x] @ ys\<close> \<open>ls' = (z#xs) @ [x'] @ ys'\<close> using lz zz by auto
	+ hence \<open>thesis\<close> using less(2) xx by blast
	+ } note * = this
	+ { fix xs
	+ assume \<open>zs = zs' @ xs\<close> and xs: \<open>xs \<noteq> []\<close>
	+ hence \<open>ls = ls' @ xs\<close> using lz zz by auto
	+ hence \<open>thesis\<close> using xs less(3) by blast
	+ } note ** = this
	+ { fix xs
	+ assume \<open>zs@xs = zs'\<close> and xs: \<open>xs \<noteq> []\<close>
	+ hence \<open>ls@xs = ls'\<close> using lz zz by auto
	+ hence \<open>thesis\<close> using xs less(4) by blast
	+ } note *** = this
	+ have \<open>(\<And>xs x ys x' ys'. zs = xs @ [x] @ ys \<Longrightarrow> zs' = xs @ [x'] @ ys' \<Longrightarrow> x \<noteq> x' \<Longrightarrow> thesis) \<Longrightarrow>
	+ (\<And>xs. zs = zs' @ xs \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> thesis) \<Longrightarrow>
	+ (\<And>xs. zs @ xs = zs' \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
	+ using less(1)[OF lenz _ _ _ zsz zs zs' ] .
	+ thus \<open>thesis\<close> using * * by blast
	+ qed
	+ qed
	+ next
	+ assume \<open>z \<noteq> z'\<close>
	+ moreover
	+ have \<open>ls = []@[z]@zs\<close> \<open>ls' = []@[z']@zs'\<close> using lz by auto
	+ ultimately show \<open>thesis\<close> using less(2) by blast
	+ qed
	+qed
	+
	+lemma three_cases: assumes \<open>A \<or> B \<or> C\<close> obtains \<open>A\<close> \| \<open>B\<close> \| \<open>C\<close> using assms by auto
	+
	+lemma insort_greater: \<open>\<forall> x \<in> set ls. x < y \<Longrightarrow> insort y ls = ls@[y]\<close> by (induction \<open>ls\<close>,auto)
	+
	+lemma insort_append_first: assumes \<open>\<forall> y \<in> set ys. x \<le> y\<close> shows \<open>insort x (xs@ys) = insort x xs @ ys\<close> using assms by (induction \<open>xs\<close>,auto,metis insort_is_Cons)
	+
	+lemma sorted_list_of_set_append: assumes \<open>finite xs\<close> \<open>finite ys\<close> \<open>\<forall> x \<in> xs. \<forall> y \<in> ys. x < y\<close> shows \<open>sorted_list_of_set (xs \<union> ys) = sorted_list_of_set xs @ (sorted_list_of_set ys)\<close>
	+using assms(1,3) proof (induction \<open>xs\<close>)
	+ case empty thus \<open>?case\<close> by simp
	+next
	+ case (insert x xs)
	+ hence iv: \<open>sorted_list_of_set (xs \<union> ys) = sorted_list_of_set xs @ sorted_list_of_set ys\<close> by blast
	+ have le: \<open>\<forall> y \<in> set (sorted_list_of_set ys). x < y\<close> using insert(4) assms(2) sorted_list_of_set by auto
	+ have \<open>sorted_list_of_set (insert x xs \<union> ys) = sorted_list_of_set (insert x (xs \<union> ys))\<close> by auto
	+ also
	+ have \<open>\<dots> = insort x (sorted_list_of_set (xs \<union> ys))\<close> by (metis Un_iff assms(2) finite_Un insert.hyps(1) insert.hyps(2) insert.prems insertI1 less_irrefl sorted_list_of_set.insert)
	+ also
	+ have \<open>\<dots> = insort x (sorted_list_of_set xs @ sorted_list_of_set ys)\<close> using iv by simp
	+ also
	+ have \<open>\<dots> = insort x (sorted_list_of_set xs) @ sorted_list_of_set ys\<close> by (metis le insort_append_first less_le_not_le)
	+ also
	+ have \<open>\<dots> = sorted_list_of_set (insert x xs) @ sorted_list_of_set ys\<close> using sorted_list_of_set_insert[OF insert(1),of \<open>x\<close>] insert(2) by auto
	+ finally
	+ show \<open>?case\<close> .
	+qed
	+
	+lemma filter_insort: \<open>sorted xs \<Longrightarrow> filter P (insort x xs) = (if P x then insort x (filter P xs) else filter P xs)\<close> by (induction \<open>xs\<close>, simp) (metis filter_insort filter_insort_triv map_ident)
	+
	+lemma filter_sorted_list_of_set: assumes \<open>finite xs\<close> shows \<open>filter P (sorted_list_of_set xs) = sorted_list_of_set {x \<in> xs. P x}\<close> using assms proof(induction \<open>xs\<close>)
	+ case empty thus \<open>?case\<close> by simp
	+next
	+ case (insert x xs)
	+ have *: \<open>set (sorted_list_of_set xs) = xs\<close> \<open>sorted (sorted_list_of_set xs)\<close> \<open>distinct (sorted_list_of_set xs)\<close> by (auto simp add: insert.hyps(1))
	+ have **: \<open>P x \<Longrightarrow> {y \<in> insert x xs. P y} = insert x {y \<in> xs. P y}\<close> by auto
	+ have ***: \<open>\<not> P x \<Longrightarrow> {y \<in> insert x xs. P y} = {y \<in> xs. P y}\<close> by auto
	+ note filter_insort[OF (2),of \<open>P\<close> \<open>x\<close>] sorted_list_of_set_insert[OF insert(1), of \<open>x\<close>] insert(2,3) * ***
	+ thus \<open>?case\<close> by (metis (mono_tags) "*"(1) List.finite_set distinct_filter distinct_insort distinct_sorted_list_of_set set_filter sorted_list_of_set.insert)
	+qed
	+
	+lemma unbounded_nat_set_infinite: assumes \<open>\<forall> (i::nat). \<exists> j\<ge>i. j \<in> A\<close> shows \<open>\<not> finite A\<close> using assms
	+by (metis finite_nat_set_iff_bounded_le not_less_eq_eq)
	+
	+lemma infinite_ascending: assumes nf: \<open>\<not> finite (A::nat set)\<close> obtains f where \<open>range f = A\<close> \<open>\<forall> i. f i < f (Suc i)\<close> proof
	+ let \<open>?f\<close> = \<open>\<lambda> i. (LEAST a. a \<in> A \<and> card (A \<inter> {..<a}) = i)\<close>
	+ { fix i
	+ obtain a where \<open>a \<in> A\<close> \<open>card (A \<inter> {..<a}) = i\<close>
	+ proof (induction \<open>i\<close> arbitrary: \<open>thesis\<close>)
	+ case 0
	+ let \<open>?a0\<close> = \<open>(LEAST a. a \<in> A)\<close>
	+ have \<open>?a0 \<in> A\<close> by (metis LeastI empty_iff finite.emptyI nf set_eq_iff)
	+ moreover
	+ have \<open>\<And>b. b \<in> A \<Longrightarrow> ?a0 \<le> b\<close> by (metis Least_le)
	+ hence \<open>card (A \<inter> {..<?a}) = 0\<close> by force
	+ ultimately
	+ show \<open>?case\<close> using 0 by blast
	+ next
	+ case (Suc i)
	+ obtain a where aa: \<open>a \<in> A\<close> and card: \<open>card (A \<inter> {..<a}) = i\<close> using Suc.IH by metis
	+ have nf': \<open>~ finite (A - {..a})\<close> using nf by auto
	+ let \<open>?b\<close> = \<open>LEAST b. b \<in> A - {..a}\<close>
	+ have bin: \<open>?b \<in> A-{..a}\<close> by (metis LeastI empty_iff finite.emptyI nf' set_eq_iff)
	+ have le: \<open>\<And>c. c \<in> A-{..a} \<Longrightarrow> ?b \<le> c\<close> by (metis Least_le)
	+ have ab: \<open>a < ?b\<close> using bin by auto
	+ have \<open>\<And> c. c \<in> A \<Longrightarrow> c < ?b \<Longrightarrow> c \<le> a\<close> using le by force
	+ hence \<open>A \<inter> {..<?b} = insert a (A \<inter> {..<a})\<close> using bin ab aa by force
	+ hence \<open>card (A \<inter>{..<?b}) = Suc i\<close> using card by auto
	+ thus \<open>?case\<close> using Suc.prems bin by auto
	+ qed
	+ note \<open>\<And> thesis. ((\<And>a. a \<in> A \<Longrightarrow> card (A \<inter> {..<a}) = i \<Longrightarrow> thesis) \<Longrightarrow> thesis)\<close>
	+ }
	+ note ex = this
	+
	+ {
	+ fix i
	+ obtain a where a: \<open>a \<in> A \<and> card (A \<inter>{..<a}) = i\<close> using ex by blast
	+ have ina: \<open>?f i \<in> A\<close> and card: \<open>card (A \<inter>{..<?f i}) = i\<close> using LeastI[of \<open>\<lambda> a. a \<in> A \<and> card (A \<inter>{..<a}) = i\<close> \<open>a\<close>, OF a] by auto
	+ obtain b where b: \<open>b \<in> A \<and> card (A \<inter>{..<b}) = Suc i\<close> using ex by blast
	+ have inab: \<open>?f (Suc i) \<in> A\<close> and cardb: \<open>card (A \<inter>{..<?f (Suc i)}) = Suc i\<close> using LeastI[of \<open>\<lambda> a. a \<in> A \<and> card (A \<inter>{..<a}) = Suc i\<close> \<open>b\<close>, OF b] by auto
	+ have \<open>?f i < ?f (Suc i)\<close> proof (rule ccontr)
	+ assume \<open>\<not> ?f i < ?f (Suc i)\<close>
	+ hence \<open>A \<inter>{..<?f (Suc i)} \<subseteq> A \<inter>{..<?f i}\<close> by auto
	+ moreover have \<open>finite (A \<inter>{..<?f i})\<close> by auto
	+ ultimately have \<open>card(A \<inter>{..<?f (Suc i)}) \<le> card (A \<inter>{..<?f i})\<close> by (metis (erased, lifting) card_mono)
	+ thus \<open>False\<close> using card cardb by auto
	+ qed
	+ note this ina
	+ }
	+ note b = this
	+ thus \<open>\<forall> i. ?f i < ?f (Suc i)\<close> by auto
	+ have *: \<open>range ?f \<subseteq> A\<close> using b by auto
	+ moreover
	+ {
	+ fix a assume ina: \<open>a \<in> A\<close>
	+ let \<open>?i\<close> = \<open>card (A \<inter> {..<a})\<close>
	+ obtain b where b: \<open>b \<in> A \<and> card (A \<inter>{..<b}) = ?i\<close> using ex by blast
	+ have inab: \<open>?f ?i \<in> A\<close> and cardb: \<open>card (A \<inter>{..<?f ?i}) = ?i\<close> using LeastI[of \<open>\<lambda> a. a \<in> A \<and> card (A \<inter>{..<a}) = ?i\<close> \<open>b\<close>, OF b] by auto
	+ have le: \<open>?f ?i \<le> a\<close> using Least_le[of \<open>\<lambda> a. a \<in> A \<and> card (A \<inter>{..<a}) = ?i\<close> \<open>a\<close>] ina by auto
	+ have \<open>a = ?f ?i\<close> proof (rule ccontr)
	+ have fin: \<open>finite (A \<inter> {..<a})\<close> by auto
	+ assume \<open>a \<noteq> ?f ?i\<close>
	+ hence \<open>?f ?i < a\<close> using le by simp
	+ hence \<open>?f ?i \<in> A \<inter> {..<a}\<close> using inab by auto
	+ moreover
	+ have \<open>A \<inter> {..<?f ?i} \<subseteq> A \<inter> {..<a}\<close> using le by auto
	+ hence \<open>A \<inter> {..<?f ?i} = A \<inter> {..<a}\<close> using cardb card_subset_eq[OF fin] by auto
	+ ultimately
	+ show \<open>False\<close> by auto
	+ qed
	+ hence \<open>a \<in> range ?f\<close> by auto
	+ }
	+ hence \<open>A \<subseteq> range ?f\<close> by auto
	+ ultimately show \<open>range ?f = A\<close> by auto
	+qed
	+
	+lemma mono_ge_id: \<open>\<forall> i. f i < f (Suc i) \<Longrightarrow> i \<le> f i\<close>
	+ apply (induction \<open>i\<close>,auto)
	+ by (metis not_le not_less_eq_eq order_trans)
	+
	+lemma insort_map_mono: assumes mono: \<open>\<forall> n m. n < m \<longrightarrow> f n < f m\<close> shows \<open>map f (insort n ns) = insort (f n) (map f ns)\<close>
	+ apply (induction \<open>ns\<close>)
	+ apply auto
	+ apply (metis not_less not_less_iff_gr_or_eq mono)
	+ apply (metis antisym_conv1 less_imp_le mono)
	+ apply (metis mono not_less)
	+ by (metis mono not_less)
	+
	+lemma sorted_list_of_set_map_mono: assumes mono: \<open>\<forall> n m. n < m \<longrightarrow> f n < f m\<close> and fin: \<open>finite A\<close>
	+shows \<open>map f (sorted_list_of_set A) = sorted_list_of_set (f`A)\<close>
	+using fin proof (induction)
	+ case empty thus \<open>?case\<close> by simp
	+next
	+ case (insert x A)
	+ have [simp]:\<open>sorted_list_of_set (insert x A) = insort x (sorted_list_of_set A)\<close> using insert sorted_list_of_set.insert by simp
	+ have \<open>f ` insert x A = insert (f x) (f ` A)\<close> by auto
	+ moreover
	+ have \<open>f x \<notin> f`A\<close> apply (rule ccontr) using insert(2) mono apply auto by (metis insert.hyps(2) mono neq_iff)
	+ ultimately
	+ have \<open>sorted_list_of_set (f ` insert x A) = insort (f x) (sorted_list_of_set (f`A))\<close> using insert(1) sorted_list_of_set.insert by simp
	+ also
	+ have \<open>\<dots> = insort (f x) (map f (sorted_list_of_set A))\<close> using insert.IH by auto
	+ also have \<open>\<dots> = map f (insort x (sorted_list_of_set A))\<close> using insort_map_mono[OF mono] by auto
	+ finally
	+ show \<open>map f (sorted_list_of_set (insert x A)) = sorted_list_of_set (f ` insert x A)\<close> by simp
	+qed
	+
	+lemma GreatestIB:
	+fixes n :: \<open>nat\<close> and P
	+assumes a:\<open>\<exists>k\<le>n. P k\<close>
	+shows GreatestBI: \<open>P (GREATEST k. k\<le>n \<and> P k)\<close> and GreatestB: \<open>(GREATEST k. k\<le>n \<and> P k) \<le> n\<close>
	+proof -
	+ show \<open>P (GREATEST k. k\<le>n \<and> P k)\<close> using GreatestI_ex_nat[OF assms] by auto
	+ show \<open>(GREATEST k. k\<le>n \<and> P k) \<le> n\<close> using GreatestI_ex_nat[OF assms] by auto
	+qed
	+
	+lemma GreatestB_le:
	+fixes n :: \<open>nat\<close>
	+assumes \<open>x\<le>n\<close> and \<open>P x\<close>
	+shows \<open>x \<le> (GREATEST k. k\<le>n \<and> P k)\<close>
	+proof -
	+ have *: \<open>\<forall> y. y\<le>n \<and> P y \<longrightarrow> y<Suc n\<close> by auto
	+ then show \<open>x \<le> (GREATEST k. k\<le>n \<and> P k)\<close> using assms by (blast intro: Greatest_le_nat)
	+qed
	+
	+lemma LeastBI_ex: assumes \<open>\<exists>k \<le> n. P k\<close> shows \<open>P (LEAST k::'c::wellorder. P k)\<close> and \<open>(LEAST k. P k) \<le> n\<close>
	+proof -
	+ from assms guess k ..
	+ hence k: \<open>k \<le> n\<close> \<open>P k\<close> by auto
	+ thus \<open>P (LEAST k. P k)\<close> using LeastI[of \<open>P\<close> \<open>k\<close>] by simp
	+ show \<open>(LEAST k. P k) \<le> n\<close> using Least_le[of \<open>P\<close> \<open>k\<close>] k by auto
	+qed
	+
	+lemma allB_atLeastLessThan_lower: assumes \<open>(i::nat) \<le> j\<close> \<open>\<forall> x\<in>{i..<n}. P x\<close> shows \<open>\<forall> x\<in>{j..<n}. P x\<close> proof
	+ fix x assume \<open>x\<in>{j..<n}\<close> hence \<open>x\<in>{i..<n}\<close> using assms(1) by simp
	+ thus \<open>P x\<close> using assms(2) by auto
	+qed
	+
	+
	+subsection \<open>Facts about Paths\<close>
	+
	+context IFC
	+begin
	+
	+lemma path0: \<open>path \<sigma> 0 = entry\<close> unfolding path_def by auto
	+
	+lemma path_in_nodes[intro]: \<open>path \<sigma> k \<in> nodes\<close> proof (induction \<open>k\<close>)
	+ case (Suc k)
	+ hence \<open>\<And> \<sigma>'. (path \<sigma> k, suc (path \<sigma> k) \<sigma>') \<in> edges\<close> by auto
	+ hence \<open>(path \<sigma> k, path \<sigma> (Suc k)) \<in> edges\<close> unfolding path_def
	+ by (metis suc_def comp_apply funpow.simps(2) prod.collapse)
	+ thus \<open>?case\<close> using edges_nodes by force
	+qed (auto simp add: path_def)
	+
	+lemma path_is_path[simp]: \<open>is_path (path \<sigma>)\<close> unfolding is_path_def path_def using step_suc_sem apply auto
	+by (metis path_def suc_def edges_complete path_in_nodes prod.collapse)
	+
	+lemma term_path_stable: assumes \<open>is_path \<pi>\<close> \<open>\<pi> i = return\<close> and le: \<open>i \<le> j\<close> shows \<open>\<pi> j = return\<close>
	+using le proof (induction \<open>j\<close>)
	+ case (Suc j)
	+ show \<open>?case\<close> proof cases
	+ assume \<open>i\<le>j\<close>
	+ hence \<open>\<pi> j = return\<close> using Suc by simp
	+ hence \<open>(return, \<pi> (Suc j)) \<in> edges\<close> using assms(1) unfolding is_path_def by metis
	+ thus \<open>\<pi> (Suc j) = return\<close> using edges_return by auto
	+ next
	+ assume \<open>\<not> i \<le> j\<close>
	+ hence \<open>Suc j = i\<close> using Suc by auto
	+ thus \<open>?thesis\<close> using assms(2) by auto
	+ qed
	+next
	+ case 0 thus \<open>?case\<close> using assms by simp
	+qed
	+
	+lemma path_path_shift: assumes \<open>is_path \<pi>\<close> shows \<open>is_path (\<pi>\<guillemotleft>m)\<close>
	+using assms unfolding is_path_def by simp
	+
	+lemma path_cons: assumes \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> \<open>\<pi> m = \<pi>' 0\<close> shows \<open>is_path (\<pi> @\<^bsup>m\<^esup> \<pi>')\<close>
	+unfolding is_path_def proof(rule,cases)
	+ fix n assume \<open>m < n\<close> thus \<open>((\<pi> @\<^bsup>m\<^esup> \<pi>') n, (\<pi> @\<^bsup>m\<^esup> \<pi>') (Suc n)) \<in> edges\<close>
	+ using assms(2) unfolding is_path_def path_append_def
	+ by (auto,metis Suc_diff_Suc diff_Suc_Suc less_SucI)
	+next
	+ fix n assume *: \<open>\<not> m < n\<close> thus \<open>((\<pi> @\<^bsup>m\<^esup> \<pi>') n, (\<pi> @\<^bsup>m\<^esup> \<pi>') (Suc n)) \<in> edges\<close> proof cases
	+ assume [simp]: \<open>n = m\<close>
	+ thus \<open>?thesis\<close> using assms unfolding is_path_def path_append_def by force
	+ next
	+ assume \<open>n \<noteq> m\<close>
	+ hence \<open>Suc n \<le> m\<close> \<open>n\<le> m\<close> using * by auto
	+ with assms(1) show \<open>?thesis\<close> unfolding is_path_def by auto
	+ qed
	+qed
	+
	+lemma is_path_loop: assumes \<open>is_path \<pi>\<close> \<open>0 < i\<close> \<open>\<pi> i = \<pi> 0\<close> shows \<open>is_path (\<lambda> n. \<pi> (n mod i))\<close> unfolding is_path_def proof (rule,cases)
	+ fix n
	+ assume \<open>0 < Suc n mod i\<close>
	+ hence \<open>Suc n mod i = Suc (n mod i)\<close> by (metis mod_Suc neq0_conv)
	+ moreover
	+ have \<open>(\<pi> (n mod i), \<pi> (Suc (n mod i))) \<in> edges\<close> using assms(1) unfolding is_path_def by auto
	+ ultimately
	+ show \<open>(\<pi> (n mod i), \<pi> (Suc n mod i)) \<in> edges\<close> by simp
	+ next
	+ fix n
	+ assume \<open>\<not> 0 < Suc n mod i\<close>
	+ hence \<open>Suc n mod i = 0\<close> by auto
	+ moreover
	+ hence \<open>n mod i = i - 1\<close> using assms(2) by (metis Zero_neq_Suc diff_Suc_1 mod_Suc)
	+ ultimately
	+ show \<open>(\<pi>(n mod i), \<pi> (Suc n mod i)) \<in> edges\<close> using assms(1) unfolding is_path_def by (metis assms(3) mod_Suc)
	+qed
	+
	+lemma path_nodes: \<open>is_path \<pi> \<Longrightarrow> \<pi> k \<in> nodes\<close> unfolding is_path_def using edges_nodes by force
	+
	+lemma direct_path_return': assumes \<open>is_path \<pi> \<close> \<open>\<pi> 0 = x\<close> \<open>x \<noteq> return\<close> \<open>\<pi> n = return\<close>
	+obtains \<pi>' n' where \<open>is_path \<pi>'\<close> \<open>\<pi>' 0 = x\<close> \<open>\<pi>' n' = return\<close> \<open>\<forall> i> 0. \<pi>' i \<noteq> x\<close>
	+using assms proof (induction \<open>n\<close> arbitrary: \<open>\<pi>\<close> rule: less_induct)
	+ case (less n \<pi>)
	+ hence ih: \<open>\<And> n' \<pi>'. n' < n \<Longrightarrow> is_path \<pi>' \<Longrightarrow> \<pi>' 0 = x \<Longrightarrow> \<pi>' n' = return \<Longrightarrow> thesis\<close> using assms by auto
	+ show \<open>thesis\<close> proof cases
	+ assume \<open>\<forall> i>0. \<pi> i \<noteq> x\<close> thus \<open>thesis\<close> using less by auto
	+ next
	+ assume \<open>\<not> (\<forall> i>0. \<pi> i \<noteq> x)\<close>
	+ then obtain i where \<open>0<i\<close> \<open>\<pi> i = x\<close> by auto
	+ hence \<open>(\<pi>\<guillemotleft>i) 0 = x\<close> by auto
	+ moreover
	+ have \<open>i < n\<close> using less(3,5,6) \<open>\<pi> i = x\<close> by (metis linorder_neqE_nat term_path_stable less_imp_le)
	+ hence \<open>(\<pi>\<guillemotleft>i) (n-i) = return\<close> using less(6) by auto
	+ moreover
	+ have \<open>is_path (\<pi>\<guillemotleft>i)\<close> using less(3) by (metis path_path_shift)
	+ moreover
	+ have \<open>n - i < n\<close> using \<open>0<i\<close> \<open>i < n\<close> by auto
	+ ultimately show \<open>thesis\<close> using ih by auto
	+ qed
	+qed
	+
	+lemma direct_path_return: assumes \<open>x \<in> nodes\<close> \<open>x \<noteq> return\<close>
	+obtains \<pi> n where \<open>is_path \<pi>\<close> \<open>\<pi> 0 = x\<close> \<open>\<pi> n = return\<close> \<open>\<forall> i> 0. \<pi> i \<noteq> x\<close>
	+using direct_path_return'[of _ \<open>x\<close>] reaching_ret[OF assms(1)] assms(2) by blast
	+
	+lemma path_append_eq_up_to: \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>') =\<^bsub>k\<^esub> \<pi>\<close> unfolding eq_up_to_def by auto
	+
	+lemma eq_up_to_le: assumes \<open>k \<le> n\<close> \<open>\<pi> =\<^bsub>n\<^esub> \<pi>'\<close> shows \<open>\<pi> =\<^bsub>k\<^esub> \<pi>'\<close> using assms unfolding eq_up_to_def by auto
	+
	+lemma eq_up_to_refl: shows \<open>\<pi> =\<^bsub>k\<^esub> \<pi>\<close> unfolding eq_up_to_def by auto
	+
	+lemma eq_up_to_sym: assumes \<open>\<pi> =\<^bsub>k\<^esub> \<pi>'\<close> shows \<open>\<pi>' =\<^bsub>k\<^esub> \<pi>\<close> using assms unfolding eq_up_to_def by auto
	+
	+lemma eq_up_to_apply: assumes \<open>\<pi> =\<^bsub>k\<^esub> \<pi>'\<close> \<open>j \<le> k\<close> shows \<open>\<pi> j = \<pi>' j\<close> using assms unfolding eq_up_to_def by auto
	+
	+lemma path_swap_ret: assumes \<open>is_path \<pi>\<close> obtains \<pi>' n where \<open>is_path \<pi>'\<close> \<open>\<pi> =\<^bsub>k\<^esub> \<pi>'\<close> \<open>\<pi>' n = return\<close>
	+proof -
	+ have nd: \<open>\<pi> k \<in> nodes\<close> using assms path_nodes by simp
	+ obtain \<pi>' n where *: \<open>is_path \<pi>'\<close> \<open>\<pi>' 0 = \<pi> k\<close> \<open>\<pi>' n = return\<close> using reaching_ret[OF nd] by blast
	+ have \<open>\<pi> =\<^bsub>k\<^esub> (\<pi>@\<^bsup>k\<^esup> \<pi>')\<close> by (metis eq_up_to_sym path_append_eq_up_to)
	+ moreover
	+ have \<open>is_path (\<pi>@\<^bsup>k\<^esup> \<pi>')\<close> using assms * path_cons by metis
	+ moreover
	+ have \<open>(\<pi>@\<^bsup>k\<^esup> \<pi>') (k + n) = return\<close> using * by auto
	+ ultimately
	+ show \<open>thesis\<close> using that by blast
	+qed
	+
	+lemma path_suc: \<open>path \<sigma> (Suc k) = fst (step (path \<sigma> k, \<sigma>\<^bsup>k\<^esup>))\<close> by (induction \<open>k\<close>, auto simp: path_def kth_state_def)
	+
	+lemma kth_state_suc: \<open>\<sigma>\<^bsup>Suc k\<^esup> = snd (step (path \<sigma> k, \<sigma>\<^bsup>k\<^esup>))\<close> by (induction \<open>k\<close>, auto simp: path_def kth_state_def)
	+
	+
	+subsection \<open>Facts about Post Dominators\<close>
	+
	+lemma pd_trans: assumes 1: \<open>y pd\<rightarrow> x\<close> and 2: \<open>z pd\<rightarrow>y\<close> shows \<open>z pd\<rightarrow>x\<close>
	+proof -
	+ {
	+ fix \<pi> n
	+ assume 3[simp]: \<open>is_path \<pi>\<close> \<open>\<pi> 0 = x\<close> \<open>\<pi> n = return\<close>
	+ then obtain k where \<open>\<pi> k = y\<close> and 7: \<open>k \<le> n\<close> using 1 unfolding is_pd_def by blast
	+ then have \<open>(\<pi>\<guillemotleft>k) 0 = y\<close> and \<open>(\<pi>\<guillemotleft>k) (n-k) = return\<close> by auto
	+ moreover have \<open>is_path (\<pi>\<guillemotleft>k)\<close> by(metis 3(1) path_path_shift)
	+ ultimately obtain k' where 8: \<open>(\<pi>\<guillemotleft>k) k' = z\<close> and \<open>k' \<le> n-k\<close> using 2 unfolding is_pd_def by blast
	+ hence \<open>k+k'\<le>n\<close> and \<open>\<pi> (k+ k') = z\<close> using 7 by auto
	+ hence \<open>\<exists>k\<le>n. \<pi> k = z\<close> using path_nodes by auto
	+ }
	+ thus \<open>?thesis\<close> using 1 unfolding is_pd_def by blast
	+qed
	+
	+lemma pd_path: assumes \<open>y pd\<rightarrow> x\<close>
	+obtains \<pi> n k where \<open>is_path \<pi>\<close> and \<open>\<pi> 0 = x\<close> and \<open>\<pi> n = return\<close> and \<open>\<pi> k = y\<close> and \<open>k \<le> n\<close>
	+using assms unfolding is_pd_def using reaching_ret[of \<open>x\<close>] by blast
	+
	+lemma pd_antisym: assumes xpdy: \<open>x pd\<rightarrow> y\<close> and ypdx: \<open>y pd\<rightarrow> x\<close> shows \<open>x = y\<close>
	+proof -
	+ obtain \<pi> n where path: \<open>is_path \<pi>\<close> and \<pi>0: \<open>\<pi> 0 = x\<close> and \<pi>n: \<open>\<pi> n = return\<close> using pd_path[OF ypdx] by metis
	+ hence kex: \<open>\<exists>k\<le>n. \<pi> k = y\<close> using ypdx unfolding is_pd_def by auto
	+ obtain k where k: \<open>k = (GREATEST k. k\<le>n \<and> \<pi> k = y)\<close> by simp
	+ have \<pi>k: \<open>\<pi> k = y\<close> and kn: \<open>k \<le> n\<close> using k kex by (auto intro: GreatestIB)
	+
	+ have kpath: \<open>is_path (\<pi>\<guillemotleft>k)\<close> by (metis path_path_shift path)
	+ moreover have k0: \<open>(\<pi>\<guillemotleft>k) 0 = y\<close> using \<pi>k by simp
	+ moreover have kreturn: \<open>(\<pi>\<guillemotleft>k) (n-k) = return\<close> using kn \<pi>n by simp
	+ ultimately have ky': \<open>\<exists>k'\<le>(n-k).(\<pi>\<guillemotleft>k) k' = x\<close> using xpdy unfolding is_pd_def by simp
	+
	+ obtain k' where k': \<open>k' = (GREATEST k'. k'\<le>(n-k) \<and> (\<pi>\<guillemotleft>k) k' = x)\<close> by simp
	+
	+ with ky' have \<pi>k': \<open>(\<pi>\<guillemotleft>k) k' = x\<close> and kn': \<open>k' \<le> (n-k)\<close> by (auto intro: GreatestIB)
	+ have k'path: \<open>is_path (\<pi>\<guillemotleft>k\<guillemotleft>k')\<close> using kpath by(metis path_path_shift)
	+ moreover have k'0: \<open>(\<pi>\<guillemotleft>k\<guillemotleft>k') 0 = x\<close> using \<pi>k' by simp
	+ moreover have k'return: \<open>(\<pi>\<guillemotleft>k\<guillemotleft>k') (n-k-k') = return\<close> using kn' kreturn by (metis path_shift_def le_add_diff_inverse)
	+ ultimately have ky'': \<open>\<exists>k''\<le>(n-k-k').(\<pi>\<guillemotleft>k\<guillemotleft>k') k'' = y\<close> using ypdx unfolding is_pd_def by blast
	+
	+ obtain k'' where k'': \<open>k''= (GREATEST k''. k''\<le>(n-k-k') \<and> (\<pi>\<guillemotleft>k\<guillemotleft>k') k'' = y)\<close> by simp
	+ with ky'' have \<pi>k'': \<open>(\<pi>\<guillemotleft>k\<guillemotleft>k') k'' = y\<close> and kn'': \<open>k'' \<le> (n-k-k')\<close> by (auto intro: GreatestIB)
	+
	+ from this(1) have \<open>\<pi> (k + k' + k'') = y\<close> by (metis path_shift_def add.commute add.left_commute)
	+ moreover
	+ have \<open>k + k' +k'' \<le> n\<close> using kn'' kn' kn by simp
	+ ultimately have \<open>k + k' + k''\<le> k\<close> using k by(auto simp: GreatestB_le)
	+ hence \<open>k' = 0\<close> by simp
	+ with k0 \<pi>k' show \<open>x = y\<close> by simp
	+qed
	+
	+lemma pd_refl[simp]: \<open>x \<in> nodes \<Longrightarrow> x pd\<rightarrow> x\<close> unfolding is_pd_def by blast
	+
	+lemma pdt_trans_in_pdt: \<open>(x,y) \<in> pdt\<^sup>+ \<Longrightarrow> (x,y) \<in> pdt\<close>
	+proof (induction rule: trancl_induct)
	+ case base thus \<open>?case\<close> by simp
	+next
	+ case (step y z) show \<open>?case\<close> unfolding pdt_def proof (simp)
	+ have *: \<open>y pd\<rightarrow> x\<close> \<open>z pd\<rightarrow> y\<close> using step unfolding pdt_def by auto
	+ hence [simp]: \<open>z pd\<rightarrow> x\<close> using pd_trans[where x=\<open>x\<close> and y=\<open>y\<close> and z=\<open>z\<close>] by simp
	+ have \<open>x\<noteq>z\<close> proof
	+ assume \<open>x = z\<close>
	+ hence \<open>z pd\<rightarrow> y\<close> \<open>y pd\<rightarrow> z\<close> using * by auto
	+ hence \<open>z = y\<close> using pd_antisym by auto
	+ thus \<open>False\<close> using step(2) unfolding pdt_def by simp
	+ qed
	+ thus \<open>x \<noteq> z \<and> z pd\<rightarrow> x\<close> by auto
	+ qed
	+qed
	+
	+lemma pdt_trancl_pdt: \<open>pdt\<^sup>+ = pdt\<close> using pdt_trans_in_pdt by fast
	+
	+lemma trans_pdt: \<open>trans pdt\<close> by (metis pdt_trancl_pdt trans_trancl)
	+
	+definition [simp]: \<open>pdt_inv = pdt\<inverse>\<close>
	+
	+lemma wf_pdt_inv: \<open>wf (pdt_inv)\<close> proof (rule ccontr)
	+ assume \<open>\<not> wf (pdt_inv)\<close>
	+ then obtain f where \<open>\<forall>i. (f (Suc i), f i) \<in> pdt\<inverse>\<close> using wf_iff_no_infinite_down_chain by force
	+ hence *: \<open>\<forall> i. (f i, f (Suc i)) \<in> pdt\<close> by simp
	+ have **:\<open>\<forall> i. \<forall> j>i. (f i, f j) \<in> pdt\<close> proof(rule,rule,rule)
	+ fix i j assume \<open>i < (j::nat)\<close> thus \<open>(f i, f j) \<in> pdt\<close> proof (induction \<open>j\<close> rule: less_induct)
	+ case (less k)
	+ show \<open>?case\<close> proof (cases \<open>Suc i < k\<close>)
	+ case True
	+ hence k:\<open>k-1 < k\<close> \<open>i < k-1\<close> and sk: \<open>Suc (k-1) = k\<close> by auto
	+ show \<open>?thesis\<close> using less(1)[OF k] *[rule_format,of \<open>k-1\<close>,unfolded sk] trans_pdt[unfolded trans_def] by blast
	+ next
	+ case False
	+ hence \<open>Suc i = k\<close> using less(2) by auto
	+ then show \<open>?thesis\<close> using * by auto
	+ qed
	+ qed
	+ qed
	+ hence ***:\<open>\<forall> i. \<forall> j > i. f j pd\<rightarrow> f i\<close> \<open>\<forall> i. \<forall> j > i. f i \<noteq> f j\<close> unfolding pdt_def by auto
	+ hence ****:\<open>\<forall> i>0. f i pd\<rightarrow> f 0\<close> by simp
	+ hence \<open>f 0 \<in> nodes\<close> using * is_pd_def by fastforce
	+ then obtain \<pi> n where \<pi>:\<open>is_path \<pi>\<close> \<open>\<pi> 0 = f 0\<close> \<open>\<pi> n = return\<close> using reaching_ret by blast
	+ hence \<open>\<forall> i>0. \<exists> k\<le>n. \<pi> k = f i\<close> using ***(1) \<open>f 0 \<in> nodes\<close> unfolding is_pd_def by blast
	+ hence \<pi>f:\<open>\<forall> i. \<exists> k\<le>n. \<pi> k = f i\<close> using \<pi>(2) by (metis le0 not_gr_zero)
	+ have \<open>range f \<subseteq> \<pi> ` {..n}\<close> proof(rule subsetI)
	+ fix x assume \<open>x \<in> range f\<close>
	+ then obtain i where \<open>x = f i\<close> by auto
	+ then obtain k where \<open>x = \<pi> k\<close> \<open>k \<le> n\<close> using \<pi>f by metis
	+ thus \<open>x \<in> \<pi> ` {..n}\<close> by simp
	+ qed
	+ hence f:\<open>finite (range f)\<close> using finite_surj by auto
	+ hence fi:\<open>\<exists> i. infinite {j. f j = f i}\<close> using pigeonhole_infinite[OF _ f] by auto
	+ obtain i where \<open>infinite {j. f j = f i}\<close> using fi ..
	+ thus \<open>False\<close>
	+ by (metis (mono_tags, lifting) "***"(2) bounded_nat_set_is_finite gt_ex mem_Collect_eq nat_neq_iff)
	+qed
	+
	+lemma return_pd: assumes \<open>x \<in> nodes\<close> shows \<open>return pd\<rightarrow> x\<close> unfolding is_pd_def using assms by blast
	+
	+lemma pd_total: assumes xz: \<open>x pd\<rightarrow> z\<close> and yz: \<open>y pd\<rightarrow> z\<close> shows \<open>x pd\<rightarrow> y \<or> y pd\<rightarrow>x\<close>
	+proof -
	+ obtain \<pi> n where path: \<open>is_path \<pi>\<close> and \<pi>0: \<open>\<pi> 0 = z\<close> and \<pi>n: \<open>\<pi> n = return\<close> using xz reaching_ret unfolding is_pd_def by force
	+ have *: \<open>\<exists> k\<le>n. (\<pi> k = x \<or> \<pi> k = y)\<close> (is \<open>\<exists> k\<le>n. ?P k\<close>) using path \<pi>0 \<pi>n xz yz unfolding is_pd_def by auto
	+ obtain k where k: \<open>k = (LEAST k. \<pi> k = x \<or> \<pi> k = y)\<close> by simp
	+ hence kn: \<open>k\<le>n\<close> and \<pi>k: \<open>\<pi> k = x \<or> \<pi> k = y\<close> using LeastBI_ex[OF *] by auto
	+ note k_le = Least_le[where P = \<open>?P\<close>]
	+ show \<open>?thesis\<close> proof (cases)
	+ assume kx: \<open>\<pi> k = x\<close>
	+ have k_min: \<open>\<And> k'. \<pi> k' = y \<Longrightarrow> k \<le> k'\<close> using k_le unfolding k by auto
	+ {
	+ fix \<pi>'
	+ and n' :: \<open>nat\<close>
	+ assume path': \<open>is_path \<pi>'\<close> and \<pi>'0: \<open>\<pi>' 0 = x\<close> and \<pi>'n': \<open>\<pi>' n' = return\<close>
	+ have path'': \<open>is_path (\<pi> @\<^bsup>k\<^esup> \<pi>')\<close> using path_cons[OF path path'] kx \<pi>'0 by auto
	+ have \<pi>''0: \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>') 0 = z\<close> using \<pi>0 by simp
	+ have \<pi>''n: \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>') (k+n') = return\<close> using \<pi>'n' kx \<pi>'0 by auto
	+ obtain k' where k': \<open>k' \<le> k + n'\<close> \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>') k' = y\<close> using yz path'' \<pi>''0 \<pi>''n unfolding is_pd_def by blast
	+ have **: \<open>k \<le> k'\<close> proof (rule ccontr)
	+ assume \<open>\<not> k \<le> k'\<close>
	+ hence \<open>k' < k\<close> by simp
	+ moreover
	+ hence \<open>\<pi> k' = y\<close> using k' by auto
	+ ultimately
	+ show \<open>False\<close> using k_min by force
	+ qed
	+ hence \<open>\<pi>' (k' - k) = y\<close> using k' \<pi>'0 kx by auto
	+ moreover
	+ have \<open>(k' - k) \<le> n'\<close> using k' by auto
	+ ultimately
	+ have \<open>\<exists> k\<le> n'. \<pi>' k = y\<close> by auto
	+ }
	+ hence \<open>y pd\<rightarrow> x\<close> using kx path_nodes path unfolding is_pd_def by auto
	+ thus \<open>?thesis\<close> ..
	+ next \<comment> \<open>This is analogous argument\<close>
	+ assume kx: \<open>\<pi> k \<noteq> x\<close>
	+ hence ky: \<open>\<pi> k = y\<close> using \<pi>k by auto
	+ have k_min: \<open>\<And> k'. \<pi> k' = x \<Longrightarrow> k \<le> k'\<close> using k_le unfolding k by auto
	+ {
	+ fix \<pi>'
	+ and n' :: \<open>nat\<close>
	+ assume path': \<open>is_path \<pi>'\<close> and \<pi>'0: \<open>\<pi>' 0 = y\<close> and \<pi>'n': \<open>\<pi>' n' = return\<close>
	+ have path'': \<open>is_path (\<pi> @\<^bsup>k\<^esup> \<pi>')\<close> using path_cons[OF path path'] ky \<pi>'0 by auto
	+ have \<pi>''0: \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>') 0 = z\<close> using \<pi>0 by simp
	+ have \<pi>''n: \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>') (k+n') = return\<close> using \<pi>'n' ky \<pi>'0 by auto
	+ obtain k' where k': \<open>k' \<le> k + n'\<close> \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>') k' = x\<close> using xz path'' \<pi>''0 \<pi>''n unfolding is_pd_def by blast
	+ have **: \<open>k \<le> k'\<close> proof (rule ccontr)
	+ assume \<open>\<not> k \<le> k'\<close>
	+ hence \<open>k' < k\<close> by simp
	+ moreover
	+ hence \<open>\<pi> k' = x\<close> using k' by auto
	+ ultimately
	+ show \<open>False\<close> using k_min by force
	+ qed
	+ hence \<open>\<pi>' (k' - k) = x\<close> using k' \<pi>'0 ky by auto
	+ moreover
	+ have \<open>(k' - k) \<le> n'\<close> using k' by auto
	+ ultimately
	+ have \<open>\<exists> k\<le> n'. \<pi>' k = x\<close> by auto
	+ }
	+ hence \<open>x pd\<rightarrow> y\<close> using ky path_nodes path unfolding is_pd_def by auto
	+ thus \<open>?thesis\<close> ..
	+ qed
	+qed
	+
	+lemma pds_finite: \<open>finite {y . (x,y) \<in> pdt}\<close> proof cases
	+ assume \<open>x \<in> nodes\<close>
	+ then obtain \<pi> n where \<pi>:\<open>is_path \<pi>\<close> \<open>\<pi> 0 = x\<close> \<open>\<pi> n = return\<close> using reaching_ret by blast
	+ have *: \<open>\<forall> y \<in> {y. (x,y)\<in> pdt}. y pd\<rightarrow> x\<close> using pdt_def by auto
	+ have \<open>\<forall> y \<in> {y. (x,y)\<in> pdt}. \<exists> k \<le> n. \<pi> k = y\<close> using * \<pi> is_pd_def by blast
	+ hence \<open>{y. (x,y)\<in> pdt} \<subseteq> \<pi> ` {..n}\<close> by auto
	+ then show \<open>?thesis\<close> using finite_surj by blast
	+next
	+ assume \<open>\<not> x\<in> nodes\<close>
	+ hence \<open>{y. (x,y)\<in>pdt} = {}\<close> unfolding pdt_def is_pd_def using path_nodes reaching_ret by fastforce
	+ then show \<open>?thesis\<close> by simp
	+qed
	+
	+lemma ipd_exists: assumes node: \<open>x \<in> nodes\<close> and not_ret: \<open>x\<noteq>return\<close> shows \<open>\<exists>y. y ipd\<rightarrow> x\<close>
	+proof -
	+ let \<open>?Q\<close> = \<open>{y. x\<noteq>y \<and> y pd\<rightarrow> x}\<close>
	+ have *: \<open>return \<in> ?Q\<close> using assms return_pd by simp
	+ hence **: \<open>\<exists> x. x\<in> ?Q\<close> by auto
	+ have fin: \<open>finite ?Q\<close> using pds_finite unfolding pdt_def by auto
	+ have tot: \<open>\<forall> y z. y\<in>?Q \<and> z \<in> ?Q \<longrightarrow> z pd\<rightarrow> y \<or> y pd\<rightarrow> z\<close> using pd_total by auto
	+ obtain y where ymax: \<open>y\<in> ?Q\<close> \<open>\<forall> z\<in>?Q. z = y \<or> z pd\<rightarrow> y\<close> using fin ** tot proof (induct)
	+ case empty
	+ then show \<open>?case\<close> by auto
	+ next
	+ case (insert x F) show \<open>thesis\<close> proof (cases \<open>F = {}\<close>)
	+ assume \<open>F = {}\<close>
	+ thus \<open>thesis\<close> using insert(4)[of \<open>x\<close>] by auto
	+ next
	+ assume \<open>F \<noteq> {}\<close>
	+ hence \<open>\<exists> x. x\<in> F\<close> by auto
	+ have \<open>\<And>y. y \<in> F \<Longrightarrow> \<forall>z\<in>F. z = y \<or> z pd\<rightarrow> y \<Longrightarrow> thesis\<close> proof -
	+ fix y assume a: \<open>y \<in> F\<close> \<open>\<forall>z\<in>F. z = y \<or> z pd\<rightarrow> y\<close>
	+ have \<open>x \<noteq> y\<close> using insert a by auto
	+ have \<open>x pd\<rightarrow> y \<or> y pd\<rightarrow> x\<close> using insert(6) a(1) by auto
	+ thus \<open>thesis\<close> proof
	+ assume \<open>x pd\<rightarrow> y\<close>
	+ hence \<open>\<forall>z\<in>insert x F. z = y \<or> z pd\<rightarrow> y\<close> using a(2) by blast
	+ thus \<open>thesis\<close> using a(1) insert(4) by blast
	+ next
	+ assume \<open>y pd\<rightarrow> x\<close>
	+ have \<open>\<forall>z\<in>insert x F. z = x \<or> z pd\<rightarrow> x\<close> proof
	+ fix z assume \<open>z\<in> insert x F\<close> thus \<open>z = x \<or> z pd\<rightarrow> x\<close> proof(rule,simp)
	+ assume \<open>z\<in>F\<close>
	+ hence \<open>z = y \<or> z pd\<rightarrow> y\<close> using a(2) by auto
	+ thus \<open>z = x \<or> z pd\<rightarrow> x\<close> proof(rule,simp add: \<open>y pd\<rightarrow> x\<close>)
	+ assume \<open>z pd\<rightarrow> y\<close>
	+ show \<open>z = x \<or> z pd\<rightarrow> x\<close> using \<open>y pd\<rightarrow> x\<close> \<open>z pd\<rightarrow> y\<close> pd_trans by blast
	+ qed
	+ qed
	+ qed
	+ then show \<open>thesis\<close> using insert by blast
	+ qed
	+ qed
	+ then show \<open>thesis\<close> using insert by blast
	+ qed
	+ qed
	+ hence ***: \<open>y pd\<rightarrow> x\<close> \<open>x\<noteq>y\<close> by auto
	+ have \<open>\<forall> z. z \<noteq> x \<and> z pd\<rightarrow> x \<longrightarrow> z pd\<rightarrow> y\<close> proof (rule,rule)
	+ fix z
	+ assume a: \<open> z \<noteq> x \<and> z pd\<rightarrow> x\<close>
	+ hence b: \<open>z \<in> ?Q\<close> by auto
	+ have \<open>y pd\<rightarrow> z \<or> z pd\<rightarrow> y\<close> using pd_total ***(1) a by auto
	+ thus \<open>z pd\<rightarrow> y\<close> proof
	+ assume c: \<open>y pd\<rightarrow> z\<close>
	+ hence \<open>y = z\<close> using b ymax pdt_def pd_antisym by auto
	+ thus \<open>z pd\<rightarrow> y\<close> using c by simp
	+ qed simp
	+ qed
	+ with *** have \<open>y ipd\<rightarrow> x\<close> unfolding is_ipd_def by simp
	+ thus \<open>?thesis\<close> by blast
	+qed
	+
	+lemma ipd_unique: assumes yipd: \<open>y ipd\<rightarrow> x\<close> and y'ipd: \<open>y' ipd\<rightarrow> x\<close> shows \<open>y = y'\<close>
	+proof -
	+ have 1: \<open>y pd\<rightarrow> y'\<close> and 2: \<open>y' pd\<rightarrow> y\<close> using yipd y'ipd unfolding is_ipd_def by auto
	+ show \<open>?thesis\<close> using pd_antisym[OF 1 2] .
	+qed
	+
	+lemma ipd_is_ipd: assumes \<open>x \<in> nodes\<close> and \<open>x\<noteq>return\<close> shows \<open>ipd x ipd\<rightarrow> x\<close> proof -
	+ from assms obtain y where \<open>y ipd\<rightarrow> x\<close> using ipd_exists by auto
	+ moreover
	+ hence \<open>\<And> z. z ipd\<rightarrow>x \<Longrightarrow> z = y\<close> using ipd_unique by simp
	+ ultimately show \<open>?thesis\<close> unfolding ipd_def by (auto intro: theI2)
	+qed
	+
	+lemma is_ipd_in_pdt: \<open>y ipd\<rightarrow> x \<Longrightarrow> (x,y) \<in> pdt\<close> unfolding is_ipd_def pdt_def by auto
	+
	+lemma ipd_in_pdt: \<open>x \<in> nodes \<Longrightarrow> x\<noteq>return \<Longrightarrow> (x,ipd x) \<in> pdt\<close> by (metis ipd_is_ipd is_ipd_in_pdt)
	+
	+lemma no_pd_path: assumes \<open>x \<in> nodes\<close> and \<open>\<not> y pd\<rightarrow> x\<close>
	+obtains \<pi> n where \<open>is_path \<pi>\<close> and \<open>\<pi> 0 = x\<close> and \<open>\<pi> n = return\<close> and \<open>\<forall> k \<le> n. \<pi> k \<noteq> y\<close>
	+proof (rule ccontr)
	+ assume \<open>\<not> thesis\<close>
	+ hence \<open>\<forall> \<pi> n. is_path \<pi> \<and> \<pi> 0 = x \<and> \<pi> n = return \<longrightarrow> (\<exists> k\<le>n . \<pi> k = y)\<close> using that by force
	+ thus \<open>False\<close> using assms unfolding is_pd_def by auto
	+qed
	+
	+lemma pd_pd_ipd: assumes \<open>x \<in> nodes\<close> \<open>x\<noteq>return\<close> \<open>y\<noteq>x\<close> \<open>y pd\<rightarrow> x\<close> shows \<open>y pd\<rightarrow> ipd x\<close>
	+proof -
	+ have \<open>ipd x pd\<rightarrow> x\<close> by (metis assms(1,2) ipd_is_ipd is_ipd_def)
	+ hence \<open>y pd\<rightarrow> ipd x \<or> ipd x pd\<rightarrow> y\<close> by (metis assms(4) pd_total)
	+ thus \<open>?thesis\<close> proof
	+ have 1: \<open>ipd x ipd\<rightarrow> x\<close> by (metis assms(1,2) ipd_is_ipd)
	+ moreover
	+ assume \<open>ipd x pd\<rightarrow> y\<close>
	+ ultimately
	+ show \<open>y pd\<rightarrow> ipd x\<close> unfolding is_ipd_def using assms(3,4) by auto
	+ qed auto
	+qed
	+
	+lemma pd_nodes: assumes \<open>y pd\<rightarrow> x\<close> shows pd_node1: \<open>y \<in> nodes\<close> and pd_node2: \<open>x \<in> nodes\<close>
	+proof -
	+ obtain \<pi> k where \<open>is_path \<pi>\<close> \<open>\<pi> k = y\<close> using assms unfolding is_pd_def using reaching_ret by force
	+ thus \<open>y \<in> nodes\<close> using path_nodes by auto
	+ show \<open>x \<in> nodes\<close> using assms unfolding is_pd_def by simp
	+qed
	+
	+lemma pd_ret_is_ret: \<open>x pd\<rightarrow> return \<Longrightarrow> x = return\<close> by (metis pd_antisym pd_node1 return_pd)
	+
	+lemma ret_path_none_pd: assumes \<open>x \<in> nodes\<close> \<open>x\<noteq>return\<close>
	+obtains \<pi> n where \<open>is_path \<pi>\<close> \<open>\<pi> 0 = x\<close> \<open>\<pi> n = return\<close> \<open>\<forall> i>0. \<not> x pd\<rightarrow> \<pi> i\<close>
	+proof(rule ccontr)
	+ assume \<open>\<not>thesis\<close>
	+ hence *: \<open>\<And> \<pi> n. \<lbrakk>is_path \<pi>; \<pi> 0 = x; \<pi> n = return\<rbrakk> \<Longrightarrow> \<exists>i>0. x pd\<rightarrow> \<pi> i\<close> using that by blast
	+ obtain \<pi> n where **: \<open>is_path \<pi>\<close> \<open>\<pi> 0 = x\<close> \<open>\<pi> n = return\<close> \<open>\<forall> i>0. \<pi> i \<noteq> x\<close> using direct_path_return[OF assms] by metis
	+ then obtain i where **: \<open>i>0\<close> \<open>x pd\<rightarrow> \<pi> i\<close> using by blast
	+ hence \<open>\<pi> i \<noteq> return\<close> using pd_ret_is_ret assms(2) by auto
	+ hence \<open>i < n\<close> using assms(2) term_path_stable ** by (metis linorder_neqE_nat less_imp_le)
	+ hence \<open>(\<pi>\<guillemotleft>i)(n-i) = return\<close> using **(3) by auto
	+ moreover
	+ have \<open>(\<pi>\<guillemotleft>i) (0) = \<pi> i\<close> by simp
	+ moreover
	+ have \<open>is_path (\<pi>\<guillemotleft>i)\<close> using **(1) path_path_shift by metis
	+ ultimately
	+ obtain k where \<open>(\<pi>\<guillemotleft>i) k = x\<close> using ***(2) unfolding is_pd_def by metis
	+ hence \<open>\<pi> (i + k) = x\<close> by auto
	+ thus \<open>False\<close> using **(4) \<open>i>0\<close> by auto
	+qed
	+
	+lemma path_pd_ipd0': assumes \<open>is_path \<pi>\<close> and \<open>\<pi> n \<noteq> return\<close> \<open>\<pi> n \<noteq> \<pi> 0\<close> and \<open>\<pi> n pd\<rightarrow> \<pi> 0\<close>
	+obtains k where \<open>k \<le> n\<close> and \<open>\<pi> k = ipd(\<pi> 0)\<close>
	+proof(rule ccontr)
	+ have *: \<open>\<pi> n pd\<rightarrow> ipd (\<pi> 0)\<close> by (metis is_pd_def assms(3,4) pd_pd_ipd pd_ret_is_ret)
	+ obtain \<pi>' n' where **: \<open>is_path \<pi>'\<close> \<open>\<pi>' 0 = \<pi> n\<close> \<open>\<pi>' n' = return\<close> \<open>\<forall> i>0. \<not> \<pi> n pd\<rightarrow> \<pi>' i\<close> by (metis assms(2) assms(4) pd_node1 ret_path_none_pd)
	+ hence \<open>\<forall> i>0. \<pi>' i \<noteq> ipd (\<pi> 0)\<close> using * by metis
	+ moreover
	+ assume \<open>\<not> thesis\<close>
	+ hence \<open>\<forall> k\<le>n. \<pi> k \<noteq> ipd (\<pi> 0)\<close> using that by blast
	+ ultimately
	+ have \<open>\<forall> i. (\<pi>@\<^bsup>n\<^esup> \<pi>') i \<noteq> ipd (\<pi> 0)\<close> by (metis diff_is_0_eq neq0_conv path_append_def)
	+ moreover
	+ have \<open>(\<pi>@\<^bsup>n\<^esup> \<pi>') (n + n') = return\<close>
	+ by (metis \<open>\<pi>' 0 = \<pi> n\<close> \<open>\<pi>' n' = return\<close> add_diff_cancel_left' assms(2) diff_is_0_eq path_append_def)
	+ moreover
	+ have \<open>(\<pi>@\<^bsup>n\<^esup> \<pi>') 0 = \<pi> 0\<close> by (metis le0 path_append_def)
	+ moreover
	+ have \<open>is_path (\<pi>@\<^bsup>n\<^esup> \<pi>')\<close> by (metis \<open>\<pi>' 0 = \<pi> n\<close> \<open>is_path \<pi>'\<close> assms(1) path_cons)
	+ moreover
	+ have \<open>ipd (\<pi> 0) pd\<rightarrow> \<pi> 0\<close> by (metis **(2,3,4) assms(2) assms(4) ipd_is_ipd is_ipd_def neq0_conv pd_node2)
	+ moreover
	+ have \<open>\<pi> 0 \<in> nodes\<close> by (metis assms(1) path_nodes)
	+ ultimately
	+ show \<open>False\<close> unfolding is_pd_def by blast
	+qed
	+
	+lemma path_pd_ipd0: assumes \<open>is_path \<pi>\<close> and \<open>\<pi> 0 \<noteq> return\<close> \<open>\<pi> n \<noteq> \<pi> 0\<close> and \<open>\<pi> n pd\<rightarrow> \<pi> 0\<close>
	+obtains k where \<open>k \<le> n\<close> and \<open>\<pi> k = ipd(\<pi> 0)\<close>
	+proof cases
	+ assume *: \<open>\<pi> n = return\<close>
	+ have \<open>ipd (\<pi> 0) pd\<rightarrow> (\<pi> 0)\<close> by (metis is_ipd_def is_pd_def assms(2,4) ipd_is_ipd)
	+ with assms(1,2,3) * show \<open>thesis\<close> unfolding is_pd_def by (metis that)
	+next
	+ assume \<open>\<pi> n \<noteq> return\<close>
	+ from path_pd_ipd0' [OF assms(1) this assms(3,4)] that show \<open>thesis\<close> by auto
	+qed
	+
	+lemma path_pd_ipd: assumes \<open>is_path \<pi>\<close> and \<open>\<pi> k \<noteq> return\<close> \<open>\<pi> n \<noteq> \<pi> k\<close> and \<open>\<pi> n pd\<rightarrow> \<pi> k\<close> and kn: \<open>k < n\<close>
	+obtains l where \<open>k < l\<close> and \<open>l \<le> n\<close> and \<open>\<pi> l = ipd(\<pi> k)\<close>
	+proof -
	+ have \<open>is_path (\<pi> \<guillemotleft> k)\<close> \<open>(\<pi> \<guillemotleft> k) 0 \<noteq> return\<close> \<open>(\<pi> \<guillemotleft> k) (n - k) \<noteq> (\<pi> \<guillemotleft> k) 0\<close> \<open>(\<pi> \<guillemotleft> k) (n - k) pd\<rightarrow> (\<pi> \<guillemotleft> k) 0\<close>
	+ using assms path_path_shift by auto
	+ with path_pd_ipd0[of \<open>\<pi>\<guillemotleft>k\<close> \<open>n-k\<close>]
	+ obtain ka where \<open>ka \<le> n - k\<close> \<open>(\<pi> \<guillemotleft> k) ka = ipd ((\<pi> \<guillemotleft> k) 0)\<close> .
	+ hence \<open>k + ka \<le> n\<close> \<open>\<pi> (k + ka) = ipd (\<pi> k)\<close> using kn by auto
	+ moreover
	+ hence \<open>\<pi> (k + ka) ipd\<rightarrow> \<pi> k\<close> by (metis assms(1) assms(2) ipd_is_ipd path_nodes)
	+ hence \<open>k < k + ka\<close> unfolding is_ipd_def by (metis nat_neq_iff not_add_less1)
	+ ultimately
	+ show \<open>thesis\<close> using that[of \<open>k+ka\<close>] by auto
	+qed
	+
	+lemma path_ret_ipd: assumes \<open>is_path \<pi>\<close> and \<open>\<pi> k \<noteq> return\<close> \<open>\<pi> n = return\<close>
	+obtains l where \<open>k < l\<close> and \<open>l \<le> n\<close> and \<open>\<pi> l = ipd(\<pi> k)\<close>
	+proof -
	+ have \<open>\<pi> n \<noteq> \<pi> k\<close> using assms by auto
	+ moreover
	+ have \<open>k \<le> n\<close> apply (rule ccontr) using term_path_stable assms by auto
	+ hence \<open>k < n\<close> by (metis assms(2,3) dual_order.order_iff_strict)
	+ moreover
	+ have \<open>\<pi> n pd\<rightarrow> \<pi> k\<close> by (metis assms(1,3) path_nodes return_pd)
	+ ultimately
	+ obtain l where \<open>k < l\<close> \<open>l \<le> n\<close> \<open>\<pi> l = ipd (\<pi> k)\<close> using assms path_pd_ipd by blast
	+ thus \<open>thesis\<close> using that by auto
	+qed
	+
	+lemma pd_intro: assumes \<open>l pd\<rightarrow> k\<close> \<open>is_path \<pi>\<close> \<open>\<pi> 0 = k\<close> \<open>\<pi> n = return\<close>
	+obtains i where \<open>i \<le> n\<close> \<open>\<pi> i = l\<close> using assms unfolding is_pd_def by metis
	+
	+lemma path_pd_pd0: assumes path: \<open>is_path \<pi>\<close> and lpdn: \<open>\<pi> l pd\<rightarrow> n\<close> and npd0: \<open>n pd\<rightarrow> \<pi> 0\<close>
	+obtains k where \<open>k \<le> l\<close> \<open>\<pi> k = n\<close>
	+proof (rule ccontr)
	+ assume \<open>\<not> thesis\<close>
	+ hence notn: \<open>\<And> k. k \<le> l \<Longrightarrow> \<pi> k \<noteq> n\<close> using that by blast
	+ have nret: \<open>\<pi> l \<noteq> return\<close> by (metis is_pd_def assms(1,3) notn)
	+
	+ obtain \<pi>' n' where path': \<open>is_path \<pi>'\<close> and \<pi>0': \<open>\<pi>' 0 = \<pi> l\<close> and \<pi>n': \<open>\<pi>' n' = return\<close> and nonepd: \<open>\<forall> i>0. \<not> \<pi> l pd\<rightarrow> \<pi>' i\<close>
	+ using nret path path_nodes ret_path_none_pd by metis
	+
	+ have \<open>\<pi> l \<noteq> n\<close> using notn by simp
	+ hence \<open>\<forall> i. \<pi>' i \<noteq> n\<close> using nonepd \<pi>0' lpdn by (metis neq0_conv)
	+
	+ hence notn': \<open>\<forall> i. (\<pi>@\<^bsup>l\<^esup> \<pi>') i \<noteq> n\<close> using notn \<pi>0' by auto
	+
	+ have \<open>is_path (\<pi>@\<^bsup>l\<^esup> \<pi>')\<close> using path path' by (metis \<pi>0' path_cons)
	+ moreover
	+ have \<open>(\<pi>@\<^bsup>l\<^esup> \<pi>') 0 = \<pi> 0\<close> by simp
	+ moreover
	+ have \<open>(\<pi>@\<^bsup>l\<^esup> \<pi>') (n' + l) = return\<close> using \<pi>0' \<pi>n' by auto
	+ ultimately
	+ show \<open>False\<close> using notn' npd0 unfolding is_pd_def by blast
	+qed
	+
	+
	+subsection \<open>Facts about Control Dependencies\<close>
	+
	+lemma icd_imp_cd: \<open>n icd\<^bsup>\<pi>\<^esup>\<rightarrow> k \<Longrightarrow> n cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> by (metis is_icdi_def)
	+
	+lemma ipd_impl_not_cd: assumes \<open>j \<in> {k..i}\<close> and \<open>\<pi> j = ipd (\<pi> k)\<close> shows \<open>\<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ by (metis assms(1) assms(2) is_cdi_def)
	+
	+lemma cd_not_ret: assumes \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k \<close> shows \<open>\<pi> k \<noteq> return\<close> by (metis is_cdi_def assms nat_less_le term_path_stable)
	+
	+lemma cd_path_shift: assumes \<open>j \<le> k\<close> \<open>is_path \<pi> \<close> shows \<open>(i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k) = (i - j cd\<^bsup>\<pi>\<guillemotleft>j\<^esup>\<rightarrow> k-j)\<close> proof
	+ assume a: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ hence b: \<open>k < i\<close> by (metis is_cdi_def)
	+ hence \<open>is_path (\<pi> \<guillemotleft> j)\<close> \<open>k - j < i - j\<close> using assms apply (metis path_path_shift)
	+ by (metis assms(1) b diff_less_mono)
	+ moreover
	+ have c: \<open>\<forall> j \<in> {k..i}. \<pi> j \<noteq> ipd (\<pi> k)\<close> by (metis a ipd_impl_not_cd)
	+ hence \<open>\<forall> ja \<in> {k - j..i - j}. (\<pi> \<guillemotleft> j) ja \<noteq> ipd ((\<pi> \<guillemotleft> j) (k - j))\<close> using b assms by auto fastforce
	+ moreover
	+ have \<open>j < i\<close> using assms(1) b by auto
	+ hence \<open>(\<pi>\<guillemotleft>j) (i - j) \<noteq> return\<close> using a unfolding is_cdi_def by auto
	+ ultimately
	+ show \<open>i - j cd\<^bsup>\<pi>\<guillemotleft>j\<^esup>\<rightarrow> k-j\<close> unfolding is_cdi_def by simp
	+next
	+ assume a: \<open>i - j cd\<^bsup>\<pi>\<guillemotleft>j\<^esup>\<rightarrow> k-j\<close>
	+ hence b: \<open>k - j < i-j\<close> by (metis is_cdi_def)
	+ moreover
	+ have c: \<open>\<forall> ja \<in> {k - j..i - j}. (\<pi> \<guillemotleft> j) ja \<noteq> ipd ((\<pi> \<guillemotleft> j) (k - j))\<close> by (metis a ipd_impl_not_cd)
	+ have \<open>\<forall> j \<in> {k..i}. \<pi> j \<noteq> ipd (\<pi> k)\<close> proof (rule,goal_cases) case (1 n)
	+ hence \<open>n-j \<in> {k-j..i-j}\<close> using assms by auto
	+ hence \<open>\<pi> (j + (n-j)) \<noteq> ipd(\<pi> (j + (k-j)))\<close> by (metis c path_shift_def)
	+ thus \<open>?case\<close> using 1 assms(1) by auto
	+ qed
	+ moreover
	+ have \<open>j < i\<close> using assms(1) b by auto
	+ hence \<open>\<pi> i \<noteq> return\<close> using a unfolding is_cdi_def by auto
	+ ultimately
	+ show \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> unfolding is_cdi_def by (metis assms(1) assms(2) diff_is_0_eq' le_diff_iff nat_le_linear nat_less_le)
	+qed
	+
	+lemma cd_path_shift0: assumes \<open>is_path \<pi>\<close> shows \<open>(i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k) = (i-k cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow>0)\<close>
	+ using cd_path_shift[OF _ assms] by (metis diff_self_eq_0 le_refl)
	+
	+lemma icd_path_shift: assumes \<open>l \<le> k\<close> \<open>is_path \<pi>\<close> shows \<open>(i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k) = (i - l icd\<^bsup>\<pi>\<guillemotleft>l\<^esup>\<rightarrow> k - l)\<close>
	+proof -
	+ have \<open>is_path (\<pi>\<guillemotleft>l)\<close> using path_path_shift assms(2) by auto
	+ moreover
	+ have \<open>(i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k) = (i - l cd\<^bsup>\<pi>\<guillemotleft>l\<^esup>\<rightarrow> k - l)\<close> using assms cd_path_shift by auto
	+ moreover
	+ have \<open>(\<forall> m \<in> {k<..<i}. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m) = (\<forall> m \<in> {k - l<..<i - l}. \<not> i - l cd\<^bsup>\<pi> \<guillemotleft> l\<^esup>\<rightarrow> m)\<close>
	+ proof -
	+ {fix m assume *: \<open>\<forall> m \<in> {k - l<..<i - l}. \<not> i - l cd\<^bsup>\<pi> \<guillemotleft> l\<^esup>\<rightarrow> m\<close> \<open>m \<in> {k<..<i}\<close>
	+ hence \<open>m-l \<in> {k-l<..<i-l}\<close> using assms(1) by auto
	+ hence \<open>\<not> i - l cd\<^bsup>\<pi>\<guillemotleft>l\<^esup>\<rightarrow>(m-l)\<close> using * by blast
	+ moreover
	+ have \<open>l \<le> m\<close> using * assms by auto
	+ ultimately have \<open>\<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow>m\<close> using assms(2) cd_path_shift by blast
	+ }
	+ moreover
	+ {fix m assume *: \<open>\<forall> m \<in> {k<..<i}. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> \<open>m-l \<in> {k-l<..<i-l}\<close>
	+ hence \<open>m \<in> {k<..<i}\<close> using assms(1) by auto
	+ hence \<open>\<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow>m\<close> using * by blast
	+ moreover
	+ have \<open>l \<le> m\<close> using * assms by auto
	+ ultimately have \<open>\<not> i - l cd\<^bsup>\<pi>\<guillemotleft>l\<^esup>\<rightarrow>(m-l)\<close> using assms(2) cd_path_shift by blast
	+ }
	+ ultimately show \<open>?thesis\<close> by auto (metis diff_add_inverse)
	+ qed
	+ ultimately
	+ show \<open>?thesis\<close> unfolding is_icdi_def using assms by blast
	+qed
	+
	+lemma icd_path_shift0: assumes \<open>is_path \<pi>\<close> shows \<open>(i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k) = (i-k icd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow>0)\<close>
	+ using icd_path_shift[OF _ assms] by (metis diff_self_eq_0 le_refl)
	+
	+lemma cdi_path_swap: assumes \<open>is_path \<pi>'\<close> \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> \<open>\<pi> =\<^bsub>j\<^esub> \<pi>'\<close> shows \<open>j cd\<^bsup>\<pi>'\<^esup>\<rightarrow>k\<close> using assms unfolding eq_up_to_def is_cdi_def by auto
	+
	+lemma cdi_path_swap_le: assumes \<open>is_path \<pi>'\<close> \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> \<open>\<pi> =\<^bsub>n\<^esub> \<pi>'\<close> \<open>j \<le> n\<close> shows \<open>j cd\<^bsup>\<pi>'\<^esup>\<rightarrow>k\<close> by (metis assms cdi_path_swap eq_up_to_le)
	+
	+lemma not_cd_impl_ipd: assumes \<open>is_path \<pi>\<close> and \<open>k < i\<close> and \<open>\<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and \<open>\<pi> i \<noteq> return\<close> obtains j where \<open>j \<in> {k..i}\<close> and \<open>\<pi> j = ipd (\<pi> k)\<close>
	+by (metis assms(1) assms(2) assms(3) assms(4) is_cdi_def)
	+
	+lemma icd_is_the_icd: assumes \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> shows \<open>k = (THE k. i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close> using assms icd_uniq
	+ by (metis the1_equality)
	+
	+lemma all_ipd_imp_ret: assumes \<open>is_path \<pi>\<close> and \<open>\<forall> i. \<pi> i \<noteq> return \<longrightarrow> (\<exists> j>i. \<pi> j = ipd (\<pi> i))\<close> shows \<open>\<exists>j. \<pi> j = return\<close>
	+proof -
	+ { fix x assume *: \<open>\<pi> 0 = x\<close>
	+ have \<open>?thesis\<close> using wf_pdt_inv * assms
	+ proof(induction \<open>x\<close> arbitrary: \<open>\<pi>\<close> rule: wf_induct_rule )
	+ case (less x \<pi>) show \<open>?case\<close> proof (cases \<open>x = return\<close>)
	+ case True thus \<open>?thesis\<close> using less(2) by auto
	+ next
	+ assume not_ret: \<open>x \<noteq> return\<close>
	+ moreover
	+ then obtain k where k_ipd: \<open>\<pi> k = ipd x\<close> using less(2,4) by auto
	+ moreover
	+ have \<open>x \<in> nodes\<close> using less(2,3) by (metis path_nodes)
	+ ultimately
	+ have \<open>(x, \<pi> k) \<in> pdt\<close> by (metis ipd_in_pdt)
	+ hence a: \<open>(\<pi> k, x) \<in> pdt_inv\<close> unfolding pdt_inv_def by simp
	+ have b: \<open>is_path (\<pi> \<guillemotleft> k)\<close> by (metis less.prems(2) path_path_shift)
	+ have c: \<open>\<forall> i. (\<pi>\<guillemotleft>k) i \<noteq> return \<longrightarrow> (\<exists>j>i. (\<pi>\<guillemotleft>k) j = ipd ((\<pi>\<guillemotleft>k) i))\<close> using less(4) apply auto
	+ by (metis (full_types) ab_semigroup_add_class.add_ac(1) less_add_same_cancel1 less_imp_add_positive)
	+ from less(1)[OF a _ b c]
	+ have \<open>\<exists>j. (\<pi>\<guillemotleft>k) j = return\<close> by auto
	+ thus \<open>\<exists>j. \<pi> j = return\<close> by auto
	+ qed
	+ qed
	+ }
	+ thus \<open>?thesis\<close> by simp
	+qed
	+
	+lemma loop_has_cd: assumes \<open>is_path \<pi>\<close> \<open>0 < i\<close> \<open>\<pi> i = \<pi> 0\<close> \<open>\<pi> 0 \<noteq> return\<close> shows \<open>\<exists> k < i. i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> proof (rule ccontr)
	+ let \<open>?\<pi>\<close> = \<open>(\<lambda> n. \<pi> (n mod i))\<close>
	+ assume \<open>\<not> (\<exists>k<i. i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close>
	+ hence \<open>\<forall> k <i. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> by blast
	+ hence *: \<open>\<forall> k<i. (\<exists>j \<in> {k..i}. \<pi> j = ipd (\<pi> k))\<close> using assms(1,3,4) not_cd_impl_ipd by metis
	+ have \<open>\<forall> k. (\<exists> j > k. ?\<pi> j = ipd (?\<pi> k))\<close> proof
	+ fix k
	+ have \<open>k mod i < i\<close> using assms(2) by auto
	+ with * obtain j where \<open>j \<in> {(k mod i)..i}\<close> \<open>\<pi> j = ipd (\<pi> (k mod i))\<close> by auto
	+ then obtain j' where 1: \<open>j' < i\<close> \<open>\<pi> j' = ipd (\<pi> (k mod i))\<close>
	+ by (cases \<open>j = i\<close>, auto ,metis assms(2) assms(3),metis le_neq_implies_less)
	+ then obtain j'' where 2: \<open>j'' > k\<close> \<open>j'' mod i = j'\<close> by (metis mod_bound_instance)
	+ hence \<open>?\<pi> j'' = ipd (?\<pi> k)\<close> using 1 by auto
	+ with 2(1)
	+ show \<open>\<exists> j > k. ?\<pi> j = ipd (?\<pi> k)\<close> by auto
	+ qed
	+ moreover
	+ have \<open>is_path ?\<pi>\<close> by (metis assms(1) assms(2) assms(3) is_path_loop)
	+ ultimately
	+ obtain k where \<open>?\<pi> k = return\<close> by (metis (lifting) all_ipd_imp_ret)
	+ moreover
	+ have \<open>k mod i < i\<close> by (simp add: assms(2))
	+ ultimately
	+ have \<open>\<pi> i = return\<close> by (metis assms(1) term_path_stable less_imp_le)
	+ thus \<open>False\<close> by (metis assms(3) assms(4))
	+qed
	+
	+lemma loop_has_cd': assumes \<open>is_path \<pi>\<close> \<open>j < i\<close> \<open>\<pi> i = \<pi> j\<close> \<open>\<pi> j \<noteq> return\<close> shows \<open>\<exists> k \<in> {j..<i}. i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+proof -
	+ have \<open>\<exists> k'< i-j. i-j cd\<^bsup>\<pi>\<guillemotleft>j\<^esup>\<rightarrow>k'\<close>
	+ apply(rule loop_has_cd)
	+ apply (metis assms(1) path_path_shift)
	+ apply (auto simp add: assms less_imp_le)
	+ done
	+ then obtain k where k: \<open>k<i-j\<close> \<open>i-j cd\<^bsup>\<pi>\<guillemotleft>j\<^esup>\<rightarrow>k\<close> by auto
	+ hence k': \<open>(k+j) < i\<close> \<open>i-j cd\<^bsup>\<pi>\<guillemotleft>j\<^esup>\<rightarrow> (k+j)-j\<close> by auto
	+ note cd_path_shift[OF _ assms(1)]
	+ hence \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k+j\<close> using k'(2) by (metis le_add1 add.commute)
	+ with k'(1) show \<open>?thesis\<close> by force
	+qed
	+
	+lemma claim'': assumes path\<pi>: \<open>is_path \<pi>\<close> and path\<pi>': \<open>is_path \<pi>'\<close>
	+and \<pi>i: \<open>\<pi> i = \<pi>' i'\<close> and \<pi>j: \<open>\<pi> j = \<pi>' j'\<close>
	+and not_cd: \<open>\<forall> k. \<not> j cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>\<forall> k. \<not> i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k\<close>
	+and nret: \<open>\<pi> i \<noteq> return\<close>
	+and ilj: \<open>i < j\<close>
	+shows \<open>i' < j'\<close> proof (rule ccontr)
	+ assume \<open>\<not> i' < j'\<close>
	+ hence jlei: \<open>j' \<le> i'\<close> by auto
	+ show \<open>False\<close> proof (cases)
	+ assume j'li': \<open>j' < i'\<close>
	+ define \<pi>'' where \<open>\<pi>'' \<equiv> (\<pi>@\<^bsup>j\<^esup>(\<pi>'\<guillemotleft>j'))\<guillemotleft>i\<close>
	+ note \<pi>''_def[simp]
	+ have \<open>\<pi> j = (\<pi>' \<guillemotleft> j') 0\<close> by (metis path_shift_def Nat.add_0_right \<pi>j)
	+ hence \<open>is_path \<pi>''\<close> using path\<pi> path\<pi>' \<pi>''_def path_path_shift path_cons by presburger
	+ moreover
	+ have \<open>\<pi>'' (j-i+(i'-j')) = \<pi>'' 0\<close> using ilj jlei \<pi>i \<pi>j
	+ by (auto, metis add_diff_cancel_left' le_antisym le_diff_conv le_eq_less_or_eq)
	+ moreover
	+ have \<open>\<pi>'' 0 \<noteq> return\<close> by (simp add: ilj less_or_eq_imp_le nret)
	+ moreover
	+ have \<open>0 < j-i+(i'-j')\<close> by (metis add_is_0 ilj neq0_conv zero_less_diff)
	+ ultimately obtain k where k: \<open>k < j-i+(i'-j')\<close> \<open>j-i+(i'-j') cd\<^bsup>\<pi>''\<^esup>\<rightarrow> k\<close> by (metis loop_has_cd)
	+ hence *: \<open>\<forall> l \<in> {k..j-i+(i'-j')}. \<pi>'' l \<noteq> ipd (\<pi>'' k)\<close> by (metis is_cdi_def)
	+ show \<open>False\<close> proof (cases \<open>k < j-i\<close>)
	+ assume a: \<open>k < j - i\<close>
	+ hence b: \<open>\<pi>'' k = \<pi> (i + k)\<close> by auto
	+ have \<open>\<forall> l \<in> {i+k..j}. \<pi> l \<noteq> ipd (\<pi> (i+k))\<close> proof
	+ fix l assume l: \<open>l \<in> {i + k..j}\<close>
	+ hence \<open>\<pi> l = \<pi>'' (l - i)\<close> by auto
	+ moreover
	+ from a l have \<open>l-i \<in> {k .. j-i + (i'-j')}\<close> by force
	+ ultimately show \<open>\<pi> l \<noteq> ipd (\<pi> (i + k))\<close> using * b by auto
	+ qed
	+ moreover
	+ have \<open>i + k < j\<close> using a by simp
	+ moreover
	+ have \<open>\<pi> j \<noteq> return\<close> by (metis \<pi>i \<pi>j j'li' nret path\<pi>' term_path_stable less_imp_le)
	+ ultimately
	+ have \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i+k\<close> by (metis not_cd_impl_ipd path\<pi>)
	+ thus \<open>False\<close> by (metis not_cd(1))
	+ next
	+ assume \<open>\<not> k < j - i\<close>
	+ hence a: \<open>j - i \<le> k\<close> by simp
	+ hence b: \<open>\<pi>'' k = \<pi>' (j' + (i + k) - j)\<close> unfolding \<pi>''_def path_shift_def path_append_def using ilj
	+ by(auto,metis \<pi>j add_diff_cancel_left' le_antisym le_diff_conv add.commute)
	+ have \<open>\<forall> l \<in> {j' + (i+k) - j..i'}. \<pi>' l \<noteq> ipd (\<pi>' (j' + (i+k) - j))\<close> proof
	+ fix l assume l: \<open>l \<in> {j' + (i+k) - j..i'}\<close>
	+ hence \<open>\<pi>' l = \<pi>'' (j + l - i - j')\<close> unfolding \<pi>''_def path_shift_def path_append_def using ilj
	+ by (auto, metis Nat.diff_add_assoc \<pi>j a add.commute add_diff_cancel_left' add_leD1 le_antisym le_diff_conv)
	+ moreover
	+ from a l have \<open>j + l - i - j' \<in> {k .. j-i + (i'-j')}\<close> by force
	+ ultimately show \<open>\<pi>' l \<noteq> ipd (\<pi>' (j' + (i + k) - j))\<close> using * b by auto
	+ qed
	+ moreover
	+ have \<open>j' + (i+k) - j < i'\<close> using a j'li' ilj k(1) by linarith
	+ moreover
	+ have \<open>\<pi>' i' \<noteq> return\<close> by (metis \<pi>i nret)
	+ ultimately
	+ have \<open>i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j' + (i+k) - j\<close> by (metis not_cd_impl_ipd path\<pi>')
	+ thus \<open>False\<close> by (metis not_cd(2))
	+ qed
	+ next
	+ assume \<open>\<not> j' < i'\<close>
	+ hence \<open>j' = i'\<close> by (metis \<open>\<not> i' < j'\<close> linorder_cases)
	+ hence \<open>\<pi> i = \<pi> j\<close> by (metis \<pi>i \<pi>j)
	+ thus \<open>False\<close> by (metis ilj loop_has_cd' not_cd(1) nret path\<pi>)
	+qed
	+qed
	+
	+lemma other_claim': assumes path: \<open>is_path \<pi>\<close> and eq: \<open>\<pi> i = \<pi> j\<close> and \<open>\<pi> i \<noteq> return\<close>
	+and icd: \<open>\<forall> k. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and \<open>\<forall> k. \<not> j cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> shows \<open>i = j\<close>
	+proof (rule ccontr,cases)
	+ assume \<open>i < j\<close> thus \<open>False\<close> using assms claim'' by blast
	+next
	+ assume \<open>\<not> i < j\<close> \<open>i \<noteq> j\<close>
	+ hence \<open>j < i\<close> by auto
	+ thus \<open>False\<close> using assms claim'' by (metis loop_has_cd')
	+qed
	+
	+lemma icd_no_cd_path_shift: assumes \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> shows \<open>(\<forall> k. \<not> i - 1 cd\<^bsup>\<pi>\<guillemotleft>1\<^esup>\<rightarrow> k)\<close>
	+proof (rule,rule ccontr,goal_cases)
	+ case (1 k)
	+ hence *: \<open>i - 1 cd\<^bsup>\<pi> \<guillemotleft> 1\<^esup>\<rightarrow> k\<close> by simp
	+ have **: \<open>1 \<le> k + 1\<close> by simp
	+ have ***: \<open>is_path \<pi>\<close> by (metis assms is_icdi_def)
	+ hence \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k+1\<close> using cd_path_shift[OF ] by auto
	+ moreover
	+ hence \<open>k+1 < i\<close> unfolding is_cdi_def by simp
	+ moreover
	+ have \<open>0 < k + 1\<close> by simp
	+ ultimately show \<open>False\<close> using assms[unfolded is_icdi_def] by auto
	+qed
	+
	+lemma claim': assumes path\<pi>: \<open>is_path \<pi>\<close> and path\<pi>': \<open>is_path \<pi>'\<close> and
	+ \<pi>i: \<open>\<pi> i = \<pi>' i'\<close> and \<pi>j: \<open>\<pi> j = \<pi>' j'\<close> and not_cd:
	+ \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> \<open>j icd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close>
	+ \<open>i' icd\<^bsup>\<pi>'\<^esup>\<rightarrow> 0\<close> \<open>j' icd\<^bsup>\<pi>'\<^esup>\<rightarrow> 0\<close>
	+ and ilj: \<open>i < j\<close>
	+ and nret: \<open>\<pi> i \<noteq> return\<close>
	+ shows \<open>i' < j'\<close>
	+proof -
	+ have g0: \<open>0 < i\<close> \<open>0 < j\<close> \<open>0 < i'\<close> \<open>0 < j'\<close>using not_cd[unfolded is_icdi_def is_cdi_def] by auto
	+ have \<open>(\<pi> \<guillemotleft> 1) (i - 1) = (\<pi>' \<guillemotleft> 1) (i' - 1)\<close> \<open>(\<pi> \<guillemotleft> 1) (j - 1) = (\<pi>' \<guillemotleft> 1) (j' - 1)\<close> using \<pi>i \<pi>j g0 by auto
	+ moreover
	+ have \<open>\<forall> k. \<not> (j - 1) cd\<^bsup>\<pi>\<guillemotleft>1\<^esup>\<rightarrow> k\<close> \<open>\<forall> k. \<not> (i' - 1) cd\<^bsup>\<pi>'\<guillemotleft>1\<^esup>\<rightarrow> k\<close>
	+ by (metis icd_no_cd_path_shift not_cd(2)) (metis icd_no_cd_path_shift not_cd(3))
	+ moreover
	+ have \<open>is_path (\<pi>\<guillemotleft>1)\<close> \<open>is_path (\<pi>'\<guillemotleft>1)\<close> using path\<pi> path\<pi>' path_path_shift by blast+
	+ moreover
	+ have \<open>(\<pi>\<guillemotleft>1) (i - 1) \<noteq> return\<close> using g0 nret by auto
	+ moreover
	+ have \<open>i - 1 < j - 1\<close> using g0 ilj by auto
	+ ultimately have \<open>i' - 1 < j' - 1\<close> using claim'' by blast
	+ thus \<open>i'<j'\<close> by auto
	+qed
	+
	+lemma other_claim: assumes path: \<open>is_path \<pi>\<close> and eq: \<open>\<pi> i = \<pi> j\<close> and \<open>\<pi> i \<noteq> return\<close>
	+and icd: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> and \<open>j icd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> shows \<open>i = j\<close> proof (rule ccontr,cases)
	+ assume \<open>i < j\<close> thus \<open>False\<close> using assms claim' by blast
	+next
	+ assume \<open>\<not> i < j\<close> \<open>i \<noteq> j\<close>
	+ hence \<open>j < i\<close> by auto
	+ thus \<open>False\<close> using assms claim' by (metis less_not_refl)
	+qed
	+
	+lemma cd_trans0: assumes \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> and \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow>j\<close> shows \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> proof (rule ccontr)
	+ have path: \<open>is_path \<pi>\<close> and ij: \<open>0 < j\<close> and jk: \<open>j < k\<close>
	+ and nret: \<open>\<pi> j \<noteq> return\<close> \<open>\<pi> k \<noteq> return\<close>
	+ and noipdi: \<open>\<forall> l \<in> {0..j}. \<pi> l \<noteq> ipd (\<pi> 0)\<close>
	+ and noipdj: \<open>\<forall> l \<in> {j..k}. \<pi> l \<noteq> ipd (\<pi> j)\<close>
	+ using assms unfolding is_cdi_def by auto
	+ assume \<open>\<not> k cd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close>
	+ hence \<open>\<exists>l \<in> {0..k}. \<pi> l = ipd (\<pi> 0)\<close> unfolding is_cdi_def using path ij jk nret by force
	+ then obtain l where \<open>l \<in> {0..k}\<close> and l: \<open>\<pi> l = ipd (\<pi> 0)\<close> by auto
	+ hence jl: \<open>j<l\<close> and lk: \<open>l\<le>k\<close> using noipdi ij by auto
	+ have pdj: \<open>ipd (\<pi> 0) pd\<rightarrow> \<pi> j\<close> proof (rule ccontr)
	+ have \<open>\<pi> j \<in> nodes\<close> using path by (metis path_nodes)
	+ moreover
	+ assume \<open>\<not> ipd (\<pi> 0) pd\<rightarrow> \<pi> j\<close>
	+ ultimately
	+ obtain \<pi>' n where *: \<open>is_path \<pi>'\<close> \<open>\<pi>' 0 = \<pi> j\<close> \<open>\<pi>' n = return\<close> \<open>\<forall> k\<le>n. \<pi>' k \<noteq> ipd(\<pi> 0)\<close> using no_pd_path by metis
	+ hence path': \<open>is_path (\<pi> @\<^bsup>j\<^esup> \<pi>')\<close> by (metis path path_cons)
	+ moreover
	+ have \<open>\<forall> k \<le> j + n. (\<pi>@\<^bsup>j\<^esup> \<pi>') k \<noteq> ipd (\<pi> 0)\<close> using noipdi *(4) by auto
	+ moreover
	+ have \<open>(\<pi>@\<^bsup>j\<^esup> \<pi>') 0 = \<pi> 0\<close> by auto
	+ moreover
	+ have \<open>(\<pi>@\<^bsup>j\<^esup> \<pi>') (j + n) = return\<close> using *(2,3) by auto
	+ ultimately
	+ have \<open>\<not> ipd (\<pi> 0) pd\<rightarrow> \<pi> 0\<close> unfolding is_pd_def by metis
	+ thus \<open>False\<close> by (metis is_ipd_def ij ipd_is_ipd nret(1) path path_nodes term_path_stable less_imp_le)
	+ qed
	+ hence \<open>(\<pi>\<guillemotleft>j) (l-j) pd\<rightarrow> (\<pi>\<guillemotleft>j) 0\<close> using jl l by auto
	+ moreover
	+ have \<open>is_path (\<pi>\<guillemotleft>j)\<close> by (metis path path_path_shift)
	+ moreover
	+ have \<open>\<pi> l \<noteq> return\<close> by (metis lk nret(2) path term_path_stable)
	+ hence \<open>(\<pi>\<guillemotleft>j) (l-j) \<noteq> return\<close> using jl by auto
	+ moreover
	+ have \<open>\<pi> j \<noteq> ipd (\<pi> 0)\<close> using noipdi by force
	+ hence \<open>(\<pi>\<guillemotleft>j) (l-j) \<noteq> (\<pi>\<guillemotleft>j) 0\<close> using jl l by auto
	+ ultimately
	+ obtain k' where \<open>k' \<le> l-j\<close> and \<open>(\<pi>\<guillemotleft>j) k' = ipd ((\<pi>\<guillemotleft>j) 0)\<close> using path_pd_ipd0' by blast
	+ hence \<open>j + k' \<in> {j..k}\<close> \<open>\<pi> (j+k') = ipd (\<pi> j)\<close> using jl lk by auto
	+ thus \<open>False\<close> using noipdj by auto
	+qed
	+
	+lemma cd_trans: assumes \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> and \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow>j\<close> shows \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> proof -
	+ have path: \<open>is_path \<pi>\<close> using assms is_cdi_def by auto
	+ have ij: \<open>i<j\<close> using assms is_cdi_def by auto
	+ let \<open>?\<pi>\<close> = \<open>\<pi>\<guillemotleft>i\<close>
	+ have \<open>j-i cd\<^bsup>?\<pi>\<^esup>\<rightarrow> 0\<close> using assms(1) cd_path_shift0 path by auto
	+ moreover
	+ have \<open>k-i cd\<^bsup>?\<pi>\<^esup>\<rightarrow>j-i\<close> by (metis assms(2) cd_path_shift is_cdi_def ij less_imp_le_nat)
	+ ultimately
	+ have \<open>k-i cd\<^bsup>?\<pi>\<^esup>\<rightarrow> 0\<close> using cd_trans0 by auto
	+ thus \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> using path cd_path_shift0 by auto
	+qed
	+
	+lemma excd_impl_exicd: assumes \<open>\<exists> k. i cd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> shows \<open>\<exists> k. i icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close>
	+using assms proof(induction \<open>i\<close> arbitrary: \<open>\<pi>\<close> rule: less_induct)
	+ case (less i)
	+ then obtain k where k: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> by auto
	+ hence ip: \<open>is_path \<pi>\<close> unfolding is_cdi_def by auto
	+ show \<open>?case\<close> proof (cases)
	+ assume *: \<open>\<forall> m \<in> {k<..<i}. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close>
	+ hence \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> using k ip unfolding is_icdi_def by auto
	+ thus \<open>?case\<close> by auto
	+ next
	+ assume \<open>\<not> (\<forall> m \<in> {k<..<i}. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m)\<close>
	+ then obtain m where m: \<open>m \<in> {k<..<i}\<close> \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> by blast
	+ hence \<open>i - m cd\<^bsup>\<pi>\<guillemotleft>m\<^esup>\<rightarrow> 0\<close> by (metis cd_path_shift0 is_cdi_def)
	+ moreover
	+ have \<open>i - m < i\<close> using m by auto
	+ ultimately
	+ obtain k' where k': \<open>i - m icd\<^bsup>\<pi>\<guillemotleft>m\<^esup>\<rightarrow> k'\<close> using less(1) by blast
	+ hence \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k' + m\<close> using ip
	+ by (metis add.commute add_diff_cancel_right' icd_path_shift le_add1)
	+ thus \<open>?case\<close> by auto
	+ qed
	+qed
	+
	+lemma cd_split: assumes \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and \<open>\<not> i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> obtains m where \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> and \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+proof -
	+ have ki: \<open>k < i\<close> using assms is_cdi_def by auto
	+ obtain m where m: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using assms(1) by (metis excd_impl_exicd)
	+ hence \<open>k \<le> m\<close> unfolding is_icdi_def using ki assms(1) by force
	+ hence km: \<open>k < m\<close>using m assms(2) by (metis le_eq_less_or_eq)
	+ moreover have \<open>\<pi> m \<noteq> return\<close> using m unfolding is_icdi_def is_cdi_def by (simp, metis term_path_stable less_imp_le)
	+ moreover have \<open>m<i\<close> using m unfolding is_cdi_def is_icdi_def by auto
	+ ultimately
	+ have \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> using assms(1) unfolding is_cdi_def by auto
	+ with m that show \<open>thesis\<close> by auto
	+qed
	+
	+lemma cd_induct[consumes 1, case_names base IS]: assumes prem: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and base: \<open>\<And> i. i icd\<^bsup>\<pi>\<^esup>\<rightarrow>k \<Longrightarrow> P i\<close>
	+and IH: \<open>\<And> k' i'. k' cd\<^bsup>\<pi>\<^esup>\<rightarrow> k \<Longrightarrow> P k' \<Longrightarrow> i' icd\<^bsup>\<pi>\<^esup>\<rightarrow> k' \<Longrightarrow> P i'\<close> shows \<open>P i\<close>
	+using prem IH proof (induction \<open>i\<close> rule: less_induct,cases)
	+ case (less i)
	+ assume \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ thus \<open>P i\<close> using base by simp
	+next
	+ case (less i')
	+ assume \<open>\<not> i' icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ then obtain k' where k': \<open> i' icd\<^bsup>\<pi>\<^esup>\<rightarrow> k'\<close> \<open>k' cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> using less cd_split by blast
	+ hence icdk: \<open>i' cd\<^bsup>\<pi>\<^esup>\<rightarrow> k'\<close> using is_icdi_def by auto
	+ note ih=less(3)[OF k'(2) _ k'(1)]
	+ have ki: \<open>k' < i'\<close> using k' is_icdi_def is_cdi_def by auto
	+ have \<open>P k'\<close> using less(1)[OF ki k'(2) ] less(3) by auto
	+ thus \<open>P i'\<close> using ih by simp
	+qed
	+
	+lemma cdi_prefix: \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> m \<Longrightarrow> m < n' \<Longrightarrow> n' \<le> n \<Longrightarrow> n' cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> unfolding is_cdi_def
	+ by (simp, metis term_path_stable)
	+
	+lemma cr_wn': assumes 1: \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> and nc: \<open>\<not> m' cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> and 3: \<open>m < m'\<close> shows \<open>n < m'\<close>
	+proof (rule ccontr)
	+ assume \<open>\<not> n < m'\<close>
	+ hence \<open>m' \<le> n\<close> by simp
	+ hence \<open>m' cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> by (metis 1 3 cdi_prefix)
	+ thus \<open>False\<close> using nc by simp
	+qed
	+
	+lemma cr_wn'': assumes \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> and \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> and \<open>\<not> m cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> and \<open>i \<le> j\<close> shows \<open>m \<le> n\<close> proof (rule ccontr)
	+ assume \<open>\<not>m\<le>n\<close>
	+ hence nm: \<open>n < m\<close> by auto
	+ moreover
	+ have \<open>m<j\<close> using assms(1) assms(4) unfolding is_cdi_def by auto
	+ ultimately
	+ have \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> using assms(2) cdi_prefix by auto
	+ thus \<open>False\<close> using assms(3) by auto
	+qed
	+
	+lemma ret_no_cd: assumes \<open>\<pi> n = return\<close> shows \<open>\<not> n cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> by (metis assms is_cdi_def)
	+
	+lemma ipd_not_self: assumes \<open>x \<in> nodes\<close> \<open>x\<noteq> return\<close> shows \<open>x \<noteq> ipd x\<close> by (metis is_ipd_def assms ipd_is_ipd)
	+
	+lemma icd_cs: assumes \<open>l icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>\<^esup> k @ [\<pi> l]\<close>
	+proof -
	+ from assms have \<open>k = (THE k. l icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close> by (metis icd_is_the_icd)
	+ with assms show \<open>?thesis\<close> by auto
	+qed
	+
	+lemma cd_not_pd: assumes \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>\<pi> l \<noteq> \<pi> k\<close> shows \<open>\<not> \<pi> l pd\<rightarrow> \<pi> k\<close> proof
	+ assume pd: \<open>\<pi> l pd\<rightarrow> \<pi> k\<close>
	+ have nret: \<open>\<pi> k \<noteq> return\<close> by (metis assms(1) pd pd_ret_is_ret ret_no_cd)
	+ have kl: \<open>k < l\<close> by (metis is_cdi_def assms(1))
	+ have path: \<open>is_path \<pi>\<close> by (metis is_cdi_def assms(1))
	+ from path_pd_ipd[OF path nret assms(2) pd kl]
	+ obtain n where \<open>k < n\<close> \<open>n \<le> l\<close> \<open>\<pi> n = ipd (\<pi> k)\<close> .
	+ thus \<open>False\<close> using assms(1) unfolding is_cdi_def by auto
	+qed
	+
	+lemma cd_ipd_is_cd: assumes \<open>k<m\<close> \<open>\<pi> m = ipd (\<pi> k)\<close> \<open>\<forall> n \<in> {k..<m}. \<pi> n \<noteq> ipd (\<pi> k)\<close> and mcdj: \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> shows \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> proof cases
	+ assume \<open>j < k\<close> thus \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> by (metis mcdj assms(1) cdi_prefix less_imp_le_nat)
	+next
	+ assume \<open>\<not> j < k\<close>
	+ hence kj: \<open>k \<le> j\<close> by simp
	+ have \<open>k < j\<close> apply (rule ccontr) using kj assms mcdj by (auto, metis is_cdi_def is_ipd_def cd_not_pd ipd_is_ipd path_nodes term_path_stable less_imp_le)
	+ moreover
	+ have \<open>j < m\<close> using mcdj is_cdi_def by auto
	+ hence \<open>\<forall> n \<in> {k..j}. \<pi> n \<noteq> ipd(\<pi> k)\<close> using assms(3) by force
	+ ultimately
	+ have \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> by (metis mcdj is_cdi_def term_path_stable less_imp_le)
	+ hence \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> by (metis mcdj cd_trans)
	+ hence \<open>False\<close> by (metis is_cdi_def is_ipd_def assms(2) cd_not_pd ipd_is_ipd path_nodes term_path_stable less_imp_le)
	+ thus \<open>?thesis\<close> by simp
	+qed
	+
	+lemma ipd_pd_cd0: assumes lcd: \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> shows \<open>ipd (\<pi> 0) pd\<rightarrow> (\<pi> n)\<close>
	+proof -
	+ obtain k l where \<pi>0: \<open>\<pi> 0 = k\<close> and \<pi>n: \<open>\<pi> n = l\<close> and cdi: \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> 0\<close> using lcd unfolding is_cdi_def by blast
	+ have nret: \<open>k \<noteq> return\<close> by (metis is_cdi_def \<pi>0 cdi term_path_stable less_imp_le)
	+ have path: \<open>is_path \<pi>\<close> and ipd: \<open>\<forall> i\<le>n. \<pi> i \<noteq> ipd k\<close> using cdi unfolding is_cdi_def \<pi>0 by auto
	+ {
	+ fix \<pi>' n'
	+ assume path': \<open>is_path \<pi>'\<close>
	+ and \<pi>'0: \<open>\<pi>' 0 = l\<close>
	+ and ret: \<open>\<pi>' n' = return\<close>
	+ have \<open>is_path (\<pi> @\<^bsup>n\<^esup> \<pi>')\<close> using path path' \<pi>n \<pi>'0 by (metis path_cons)
	+ moreover
	+ have \<open>(\<pi> @\<^bsup>n\<^esup> \<pi>') (n+n') = return\<close> using ret \<pi>n \<pi>'0 by auto
	+ moreover
	+ have \<open>(\<pi> @\<^bsup>n\<^esup> \<pi>') 0 = k\<close> using \<pi>0 by auto
	+ moreover
	+ have \<open>ipd k pd\<rightarrow> k\<close> by (metis is_ipd_def path \<pi>0 ipd_is_ipd nret path_nodes)
	+ ultimately
	+ obtain k' where k': \<open>k' \<le> n+n'\<close> \<open>(\<pi> @\<^bsup>n\<^esup> \<pi>') k' = ipd k\<close> by (metis pd_intro)
	+ have \<open>\<not> k'\<le> n\<close> proof
	+ assume \<open>k' \<le> n\<close>
	+ hence \<open>(\<pi> @\<^bsup>n\<^esup> \<pi>') k' = \<pi> k'\<close> by auto
	+ thus \<open>False\<close> using k'(2) ipd by (metis \<open>k' \<le> n\<close>)
	+ qed
	+ hence \<open>(\<pi> @\<^bsup>n\<^esup> \<pi>') k' = \<pi>' (k' - n)\<close> by auto
	+ moreover
	+ have \<open>(k' - n) \<le> n'\<close> using k' by simp
	+ ultimately
	+ have \<open>\<exists> k'\<le>n'. \<pi>' k' = ipd k\<close> unfolding k' by auto
	+ }
	+ moreover
	+ have \<open>l \<in> nodes\<close> by (metis \<pi>n path path_nodes)
	+ ultimately show \<open>ipd (\<pi> 0) pd\<rightarrow> (\<pi> n)\<close> unfolding is_pd_def by (simp add: \<pi>0 \<pi>n)
	+qed
	+
	+lemma ipd_pd_cd: assumes lcd: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> shows \<open>ipd (\<pi> k) pd\<rightarrow> (\<pi> l)\<close>
	+proof -
	+ have \<open>l-k cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow>0\<close> using lcd cd_path_shift0 is_cdi_def by blast
	+ moreover
	+ note ipd_pd_cd0[OF this]
	+ moreover
	+ have \<open>(\<pi> \<guillemotleft> k) 0 = \<pi> k\<close> by auto
	+ moreover
	+ have \<open>k < l\<close> using lcd unfolding is_cdi_def by simp
	+ then have \<open>(\<pi> \<guillemotleft> k) (l - k) = \<pi> l\<close> by simp
	+ ultimately show \<open>?thesis\<close> by simp
	+qed
	+
	+lemma cd_is_cd_ipd: assumes km: \<open>k<m\<close> and ipd: \<open>\<pi> m = ipd (\<pi> k)\<close> \<open>\<forall> n \<in> {k..<m}. \<pi> n \<noteq> ipd (\<pi> k)\<close> and cdj: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> and nipdj: \<open>ipd (\<pi> j) \<noteq> \<pi> m\<close> shows \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> proof -
	+ have path: \<open>is_path \<pi>\<close>
	+ and jk: \<open>j < k\<close>
	+ and nretj: \<open>\<pi> k \<noteq> return\<close>
	+ and nipd: \<open>\<forall> l \<in> {j..k}. \<pi> l \<noteq> ipd (\<pi> j)\<close> using cdj is_cdi_def by auto
	+ have pd: \<open>ipd (\<pi> j) pd\<rightarrow> \<pi> m\<close> by (metis atLeastAtMost_iff cdj ipd(1) ipd_pd_cd jk le_refl less_imp_le nipd nretj path path_nodes pd_pd_ipd)
	+ have nretm: \<open>\<pi> m \<noteq> return\<close> by (metis nipdj pd pd_ret_is_ret)
	+ have jm: \<open>j < m\<close> using jk km by simp
	+ show \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> proof (rule ccontr)
	+ assume ncdj: \<open>\<not> m cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close>
	+ hence \<open>\<exists> l \<in> {j..m}. \<pi> l = ipd (\<pi> j)\<close> unfolding is_cdi_def by (metis jm nretm path)
	+ then obtain l
	+ where jl: \<open>j \<le> l\<close> and \<open>l \<le> m\<close>
	+ and lipd: \<open>\<pi> l = ipd (\<pi> j)\<close> by force
	+ hence lm: \<open>l < m\<close> using nipdj by (metis le_eq_less_or_eq)
	+ have npd: \<open>\<not> ipd (\<pi> k) pd\<rightarrow> \<pi> l\<close> by (metis ipd(1) lipd nipdj pd pd_antisym)
	+ have nd: \<open>\<pi> l \<in> nodes\<close> using path path_nodes by simp
	+ from no_pd_path[OF nd npd]
	+ obtain \<pi>' n where path': \<open>is_path \<pi>'\<close> and \<pi>'0: \<open>\<pi>' 0 = \<pi> l\<close> and \<pi>'n: \<open>\<pi>' n = return\<close> and nipd: \<open>\<forall> ka\<le>n. \<pi>' ka \<noteq> ipd (\<pi> k)\<close> .
	+ let \<open>?\<pi>\<close> = \<open>(\<pi>@\<^bsup>l\<^esup> \<pi>') \<guillemotleft> k\<close>
	+ have path'': \<open>is_path ?\<pi>\<close> by (metis \<pi>'0 path path' path_cons path_path_shift)
	+ moreover
	+ have kl: \<open>k < l\<close> using lipd cdj jl unfolding is_cdi_def by fastforce
	+ have \<open>?\<pi> 0 = \<pi> k\<close> using kl by auto
	+ moreover
	+ have \<open>?\<pi> (l + n - k) = return\<close> using \<pi>'n \<pi>'0 kl by auto
	+ moreover
	+ have \<open>ipd (\<pi> k) pd\<rightarrow> \<pi> k\<close> by (metis is_ipd_def ipd_is_ipd nretj path path_nodes)
	+ ultimately
	+ obtain l' where l': \<open>l' \<le> (l + n - k)\<close> \<open>?\<pi> l' = ipd (\<pi> k)\<close> unfolding is_pd_def by blast
	+ show \<open>False\<close> proof (cases )
	+ assume *: \<open>k + l' \<le> l\<close>
	+ hence \<open>\<pi> (k + l') = ipd (\<pi> k)\<close> using l' by auto
	+ moreover
	+ have \<open>k + l' < m\<close> by (metis "*" dual_order.strict_trans2 lm)
	+ ultimately
	+ show \<open>False\<close> using ipd(2) by simp
	+ next
	+ assume \<open>\<not> k + l' \<le> l\<close>
	+ hence \<open>\<pi>' (k + l' - l) = ipd (\<pi> k)\<close> using l' by auto
	+ moreover
	+ have \<open>k + l' - l \<le> n\<close> using l' kl by linarith
	+ ultimately
	+ show \<open>False\<close> using nipd by auto
	+ qed
	+ qed
	+qed
	+
	+lemma ipd_icd_greatest_cd_not_ipd: assumes ipd: \<open>\<pi> m = ipd (\<pi> k)\<close> \<open>\<forall> n \<in> {k..<m}. \<pi> n \<noteq> ipd (\<pi> k)\<close>
	+and km: \<open>k < m\<close> and icdj: \<open>m icd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> shows \<open>j = (GREATEST j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> \<pi> m)\<close>
	+proof -
	+ let \<open>?j\<close> = \<open>GREATEST j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> \<pi> m\<close>
	+ have kcdj: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using assms cd_ipd_is_cd is_icdi_def by blast
	+ have nipd: \<open>ipd (\<pi> j) \<noteq> \<pi> m\<close> using icdj unfolding is_icdi_def is_cdi_def by auto
	+ have bound: \<open>\<And> j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> \<pi> m \<Longrightarrow> j \<le> k\<close> unfolding is_cdi_def by simp
	+ have exists: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> \<pi> m\<close> (is \<open>?P j\<close>) using kcdj nipd by auto
	+ note GreatestI_nat[of \<open>?P\<close> _ \<open>k\<close>, OF exists] Greatest_le_nat[of \<open>?P\<close> \<open>j\<close> \<open>k\<close>, OF exists]
	+ hence kcdj': \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> ?j\<close> and ipd': \<open>ipd (\<pi> ?j) \<noteq> \<pi> m\<close> and jj: \<open>j \<le> ?j\<close> using bound by auto
	+ hence mcdj': \<open>m cd\<^bsup>\<pi>\<^esup>\<rightarrow> ?j\<close> using ipd km cd_is_cd_ipd by auto
	+ show \<open>j = ?j\<close> proof (rule ccontr)
	+ assume \<open>j \<noteq> ?j\<close>
	+ hence jlj: \<open>j < ?j\<close> using jj by simp
	+ moreover
	+ have \<open>?j < m\<close> using kcdj' km unfolding is_cdi_def by auto
	+ ultimately
	+ show \<open>False\<close> using icdj mcdj' unfolding is_icdi_def by auto
	+ qed
	+qed
	+
	+lemma cd_impl_icd_cd: assumes \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> and \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and \<open>\<not> i icd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> shows \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close>
	+ using assms cd_split icd_uniq by metis
	+
	+lemma cdi_is_cd_icdi: assumes \<open>k icd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> shows \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<longleftrightarrow> j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<or> i = j\<close>
	+ by (metis assms cd_impl_icd_cd cd_trans icd_imp_cd icd_uniq)
	+
	+lemma same_ipd_stable: assumes \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> \<open>i<j\<close> \<open>ipd (\<pi> i) = ipd (\<pi> k)\<close> shows \<open>ipd (\<pi> j) = ipd (\<pi> k)\<close>
	+proof -
	+ have jcdi: \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> by (metis is_cdi_def assms(1,2,3) cr_wn' le_antisym less_imp_le_nat)
	+ have 1: \<open>ipd (\<pi> j) pd\<rightarrow> \<pi> k \<close> by (metis assms(2) ipd_pd_cd)
	+ have 2: \<open>ipd (\<pi> k) pd\<rightarrow> \<pi> j \<close> by (metis assms(4) ipd_pd_cd jcdi)
	+ have 3: \<open>ipd (\<pi> k) pd\<rightarrow> (ipd (\<pi> j))\<close> by (metis 2 IFC_def.is_cdi_def assms(1,2,4) atLeastAtMost_iff jcdi less_imp_le pd_node2 pd_pd_ipd)
	+ have 4: \<open>ipd (\<pi> j) pd\<rightarrow> (ipd (\<pi> k))\<close> by (metis 1 2 IFC_def.is_ipd_def assms(2) cd_not_pd ipd_is_ipd jcdi pd_node2 ret_no_cd)
	+ show \<open>?thesis\<close> using 3 4 pd_antisym by simp
	+qed
	+
	+lemma icd_pd_intermediate': assumes icd: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and j: \<open>k < j\<close> \<open>j < i\<close> shows \<open>\<pi> i pd\<rightarrow> (\<pi> j)\<close>
	+using j proof (induction \<open>i - j\<close> arbitrary: \<open>j\<close> rule: less_induct)
	+ case (less j)
	+ have \<open>\<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using less.prems icd unfolding is_icdi_def by force
	+ moreover
	+ have \<open>is_path \<pi>\<close> using icd by (metis is_icdi_def)
	+ moreover
	+ have \<open>\<pi> i \<noteq> return\<close> using icd by (metis is_icdi_def ret_no_cd)
	+ ultimately
	+ have \<open>\<exists> l. j \<le> l \<and> l \<le> i \<and> \<pi> l = ipd (\<pi> j)\<close> unfolding is_cdi_def using less.prems by auto
	+ then obtain l where l: \<open>j \<le> l\<close> \<open>l \<le> i\<close> \<open>\<pi> l = ipd (\<pi> j)\<close> by blast
	+ hence lpd: \<open>\<pi> l pd\<rightarrow> (\<pi> j)\<close> by (metis is_ipd_def \<open>\<pi> i \<noteq> return\<close> \<open>is_path \<pi>\<close> ipd_is_ipd path_nodes term_path_stable)
	+ show \<open>?case\<close> proof (cases)
	+ assume \<open>l = i\<close>
	+ thus \<open>?case\<close> using lpd by auto
	+ next
	+ assume \<open>l \<noteq> i\<close>
	+ hence \<open>l < i\<close> using l by simp
	+ moreover
	+ have \<open>j \<noteq> l\<close> using l by (metis is_ipd_def \<open>\<pi> i \<noteq> return\<close> \<open>is_path \<pi>\<close> ipd_is_ipd path_nodes term_path_stable)
	+ hence \<open>j < l\<close> using l by simp
	+ moreover
	+ hence \<open>i - l < i - j\<close> by (metis diff_less_mono2 less.prems(2))
	+ moreover
	+ have \<open>k < l\<close> by (metis l(1) less.prems(1) linorder_neqE_nat not_le order.strict_trans)
	+ ultimately
	+ have \<open>\<pi> i pd\<rightarrow> (\<pi> l)\<close> using less.hyps by auto
	+ thus \<open>?case\<close> using lpd by (metis pd_trans)
	+ qed
	+qed
	+
	+lemma icd_pd_intermediate: assumes icd: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and j: \<open>k < j\<close> \<open>j \<le> i\<close> shows \<open>\<pi> i pd\<rightarrow> (\<pi> j)\<close>
	+using assms icd_pd_intermediate'[OF assms(1,2)] apply (cases \<open>j < i\<close>,metis) by (metis is_icdi_def le_neq_trans path_nodes pd_refl)
	+
	+lemma no_icd_pd: assumes path: \<open>is_path \<pi>\<close> and noicd: \<open>\<forall> l\<ge>n. \<not> k icd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> and nk: \<open>n \<le> k\<close> shows \<open>\<pi> k pd\<rightarrow> \<pi> n\<close>
	+proof cases
	+ assume \<open>\<pi> k = return\<close> thus \<open>?thesis\<close> by (metis path path_nodes return_pd)
	+next
	+ assume nret: \<open>\<pi> k \<noteq> return\<close>
	+ have nocd: \<open>\<And> l. n\<le>l \<Longrightarrow> \<not> k cd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> proof
	+ fix l assume kcd: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> and nl: \<open>n \<le> l\<close>
	+ hence \<open>(k - n) cd\<^bsup>\<pi>\<guillemotleft>n\<^esup>\<rightarrow> (l - n)\<close> using cd_path_shift[OF nl path] by simp
	+ hence \<open>\<exists> l. (k - n) icd\<^bsup>\<pi>\<guillemotleft>n\<^esup>\<rightarrow> l\<close> using excd_impl_exicd by blast
	+ then guess l' ..
	+ hence \<open>k icd\<^bsup>\<pi>\<^esup>\<rightarrow> (l' + n)\<close> using icd_path_shift[of \<open>n\<close> \<open>l' + n\<close> \<open>\<pi>\<close> \<open>k\<close>] path by auto
	+ thus \<open>False\<close> using noicd by auto
	+ qed
	+ hence \<open>\<And>l. n \<le> l \<Longrightarrow> l<k \<Longrightarrow> \<exists> j \<in> {l..k}. \<pi> j = ipd (\<pi> l)\<close> using path nret unfolding is_cdi_def by auto
	+ thus \<open>?thesis\<close> using nk proof (induction \<open>k - n\<close> arbitrary: \<open>n\<close> rule: less_induct,cases)
	+ case (less n)
	+ assume \<open>n = k\<close>
	+ thus \<open>?case\<close> using pd_refl path path_nodes by auto
	+ next
	+ case (less n)
	+ assume \<open>n \<noteq> k\<close>
	+ hence nk: \<open>n < k\<close> using less(3) by auto
	+ with less(2) obtain j where jnk: \<open>j \<in> {n..k}\<close> and ipdj: \<open>\<pi> j = ipd (\<pi> n)\<close> by blast
	+ have nretn: \<open>\<pi> n \<noteq> return\<close> using nk nret term_path_stable path by auto
	+ with ipd_is_ipd path path_nodes is_ipd_def ipdj
	+ have jpdn: \<open>\<pi> j pd\<rightarrow> \<pi> n\<close> by auto
	+ show \<open>?case\<close> proof cases
	+ assume \<open>j = k\<close> thus \<open>?case\<close> using jpdn by simp
	+ next
	+ assume \<open>j \<noteq> k\<close>
	+ hence jk: \<open>j < k\<close> using jnk by auto
	+ have \<open>j \<noteq> n\<close> using ipdj by (metis ipd_not_self nretn path path_nodes)
	+ hence nj: \<open>n < j\<close> using jnk by auto
	+ have *: \<open>k - j < k - n\<close> using jk nj by auto
	+
	+ with less(1)[OF *] less(2) jk nj
	+ have \<open>\<pi> k pd\<rightarrow> \<pi> j\<close> by auto
	+
	+ thus \<open>?thesis\<close> using jpdn pd_trans by metis
	+ qed
	+ qed
	+qed
	+
	+
	+lemma first_pd_no_cd: assumes path: \<open>is_path \<pi>\<close> and pd: \<open>\<pi> n pd\<rightarrow> \<pi> 0\<close> and first: \<open>\<forall> l < n. \<pi> l \<noteq> \<pi> n\<close> shows \<open>\<forall> l. \<not> n cd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close>
	+proof (rule ccontr, goal_cases)
	+ case 1
	+ then obtain l where ncdl: \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> by blast
	+ hence ln: \<open>l < n\<close> using is_cdi_def by auto
	+ have \<open>\<not> \<pi> n pd\<rightarrow> \<pi> l\<close> using ncdl cd_not_pd by (metis ln first)
	+ then obtain \<pi>' n' where path': \<open>is_path \<pi>'\<close> and \<pi>0: \<open>\<pi>' 0 = \<pi> l\<close> and \<pi>n: \<open>\<pi>' n' = return\<close> and not\<pi>n: \<open>\<forall> j\<le> n'. \<pi>' j \<noteq> \<pi> n\<close> unfolding is_pd_def using path path_nodes by auto
	+ let \<open>?\<pi>\<close> = \<open>\<pi>@\<^bsup>l\<^esup> \<pi>'\<close>
	+
	+ have \<open>is_path ?\<pi>\<close> by (metis \<pi>0 path path' path_cons)
	+ moreover
	+ have \<open>?\<pi> 0 = \<pi> 0\<close> by auto
	+ moreover
	+ have \<open>?\<pi> (n' + l) = return\<close> using \<pi>0 \<pi>n by auto
	+ ultimately
	+ obtain j where j: \<open>j \<le> n' + l\<close> and jn: \<open>?\<pi> j = \<pi> n\<close> using pd unfolding is_pd_def by blast
	+ show \<open>False\<close> proof cases
	+ assume \<open>j \<le> l\<close> thus \<open>False\<close> using jn first ln by auto
	+ next
	+ assume \<open>\<not> j \<le> l\<close> thus \<open>False\<close> using j jn not\<pi>n by auto
	+ qed
	+qed
	+
	+lemma first_pd_no_icd: assumes path: \<open>is_path \<pi>\<close> and pd: \<open>\<pi> n pd\<rightarrow> \<pi> 0\<close> and first: \<open>\<forall> l < n. \<pi> l \<noteq> \<pi> n\<close> shows \<open>\<forall> l. \<not> n icd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close>
	+ by (metis first first_pd_no_cd icd_imp_cd path pd)
	+
	+lemma path_nret_ex_nipd: assumes \<open>is_path \<pi>\<close> \<open>\<forall> i. \<pi> i \<noteq> return\<close> shows \<open>\<forall> i. (\<exists> j\<ge>i. (\<forall> k>j. \<pi> k \<noteq> ipd (\<pi> j)))\<close> proof(rule, rule ccontr)
	+ fix i
	+ assume \<open>\<not> (\<exists>j\<ge>i. \<forall> k>j. \<pi> k \<noteq> ipd (\<pi> j))\<close>
	+ hence *: \<open>\<forall> j\<ge>i. (\<exists>k>j. \<pi> k = ipd (\<pi> j))\<close> by blast
	+ have \<open>\<forall> j. (\<exists>k>j. (\<pi>\<guillemotleft>i) k = ipd ((\<pi>\<guillemotleft>i) j))\<close> proof
	+ fix j
	+ have \<open>i + j \<ge> i\<close> by auto
	+ then obtain k where k: \<open>k>i+j\<close> \<open>\<pi> k = ipd (\<pi> (i+j))\<close> using * by blast
	+ hence \<open>(\<pi>\<guillemotleft>i) (k - i) = ipd ((\<pi>\<guillemotleft>i) j)\<close> by auto
	+ moreover
	+ have \<open>k - i > j\<close> using k by auto
	+ ultimately
	+ show \<open>\<exists>k>j. (\<pi>\<guillemotleft>i) k = ipd ((\<pi>\<guillemotleft>i) j)\<close> by auto
	+ qed
	+ moreover
	+ have \<open>is_path (\<pi>\<guillemotleft>i)\<close> using assms(1) path_path_shift by simp
	+ ultimately
	+ obtain k where \<open>(\<pi>\<guillemotleft>i) k = return\<close> using all_ipd_imp_ret by blast
	+ thus \<open>False\<close> using assms(2) by auto
	+qed
	+
	+lemma path_nret_ex_all_cd: assumes \<open>is_path \<pi>\<close> \<open>\<forall> i. \<pi> i \<noteq> return\<close> shows \<open>\<forall> i. (\<exists> j\<ge>i. (\<forall> k>j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j))\<close>
	+unfolding is_cdi_def using assms path_nret_ex_nipd[OF assms] by (metis atLeastAtMost_iff ipd_not_self linorder_neqE_nat not_le path_nodes)
	+
	+
	+lemma path_nret_inf_all_cd: assumes \<open>is_path \<pi>\<close> \<open>\<forall> i. \<pi> i \<noteq> return\<close> shows \<open>\<not> finite {j. \<forall> k>j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j}\<close>
	+using unbounded_nat_set_infinite path_nret_ex_all_cd[OF assms] by auto
	+
	+lemma path_nret_inf_icd_seq: assumes path: \<open>is_path \<pi>\<close> and nret: \<open>\<forall> i. \<pi> i \<noteq> return\<close>
	+obtains f where \<open>\<forall> i. f (Suc i) icd\<^bsup>\<pi>\<^esup>\<rightarrow> f i\<close> \<open>range f = {i. \<forall> j>i. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}\<close> \<open>\<not> (\<exists>i. f 0 cd\<^bsup>\<pi>\<^esup>\<rightarrow> i)\<close>
	+proof -
	+ note path_nret_inf_all_cd[OF assms]
	+ then obtain f where ran: \<open>range f = {j. \<forall> k>j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j}\<close> and asc: \<open>\<forall> i. f i < f (Suc i)\<close> using infinite_ascending by blast
	+ have mono: \<open>\<forall> i j. i < j \<longrightarrow> f i < f j\<close> using asc by (metis lift_Suc_mono_less)
	+ {
	+ fix i
	+ have cd: \<open>f (Suc i) cd\<^bsup>\<pi>\<^esup>\<rightarrow> f i\<close> using ran asc by auto
	+ have \<open>f (Suc i) icd\<^bsup>\<pi>\<^esup>\<rightarrow> f i\<close> proof (rule ccontr)
	+ assume \<open>\<not> f (Suc i) icd\<^bsup>\<pi>\<^esup>\<rightarrow> f i\<close>
	+ then obtain m where im: \<open>f i < m\<close> and mi: \<open> m < f (Suc i)\<close> and cdm: \<open>f (Suc i) cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> unfolding is_icdi_def using assms(1) cd by auto
	+ have \<open>\<forall> k>m. k cd\<^bsup>\<pi>\<^esup>\<rightarrow>m\<close> proof (rule,rule,cases)
	+ fix k assume \<open>f (Suc i) < k\<close>
	+ hence \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> f (Suc i)\<close> using ran by auto
	+ thus \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using cdm cd_trans by metis
	+ next
	+ fix k assume mk: \<open>m < k\<close> and \<open>\<not> f (Suc i) < k\<close>
	+ hence ik: \<open>k \<le> f (Suc i)\<close> by simp
	+ thus \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using cdm by (metis cdi_prefix mk)
	+ qed
	+ hence \<open>m \<in> range f\<close> using ran by blast
	+ then obtain j where m: \<open>m = f j\<close> by blast
	+ show \<open>False\<close> using im mi mono unfolding m by (metis Suc_lessI le_less not_le)
	+ qed
	+ }
	+ moreover
	+ {
	+ fix m
	+ assume cdm: \<open>f 0 cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close>
	+ have \<open>\<forall> k>m. k cd\<^bsup>\<pi>\<^esup>\<rightarrow>m\<close> proof (rule,rule,cases)
	+ fix k assume \<open>f 0 < k\<close>
	+ hence \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> f 0\<close> using ran by auto
	+ thus \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using cdm cd_trans by metis
	+ next
	+ fix k assume mk: \<open>m < k\<close> and \<open>\<not> f 0 < k\<close>
	+ hence ik: \<open>k \<le> f 0\<close> by simp
	+ thus \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using cdm by (metis cdi_prefix mk)
	+ qed
	+ hence \<open>m \<in> range f\<close> using ran by blast
	+ then obtain j where m: \<open>m = f j\<close> by blast
	+ hence fj0: \<open>f j < f 0\<close> using cdm m is_cdi_def by auto
	+ hence \<open>0 < j\<close> by (metis less_irrefl neq0_conv)
	+ hence \<open>False\<close> using fj0 mono by fastforce
	+ }
	+ ultimately show \<open>thesis\<close> using that ran by blast
	+qed
	+
	+lemma cdi_iff_no_strict_pd: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k \<longleftrightarrow> is_path \<pi> \<and> k < i \<and> \<pi> i \<noteq> return \<and> (\<forall> j \<in> {k..i}. \<not> (\<pi> k, \<pi> j) \<in> pdt)\<close>
	+proof
	+ assume cd:\<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ have 1: \<open>is_path \<pi> \<and> k < i \<and> \<pi> i \<noteq> return\<close> using cd unfolding is_cdi_def by auto
	+ have 2: \<open>\<forall> j \<in> {k..i}. \<not> (\<pi> k, \<pi> j) \<in> pdt\<close> proof (rule ccontr)
	+ assume \<open> \<not> (\<forall>j\<in>{k..i}. (\<pi> k, \<pi> j) \<notin> pdt)\<close>
	+ then obtain j where \<open>j \<in> {k..i}\<close> and \<open>(\<pi> k, \<pi> j) \<in> pdt\<close> by auto
	+ hence \<open>\<pi> j \<noteq> \<pi> k\<close> and \<open>\<pi> j pd\<rightarrow> \<pi> k\<close> unfolding pdt_def by auto
	+ thus \<open>False\<close> using path_pd_ipd by (metis \<open>j \<in> {k..i}\<close> atLeastAtMost_iff cd cd_not_pd cdi_prefix le_eq_less_or_eq)
	+ qed
	+ show \<open>is_path \<pi> \<and> k < i \<and> \<pi> i \<noteq> return \<and> (\<forall> j \<in> {k..i}. \<not> (\<pi> k, \<pi> j) \<in> pdt)\<close> using 1 2 by simp
	+next
	+ assume \<open>is_path \<pi> \<and> k < i \<and> \<pi> i \<noteq> return \<and> (\<forall> j \<in> {k..i}. \<not> (\<pi> k, \<pi> j) \<in> pdt)\<close>
	+ thus \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> by (metis ipd_in_pdt term_path_stable less_or_eq_imp_le not_cd_impl_ipd path_nodes)
	+qed
	+
	+
	+subsection \<open>Facts about Control Slices\<close>
	+
	+lemma last_cs: \<open>last (cs\<^bsup>\<pi>\<^esup> i) = \<pi> i\<close> by auto
	+
	+lemma cs_not_nil: \<open>cs\<^bsup>\<pi>\<^esup> n \<noteq> []\<close> by (auto)
	+
	+lemma cs_return: assumes \<open>\<pi> n = return\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> n = [\<pi> n]\<close> by (metis assms cs.elims icd_imp_cd ret_no_cd)
	+
	+lemma cs_0[simp]: \<open>cs\<^bsup>\<pi>\<^esup> 0 = [\<pi> 0]\<close> using is_icdi_def is_cdi_def by auto
	+
	+lemma cs_inj: assumes \<open>is_path \<pi>\<close> \<open>\<pi> n \<noteq> return\<close> \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>\<^esup> n'\<close> shows \<open>n = n'\<close>
	+using assms proof (induction \<open>cs\<^bsup>\<pi>\<^esup> n\<close> arbitrary: \<open>\<pi>\<close> \<open>n\<close> \<open>n'\<close> rule:rev_induct)
	+ case Nil hence \<open>False\<close> using cs_not_nil by metis thus \<open>?case\<close> by simp
	+next
	+ case (snoc x xs \<pi> n n') show \<open>?case\<close> proof (cases \<open>xs\<close>)
	+ case Nil
	+ hence *: \<open>\<not> (\<exists> k. n icd\<^bsup>\<pi>\<^esup>\<rightarrow>k)\<close> using snoc(2) cs_not_nil
	+ by (auto,metis append1_eq_conv append_Nil cs_not_nil)
	+ moreover
	+ have \<open>[x] = cs\<^bsup>\<pi>\<^esup> n'\<close> using Nil snoc by auto
	+ hence **: \<open>\<not> (\<exists> k. n' icd\<^bsup>\<pi>\<^esup>\<rightarrow>k)\<close> using cs_not_nil
	+ by (auto,metis append1_eq_conv append_Nil cs_not_nil)
	+ ultimately
	+ have \<open>\<forall> k. \<not> n cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>\<forall> k. \<not> n' cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> using excd_impl_exicd by auto blast+
	+ moreover
	+ hence \<open>\<pi> n = \<pi> n'\<close> using snoc(5,2) by auto (metis * ** list.inject)
	+ ultimately
	+ show \<open>n = n'\<close> using other_claim' snoc by blast
	+next
	+ case (Cons y ys)
	+ hence *: \<open>\<exists> k. n icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> using snoc(2) by auto (metis append_is_Nil_conv list.distinct(1) list.inject)
	+ then obtain k where k: \<open>n icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> by auto
	+ have \<open>k = (THE k . n icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close> using k by (metis icd_is_the_icd)
	+ hence xsk: \<open>xs = cs\<^bsup>\<pi>\<^esup> k\<close> using * k snoc(2) unfolding cs.simps[of \<open>\<pi>\<close> \<open>n\<close>] by auto
	+ have **: \<open>\<exists> k. n' icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> using snoc(2)[unfolded snoc(5)] by auto (metis Cons append1_eq_conv append_Nil list.distinct(1))
	+ then obtain k' where k': \<open>n' icd\<^bsup>\<pi>\<^esup>\<rightarrow> k'\<close> by auto
	+ hence \<open>k' = (THE k . n' icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close> using k' by (metis icd_is_the_icd)
	+ hence xsk': \<open>xs = cs\<^bsup>\<pi>\<^esup> k'\<close> using ** k' snoc(5,2) unfolding cs.simps[of \<open>\<pi>\<close> \<open>n'\<close>] by auto
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>\<^esup> k'\<close> using xsk by simp
	+ moreover
	+ have kn: \<open>k < n\<close> using k by (metis is_icdi_def is_cdi_def)
	+ hence \<open>\<pi> k \<noteq> return\<close> using snoc by (metis term_path_stable less_imp_le)
	+ ultimately
	+ have kk'[simp]: \<open>k' = k\<close> using snoc(1) xsk snoc(3) by metis
	+ have nk0: \<open>n - k icd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> 0\<close> \<open>n' - k icd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> 0\<close> using k k' icd_path_shift0 snoc(3) by auto
	+ moreover
	+ have nkr: \<open>(\<pi>\<guillemotleft>k)(n-k) \<noteq> return\<close> using snoc(4) kn by auto
	+ moreover
	+ have \<open>is_path (\<pi>\<guillemotleft>k)\<close> by (metis path_path_shift snoc.prems(1))
	+ moreover
	+ have kn': \<open>k < n'\<close> using k' kk' by (metis is_icdi_def is_cdi_def)
	+ have \<open>\<pi> n = \<pi> n'\<close> using snoc(5) * ** by auto
	+ hence \<open>(\<pi>\<guillemotleft>k)(n-k) = (\<pi>\<guillemotleft>k)(n'-k)\<close> using kn kn' by auto
	+ ultimately
	+ have \<open>n - k = n' - k\<close> using other_claim by auto
	+ thus \<open>n = n'\<close> using kn kn' by auto
	+qed
	+qed
	+
	+lemma cs_cases: fixes \<pi> i
	+obtains (base) \<open>cs\<^bsup>\<pi>\<^esup> i = [\<pi> i]\<close> and \<open>\<forall> k. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \|
	+(depend) k where \<open>cs\<^bsup>\<pi>\<^esup> i = (cs\<^bsup>\<pi>\<^esup> k)@[\<pi> i]\<close> and \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+proof cases
	+ assume *: \<open>\<exists> k. i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ then obtain k where k: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> ..
	+ hence \<open>k = (THE k. i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close> by (metis icd_is_the_icd)
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> i = (cs\<^bsup>\<pi>\<^esup> k)@[\<pi> i]\<close> using * by auto
	+ with k that show \<open>thesis\<close> by simp
	+next
	+ assume *: \<open>\<not> (\<exists> k. i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close>
	+ hence \<open>\<forall> k. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> by (metis excd_impl_exicd)
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>\<^esup> i = [\<pi> i]\<close> using * by auto
	+ ultimately
	+ show \<open>thesis\<close> using that by simp
	+qed
	+
	+lemma cs_length_one: assumes \<open>length (cs\<^bsup>\<pi>\<^esup> i) = 1\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> i = [\<pi> i]\<close> and \<open>\<forall> k. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ apply (cases \<open>i\<close> \<open>\<pi>\<close> rule: cs_cases)
	+ using assms cs_not_nil
	+ apply auto
	+ apply (cases \<open>i\<close> \<open>\<pi>\<close> rule: cs_cases)
	+ using assms cs_not_nil
	+ by auto
	+
	+lemma cs_length_g_one: assumes \<open>length (cs\<^bsup>\<pi>\<^esup> i) \<noteq> 1\<close> obtains k where \<open>cs\<^bsup>\<pi>\<^esup> i = (cs\<^bsup>\<pi>\<^esup> k)@[\<pi> i]\<close> and \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ apply (cases \<open>i\<close> \<open>\<pi>\<close> rule: cs_cases)
	+ using assms cs_not_nil by auto
	+
	+lemma claim: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and ii: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> and jj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close>
	+and bl: \<open>butlast (cs\<^bsup>\<pi>\<^esup> i) = butlast (cs\<^bsup>\<pi>\<^esup> j)\<close> and nret: \<open>\<pi> i \<noteq> return\<close> and ilj: \<open>i < j\<close>
	+shows \<open>i' < j'\<close>
	+proof (cases )
	+ assume *: \<open>length (cs\<^bsup>\<pi>\<^esup> i) = 1\<close>
	+ hence **: \<open>length (cs\<^bsup>\<pi>\<^esup> i) = 1\<close> \<open>length (cs\<^bsup>\<pi>\<^esup> j) = 1\<close> \<open>length (cs\<^bsup>\<pi>'\<^esup> i') = 1\<close> \<open>length (cs\<^bsup>\<pi>'\<^esup> j') = 1\<close>
	+ apply metis
	+ apply (metis "*" bl butlast.simps(2) butlast_snoc cs_length_g_one cs_length_one(1) cs_not_nil)
	+ apply (metis "*" ii)
	+ by (metis "*" bl butlast.simps(2) butlast_snoc cs_length_g_one cs_length_one(1) cs_not_nil jj)
	+ then obtain \<open>cs\<^bsup>\<pi>\<^esup> i = [\<pi> i]\<close> \<open>cs\<^bsup>\<pi>\<^esup> j = [\<pi> j]\<close> \<open>cs\<^bsup>\<pi>'\<^esup> j' = [\<pi>' j']\<close> \<open>cs\<^bsup>\<pi>'\<^esup> i'= [\<pi>' i']\<close>
	+ \<open>\<forall> k. \<not> j cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>\<forall> k. \<not> i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k\<close> \<open>\<forall> k. \<not> j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k\<close>
	+ by (metis cs_length_one ** )
	+ moreover
	+ hence \<open>\<pi> i = \<pi>' i'\<close> \<open>\<pi> j = \<pi>' j'\<close> using assms by auto
	+ ultimately
	+ show \<open>i' < j'\<close> using nret ilj path claim'' by blast
	+next
	+ assume *: \<open>length (cs\<^bsup>\<pi>\<^esup> i) \<noteq> 1\<close>
	+ hence **: \<open>length (cs\<^bsup>\<pi>\<^esup> i) \<noteq> 1\<close> \<open>length (cs\<^bsup>\<pi>\<^esup> j) \<noteq> 1\<close> \<open>length (cs\<^bsup>\<pi>'\<^esup> i') \<noteq> 1\<close> \<open>length (cs\<^bsup>\<pi>'\<^esup> j') \<noteq> 1\<close>
	+ apply metis
	+ apply (metis "*" bl butlast.simps(2) butlast_snoc cs_length_g_one cs_length_one(1) cs_not_nil)
	+ apply (metis "*" ii)
	+ by (metis "*" bl butlast.simps(2) butlast_snoc cs_length_g_one cs_length_one(1) cs_not_nil jj)
	+ obtain k l k' l' where ***:
	+ \<open>cs\<^bsup>\<pi>\<^esup> i = (cs\<^bsup>\<pi>\<^esup> k)@[\<pi> i]\<close> \<open>cs\<^bsup>\<pi>\<^esup> j = (cs\<^bsup>\<pi>\<^esup> l)@[\<pi> j]\<close> \<open>cs\<^bsup>\<pi>'\<^esup> i' = (cs\<^bsup>\<pi>'\<^esup> k')@[\<pi>' i']\<close> \<open>cs\<^bsup>\<pi>'\<^esup> j' = (cs\<^bsup>\<pi>'\<^esup> l')@[\<pi>' j']\<close> and
	+ icds: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>j icd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> \<open>i' icd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> \<open>j' icd\<^bsup>\<pi>'\<^esup>\<rightarrow> l'\<close>
	+ by (metis ** cs_length_g_one)
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>\<^esup> l\<close> \<open>cs\<^bsup>\<pi>'\<^esup> k' = cs\<^bsup>\<pi>'\<^esup> l'\<close> using assms by auto
	+ moreover
	+ have \<open>\<pi> k \<noteq> return\<close> \<open>\<pi>' k' \<noteq> return\<close> using nret
	+ apply (metis is_icdi_def icds(1) is_cdi_def term_path_stable less_imp_le)
	+ by (metis is_cdi_def is_icdi_def icds(3) term_path_stable less_imp_le)
	+ ultimately
	+ have lk[simp]: \<open>l = k\<close> \<open>l' = k'\<close> using path cs_inj by auto
	+ let \<open>?\<pi>\<close> = \<open>\<pi> \<guillemotleft> k\<close>
	+ let \<open>?\<pi>'\<close> = \<open>\<pi>'\<guillemotleft>k'\<close>
	+ have \<open>i-k icd\<^bsup>?\<pi>\<^esup>\<rightarrow> 0\<close> \<open>j-k icd\<^bsup>?\<pi>\<^esup>\<rightarrow> 0\<close> \<open>i'-k' icd\<^bsup>?\<pi>'\<^esup>\<rightarrow> 0\<close> \<open>j'-k' icd\<^bsup>?\<pi>'\<^esup>\<rightarrow> 0\<close> using icd_path_shift0 path icds by auto
	+ moreover
	+ have ki: \<open>k < i\<close> using icds by (metis is_icdi_def is_cdi_def)
	+ hence \<open>i-k < j-k\<close> by (metis diff_is_0_eq diff_less_mono ilj nat_le_linear order.strict_trans)
	+ moreover
	+ have \<pi>i: \<open>\<pi> i = \<pi>' i'\<close> \<open>\<pi> j = \<pi>' j'\<close> using assms *** by auto
	+ have \<open>k' < i'\<close> \<open>k' < j'\<close> using icds unfolding lk by (metis is_cdi_def is_icdi_def)+
	+ hence \<open>?\<pi> (i-k) = ?\<pi>' (i'-k')\<close> \<open>?\<pi> (j-k) = ?\<pi>' (j'-k')\<close> using \<pi>i ki ilj by auto
	+ moreover
	+ have \<open>?\<pi> (i-k) \<noteq> return\<close> using nret ki by auto
	+ moreover
	+ have \<open>is_path ?\<pi>\<close> \<open>is_path ?\<pi>'\<close> using path path_path_shift by auto
	+ ultimately
	+ have \<open>i'-k' < j' - k'\<close> using claim' by blast
	+ thus \<open>i' < j'\<close> by (metis diff_is_0_eq diff_less_mono less_nat_zero_code linorder_neqE_nat nat_le_linear)
	+qed
	+
	+lemma cs_split': assumes \<open>cs\<^bsup>\<pi>\<^esup> i = xs@[x,x']@ys\<close> shows \<open>\<exists> m. cs\<^bsup>\<pi>\<^esup> m = xs@[x] \<and> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close>
	+using assms proof (induction \<open>ys\<close> arbitrary: \<open>i\<close> rule:rev_induct )
	+ case (snoc y ys)
	+ hence \<open>length (cs\<^bsup>\<pi>\<^esup> i) \<noteq> 1\<close> by auto
	+ then obtain i' where \<open>cs\<^bsup>\<pi>\<^esup> i = (cs\<^bsup>\<pi>\<^esup> i') @ [\<pi> i]\<close> and *: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> i'\<close> using cs_length_g_one[of \<open>\<pi>\<close> \<open>i\<close>] by metis
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> i' = xs@[x,x']@ys\<close> using snoc(2) by (metis append1_eq_conv append_assoc)
	+ then obtain m where **: \<open>cs\<^bsup>\<pi>\<^esup> m = xs @ [x]\<close> and \<open>i' cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using snoc(1) by blast
	+ hence \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using * cd_trans by (metis is_icdi_def)
	+ with ** show \<open>?case\<close> by blast
	+next
	+ case Nil
	+ hence \<open>length (cs\<^bsup>\<pi>\<^esup> i) \<noteq> 1\<close> by auto
	+ then obtain i' where a: \<open>cs\<^bsup>\<pi>\<^esup> i = (cs\<^bsup>\<pi>\<^esup> i') @ [\<pi> i]\<close> and *: \<open>i icd\<^bsup>\<pi>\<^esup>\<rightarrow> i'\<close> using cs_length_g_one[of \<open>\<pi>\<close> \<open>i\<close>] by metis
	+ have \<open>cs\<^bsup>\<pi>\<^esup> i = (xs@[x])@[x']\<close> using Nil by auto
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> i' = xs@[x]\<close> using append1_eq_conv a by metis
	+ thus \<open>?case\<close> using * unfolding is_icdi_def by blast
	+qed
	+
	+lemma cs_split: assumes \<open>cs\<^bsup>\<pi>\<^esup> i = xs@[x]@ys@[\<pi> i]\<close> shows \<open>\<exists> m. cs\<^bsup>\<pi>\<^esup> m = xs@[x] \<and> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> proof -
	+ obtain x' ys' where \<open>ys@[\<pi> i] = [x']@ys'\<close> by (metis append_Cons append_Nil neq_Nil_conv)
	+ thus \<open>?thesis\<close> using cs_split'[of \<open>\<pi>\<close> \<open>i\<close> \<open>xs\<close> \<open>x\<close> \<open>x'\<close> \<open>ys'\<close>] assms by auto
	+qed
	+
	+lemma cs_less_split: assumes \<open>xs \<prec> ys\<close> obtains a as where \<open>ys = xs@a#as\<close>
	+ using assms unfolding cs_less.simps apply auto
	+by (metis Cons_nth_drop_Suc append_take_drop_id)
	+
	+lemma cs_select_is_cs: assumes \<open>is_path \<pi>\<close> \<open>xs \<noteq> Nil\<close> \<open>xs \<prec> cs\<^bsup>\<pi>\<^esup> k\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> (\<pi>\<exclamdown>xs) = xs\<close> \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> (\<pi>\<exclamdown>xs)\<close>proof -
	+ obtain b bs where b: \<open>cs\<^bsup>\<pi>\<^esup> k = xs@b#bs\<close> using assms cs_less_split by blast
	+ obtain a as where a: \<open>xs = as@[a]\<close> using assms by (metis rev_exhaust)
	+ have \<open>cs\<^bsup>\<pi>\<^esup> k = as@[a,b]@bs\<close> using a b by auto
	+ then obtain k' where csk: \<open>cs\<^bsup>\<pi>\<^esup> k' = xs\<close> and is_cd: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> k'\<close> using cs_split' a by blast
	+ hence nret: \<open>\<pi> k' \<noteq> return\<close> by (metis is_cdi_def term_path_stable less_imp_le)
	+ show a: \<open>cs\<^bsup>\<pi>\<^esup> (\<pi>\<exclamdown>xs) = xs\<close> unfolding cs_select_def using cs_inj[OF assms(1) nret] csk the_equality[of _ \<open>k'\<close>]
	+ by (metis (mono_tags))
	+ show \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> (\<pi>\<exclamdown>xs)\<close> unfolding cs_select_def by (metis a assms(1) cs_inj cs_select_def csk is_cd nret)
	+qed
	+
	+lemma cd_in_cs: assumes \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> shows \<open>\<exists> ns. cs\<^bsup>\<pi>\<^esup> n = (cs\<^bsup>\<pi>\<^esup> m) @ ns @[\<pi> n]\<close>
	+using assms proof (induction rule: cd_induct)
	+ case (base n) thus \<open>?case\<close> by (metis append_Nil cs.simps icd_is_the_icd)
	+next
	+ case (IS k n)
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>\<^esup> k @ [\<pi> n]\<close> by (metis cs.simps icd_is_the_icd)
	+ thus \<open>?case\<close> using IS by force
	+qed
	+
	+lemma butlast_cs_not_cd: assumes \<open>butlast (cs\<^bsup>\<pi>\<^esup> m) = butlast (cs\<^bsup>\<pi>\<^esup> n)\<close> shows \<open>\<not> m cd\<^bsup>\<pi>\<^esup>\<rightarrow>n\<close>
	+by (metis append_Cons append_Nil append_assoc assms cd_in_cs cs_not_nil list.distinct(1) self_append_conv snoc_eq_iff_butlast)
	+
	+lemma wn_cs_butlast: assumes \<open>butlast (cs\<^bsup>\<pi>\<^esup> m) = butlast (cs\<^bsup>\<pi>\<^esup> n)\<close> \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> \<open>m<n\<close> shows \<open>i<j\<close>
	+proof (rule ccontr)
	+ assume \<open>\<not> i < j\<close>
	+ moreover
	+ have \<open>\<not> n cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> by (metis assms(1) butlast_cs_not_cd)
	+ ultimately
	+ have \<open>n \<le> m\<close> using assms(2,3) cr_wn'' by auto
	+ thus \<open>False\<close> using assms(4) by auto
	+qed
	+
	+
	+text \<open>This is the central theorem making the control slice suitable for matching indices between executions.\<close>
	+
	+theorem cs_order: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and csi: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+and csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> and nret: \<open>\<pi> i \<noteq> return\<close> and ilj: \<open>i < j\<close>
	+shows \<open>i'<j'\<close>
	+proof -
	+ have \<open>cs\<^bsup>\<pi>\<^esup> i \<noteq> cs\<^bsup>\<pi>\<^esup> j\<close> using cs_inj[OF path(1) nret] ilj by blast
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>\<^esup> i \<noteq> Nil\<close> \<open>cs\<^bsup>\<pi>\<^esup> j \<noteq> Nil\<close> by (metis cs_not_nil)+
	+ ultimately show \<open>?thesis\<close> proof (cases rule: list_neq_prefix_cases)
	+ case (diverge xs x x' ys ys')
	+ note csx = \<open>cs\<^bsup>\<pi>\<^esup> i = xs @ [x] @ ys\<close>
	+ note csx' = \<open>cs\<^bsup>\<pi>\<^esup> j = xs @ [x'] @ ys'\<close>
	+ note xx = \<open>x \<noteq> x'\<close>
	+ show \<open>i' < j'\<close> proof (cases \<open>ys\<close>)
	+ assume ys: \<open>ys = Nil\<close>
	+ show \<open>?thesis\<close> proof (cases \<open>ys'\<close>)
	+ assume ys': \<open>ys' = Nil\<close>
	+ have cs: \<open>cs\<^bsup>\<pi>\<^esup> i = xs @ [x]\<close> \<open>cs\<^bsup>\<pi>\<^esup> j = xs @ [x']\<close> by (metis append_Nil2 csx ys, metis append_Nil2 csx' ys')
	+ hence bl: \<open>butlast (cs\<^bsup>\<pi>\<^esup> i) = butlast (cs\<^bsup>\<pi>\<^esup> j)\<close> by auto
	+ show \<open>i' < j'\<close> using claim[OF path csi csj bl nret ilj] .
	+ next
	+ fix y' zs'
	+ assume ys': \<open>ys' = y'#zs'\<close>
	+ have cs: \<open>cs\<^bsup>\<pi>\<^esup> i = xs @ [x]\<close> \<open>cs\<^bsup>\<pi>\<^esup> j = xs @ [x',y']@ zs'\<close> by (metis append_Nil2 csx ys, metis append_Cons append_Nil csx' ys')
	+ obtain n where n: \<open>cs\<^bsup>\<pi>\<^esup> n = xs@[x']\<close> and jn: \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> using cs cs_split' by blast
	+ obtain n' where n': \<open>cs\<^bsup>\<pi>'\<^esup> n' = xs@[x']\<close> and jn': \<open>j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> using cs cs_split' unfolding csj by blast
	+ have csn : \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and bl: \<open>butlast (cs\<^bsup>\<pi>\<^esup> i) = butlast (cs\<^bsup>\<pi>\<^esup> n)\<close> using n n' cs by auto
	+ hence bl': \<open>butlast (cs\<^bsup>\<pi>'\<^esup> i') = butlast (cs\<^bsup>\<pi>'\<^esup> n')\<close> using csi by auto
	+ have notcd: \<open>\<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> by (metis butlast_cs_not_cd bl)
	+ have nin: \<open>i \<noteq> n\<close> using cs n xx by auto
	+ have iln: \<open>i < n\<close> apply (rule ccontr) using cr_wn'[OF jn notcd] nin ilj by auto
	+ note claim[OF path csi csn bl nret iln]
	+ hence \<open>i' < n'\<close> .
	+ thus \<open>i' < j'\<close> using jn' unfolding is_cdi_def by auto
	+ qed
	+ next
	+ fix y zs
	+ assume ys: \<open>ys = y#zs\<close>
	+ show \<open>?thesis\<close> proof (cases \<open>ys'\<close>)
	+ assume ys' : \<open>ys' = Nil\<close>
	+ have cs: \<open>cs\<^bsup>\<pi>\<^esup> i = xs @ [x,y]@zs\<close> \<open>cs\<^bsup>\<pi>\<^esup> j = xs @ [x']\<close> by (metis append_Cons append_Nil csx ys, metis append_Nil2 csx' ys')
	+ obtain n where n: \<open>cs\<^bsup>\<pi>\<^esup> n = xs@[x]\<close> and jn: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> using cs cs_split' by blast
	+ obtain n' where n': \<open>cs\<^bsup>\<pi>'\<^esup> n' = xs@[x]\<close> and jn': \<open>i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> using cs cs_split' unfolding csi by blast
	+ have csn : \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and bl: \<open>butlast (cs\<^bsup>\<pi>\<^esup> n) = butlast (cs\<^bsup>\<pi>\<^esup> j)\<close> using n n' cs by auto
	+ hence bl': \<open>butlast (cs\<^bsup>\<pi>'\<^esup> j') = butlast (cs\<^bsup>\<pi>'\<^esup> n')\<close> using csj by auto
	+ have notcd: \<open>\<not> j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> by (metis butlast_cs_not_cd bl')
	+ have nin: \<open>n < i\<close> using jn unfolding is_cdi_def by auto
	+ have nlj: \<open>n < j\<close> using nin ilj by auto
	+ note claim[OF path csn csj bl _ nlj]
	+ hence nj': \<open>n' < j'\<close> using term_path_stable[OF path(1) _] less_imp_le nin nret by auto
	+ show \<open>i' < j'\<close> apply(rule ccontr) using cdi_prefix[OF jn' nj'] notcd by auto
	+ next
	+ fix y' zs'
	+ assume ys' : \<open>ys' = y'#zs'\<close>
	+ have cs: \<open>cs\<^bsup>\<pi>\<^esup> i = xs@[x,y]@zs\<close> \<open>cs\<^bsup>\<pi>\<^esup> j = xs@[x',y']@zs'\<close> by (metis append_Cons append_Nil csx ys,metis append_Cons append_Nil csx' ys')
	+ have neq: \<open>cs\<^bsup>\<pi>\<^esup> i \<noteq> cs\<^bsup>\<pi>\<^esup> j\<close> using cs_inj path nret ilj by blast
	+ obtain m where m: \<open>cs\<^bsup>\<pi>\<^esup> m = xs@[x]\<close> and im: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using cs cs_split' by blast
	+ obtain n where n: \<open>cs\<^bsup>\<pi>\<^esup> n = xs@[x']\<close> and jn: \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> using cs cs_split' by blast
	+ obtain m' where m': \<open>cs\<^bsup>\<pi>'\<^esup> m' = xs@[x]\<close> and im': \<open>i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> m'\<close> using cs cs_split' unfolding csi by blast
	+ obtain n' where n': \<open>cs\<^bsup>\<pi>'\<^esup> n' = xs@[x']\<close> and jn': \<open>j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> using cs cs_split' unfolding csj by blast
	+ have \<open>m \<le> n\<close> using ilj m n wn_cs_butlast[OF _ jn im] by force
	+ moreover
	+ have \<open>m \<noteq> n\<close> using m n xx by (metis last_snoc)
	+ ultimately
	+ have mn: \<open>m < n\<close> by auto
	+ moreover
	+ have \<open>\<pi> m \<noteq> return\<close> by (metis last_cs last_snoc m mn n path(1) term_path_stable xx less_imp_le)
	+ moreover
	+ have \<open>butlast (cs\<^bsup>\<pi>\<^esup> m) = butlast (cs\<^bsup>\<pi>\<^esup> n)\<close> \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close> \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> using m n n' m' by auto
	+ ultimately
	+ have \<open>m' < n'\<close> using claim path by blast
	+ thus \<open>i' < j'\<close> using m' n' im' jn' wn_cs_butlast by (metis butlast_snoc)
	+ qed
	+ qed
	+ next
	+ case (prefix1 xs)
	+ note pfx = \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>\<^esup> j @ xs\<close>
	+ note xs = \<open>xs \<noteq> []\<close>
	+ obtain a as where \<open>xs = a#as\<close> using xs by (metis list.exhaust)
	+ moreover
	+ obtain bs b where bj: \<open>cs\<^bsup>\<pi>\<^esup> j = bs@[b]\<close> using cs_not_nil by (metis rev_exhaust)
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>\<^esup> i = bs@[b,a]@as\<close> using pfx by auto
	+ then obtain m where \<open>cs\<^bsup>\<pi>\<^esup> m = bs@[b]\<close> and cdep: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> m\<close> using cs_split' by blast
	+ hence mi: \<open>m = j\<close> using bj cs_inj by (metis is_cdi_def term_path_stable less_imp_le)
	+ hence \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using cdep by auto
	+ hence \<open>False\<close> using ilj unfolding is_cdi_def by auto
	+ thus \<open>i' < j'\<close> ..
	+ next
	+ case (prefix2 xs)
	+ have pfx : \<open>cs\<^bsup>\<pi>'\<^esup> i' @ xs = cs\<^bsup>\<pi>'\<^esup> j'\<close> using prefix2 csi csj by auto
	+ note xs = \<open>xs \<noteq> []\<close>
	+ obtain a as where \<open>xs = a#as\<close> using xs by (metis list.exhaust)
	+ moreover
	+ obtain bs b where bj: \<open>cs\<^bsup>\<pi>'\<^esup> i' = bs@[b]\<close> using cs_not_nil by (metis rev_exhaust)
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>'\<^esup> j' = bs@[b,a]@as\<close> using pfx by auto
	+ then obtain m where \<open>cs\<^bsup>\<pi>'\<^esup> m = bs@[b]\<close> and cdep: \<open>j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> m\<close> using cs_split' by blast
	+ hence mi: \<open>m = i'\<close> using bj cs_inj by (metis is_cdi_def term_path_stable less_imp_le)
	+ hence \<open>j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i'\<close> using cdep by auto
	+ thus \<open>i' < j'\<close> unfolding is_cdi_def by auto
	+ qed
	+qed
	+
	+lemma cs_order_le: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and csi: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+and csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> and nret: \<open>\<pi> i \<noteq> return\<close> and ilj: \<open>i \<le> j\<close>
	+shows \<open>i'\<le>j'\<close> proof cases
	+ assume \<open>i < j\<close> with cs_order[OF assms(1,2,3,4,5)] show \<open>?thesis\<close> by simp
	+next
	+ assume \<open>\<not> i < j\<close>
	+ hence \<open>i = j\<close> using ilj by simp
	+ hence csij: \<open>cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>'\<^esup> j'\<close> using csi csj by simp
	+ have nret': \<open>\<pi>' i' \<noteq> return\<close> using nret last_cs csi by metis
	+ show \<open>?thesis\<close> using cs_inj[OF path(2) nret' csij] by simp
	+qed
	+
	+lemmas cs_induct[case_names cs] = cs.induct
	+
	+lemma icdi_path_swap: assumes \<open>is_path \<pi>'\<close> \<open>j icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> \<open>\<pi> =\<^bsub>j\<^esub> \<pi>'\<close> shows \<open>j icd\<^bsup>\<pi>'\<^esup>\<rightarrow>k\<close> using assms unfolding eq_up_to_def is_icdi_def is_cdi_def by auto
	+
	+lemma icdi_path_swap_le: assumes \<open>is_path \<pi>'\<close> \<open>j icd\<^bsup>\<pi>\<^esup>\<rightarrow>k\<close> \<open>\<pi> =\<^bsub>n\<^esub> \<pi>'\<close> \<open>j \<le> n\<close> shows \<open>j icd\<^bsup>\<pi>'\<^esup>\<rightarrow>k\<close> by (metis assms icdi_path_swap eq_up_to_le)
	+
	+lemma cs_path_swap: assumes \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> \<open>\<pi> =\<^bsub>k\<^esub> \<pi>'\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k\<close> using assms(1,3) proof (induction \<open>\<pi>\<close> \<open>k\<close> rule:cs_induct,cases)
	+ case (cs \<pi> k)
	+ let \<open>?l\<close> = \<open>(THE l. k icd\<^bsup>\<pi>\<^esup>\<rightarrow> l)\<close>
	+ assume *: \<open>\<exists>l. k icd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close>
	+ have kicd: \<open>k icd\<^bsup>\<pi>\<^esup>\<rightarrow> ?l\<close> by (metis "*" icd_is_the_icd)
	+ hence \<open>?l < k\<close> unfolding is_cdi_def[of \<open>k\<close> \<open>\<pi>\<close> \<open>?l\<close>] is_icdi_def[of \<open>k\<close> \<open>\<pi>\<close> \<open>?l\<close>] by auto
	+ hence \<open>\<forall> i\<le>?l. \<pi> i = \<pi>' i\<close> using cs(2,3) unfolding eq_up_to_def by auto
	+ hence csl: \<open>cs\<^bsup>\<pi>\<^esup> ?l = cs\<^bsup>\<pi>'\<^esup> ?l\<close> using cs(1,2) * unfolding eq_up_to_def by auto
	+ have kicd: \<open>k icd\<^bsup>\<pi>\<^esup>\<rightarrow> ?l\<close> by (metis "*" icd_is_the_icd)
	+ hence csk: \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>\<^esup> ?l @ [\<pi> k]\<close> using kicd by auto
	+ have kicd': \<open>k icd\<^bsup>\<pi>'\<^esup>\<rightarrow> ?l\<close> using kicd icdi_path_swap[OF assms(2) _ cs(3)] by simp
	+ hence \<open>?l = (THE l. k icd\<^bsup>\<pi>'\<^esup>\<rightarrow> l)\<close> by (metis icd_is_the_icd)
	+ hence csk': \<open>cs\<^bsup>\<pi>'\<^esup> k = cs\<^bsup>\<pi>'\<^esup> ?l @ [\<pi>' k]\<close> using kicd' by auto
	+ have \<open>\<pi>' k = \<pi> k\<close> using cs(3) unfolding eq_up_to_def by auto
	+ with csl csk csk'
	+ show \<open>?case\<close> by auto
	+next
	+ case (cs \<pi> k)
	+ assume *: \<open>\<not> (\<exists>l. k icd\<^bsup>\<pi>\<^esup>\<rightarrow> l)\<close>
	+ hence csk: \<open>cs\<^bsup>\<pi>\<^esup> k = [\<pi> k]\<close> by auto
	+ have \<open>\<not> (\<exists>l. k icd\<^bsup>\<pi>'\<^esup>\<rightarrow> l)\<close> apply (rule ccontr) using * icdi_path_swap_le[OF cs(2) _, of \<open>k\<close> \<open>\<pi>'\<close>] cs(3) by (metis eq_up_to_sym le_refl)
	+ hence csk': \<open>cs\<^bsup>\<pi>'\<^esup> k = [\<pi>' k]\<close> by auto
	+ with csk show \<open>?case\<close> using cs(3) eq_up_to_apply by auto
	+qed
	+
	+lemma cs_path_swap_le: assumes \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> \<open>\<pi> =\<^bsub>n\<^esub> \<pi>'\<close> \<open>k \<le> n\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k\<close> by (metis assms cs_path_swap eq_up_to_le)
	+
	+lemma cs_path_swap_cd: assumes \<open>is_path \<pi>\<close> and \<open>is_path \<pi>'\<close> and \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+obtains k' where \<open>n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> and \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close>
	+proof -
	+ from cd_in_cs[OF assms(4)]
	+ obtain ns where *: \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>\<^esup> k @ ns @ [\<pi> n]\<close> by blast
	+ obtain xs x where csk: \<open>cs\<^bsup>\<pi>\<^esup> k = xs @ [x]\<close> by (metis cs_not_nil rev_exhaust)
	+ have \<open>\<pi> n = \<pi>' n'\<close> using assms(3) last_cs by metis
	+ hence *: \<open>cs\<^bsup>\<pi>'\<^esup> n' = xs@[x]@ns@[\<pi>' n']\<close> using assms(3) csk by auto
	+ from cs_split[OF **]
	+ obtain k' where \<open>cs\<^bsup>\<pi>'\<^esup> k' = xs @ [x]\<close> \<open>n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> by blast
	+ thus \<open>thesis\<close> using that csk by auto
	+qed
	+
	+lemma path_ipd_swap: assumes \<open>is_path \<pi>\<close> \<open>\<pi> k \<noteq> return\<close> \<open>k < n\<close>
	+obtains \<pi>' m where \<open>is_path \<pi>'\<close> \<open>\<pi> =\<^bsub>n\<^esub> \<pi>'\<close> \<open>k < m\<close> \<open>\<pi>' m = ipd (\<pi>' k)\<close> \<open>\<forall> l \<in> {k..<m}. \<pi>' l \<noteq> ipd (\<pi>' k)\<close>
	+proof -
	+ obtain \<pi>' r where *: \<open>\<pi>' 0 = \<pi> n\<close> \<open>is_path \<pi>'\<close> \<open>\<pi>' r = return\<close> by (metis assms(1) path_nodes reaching_ret)
	+ let \<open>?\<pi>\<close> = \<open>\<pi>@\<^bsup>n\<^esup> \<pi>'\<close>
	+ have path: \<open>is_path ?\<pi>\<close> and ret: \<open>?\<pi> (n + r) = return\<close> and equpto: \<open>?\<pi> =\<^bsub>n\<^esub> \<pi>\<close> using assms path_cons * path_append_eq_up_to by auto
	+ have \<pi>k: \<open>?\<pi> k = \<pi> k\<close> by (metis assms(3) less_imp_le_nat path_append_def)
	+ obtain j where j: \<open>k < j \<and> j \<le> (n + r) \<and> ?\<pi> j = ipd (\<pi> k)\<close> (is \<open>?P j\<close> )by (metis \<pi>k assms(2) path path_ret_ipd ret)
	+ define m where m: \<open>m \<equiv> LEAST m . ?P m\<close>
	+ have Pm: \<open>?P m\<close> using LeastI[of \<open>?P\<close> \<open>j\<close>] j m by auto
	+ hence km: \<open>k < m\<close> \<open>m \<le> (n + r)\<close> \<open>?\<pi> m = ipd (\<pi> k)\<close> by auto
	+ have le: \<open>\<And>l. ?P l \<Longrightarrow> m \<le> l\<close> using Least_le[of \<open>?P\<close>] m by blast
	+ have \<pi>knipd: \<open>?\<pi> k \<noteq> ipd (\<pi> k)\<close> by (metis \<pi>k assms(1) assms(2) ipd_not_self path_nodes)
	+ have nipd': \<open>\<And>l. k < l \<Longrightarrow> l < m \<Longrightarrow> ?\<pi> l \<noteq> ipd (\<pi> k)\<close> apply (rule ccontr) using le km(2) by force
	+ have \<open>\<forall> l \<in> {k..<m}. ?\<pi> l \<noteq> ipd(\<pi> k)\<close> using \<pi>knipd nipd' by(auto, metis le_eq_less_or_eq,metis le_eq_less_or_eq)
	+ thus \<open>thesis\<close> using that by (metis \<pi>k eq_up_to_sym km(1) km(3) path path_append_eq_up_to)
	+qed
	+
	+lemma cs_sorted_list_of_cd': \<open>cs\<^bsup>\<pi>\<^esup> k = map \<pi> (sorted_list_of_set { i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}) @ [\<pi> k]\<close>
	+proof (induction \<open>\<pi>\<close> \<open>k\<close> rule: cs.induct, cases)
	+ case (1 \<pi> k)
	+ assume \<open>\<exists> j. k icd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close>
	+ then guess j ..
	+ note j = this
	+ hence csj: \<open>cs\<^bsup>\<pi>\<^esup> j = map \<pi> (sorted_list_of_set {i. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}) @ [\<pi> j]\<close> by (metis "1.IH" icd_is_the_icd)
	+ have \<open>{i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} = insert j {i. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}\<close> using cdi_is_cd_icdi[OF j] by auto
	+ moreover
	+ have f: \<open>finite {i. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}\<close> unfolding is_cdi_def by auto
	+ moreover
	+ have \<open>j \<notin> {i. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}\<close> unfolding is_cdi_def by auto
	+ ultimately
	+ have \<open>sorted_list_of_set { i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} = insort j (sorted_list_of_set { i . j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i})\<close> using sorted_list_of_set_insert by auto
	+ moreover
	+ have \<open>\<forall> x \<in> {i. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}. x < j\<close> unfolding is_cdi_def by auto
	+ hence \<open>\<forall> x \<in> set (sorted_list_of_set {i. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}). x < j\<close> by (simp add: f)
	+ ultimately
	+ have \<open>sorted_list_of_set { i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} = (sorted_list_of_set { i . j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i})@[j]\<close> using insort_greater by auto
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> j = map \<pi> (sorted_list_of_set { i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i})\<close> using csj by auto
	+ thus \<open>?case\<close> by (metis icd_cs j)
	+next
	+ case (1 \<pi> k)
	+ assume *: \<open>\<not> (\<exists> j. k icd\<^bsup>\<pi>\<^esup>\<rightarrow> j)\<close>
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> k = [\<pi> k]\<close> by (metis cs_cases)
	+ moreover
	+ have \<open>{ i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} = {}\<close> by (auto, metis * excd_impl_exicd)
	+ ultimately
	+ show \<open>?case\<close> by (metis append_Nil list.simps(8) sorted_list_of_set_empty)
	+qed
	+
	+lemma cs_sorted_list_of_cd: \<open>cs\<^bsup>\<pi>\<^esup> k = map \<pi> (sorted_list_of_set ({ i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {k}))\<close> proof -
	+ have le: \<open>\<forall> x \<in> {i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow>i}.\<forall> y \<in> {k}. x < y\<close> unfolding is_cdi_def by auto
	+ have fin: \<open>finite {i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow>i}\<close> \<open>finite {k}\<close> unfolding is_cdi_def by auto
	+ show \<open>?thesis\<close> unfolding cs_sorted_list_of_cd'[of \<open>\<pi>\<close> \<open>k\<close>] sorted_list_of_set_append[OF fin le] by auto
	+qed
	+
	+lemma cs_not_ipd: assumes \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> ipd (\<pi> k)\<close> (is \<open>?Q j\<close>)
	+shows \<open>cs\<^bsup>\<pi>\<^esup> (GREATEST j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> ipd (\<pi> k)) = [n\<leftarrow>cs\<^bsup>\<pi>\<^esup> k . ipd n \<noteq> ipd (\<pi> k)]\<close>
	+(is \<open>cs\<^bsup>\<pi>\<^esup> ?j = filter ?P _\<close>)
	+proof -
	+ have csk: \<open>cs\<^bsup>\<pi>\<^esup> k = map \<pi> (sorted_list_of_set ({ i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i } \<union> {k}))\<close> by (metis cs_sorted_list_of_cd)
	+ have csj: \<open>cs\<^bsup>\<pi>\<^esup> ?j = map \<pi> (sorted_list_of_set ({i. ?j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i } \<union> {?j}))\<close> by (metis cs_sorted_list_of_cd)
	+
	+ have bound: \<open>\<forall> j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> ipd(\<pi> k) \<longrightarrow> j \<le> k\<close> unfolding is_cdi_def by simp
	+
	+ have kcdj: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> ?j\<close> and ipd': \<open>ipd (\<pi> ?j) \<noteq> ipd(\<pi> k)\<close> using GreatestI_nat[of \<open>?Q\<close> \<open>j\<close> \<open>k\<close>, OF assms] bound by auto
	+
	+ have greatest: \<open>\<And> j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<Longrightarrow> ipd (\<pi> j) \<noteq> ipd (\<pi> k) \<Longrightarrow> j \<le> ?j\<close> using Greatest_le_nat[of \<open>?Q\<close> _ \<open>k\<close>] bound by auto
	+ have less_not_ipdk: \<open>\<And> j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<Longrightarrow> j < ?j \<Longrightarrow> ipd (\<pi> j) \<noteq> ipd (\<pi> k)\<close> by (metis (lifting) ipd' kcdj same_ipd_stable)
	+ hence le_not_ipdk: \<open>\<And> j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<Longrightarrow> j \<le> ?j \<Longrightarrow> ipd (\<pi> j) \<noteq> ipd (\<pi> k)\<close> using kcdj ipd' by (case_tac \<open>j = ?j\<close>,auto)
	+ have *: \<open>{j \<in> {i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow>i} \<union> {k}. ?P (\<pi> j)} = insert ?j { i . ?j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<close>
	+ apply auto
	+ apply (metis (lifting, no_types) greatest cr_wn'' kcdj le_antisym le_refl)
	+ apply (metis kcdj)
	+ apply (metis ipd')
	+ apply (metis (full_types) cd_trans kcdj)
	+ apply (subgoal_tac \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> x\<close>)
	+ apply (metis (lifting, no_types) is_cdi_def less_not_ipdk)
	+ by (metis (full_types) cd_trans kcdj)
	+ have \<open>finite ({i . k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {k})\<close> unfolding is_cdi_def by auto
	+ note filter_sorted_list_of_set[OF this, of \<open>?P o \<pi>\<close>]
	+ hence \<open>[n\<leftarrow>cs\<^bsup>\<pi>\<^esup> k . ipd n \<noteq> ipd(\<pi> k)] = map \<pi> (sorted_list_of_set {j \<in> {i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow>i} \<union> {k}. ?P (\<pi> j)})\<close> unfolding csk filter_map by auto
	+ also
	+ have \<open>\<dots> = map \<pi> (sorted_list_of_set (insert ?j { i . ?j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}))\<close> unfolding * by auto
	+ also
	+ have \<open>\<dots> = cs\<^bsup>\<pi>\<^esup> ?j\<close> using csj by auto
	+ finally
	+ show \<open>?thesis\<close> by metis
	+qed
	+
	+lemma cs_ipd: assumes ipd: \<open>\<pi> m = ipd (\<pi> k)\<close> \<open>\<forall> n \<in> {k..<m}. \<pi> n \<noteq> ipd (\<pi> k)\<close>
	+and km: \<open>k < m\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> m = [n\<leftarrow>cs\<^bsup>\<pi>\<^esup> k . ipd n \<noteq> \<pi> m] @ [\<pi> m]\<close>
	+proof cases
	+ assume \<open>\<exists> j. m icd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close>
	+ then obtain j where jicd: \<open>m icd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> by blast
	+ hence *: \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>\<^esup> j @ [\<pi> m]\<close> by (metis icd_cs)
	+ have j: \<open>j = (GREATEST j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> ipd (\<pi> j) \<noteq> \<pi> m)\<close> using jicd assms ipd_icd_greatest_cd_not_ipd by blast
	+ moreover
	+ have \<open>ipd (\<pi> j) \<noteq> ipd (\<pi> k)\<close> by (metis is_cdi_def is_icdi_def is_ipd_def cd_not_pd ipd(1) ipd_is_ipd jicd path_nodes less_imp_le term_path_stable)
	+ moreover
	+ have \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> unfolding j by (metis (lifting, no_types) assms(3) cd_ipd_is_cd icd_imp_cd ipd(1) ipd(2) j jicd)
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>\<^esup> j = [n\<leftarrow>cs\<^bsup>\<pi>\<^esup> k . ipd n \<noteq> \<pi> m]\<close> using cs_not_ipd[of \<open>k\<close> \<open>\<pi>\<close> \<open>j\<close>] ipd(1) by metis
	+ thus \<open>?thesis\<close> using * by metis
	+next
	+ assume noicd: \<open>\<not> (\<exists> j. m icd\<^bsup>\<pi>\<^esup>\<rightarrow> j)\<close>
	+ hence csm: \<open>cs\<^bsup>\<pi>\<^esup> m = [\<pi> m]\<close> by auto
	+ have \<open>\<And>j. k cd\<^bsup>\<pi>\<^esup>\<rightarrow>j \<Longrightarrow> ipd(\<pi> j) = \<pi> m\<close> using cd_is_cd_ipd[OF km ipd] by (metis excd_impl_exicd noicd)
	+ hence *: \<open>{j \<in> {i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {k}. ipd (\<pi> j) \<noteq> \<pi> m} = {}\<close> using ipd(1) by auto
	+ have **: \<open>((\<lambda>n. ipd n \<noteq> \<pi> m) o \<pi>) = (\<lambda>n. ipd (\<pi> n) \<noteq> \<pi> m)\<close> by auto
	+ have fin: \<open>finite ({i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {k})\<close> unfolding is_cdi_def by auto
	+ note csk = cs_sorted_list_of_cd[of \<open>\<pi>\<close> \<open>k\<close>]
	+ hence \<open>[n\<leftarrow>cs\<^bsup>\<pi>\<^esup> k . ipd n \<noteq> \<pi> m] = [n\<leftarrow> (map \<pi> (sorted_list_of_set ({i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {k}))) . ipd n \<noteq> \<pi> m]\<close> by simp
	+ also
	+ have \<open>\<dots> = map \<pi> [n <- sorted_list_of_set ({i. k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {k}). ipd (\<pi> n) \<noteq> \<pi> m]\<close> by (auto simp add: filter_map **)
	+ also
	+ have \<open>\<dots> = []\<close> unfolding * filter_sorted_list_of_set[OF fin, of \<open>\<lambda>n. ipd (\<pi> n) \<noteq> \<pi> m\<close>] by auto
	+ finally
	+ show \<open>?thesis\<close> using csm by (metis append_Nil)
	+qed
	+
	+lemma converged_ipd_same_icd: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and converge: \<open>l < m\<close> \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close>
	+and csk: \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> and icd: \<open>l icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and suc: \<open>\<pi> (Suc k) = \<pi>' (Suc k')\<close>
	+and ipd: \<open>\<pi>' m' = ipd (\<pi> k)\<close> \<open>\<forall> n \<in> {k'..<m'}. \<pi>' n \<noteq> ipd (\<pi> k)\<close>
	+shows \<open>\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close>
	+proof cases
	+ assume l: \<open>l = Suc k\<close>
	+ hence \<open>Suc k cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> using icd by (metis is_icdi_def)
	+ hence \<open>\<pi> (Suc k) \<noteq> ipd (\<pi> k)\<close> unfolding is_cdi_def by auto
	+ hence \<open>\<pi>' (Suc k') \<noteq> ipd (\<pi>' k')\<close> by (metis csk last_cs suc)
	+ moreover
	+ have \<open>\<pi>' (Suc k') \<noteq> return\<close> by (metis \<open>Suc k cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> ret_no_cd suc)
	+ ultimately
	+ have \<open>Suc k' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> unfolding is_cdi_def using path(2) apply auto
	+ by (metis ipd_not_self le_Suc_eq le_antisym path_nodes term_path_stable)
	+ hence \<open>Suc k' icd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> unfolding is_icdi_def using path(2) by fastforce
	+ hence \<open>cs\<^bsup>\<pi>'\<^esup> (Suc k') = cs\<^bsup>\<pi>'\<^esup> k' @[\<pi>' (Suc k')]\<close> using icd_cs by auto
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>\<^esup> k @ [\<pi> l]\<close> using icd icd_cs by auto
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> (Suc k')\<close> by (metis csk l suc)
	+ thus \<open>?thesis\<close> by blast
	+next
	+ assume nsuck: \<open>l \<noteq> Suc k\<close>
	+ have kk'[simp]: \<open>\<pi>' k' = \<pi> k\<close> by (metis csk last_cs)
	+ have kl: \<open>k < l\<close> using icd unfolding is_icdi_def is_cdi_def by auto
	+ hence skl: \<open>Suc k < l\<close> by (metis Suc_lessI nsuck)
	+ hence lpd: \<open>\<pi> l pd\<rightarrow> \<pi> (Suc k)\<close> using icd icd_pd_intermediate by auto
	+ have km: \<open>k < m\<close> by (metis converge(1) kl order.strict_trans)
	+ have lcd: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> using icd is_icdi_def by auto
	+ hence ipdk_pdl: \<open>ipd (\<pi> k) pd\<rightarrow> (\<pi> l)\<close> by (metis ipd_pd_cd)
	+ have *: \<open>ipd (\<pi> k) \<in> nodes\<close> by (metis ipdk_pdl pd_node1)
	+ have nretk: \<open>\<pi> k \<noteq> return\<close> by (metis kl lcd path(1) ret_no_cd term_path_stable less_imp_le)
	+ have **: \<open>\<not> (\<pi> l) pd\<rightarrow> ipd (\<pi> k)\<close> proof
	+ assume a: \<open>\<pi> l pd\<rightarrow> ipd (\<pi> k)\<close>
	+ hence \<open>\<pi> l pd\<rightarrow> (\<pi> k)\<close> by (metis is_ipd_def \<open>k < l\<close> ipd_is_ipd ipdk_pdl path(1) path_nodes pd_antisym term_path_stable less_imp_le)
	+ moreover
	+ have \<open>\<pi> l \<noteq> (\<pi> k)\<close> by (metis "*" a ipd_not_self ipdk_pdl lcd pd_antisym ret_no_cd)
	+ ultimately
	+ show \<open>False\<close> using lcd cd_not_pd by auto
	+ qed
	+
	+ have km': \<open>k' < m'\<close> using cs_order[OF path csk converge(2) nretk km] .
	+
	+ obtain \<pi>'' n'' where path'': \<open>is_path \<pi>''\<close> and \<pi>''0: \<open>\<pi>'' 0 = ipd (\<pi> k)\<close> and \<pi>''n: \<open>\<pi>'' n'' = return\<close> and not\<pi>l: \<open>\<forall> i\<le>n''. \<pi>'' i \<noteq> \<pi> l\<close> using no_pd_path[OF * **] .
	+ let \<open>?\<pi>'\<close> = \<open>(\<pi>' @\<^bsup>m'\<^esup> \<pi>'') \<guillemotleft> Suc k'\<close>
	+ have \<open>is_path ?\<pi>'\<close> by (metis \<pi>''0 ipd(1) path'' path(2) path_cons path_path_shift)
	+ moreover
	+ have \<open>?\<pi>' 0 = \<pi> (Suc k)\<close> using km' suc by auto
	+ moreover
	+ have \<open>?\<pi>' (m' - Suc k' + n'') = return\<close> using \<pi>''n km' \<pi>''0 ipd(1) by auto
	+ ultimately
	+ obtain l'' where l'': \<open>l'' \<le> m' - Suc k' + n''\<close> \<open>?\<pi>' l'' = \<pi> l\<close> using lpd unfolding is_pd_def by blast
	+ have l''m: \<open>l'' \<le> m' - Suc k'\<close> apply (rule ccontr) using l'' not\<pi>l km' by (cases \<open>Suc (k' + l'') \<le> m'\<close>, auto)
	+ let \<open>?l'\<close> = \<open>Suc ( k' + l'')\<close>
	+ have lm': \<open>?l' \<le> m'\<close> using l''m km' by auto
	+
	+ \<comment> \<open>Now we have found our desired l'\<close>
	+ have 1: \<open>\<pi>' ?l' = \<pi> l\<close> using l'' l''m lm' by auto
	+ have 2: \<open>k' < ?l'\<close> by simp
	+ have 3: \<open>?l' < m'\<close> apply (rule ccontr) using lm' by (simp, metis "**" 1 ipd(1) ipdk_pdl)
	+
	+ \<comment> \<open>Need the least such l'\<close>
	+
	+ let \<open>?P\<close> = \<open>\<lambda> l'. \<pi>' l' = \<pi> l \<and> k' < l' \<and> l' < m'\<close>
	+
	+ have *: \<open>?P ?l'\<close> using 1 2 3 by blast
	+
	+ define l' where l': \<open>l' == LEAST l'. ?P l'\<close>
	+
	+ have \<pi>l': \<open>\<pi>' l' = \<pi> l\<close> using l' 1 2 3 LeastI[of \<open>?P\<close>] by blast
	+ have kl': \<open>k' < l'\<close> using l' 1 2 3 LeastI[of \<open>?P\<close>] by blast
	+ have lm': \<open>l' < m'\<close> using l' 1 2 3 LeastI[of \<open>?P\<close>] by blast
	+
	+ have nretl': \<open>\<pi>' l' \<noteq> return\<close> by (metis \<pi>''n \<pi>l' le_refl not\<pi>l)
	+
	+ have nipd': \<open>\<forall> j \<in> {k'..l'}. \<pi>' j \<noteq> ipd (\<pi>' k')\<close> using lm' kk' ipd(2) kl' by force
	+
	+ have lcd': \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> by (metis is_cdi_def kl' nipd' nretl' path(2))
	+
	+ have licd: \<open>l' icd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> proof -
	+ have \<open>\<forall> m \<in> {k'<..<l'}. \<not> l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> m\<close> proof (rule ccontr)
	+ assume \<open>\<not> (\<forall> m \<in> {k'<..<l'}. \<not> l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> m)\<close>
	+ then obtain j' where kj': \<open>k' < j'\<close> and jl': \<open>j' < l'\<close> and lcdj': \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> by force
	+ have jm': \<open>j'<m'\<close> by (metis jl' lm' order.strict_trans)
	+ have \<open>\<pi>' j' \<noteq> \<pi> l\<close> apply (rule ccontr) using l' kj' jm' jl' Least_le[of \<open>?P\<close> \<open>j'\<close>] by auto
	+ hence \<open>\<not> \<pi>' l' pd\<rightarrow> \<pi>' j'\<close> using cd_not_pd lcdj' \<pi>l' by metis
	+ moreover have \<open>\<pi>' j' \<in> nodes\<close> using path(2) path_nodes by auto
	+ ultimately
	+ obtain \<pi>\<^sub>1 n\<^sub>1 where path\<^sub>1: \<open>is_path \<pi>\<^sub>1\<close> and \<pi>0\<^sub>1: \<open>\<pi>\<^sub>1 0 = \<pi>' j'\<close> and \<pi>n\<^sub>1: \<open>\<pi>\<^sub>1 n\<^sub>1 = return\<close> and nl': \<open>\<forall> l \<le>n\<^sub>1. \<pi>\<^sub>1 l \<noteq> \<pi>' l'\<close> unfolding is_pd_def by blast
	+ let \<open>?\<pi>''\<close> = \<open>(\<pi>'@\<^bsup>j'\<^esup> \<pi>\<^sub>1) \<guillemotleft> Suc k'\<close>
	+ have \<open>is_path ?\<pi>''\<close> by (metis \<pi>0\<^sub>1 path(2) path\<^sub>1 path_cons path_path_shift)
	+ moreover
	+ have \<open>?\<pi>'' 0 = \<pi> (Suc k)\<close> by (simp, metis kj' less_eq_Suc_le suc)
	+ moreover
	+ have kj': \<open>Suc k' \<le> j'\<close> by (metis kj' less_eq_Suc_le)
	+ hence \<open>?\<pi>'' (j' - Suc k' + n\<^sub>1) = return\<close> by (simp, metis \<pi>0\<^sub>1 \<pi>n\<^sub>1)
	+ ultimately
	+ obtain l'' where : \<open>?\<pi>'' l'' = \<pi> l\<close> and *: \<open>l'' \<le>j' - Suc k' + n\<^sub>1\<close> using lpd is_pd_def by blast
	+ show \<open>False\<close> proof (cases)
	+ assume a: \<open>l'' \<le> j' - Suc k'\<close>
	+ hence \<open>\<pi>' (l'' + Suc k') = \<pi> l\<close> using * kj' by(simp, metis Nat.le_diff_conv2 add_Suc diff_add_inverse le_add1 le_add_diff_inverse2)
	+ moreover
	+ have \<open>l'' + Suc k' < l'\<close> by (metis a jl' add_diff_cancel_right' kj' le_add_diff_inverse less_imp_diff_less ordered_cancel_comm_monoid_diff_class.le_diff_conv2)
	+ moreover
	+ have \<open>l'' + Suc k' < m'\<close> by (metis Suc_lessD calculation(2) less_trans_Suc lm')
	+ moreover
	+ have \<open>k' < l'' + Suc k'\<close> by simp
	+ ultimately
	+ show \<open>False\<close> using Least_le[of \<open>?P\<close> \<open>l'' + Suc k'\<close>] l' by auto
	+ next
	+ assume a: \<open>\<not> l'' \<le> j' - Suc k'\<close>
	+ hence \<open>\<not> Suc (k' + l'') \<le> j'\<close> by simp
	+ hence \<open>\<pi>\<^sub>1 (Suc (k' + l'') - j') = \<pi> l\<close> using * kj' by simp
	+ moreover
	+ have \<open>Suc (k' + l'') - j' \<le> n\<^sub>1\<close> using ** kj' by simp
	+ ultimately
	+ show \<open>False\<close> using nl' by (metis \<pi>l')
	+ qed
	+ qed
	+ thus \<open>?thesis\<close> unfolding is_icdi_def using lcd' path(2) by simp
	+ qed
	+ hence \<open>cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>'\<^esup> k' @ [\<pi>' l']\<close> by (metis icd_cs)
	+ hence \<open>cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>\<^esup> l\<close> by (metis \<pi>l' csk icd icd_cs)
	+ thus \<open>?thesis\<close> by metis
	+qed
	+
	+lemma converged_same_icd: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and converge: \<open>l < n\<close> \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close>
	+and csk: \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> and icd: \<open>l icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and suc: \<open>\<pi> (Suc k) = \<pi>' (Suc k')\<close>
	+shows \<open>\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> proof -
	+
	+ have nret: \<open>\<pi> k \<noteq> return\<close> using icd unfolding is_icdi_def is_cdi_def using term_path_stable less_imp_le by metis
	+ have kl: \<open>k < l\<close> using icd unfolding is_icdi_def is_cdi_def by auto
	+ have kn: \<open>k < n\<close> using converge kl by simp
	+ from path_ipd_swap[OF path(1) nret kn]
	+ obtain \<rho> m where path\<rho>: \<open>is_path \<rho>\<close> and \<pi>\<rho>: \<open>\<pi> =\<^bsub>n\<^esub> \<rho>\<close> and km: \<open>k < m\<close> and ipd: \<open>\<rho> m = ipd (\<rho> k)\<close> \<open>\<forall> l \<in> {k..<m}. \<rho> l \<noteq> ipd (\<rho> k)\<close> .
	+ have csk1: \<open>cs\<^bsup>\<rho>\<^esup> k = cs\<^bsup>\<pi>\<^esup> k\<close> using cs_path_swap_le path path\<rho> \<pi>\<rho> kn by auto
	+ have suc\<rho>: \<open>\<rho> (Suc k) = \<pi> (Suc k)\<close> by (metis \<pi>\<rho> eq_up_to_def kn less_eq_Suc_le)
	+
	+ have nret': \<open>\<pi>' k' \<noteq> return\<close> by (metis csk last_cs nret)
	+ have kn': \<open>k' < n'\<close> using cs_order[OF path csk converge(2) nret kn] .
	+ from path_ipd_swap[OF path(2) nret' kn']
	+ obtain \<rho>' m' where path\<rho>': \<open>is_path \<rho>'\<close> and \<pi>\<rho>': \<open>\<pi>' =\<^bsub>n'\<^esub> \<rho>'\<close> and km': \<open>k' < m'\<close> and ipd': \<open>\<rho>' m' = ipd (\<rho>' k')\<close> \<open>\<forall> l \<in> {k'..<m'}. \<rho>' l \<noteq> ipd (\<rho>' k')\<close> .
	+ have csk1': \<open>cs\<^bsup>\<rho>'\<^esup> k' = cs\<^bsup>\<pi>'\<^esup> k'\<close> using cs_path_swap_le path path\<rho>' \<pi>\<rho>' kn' by auto
	+ have suc\<rho>': \<open>\<rho>' (Suc k') = \<pi>' (Suc k')\<close> by (metis \<pi>\<rho>' eq_up_to_def kn' less_eq_Suc_le)
	+
	+ have icd\<rho>: \<open>l icd\<^bsup>\<rho>\<^esup>\<rightarrow> k\<close> using icdi_path_swap_le[OF path\<rho> icd \<pi>\<rho>] converge by simp
	+
	+ have lm: \<open>l < m\<close> using ipd(1) icd\<rho> km unfolding is_icdi_def is_cdi_def by auto
	+
	+ have csk': \<open>cs\<^bsup>\<rho>\<^esup> k = cs\<^bsup>\<rho>'\<^esup> k'\<close> using csk1 csk1' csk by auto
	+
	+ hence kk': \<open>\<rho>' k' = \<rho> k\<close> using last_cs by metis
	+
	+ have suc': \<open>\<rho> (Suc k) = \<rho>' (Suc k')\<close> using suc suc\<rho> suc\<rho>' by auto
	+
	+ have mm': \<open>\<rho>' m' = \<rho> m\<close> using ipd(1) ipd'(1) kk' by auto
	+
	+ from cs_ipd[OF ipd km] cs_ipd[OF ipd' km',unfolded mm', folded csk']
	+ have csm: \<open>cs\<^bsup>\<rho>\<^esup> m = cs\<^bsup>\<rho>'\<^esup> m'\<close> by metis
	+
	+ from converged_ipd_same_icd[OF path\<rho> path\<rho>' lm csm csk' icd\<rho> suc' ipd'[unfolded kk']]
	+ obtain l' where csl: \<open>cs\<^bsup>\<rho>\<^esup> l = cs\<^bsup>\<rho>'\<^esup> l'\<close> by blast
	+
	+ have csl\<rho>: \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<rho>\<^esup> l\<close> using \<pi>\<rho> converge(1) cs_path_swap_le less_imp_le_nat path(1) path\<rho> by blast
	+
	+ have nretl: \<open>\<rho> l \<noteq> return\<close> by (metis icd\<rho> icd_imp_cd ret_no_cd)
	+
	+ have csn': \<open>cs\<^bsup>\<rho>\<^esup> n = cs\<^bsup>\<rho>'\<^esup> n'\<close> using converge(2) cs_path_swap path path\<rho> path\<rho>' \<pi>\<rho> \<pi>\<rho>' by auto
	+
	+ have ln': \<open>l' < n'\<close> using cs_order[OF path\<rho> path\<rho>' csl csn' nretl converge(1)] .
	+
	+ have csl\<rho>': \<open>cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<rho>'\<^esup> l'\<close> using cs_path_swap_le[OF path(2) path\<rho>' \<pi>\<rho>'] ln' by auto
	+
	+ have csl': \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> using csl\<rho> csl\<rho>' csl by auto
	+ thus \<open>?thesis\<close> by blast
	+qed
	+
	+lemma cd_is_cs_less: assumes \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> k \<prec> cs\<^bsup>\<pi>\<^esup> l\<close> proof -
	+ obtain xs where csl: \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>\<^esup> k @ xs @[\<pi> l]\<close> using cd_in_cs[OF assms] by blast
	+ hence len: \<open>length(cs\<^bsup>\<pi>\<^esup> k) < length (cs\<^bsup>\<pi>\<^esup> l)\<close> by auto
	+ have take: \<open>take (length (cs\<^bsup>\<pi>\<^esup> k)) (cs\<^bsup>\<pi>\<^esup> l) = cs\<^bsup>\<pi>\<^esup> k\<close> using csl by auto
	+ show \<open>?thesis\<close> using cs_less.intros[OF len take] .
	+qed
	+
	+lemma cs_select_id: assumes \<open>is_path \<pi>\<close> \<open>\<pi> k \<noteq> return\<close> shows \<open>\<pi>\<exclamdown>cs\<^bsup>\<pi>\<^esup> k = k\<close> (is \<open>?k = k\<close>) proof -
	+ have *: \<open>\<And> i . cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>\<^esup> k \<Longrightarrow> i = k\<close> using cs_inj[OF assms] by metis
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> ?k = cs\<^bsup>\<pi>\<^esup> k\<close> unfolding cs_select_def using theI[of \<open>\<lambda> i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>\<^esup> k\<close> \<open>k\<close>] by auto
	+ thus \<open>?k = k\<close> using * by auto
	+qed
	+
	+lemma cs_single_nocd: assumes \<open>cs\<^bsup>\<pi>\<^esup> i = [x]\<close> shows \<open>\<forall> k. \<not> i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> proof -
	+ have \<open>\<not> (\<exists> k. i icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close> apply (rule ccontr) using assms cs_not_nil by auto
	+ hence \<open>\<not> (\<exists> k. i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close> by (metis excd_impl_exicd)
	+ thus \<open>?thesis\<close> by blast
	+qed
	+
	+lemma cs_single_pd_intermed: assumes \<open>is_path \<pi>\<close> \<open>cs\<^bsup>\<pi>\<^esup> n = [\<pi> n]\<close> \<open>k \<le> n\<close> shows \<open>\<pi> n pd\<rightarrow> \<pi> k\<close> proof -
	+ have \<open>\<forall> l. \<not> n icd\<^bsup>\<pi>\<^esup>\<rightarrow> l\<close> by (metis assms(2) cs_single_nocd icd_imp_cd)
	+ thus \<open>?thesis\<close> by (metis assms(1) assms(3) no_icd_pd)
	+qed
	+
	+
	+lemma cs_first_pd: assumes path: \<open>is_path \<pi>\<close> and pd: \<open>\<pi> n pd\<rightarrow> \<pi> 0\<close> and first: \<open>\<forall> l < n. \<pi> l \<noteq> \<pi> n\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> n = [\<pi> n]\<close>
	+by (metis cs_cases first first_pd_no_cd icd_imp_cd path pd)
	+
	+lemma converged_pd_cs_single: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and converge: \<open>l < m\<close> \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close>
	+and \<pi>0: \<open>\<pi> 0 = \<pi>' 0\<close> and mpdl: \<open>\<pi> m pd\<rightarrow> \<pi> l\<close> and csl: \<open>cs\<^bsup>\<pi>\<^esup> l = [\<pi> l]\<close>
	+shows \<open>\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> proof -
	+ have *: \<open>\<pi> l pd\<rightarrow> \<pi>' 0\<close> using cs_single_pd_intermed[OF path(1) csl] \<pi>0[symmetric] by auto
	+ have \<pi>m: \<open>\<pi> m = \<pi>' m'\<close> by (metis converge(2) last_cs)
	+ hence **: \<open>\<pi>' m' pd\<rightarrow> \<pi> l\<close> using mpdl by metis
	+
	+ obtain l' where lm': \<open>l' \<le> m'\<close> and \<pi>l: \<open>\<pi>' l' = \<pi> l\<close> (is \<open>?P l'\<close>) using path_pd_pd0[OF path(2) ** *] .
	+
	+ let \<open>?l\<close> = \<open>(LEAST l'. \<pi>' l' = \<pi> l)\<close>
	+
	+ have \<pi>l': \<open>\<pi>' ?l = \<pi> l\<close> using LeastI[of \<open>?P\<close>,OF \<pi>l] .
	+ moreover
	+ have \<open>\<forall> i <?l. \<pi>' i \<noteq> \<pi> l\<close> using Least_le[of \<open>?P\<close>] by (metis not_less)
	+ hence \<open>\<forall> i <?l. \<pi>' i \<noteq> \<pi>' ?l\<close> using \<pi>l' by metis
	+ moreover
	+ have \<open>\<pi>' ?l pd\<rightarrow> \<pi>' 0\<close> using * \<pi>l' by metis
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>'\<^esup> ?l = [\<pi>' ?l]\<close> using cs_first_pd[OF path(2)] by metis
	+ thus \<open>?thesis\<close> using csl \<pi>l' by metis
	+qed
	+
	+lemma converged_cs_single: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and converge: \<open>l < m\<close> \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close>
	+and \<pi>0: \<open>\<pi> 0 = \<pi>' 0\<close> and csl: \<open>cs\<^bsup>\<pi>\<^esup> l = [\<pi> l]\<close>
	+shows \<open>\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> proof cases
	+ assume *: \<open>\<pi> l = return\<close>
	+ hence \<open>\<pi> m = return\<close> by (metis converge(1) path(1) term_path_stable less_imp_le)
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> m = [return]\<close> using cs_return by auto
	+ hence \<open>cs\<^bsup>\<pi>'\<^esup> m' = [return]\<close> using converge by simp
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>\<^esup> l = [return]\<close> using * cs_return by auto
	+ ultimately show \<open>?thesis\<close> by metis
	+next
	+ assume nret: \<open>\<pi> l \<noteq> return\<close>
	+ have \<pi>m: \<open>\<pi> m = \<pi>' m'\<close> by (metis converge(2) last_cs)
	+
	+ obtain \<pi>\<^sub>1 n where path1: \<open>is_path \<pi>\<^sub>1\<close> and upto: \<open>\<pi> =\<^bsub>m\<^esub> \<pi>\<^sub>1\<close> and \<pi>n: \<open>\<pi>\<^sub>1 n = return\<close> using path(1) path_swap_ret by blast
	+
	+ obtain \<pi>\<^sub>1' n' where path1': \<open>is_path \<pi>\<^sub>1'\<close> and upto': \<open>\<pi>' =\<^bsub>m'\<^esub> \<pi>\<^sub>1'\<close> and \<pi>n': \<open>\<pi>\<^sub>1' n' = return\<close> using path(2) path_swap_ret by blast
	+
	+ have \<pi>1l: \<open>\<pi>\<^sub>1 l = \<pi> l\<close> using upto converge(1) by (metis eq_up_to_def nat_less_le)
	+
	+ have cs1l: \<open>cs\<^bsup>\<pi>\<^sub>1\<^esup> l = cs\<^bsup>\<pi>\<^esup> l\<close> using cs_path_swap_le upto path1 path(1) converge(1) by auto
	+
	+ have csl1: \<open>cs\<^bsup>\<pi>\<^sub>1\<^esup> l = [\<pi>\<^sub>1 l]\<close> by (metis \<pi>1l cs1l csl)
	+
	+ have converge1: \<open>cs\<^bsup>\<pi>\<^sub>1\<^esup> n = cs\<^bsup>\<pi>\<^sub>1'\<^esup> n'\<close> using \<pi>n \<pi>n' cs_return by auto
	+
	+ have ln: \<open>l < n\<close> using nret \<pi>n \<pi>1l term_path_stable[OF path1 \<pi>n] by (auto, metis linorder_neqE_nat less_imp_le)
	+
	+ have \<pi>01: \<open>\<pi>\<^sub>1 0 = \<pi>\<^sub>1' 0\<close> using \<pi>0 eq_up_to_apply[OF upto] eq_up_to_apply[OF upto'] by auto
	+
	+ have pd: \<open>\<pi>\<^sub>1 n pd\<rightarrow> \<pi>\<^sub>1 l\<close> using \<pi>n by (metis path1 path_nodes return_pd)
	+
	+ obtain l' where csl: \<open>cs\<^bsup>\<pi>\<^sub>1\<^esup> l = cs\<^bsup>\<pi>\<^sub>1'\<^esup> l'\<close> using converged_pd_cs_single[OF path1 path1' ln converge1 \<pi>01 pd csl1] by blast
	+
	+ have cs1m: \<open>cs\<^bsup>\<pi>\<^sub>1\<^esup> m = cs\<^bsup>\<pi>\<^esup> m\<close> using cs_path_swap upto path1 path(1) by auto
	+ have cs1m': \<open>cs\<^bsup>\<pi>\<^sub>1'\<^esup> m' = cs\<^bsup>\<pi>'\<^esup> m'\<close> using cs_path_swap upto' path1' path(2) by auto
	+ hence converge1: \<open>cs\<^bsup>\<pi>\<^sub>1\<^esup> m = cs\<^bsup>\<pi>\<^sub>1'\<^esup> m'\<close> using converge(2) cs1m by metis
	+
	+ have nret1: \<open>\<pi>\<^sub>1 l \<noteq> return\<close> using nret \<pi>1l by auto
	+
	+ have lm': \<open>l' < m'\<close> using cs_order[OF path1 path1' csl converge1 nret1 converge(1)] .
	+
	+ have \<open>cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>\<^sub>1'\<^esup> l'\<close> using cs_path_swap_le[OF path(2) path1' upto'] lm' by auto
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>\<^sub>1\<^esup> l\<close> using cs_path_swap_le[OF path(1) path1 upto] converge(1) by auto
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> using csl by auto
	+ thus \<open>?thesis\<close> by blast
	+qed
	+
	+lemma converged_cd_same_suc: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and init: \<open>\<pi> 0 = \<pi>' 0\<close>
	+and cd_suc: \<open>\<forall> k k'. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k' \<and> l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k \<longrightarrow> \<pi> (Suc k) = \<pi>' (Suc k')\<close> and converge: \<open>l < m\<close> \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close>
	+shows \<open>\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close>
	+using path init cd_suc converge proof (induction \<open>\<pi>\<close> \<open>l\<close> rule: cs_induct,cases)
	+ case (cs \<pi> l)
	+ assume *: \<open>\<exists>k. l icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ let \<open>?k\<close> = \<open>THE k. l icd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close>
	+ have icd: \<open>l icd\<^bsup>\<pi>\<^esup>\<rightarrow> ?k\<close> by (metis "*" icd_is_the_icd)
	+ hence lcdk: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> ?k\<close> by (metis is_icdi_def)
	+ hence kl: \<open>?k<l\<close> using is_cdi_def by metis
	+
	+ have \<open>\<And> j. ?k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<Longrightarrow> l cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using icd cd_trans is_icdi_def by fast
	+ hence suc': \<open>\<forall> j j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j' \<and> ?k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<longrightarrow> \<pi> (Suc j) = \<pi>' (Suc j')\<close> using cs.prems(4) by blast
	+
	+ from cs.IH[OF * cs(2) path(2) cs(4) suc'] cs.prems kl
	+ have \<open>\<exists>k'. cs\<^bsup>\<pi>\<^esup> (THE k. l icd\<^bsup>\<pi>\<^esup>\<rightarrow> k) = cs\<^bsup>\<pi>'\<^esup> k'\<close> by (metis Suc_lessD less_trans_Suc)
	+ then obtain k' where csk: \<open>cs\<^bsup>\<pi>\<^esup> ?k = cs\<^bsup>\<pi>'\<^esup> k'\<close> by blast
	+
	+ have suc2: \<open>\<pi> (Suc ?k) = \<pi>' (Suc k')\<close> using cs.prems(4) lcdk csk by auto
	+
	+ have km: \<open>?k < m\<close> using kl cs.prems(5) by simp
	+
	+ from converged_same_icd[OF cs(2) path(2) cs.prems(5) cs.prems(6) csk icd suc2]
	+ show \<open>?case\<close> .
	+next
	+ case (cs \<pi> l)
	+ assume \<open>\<not> (\<exists>k. l icd\<^bsup>\<pi>\<^esup>\<rightarrow> k)\<close>
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> l = [\<pi> l]\<close> by auto
	+ with cs converged_cs_single
	+ show \<open>?case\<close> by metis
	+qed
	+
	+lemma converged_cd_diverge:
	+assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and init: \<open>\<pi> 0 = \<pi>' 0\<close> and notin: \<open>\<not> (\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l')\<close> and converge: \<open>l < m\<close> \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close>
	+obtains k k' where \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>\<pi> (Suc k) \<noteq> \<pi>' (Suc k')\<close>
	+using assms converged_cd_same_suc by blast
	+
	+
	+
	+lemma converged_cd_same_suc_return: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and \<pi>0: \<open>\<pi> 0 = \<pi>' 0\<close>
	+and cd_suc: \<open>\<forall> k k'. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k' \<and> l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k \<longrightarrow> \<pi> (Suc k) = \<pi>' (Suc k')\<close> and ret: \<open>\<pi>' n' = return\<close>
	+shows \<open>\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close>proof cases
	+ assume \<open>\<pi> l = return\<close>
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> n'\<close> using ret cs_return by presburger
	+ thus \<open>?thesis\<close> by blast
	+next
	+ assume nretl: \<open>\<pi> l \<noteq> return\<close>
	+ have \<open>\<pi> l \<in> nodes\<close> using path path_nodes by auto
	+ then obtain \<pi>l n where ipl: \<open>is_path \<pi>l\<close> and \<pi>l: \<open>\<pi> l = \<pi>l 0\<close> and retn: \<open>\<pi>l n = return\<close> and notl: \<open>\<forall> i>0. \<pi>l i \<noteq> \<pi> l\<close> by (metis direct_path_return nretl)
	+ hence ip: \<open>is_path (\<pi>@\<^bsup>l\<^esup> \<pi>l)\<close> and l: \<open>(\<pi>@\<^bsup>l\<^esup> \<pi>l) l = \<pi> l\<close> and retl: \<open>(\<pi>@\<^bsup>l\<^esup> \<pi>l) (l + n) = return\<close> and nl: \<open>\<forall> i>l. (\<pi>@\<^bsup>l\<^esup> \<pi>l) i \<noteq> \<pi> l\<close> using path_cons[OF path(1) ipl \<pi>l] by auto
	+
	+ have \<pi>0': \<open>(\<pi>@\<^bsup>l\<^esup> \<pi>l) 0 = \<pi>' 0\<close> unfolding cs_0 using \<pi>l \<pi>0 by auto
	+
	+ have csn: \<open>cs\<^bsup>\<pi>@\<^bsup>l\<^esup> \<pi>l\<^esup> (l+n) = cs\<^bsup>\<pi>'\<^esup> n'\<close> using ret retl cs_return by metis
	+
	+ have eql: \<open>(\<pi>@\<^bsup>l\<^esup> \<pi>l) =\<^bsub>l\<^esub> \<pi>\<close> by (metis path_append_eq_up_to)
	+
	+ have csl': \<open>cs\<^bsup>\<pi>@\<^bsup>l\<^esup> \<pi>l\<^esup> l = cs\<^bsup>\<pi>\<^esup> l\<close> using eql cs_path_swap ip path(1) by metis
	+
	+ have \<open>0 < n\<close> using nretl[unfolded \<pi>l] retn by (metis neq0_conv)
	+ hence ln: \<open>l < l + n\<close> by simp
	+
	+ have *: \<open>\<forall> k k'. cs\<^bsup>\<pi> @\<^bsup>l\<^esup> \<pi>l\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k' \<and> l cd\<^bsup>\<pi> @\<^bsup>l\<^esup> \<pi>l\<^esup>\<rightarrow> k \<longrightarrow> (\<pi> @\<^bsup>l\<^esup> \<pi>l) (Suc k) = \<pi>' (Suc k')\<close> proof (rule,rule,rule)
	+ fix k k' assume *: \<open>cs\<^bsup>\<pi> @\<^bsup>l\<^esup> \<pi>l\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k' \<and> l cd\<^bsup>\<pi> @\<^bsup>l\<^esup> \<pi>l\<^esup>\<rightarrow> k\<close>
	+ hence kl: \<open>k < l\<close> using is_cdi_def by auto
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k' \<and> l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> using eql * cs_path_swap_le[OF ip path(1) eql,of \<open>k\<close>] cdi_path_swap_le[OF path(1) _ eql,of \<open>l\<close> \<open>k\<close>] by auto
	+ hence \<open>\<pi> (Suc k) = \<pi>' (Suc k')\<close> using cd_suc by blast
	+ then show \<open>(\<pi> @\<^bsup>l\<^esup> \<pi>l) (Suc k) = \<pi>' (Suc k')\<close> using cs_path_swap_le[OF ip path(1) eql,of \<open>Suc k\<close>] kl by auto
	+ qed
	+ obtain l' where \<open>cs\<^bsup>\<pi> @\<^bsup>l\<^esup> \<pi>l\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> using converged_cd_same_suc[OF ip path(2) \<pi>0' * ln csn] by blast
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>@\<^bsup>l\<^esup> \<pi>l\<^esup> l = cs\<^bsup>\<pi>\<^esup> l\<close> using eql by (metis cs_path_swap ip path(1))
	+ ultimately
	+ show \<open>?thesis\<close> by metis
	+qed
	+
	+lemma converged_cd_diverge_return: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and init: \<open>\<pi> 0 = \<pi>' 0\<close>
	+and notin: \<open>\<not> (\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l')\<close> and ret: \<open>\<pi>' m' = return\<close>
	+obtains k k' where \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>\<pi> (Suc k) \<noteq> \<pi>' (Suc k')\<close> using converged_cd_same_suc_return[OF path init _ ret, of \<open>l\<close>] notin by blast
	+
	+lemma returned_missing_cd_or_loop: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and \<pi>0: \<open>\<pi> 0 = \<pi>' 0\<close>
	+and notin': \<open>\<not>(\<exists> k'. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k')\<close> and nret: \<open>\<forall> n'. \<pi>' n' \<noteq> return\<close> and ret: \<open>\<pi> n = return\<close>
	+obtains i i' where \<open>i<k\<close> \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> \<open>\<pi> (Suc i) \<noteq> \<pi>' (Suc i')\<close> \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<or> (\<forall> j'> i'. j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i')\<close>
	+proof -
	+ obtain f where icdf: \<open>\<forall> i'. f (Suc i') icd\<^bsup>\<pi>'\<^esup>\<rightarrow> f i'\<close> and ran: \<open>range f = {i'. \<forall> j'>i'. j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i'}\<close> and icdf0: \<open>\<not> (\<exists>i'. f 0 cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i')\<close> using path(2) path_nret_inf_icd_seq nret by blast
	+ show \<open>thesis\<close> proof cases
	+ assume \<open>\<exists> j. \<not> (\<exists> i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> (f j))\<close>
	+ then obtain j where ni\<pi>: \<open>\<not> (\<exists> i. cs\<^bsup>\<pi>'\<^esup> (f j) = cs\<^bsup>\<pi>\<^esup> i)\<close> by metis
	+ note converged_cd_diverge_return[OF path(2,1) \<pi>0[symmetric] ni\<pi> ret] that
	+ then obtain i k' where csk: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> k'\<close> and cdj: \<open>f j cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> and div: \<open>\<pi> (Suc i) \<noteq> \<pi>' (Suc k')\<close> by metis
	+ have \<open>k' \<in> range f\<close> using cdj proof (induction \<open>j\<close>)
	+ case 0 thus \<open>?case\<close> using icdf0 by blast
	+ next
	+ case (Suc j)
	+ have icdfj: \<open>f (Suc j) icd\<^bsup>\<pi>'\<^esup>\<rightarrow> f j\<close> using icdf by auto
	+ show \<open>?case\<close> proof cases
	+ assume \<open>f (Suc j) icd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close>
	+ hence \<open>k' = f j\<close> using icdfj by (metis icd_uniq)
	+ thus \<open>?case\<close> by auto
	+ next
	+ assume \<open>\<not> f (Suc j) icd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close>
	+ hence \<open>f j cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> using cd_impl_icd_cd[OF Suc.prems icdfj] by auto
	+ thus \<open>?case\<close> using Suc.IH by auto
	+ qed
	+ qed
	+ hence alldep: \<open>\<forall> i'>k'. i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> using ran by auto
	+ show \<open>thesis\<close> proof cases
	+ assume \<open>i < k\<close> with alldep that[OF _ csk div] show \<open>thesis\<close> by blast
	+ next
	+ assume \<open>\<not> i < k\<close>
	+ hence ki: \<open>k\<le>i\<close> by auto
	+ have \<open>k \<noteq> i\<close> using notin' csk by auto
	+ hence ki': \<open>k<i\<close> using ki by auto
	+ obtain ka k' where \<open>cs\<^bsup>\<pi>\<^esup> ka = cs\<^bsup>\<pi>'\<^esup> k'\<close> \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> ka\<close> \<open>\<pi> (Suc ka) \<noteq> \<pi>' (Suc k')\<close>
	+ using converged_cd_diverge[OF path \<pi>0 notin' ki' csk] by blast
	+ moreover
	+ hence \<open>ka < k\<close> unfolding is_cdi_def by auto
	+ ultimately
	+ show \<open>?thesis\<close> using that by blast
	+ qed
	+ next
	+ assume \<open>\<not>(\<exists> j. \<not> (\<exists> i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> (f j)))\<close>
	+ hence allin: \<open>\<forall> j. (\<exists> i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> (f j))\<close> by blast
	+ define f' where f': \<open>f' \<equiv> \<lambda> j. (SOME i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> (f j))\<close>
	+ have \<open>\<forall> i. f' i < f' (Suc i)\<close> proof
	+ fix i
	+ have csi: \<open>cs\<^bsup>\<pi>'\<^esup> (f i) = cs\<^bsup>\<pi>\<^esup> (f' i)\<close> unfolding f' using allin by (metis (mono_tags) someI_ex)
	+ have cssuci: \<open>cs\<^bsup>\<pi>'\<^esup> (f (Suc i)) = cs\<^bsup>\<pi>\<^esup> (f' (Suc i))\<close> unfolding f' using allin by (metis (mono_tags) someI_ex)
	+ have fi: \<open>f i < f (Suc i)\<close> using icdf unfolding is_icdi_def is_cdi_def by auto
	+ have \<open>f (Suc i) cd\<^bsup>\<pi>'\<^esup>\<rightarrow> f i\<close> using icdf unfolding is_icdi_def by blast
	+ hence nreti: \<open>\<pi>' (f i) \<noteq> return\<close> by (metis cd_not_ret)
	+ show \<open>f' i < f' (Suc i)\<close> using cs_order[OF path(2,1) csi cssuci nreti fi] .
	+ qed
	+ hence kle: \<open>k < f' (Suc k)\<close> using mono_ge_id[of \<open>f'\<close> \<open>Suc k\<close>] by auto
	+ have cssk: \<open>cs\<^bsup>\<pi>\<^esup> (f' (Suc k)) = cs\<^bsup>\<pi>'\<^esup> (f (Suc k))\<close> unfolding f' using allin by (metis (mono_tags) someI_ex)
	+ obtain ka k' where \<open>cs\<^bsup>\<pi>\<^esup> ka = cs\<^bsup>\<pi>'\<^esup> k'\<close> \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> ka\<close> \<open>\<pi> (Suc ka) \<noteq> \<pi>' (Suc k')\<close>
	+ using converged_cd_diverge[OF path \<pi>0 notin' kle cssk] by blast
	+ moreover
	+ hence \<open>ka < k\<close> unfolding is_cdi_def by auto
	+ ultimately
	+ show \<open>?thesis\<close> using that by blast
	+ qed
	+qed
	+
	+lemma missing_cd_or_loop: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and \<pi>0: \<open>\<pi> 0 = \<pi>' 0\<close> and notin': \<open>\<not>(\<exists> k'. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k')\<close>
	+obtains i i' where \<open>i < k\<close> \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> \<open>\<pi> (Suc i) \<noteq> \<pi>' (Suc i')\<close> \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<or> (\<forall> j'> i'. j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i')\<close>
	+proof cases
	+ assume \<open>\<exists> n'. \<pi>' n' = return\<close>
	+ then obtain n' where retn: \<open>\<pi>' n' = return\<close> by blast
	+ note converged_cd_diverge_return[OF path \<pi>0 notin' retn]
	+ then obtain ka k' where \<open>cs\<^bsup>\<pi>\<^esup> ka = cs\<^bsup>\<pi>'\<^esup> k'\<close> \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> ka\<close> \<open>\<pi> (Suc ka) \<noteq> \<pi>' (Suc k')\<close> by blast
	+ moreover
	+ hence \<open>ka < k\<close> unfolding is_cdi_def by auto
	+ ultimately show \<open>thesis\<close> using that by simp
	+next
	+ assume \<open>\<not> (\<exists> n'. \<pi>' n' = return)\<close>
	+ hence notret: \<open>\<forall> n'. \<pi>' n' \<noteq> return\<close> by auto
	+ then obtain \<pi>l n where ipl: \<open>is_path \<pi>l\<close> and \<pi>l: \<open>\<pi> k = \<pi>l 0\<close> and retn: \<open>\<pi>l n = return\<close> using reaching_ret path(1) path_nodes by metis
	+ hence ip: \<open>is_path (\<pi>@\<^bsup>k\<^esup>\<pi>l)\<close> and l: \<open>(\<pi>@\<^bsup>k\<^esup>\<pi>l) k = \<pi> k\<close> and retl: \<open>(\<pi>@\<^bsup>k\<^esup>\<pi>l) (k + n) = return\<close> using path_cons[OF path(1) ipl \<pi>l] by auto
	+
	+ have \<pi>0': \<open>(\<pi>@\<^bsup>k\<^esup>\<pi>l) 0 = \<pi>' 0\<close> unfolding cs_0 using \<pi>l \<pi>0 by auto
	+
	+ have eql: \<open>(\<pi>@\<^bsup>k\<^esup>\<pi>l) =\<^bsub>k\<^esub> \<pi>\<close> by (metis path_append_eq_up_to)
	+
	+ have csl': \<open>cs\<^bsup>\<pi>@\<^bsup>k\<^esup>\<pi>l\<^esup> k = cs\<^bsup>\<pi>\<^esup> k\<close> using eql cs_path_swap ip path(1) by metis
	+
	+ hence notin: \<open>\<not>(\<exists> k'. cs\<^bsup>\<pi>@\<^bsup>k\<^esup>\<pi>l\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k')\<close> using notin' by auto
	+
	+ obtain i i' where *: \<open>i < k\<close> and csi: \<open>cs\<^bsup>\<pi>@\<^bsup>k\<^esup>\<pi>l\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> and suci: \<open>(\<pi> @\<^bsup>k\<^esup> \<pi>l) (Suc i) \<noteq> \<pi>' (Suc i')\<close> and cdloop: \<open>k cd\<^bsup>\<pi>@\<^bsup>k\<^esup>\<pi>l\<^esup>\<rightarrow> i \<or> (\<forall> j'>i'. j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i')\<close>
	+ using returned_missing_cd_or_loop[OF ip path(2) \<pi>0' notin notret retl] by blast
	+
	+ have \<open>i \<noteq> k\<close> using notin csi by auto
	+ hence ik: \<open>i < k\<close> using * by auto
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> using csi cs_path_swap_le[OF ip path(1) eql] by auto
	+ moreover
	+ have \<open>\<pi> (Suc i) \<noteq> \<pi>' (Suc i')\<close> using ik eq_up_to_apply[OF eql, of \<open>Suc i\<close>] suci by auto
	+ moreover
	+ have \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<or> (\<forall> j'>i'. j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i')\<close> using cdloop cdi_path_swap_le[OF path(1) _ eql, of \<open>k\<close> \<open>i\<close>] by auto
	+ ultimately
	+ show \<open>thesis\<close> using that[OF *] by blast
	+qed
	+
	+
	+lemma path_shift_set_cd: assumes \<open>is_path \<pi>\<close> shows \<open>{k + j\| j . n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> j } = {i. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i }\<close>
	+proof -
	+ { fix i
	+ assume \<open>i\<in>{k+j \| j . n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> j }\<close>
	+ then obtain j where \<open>i = k+j\<close> \<open>n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> j\<close> by auto
	+ hence \<open>k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i\<close> using cd_path_shift[OF _ assms, of \<open>k\<close> \<open>k+j\<close> \<open>k+n\<close>] by simp
	+ hence \<open>i\<in>{ i. k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i }\<close> by blast
	+ }
	+ moreover
	+ { fix i
	+ assume \<open>i\<in>{ i. k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i }\<close>
	+ hence *: \<open>k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i\<close> by blast
	+ then obtain j where i: \<open>i = k+j\<close> by (metis le_Suc_ex)
	+ hence \<open>k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> k+j\<close> using * by auto
	+ hence \<open>n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> j\<close> using cd_path_shift[OF _ assms, of \<open>k\<close> \<open>k+j\<close> \<open>k+n\<close>] by simp
	+ hence \<open>i\<in>{k+j \| j . n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> j }\<close> using i by simp
	+ }
	+ ultimately show \<open>?thesis\<close> by blast
	+qed
	+
	+lemma cs_path_shift_set_cd: assumes path: \<open>is_path \<pi>\<close> shows \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n = map \<pi> (sorted_list_of_set {i. k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i }) @ [\<pi> (k+n)]\<close>
	+proof -
	+ have mono:\<open>\<forall>n m. n < m \<longrightarrow> k + n < k + m\<close> by auto
	+ have fin: \<open>finite {i. n cd\<^bsup>\<pi> \<guillemotleft> k\<^esup>\<rightarrow> i}\<close> unfolding is_cdi_def by auto
	+ have *: \<open>(\<lambda> x. k+x)`{i. n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> i} = {k + i \| i. n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> i}\<close> by auto
	+ have \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n = map (\<pi>\<guillemotleft>k) (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> i}) @ [(\<pi>\<guillemotleft>k) n]\<close> using cs_sorted_list_of_cd' by blast
	+ also
	+ have \<open>\<dots> = map \<pi> (map (\<lambda> x. k+x) (sorted_list_of_set{i. n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> i})) @ [\<pi> (k+n)]\<close> by auto
	+ also
	+ have \<open>\<dots> = map \<pi> (sorted_list_of_set ((\<lambda> x. k+x)`{i. n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> i})) @ [\<pi> (k+n)]\<close> using sorted_list_of_set_map_mono[OF mono fin] by auto
	+ also
	+ have \<open>\<dots> = map \<pi> (sorted_list_of_set ({k + i \| i. n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> i})) @ [\<pi> (k+n)]\<close> using * by auto
	+ also
	+ have \<open>\<dots> = map \<pi> (sorted_list_of_set ({i. k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i})) @ [\<pi> (k+n)]\<close> using path_shift_set_cd[OF path] by auto
	+ finally
	+ show \<open>?thesis\<close> .
	+qed
	+
	+lemma cs_split_shift_cd: assumes \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> and \<open>j < k\<close> and \<open>k < n\<close> and \<open>\<forall>j'<k. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> j' \<longrightarrow> j' \<le> j\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>\<^esup> j @ cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> (n-k)\<close>
	+proof -
	+ have path: \<open>is_path \<pi>\<close> using assms unfolding is_cdi_def by auto
	+ have 1: \<open>{i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} = {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k} \<union> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i}\<close> by auto
	+ have le: \<open>\<forall> i\<in> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k}. \<forall> j\<in> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i}. i < j\<close> by auto
	+
	+ have 2: \<open>{i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k} = {i . j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {j}\<close> proof -
	+ { fix i assume \<open>i\<in>{i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k}\<close>
	+ hence cd: \<open>n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> and ik:\<open>i < k\<close> by auto
	+ have \<open>i\<in>{i . j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {j}\<close> proof cases
	+ assume \<open>i < j\<close> hence \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> by (metis is_cdi_def assms(1) cd cdi_prefix nat_less_le)
	+ thus \<open>?thesis\<close> by simp
	+ next
	+ assume \<open>\<not> i < j\<close>
	+ moreover
	+ have \<open>i \<le> j\<close> using assms(4) ik cd by auto
	+ ultimately
	+ show \<open>?thesis\<close> by auto
	+ qed
	+ }
	+ moreover
	+ { fix i assume \<open>i\<in>{i . j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} \<union> {j}\<close>
	+ hence \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<or> i = j\<close> by auto
	+ hence \<open>i\<in>{i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k}\<close> using assms(1,2) cd_trans[OF _ assms(1)] apply auto unfolding is_cdi_def
	+ by (metis (poly_guards_query) diff_diff_cancel diff_is_0_eq le_refl le_trans nat_less_le)
	+ }
	+ ultimately show \<open>?thesis\<close> by blast
	+ qed
	+
	+ have \<open>cs\<^bsup>\<pi>\<^esup> n = map \<pi> (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}) @ [\<pi> n]\<close> using cs_sorted_list_of_cd' by simp
	+ also
	+ have \<open>\<dots> = map \<pi> (sorted_list_of_set ({i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k} \<union> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i})) @ [\<pi> n]\<close> using 1 by metis
	+ also
	+ have \<open>\<dots> = map \<pi> ((sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k}) @ (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i})) @ [\<pi> n]\<close>
	+ using sorted_list_of_set_append[OF _ _ le] is_cdi_def by auto
	+ also
	+ have \<open>\<dots> = (map \<pi> (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k})) @ (map \<pi> (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i})) @ [\<pi> n]\<close> by auto
	+ also
	+ have \<open>\<dots> = cs\<^bsup>\<pi>\<^esup> j @ (map \<pi> (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i})) @ [\<pi> n]\<close> unfolding 2 using cs_sorted_list_of_cd by auto
	+ also
	+ have \<open>\<dots> = cs\<^bsup>\<pi>\<^esup> j @ cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> (n-k)\<close> using cs_path_shift_set_cd[OF path, of \<open>k\<close> \<open>n-k\<close>] assms(3) by auto
	+ finally
	+ show \<open>?thesis\<close> .
	+qed
	+
	+lemma cs_split_shift_nocd: assumes \<open>is_path \<pi>\<close> and \<open>k < n\<close> and \<open>\<forall>j. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<longrightarrow> k \<le> j\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> (n-k)\<close>
	+proof -
	+ have path: \<open>is_path \<pi>\<close> using assms by auto
	+ have 1: \<open>{i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i} = {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k} \<union> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i}\<close> by auto
	+ have le: \<open>\<forall> i\<in> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k}. \<forall> j\<in> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i}. i < j\<close> by auto
	+ have 2: \<open>{i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k} = {}\<close> using assms by auto
	+
	+ have \<open>cs\<^bsup>\<pi>\<^esup> n = map \<pi> (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i}) @ [\<pi> n]\<close> using cs_sorted_list_of_cd' by simp
	+ also
	+ have \<open>\<dots> = map \<pi> (sorted_list_of_set ({i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> i < k} \<union> {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i})) @ [\<pi> n]\<close> using 1 by metis
	+ also
	+ have \<open>\<dots> = map \<pi> (sorted_list_of_set {i. n cd\<^bsup>\<pi>\<^esup>\<rightarrow> i \<and> k \<le> i}) @ [\<pi> n]\<close>
	+ unfolding 2 by auto
	+ also
	+ have \<open>\<dots> = cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> (n-k)\<close> using cs_path_shift_set_cd[OF path, of \<open>k\<close> \<open>n-k\<close>] assms(2) by auto
	+ finally show \<open>?thesis\<close> .
	+qed
	+
	+lemma shifted_cs_eq_is_eq: assumes \<open>is_path \<pi>\<close> and \<open>is_path \<pi>'\<close> and \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> and \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n'\<close> shows \<open>cs\<^bsup>\<pi>\<^esup> (k+n) = cs\<^bsup>\<pi>'\<^esup> (k'+n')\<close>
	+proof (rule ccontr)
	+ note path = assms(1,2)
	+ note csk = assms(3)
	+ note csn = assms(4)
	+ assume ne: \<open>cs\<^bsup>\<pi>\<^esup> (k+n) \<noteq> cs\<^bsup>\<pi>'\<^esup> (k'+n')\<close>
	+ have nretkn:\<open>\<pi> (k+n) \<noteq> return\<close> proof
	+ assume 1:\<open>\<pi> (k+n) = return\<close>
	+ hence \<open>(\<pi>\<guillemotleft>k) n = return\<close> by auto
	+ hence \<open>(\<pi>'\<guillemotleft>k') n' = return\<close> using last_cs assms(4) by metis
	+ hence \<open>\<pi>' (k' + n') = return\<close> by auto
	+ thus \<open>False\<close> using ne 1 cs_return by auto
	+ qed
	+ hence nretk: \<open>\<pi> k \<noteq> return\<close> using term_path_stable[OF assms(1), of \<open>k\<close> \<open>k +n\<close>] by auto
	+ have nretkn': \<open>\<pi>' (k'+n') \<noteq> return\<close> proof
	+ assume 1:\<open>\<pi>' (k'+n') = return\<close>
	+ hence \<open>(\<pi>'\<guillemotleft>k') n' = return\<close> by auto
	+ hence \<open>(\<pi>\<guillemotleft>k) n = return\<close> using last_cs assms(4) by metis
	+ hence \<open>\<pi> (k + n) = return\<close> by auto
	+ thus \<open>False\<close> using ne 1 cs_return by auto
	+ qed
	+ hence nretk': \<open>\<pi>' k' \<noteq> return\<close> using term_path_stable[OF assms(2), of \<open>k'\<close> \<open>k' +n'\<close>] by auto
	+ have n0:\<open>n > 0\<close> proof (rule ccontr)
	+ assume *: \<open>\<not> 0 < n\<close>
	+ hence 1:\<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> 0 = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n'\<close> using assms(3,4) by auto
	+ have \<open>(\<pi>\<guillemotleft>k) 0 = (\<pi>'\<guillemotleft>k') 0\<close> using assms(3) last_cs path_shift_def by (metis monoid_add_class.add.right_neutral)
	+ hence \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> 0 = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n'\<close> using 1 cs_0 by metis
	+ hence n0': \<open>n' = 0\<close> using cs_inj[of \<open>\<pi>'\<guillemotleft>k'\<close> \<open>0\<close> \<open>n'\<close> ] * assms(2) by (metis path_shift_def assms(4) last_cs nretkn path_path_shift)
	+ thus \<open>False\<close> using ne * assms(3) by fastforce
	+ qed
	+ have n0':\<open>n' > 0\<close> proof (rule ccontr)
	+ assume *: \<open>\<not> 0 < n'\<close>
	+ hence 1:\<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> 0 = cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n\<close> using assms(3,4) by auto
	+ have \<open>(\<pi>'\<guillemotleft>k') 0 = (\<pi>\<guillemotleft>k) 0\<close> using assms(3) last_cs path_shift_def by (metis monoid_add_class.add.right_neutral)
	+ hence \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> 0 = cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n\<close> using 1 cs_0 by metis
	+ hence n0: \<open>n = 0\<close> using cs_inj[of \<open>\<pi>\<guillemotleft>k\<close> \<open>0\<close> \<open>n\<close> ] * assms(1) by (metis path_shift_def assms(4) last_cs nretkn path_path_shift)
	+ thus \<open>False\<close> using ne * assms(3) by fastforce
	+ qed
	+ have cdleswap': \<open>\<forall> j'<k'. (k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j' \<longrightarrow> (\<exists>j<k. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close> proof (rule,rule,rule, rule ccontr)
	+ fix j' assume jk': \<open>j'<k'\<close> and ncdj': \<open>(k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> and ne: \<open>\<not> (\<exists>j<k. k + n cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close>
	+ hence kcdj': \<open>k' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> using cr_wn' by blast
	+
	+ then obtain j where kcdj: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> and csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> using csk cs_path_swap_cd path by metis
	+ hence jk: \<open>j < k\<close> unfolding is_cdi_def by auto
	+
	+ have ncdn: \<open>\<not> (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using ne csj jk by blast
	+
	+ obtain l' where lnocd': \<open>l' = n' \<or> n' cd\<^bsup>\<pi>'\<guillemotleft>k'\<^esup>\<rightarrow> l'\<close> and cslsing': \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l' = [(\<pi>'\<guillemotleft>k') l']\<close>
	+ proof cases
	+ assume \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n' = [(\<pi>'\<guillemotleft>k') n']\<close> thus \<open>thesis\<close> using that[of \<open>n'\<close>] by auto
	+ next
	+ assume *: \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n' \<noteq> [(\<pi>'\<guillemotleft>k') n']\<close>
	+ then obtain x ys where \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n' = [x]@ys@[(\<pi>'\<guillemotleft>k') n']\<close> by (metis append_Cons append_Nil cs_length_g_one cs_length_one(1) neq_Nil_conv)
	+ then obtain l' where \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l' = [x]\<close> and cdl': \<open>n' cd\<^bsup>\<pi>'\<guillemotleft>k'\<^esup>\<rightarrow> l'\<close> using cs_split[of \<open>\<pi>'\<guillemotleft>k'\<close> \<open>n'\<close> \<open>Nil\<close> \<open>x\<close> \<open>ys\<close>] by auto
	+ hence \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l' = [(\<pi>'\<guillemotleft>k') l']\<close> using last_cs by (metis last.simps)
	+ thus \<open>thesis\<close> using that cdl' by auto
	+ qed
	+ hence ln': \<open>l'\<le>n'\<close> unfolding is_cdi_def by auto
	+ hence lcdj': \<open>k'+l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> using jk' ncdj' by (metis add_le_cancel_left cdi_prefix trans_less_add1)
	+
	+ obtain l where lnocd: \<open>l = n \<or> n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> l\<close> and csl: \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l'\<close> using lnocd' proof
	+ assume \<open>l' = n'\<close> thus \<open>thesis\<close> using csn that[of \<open>n\<close>] by auto
	+ next
	+ assume \<open>n' cd\<^bsup>\<pi>'\<guillemotleft>k'\<^esup>\<rightarrow> l'\<close>
	+ then obtain l where \<open>n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> l\<close> \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l'\<close> using cs_path_swap_cd path csn by (metis path_path_shift)
	+ thus \<open>thesis\<close> using that by auto
	+ qed
	+
	+ have cslsing: \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = [(\<pi>\<guillemotleft>k) l]\<close> using cslsing' last_cs csl last.simps by metis
	+
	+ have ln: \<open>l\<le>n\<close> using lnocd unfolding is_cdi_def by auto
	+ hence nretkl: \<open>\<pi> (k + l) \<noteq> return\<close> using term_path_stable[of \<open>\<pi>\<close> \<open>k+l\<close> \<open>k+n\<close>] nretkn path(1) by auto
	+
	+ have *: \<open>n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> l \<Longrightarrow> k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> k+l\<close> using cd_path_shift[of \<open>k\<close> \<open>k+l\<close> \<open>\<pi>\<close> \<open>k+n\<close>] path(1) by auto
	+
	+ have ncdl: \<open>\<not> (k+l) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> apply rule using lnocd apply rule using ncdn apply blast using cd_trans ncdn * by blast
	+
	+ hence \<open>\<exists> i\<in> {j..k+l}. \<pi> i = ipd (\<pi> j)\<close> unfolding is_cdi_def using path(1) jk nretkl by auto
	+ hence \<open>\<exists> i\<in> {k<..k+l}. \<pi> i = ipd (\<pi> j)\<close> using kcdj unfolding is_cdi_def by force
	+
	+ then obtain i where ki: \<open>k < i\<close> and il: \<open>i \<le> k+l\<close> and ipdi: \<open>\<pi> i = ipd (\<pi> j)\<close> by force
	+
	+ hence \<open>(\<pi>\<guillemotleft>k) (i-k) = ipd (\<pi> j)\<close> \<open>i-k \<le> l\<close> by auto
	+ hence pd: \<open>(\<pi>\<guillemotleft>k) l pd\<rightarrow> ipd (\<pi> j)\<close> using cs_single_pd_intermed[OF _ cslsing] path(1) path_path_shift by metis
	+ moreover
	+ have \<open>(\<pi>\<guillemotleft>k) l = \<pi>' (k' + l')\<close> using csl last_cs by (metis path_shift_def)
	+ moreover
	+ have \<open>\<pi> j = \<pi>' j'\<close> using csj last_cs by metis
	+ ultimately
	+ have \<open>\<pi>' (k'+l') pd\<rightarrow> ipd (\<pi>' j')\<close> by simp
	+ moreover
	+ have \<open>ipd (\<pi>' j') pd\<rightarrow> \<pi>' (k'+l')\<close> using ipd_pd_cd[OF lcdj'] .
	+ ultimately
	+ have \<open>\<pi>' (k'+l') = ipd (\<pi>' j')\<close> using pd_antisym by auto
	+ thus \<open>False\<close> using lcdj' unfolding is_cdi_def by force
	+ qed
	+
	+ \<comment> \<open>Symmetric version of the above statement\<close>
	+ have cdleswap: \<open>\<forall> j<k. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<longrightarrow> (\<exists>j'<k'. (k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j' \<and> cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close> proof (rule,rule,rule, rule ccontr)
	+ fix j assume jk: \<open>j<k\<close> and ncdj: \<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> and ne: \<open>\<not> (\<exists>j'<k'. k' + n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j' \<and> cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close>
	+ hence kcdj: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using cr_wn' by blast
	+
	+ then obtain j' where kcdj': \<open>k' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> and csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> using csk cs_path_swap_cd path by metis
	+ hence jk': \<open>j' < k'\<close> unfolding is_cdi_def by auto
	+
	+ have ncdn': \<open>\<not> (k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> using ne csj jk' by blast
	+
	+ obtain l where lnocd: \<open>l = n \<or> n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> l\<close> and cslsing: \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = [(\<pi>\<guillemotleft>k) l]\<close>
	+ proof cases
	+ assume \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n = [(\<pi>\<guillemotleft>k) n]\<close> thus \<open>thesis\<close> using that[of \<open>n\<close>] by auto
	+ next
	+ assume *: \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n \<noteq> [(\<pi>\<guillemotleft>k) n]\<close>
	+ then obtain x ys where \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n = [x]@ys@[(\<pi>\<guillemotleft>k) n]\<close> by (metis append_Cons append_Nil cs_length_g_one cs_length_one(1) neq_Nil_conv)
	+ then obtain l where \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = [x]\<close> and cdl: \<open>n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> l\<close> using cs_split[of \<open>\<pi>\<guillemotleft>k\<close> \<open>n\<close> \<open>Nil\<close> \<open>x\<close> \<open>ys\<close>] by auto
	+ hence \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = [(\<pi>\<guillemotleft>k) l]\<close> using last_cs by (metis last.simps)
	+ thus \<open>thesis\<close> using that cdl by auto
	+ qed
	+ hence ln: \<open>l\<le>n\<close> unfolding is_cdi_def by auto
	+ hence lcdj: \<open>k+l cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using jk ncdj by (metis add_le_cancel_left cdi_prefix trans_less_add1)
	+
	+ obtain l' where lnocd': \<open>l' = n' \<or> n' cd\<^bsup>\<pi>'\<guillemotleft>k'\<^esup>\<rightarrow> l'\<close> and csl: \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l'\<close> using lnocd proof
	+ assume \<open>l = n\<close> thus \<open>thesis\<close> using csn that[of \<open>n'\<close>] by auto
	+ next
	+ assume \<open>n cd\<^bsup>\<pi>\<guillemotleft>k\<^esup>\<rightarrow> l\<close>
	+ then obtain l' where \<open>n' cd\<^bsup>\<pi>'\<guillemotleft>k'\<^esup>\<rightarrow> l'\<close> \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> l = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l'\<close> using cs_path_swap_cd path csn by (metis path_path_shift)
	+ thus \<open>thesis\<close> using that by auto
	+ qed
	+
	+ have cslsing': \<open>cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> l' = [(\<pi>'\<guillemotleft>k') l']\<close> using cslsing last_cs csl last.simps by metis
	+
	+ have ln': \<open>l'\<le>n'\<close> using lnocd' unfolding is_cdi_def by auto
	+ hence nretkl': \<open>\<pi>' (k' + l') \<noteq> return\<close> using term_path_stable[of \<open>\<pi>'\<close> \<open>k'+l'\<close> \<open>k'+n'\<close>] nretkn' path(2) by auto
	+
	+ have *: \<open>n' cd\<^bsup>\<pi>'\<guillemotleft>k'\<^esup>\<rightarrow> l' \<Longrightarrow> k'+n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'+l'\<close> using cd_path_shift[of \<open>k'\<close> \<open>k'+l'\<close> \<open>\<pi>'\<close> \<open>k'+n'\<close>] path(2) by auto
	+
	+ have ncdl': \<open>\<not> (k'+l') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> apply rule using lnocd' apply rule using ncdn' apply blast using cd_trans ncdn' * by blast
	+
	+ hence \<open>\<exists> i'\<in> {j'..k'+l'}. \<pi>' i' = ipd (\<pi>' j')\<close> unfolding is_cdi_def using path(2) jk' nretkl' by auto
	+ hence \<open>\<exists> i'\<in> {k'<..k'+l'}. \<pi>' i' = ipd (\<pi>' j')\<close> using kcdj' unfolding is_cdi_def by force
	+
	+ then obtain i' where ki': \<open>k' < i'\<close> and il': \<open>i' \<le> k'+l'\<close> and ipdi: \<open>\<pi>' i' = ipd (\<pi>' j')\<close> by force
	+
	+ hence \<open>(\<pi>'\<guillemotleft>k') (i'-k') = ipd (\<pi>' j')\<close> \<open>i'-k' \<le> l'\<close> by auto
	+ hence pd: \<open>(\<pi>'\<guillemotleft>k') l' pd\<rightarrow> ipd (\<pi>' j')\<close> using cs_single_pd_intermed[OF _ cslsing'] path(2) path_path_shift by metis
	+ moreover
	+ have \<open>(\<pi>'\<guillemotleft>k') l' = \<pi> (k + l)\<close> using csl last_cs by (metis path_shift_def)
	+ moreover
	+ have \<open>\<pi>' j' = \<pi> j\<close> using csj last_cs by metis
	+ ultimately
	+ have \<open>\<pi> (k+l) pd\<rightarrow> ipd (\<pi> j)\<close> by simp
	+ moreover
	+ have \<open>ipd (\<pi> j) pd\<rightarrow> \<pi> (k+l)\<close> using ipd_pd_cd[OF lcdj] .
	+ ultimately
	+ have \<open>\<pi> (k+l) = ipd (\<pi> j)\<close> using pd_antisym by auto
	+ thus \<open>False\<close> using lcdj unfolding is_cdi_def by force
	+ qed
	+
	+ have cdle: \<open>\<exists>j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> j < k\<close> (is \<open>\<exists> j. ?P j\<close>) proof (rule ccontr)
	+ assume \<open>\<not> (\<exists>j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> j < k)\<close>
	+ hence allge: \<open>\<forall>j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<longrightarrow> k \<le> j\<close> by auto
	+ have allge': \<open>\<forall>j'. (k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j' \<longrightarrow> k' \<le> j'\<close> proof (rule, rule, rule ccontr)
	+ fix j'
	+ assume *: \<open>k' + n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> and \<open>\<not> k' \<le> j'\<close>
	+ then obtain j where \<open>j<k\<close> \<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using cdleswap' by (metis le_neq_implies_less nat_le_linear)
	+ thus \<open>False\<close> using allge by auto
	+ qed
	+ have \<open>cs\<^bsup>\<pi>\<^esup> (k + n) = cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n\<close> using cs_split_shift_nocd[OF assms(1) _ allge] n0 by auto
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>'\<^esup> (k' + n') = cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> using cs_split_shift_nocd[OF assms(2) _ allge'] n0' by auto
	+ ultimately
	+ show \<open>False\<close> using ne assms(4) by auto
	+ qed
	+
	+ define j where \<open>j == GREATEST j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> j < k\<close>
	+ have cdj:\<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> and jk: \<open>j < k\<close> and jge:\<open>\<forall> j'< k. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j' \<longrightarrow> j' \<le> j\<close> proof -
	+ have bound: \<open>\<forall> y. ?P y \<longrightarrow> y \<le> k\<close> by auto
	+ show \<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using GreatestI_nat[of \<open>?P\<close>] j_def bound cdle by blast
	+ show \<open>j < k\<close> using GreatestI_nat[of \<open>?P\<close>] bound j_def cdle by blast
	+ show \<open>\<forall> j'< k. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j' \<longrightarrow> j' \<le> j\<close> using Greatest_le_nat[of \<open>?P\<close>] bound j_def by blast
	+ qed
	+
	+ obtain j' where cdj':\<open>(k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> and csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> and jk': \<open>j' < k'\<close> using cdleswap cdj jk by blast
	+ have jge':\<open>\<forall> i'< k'. (k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i' \<longrightarrow> i' \<le> j'\<close> proof(rule,rule,rule)
	+ fix i'
	+ assume ik': \<open>i' < k'\<close> and cdi': \<open>k' + n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i'\<close>
	+ then obtain i where cdi:\<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> and csi: \<open> cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i\<close> and ik: \<open>i<k\<close> using cdleswap' by force
	+ have ij: \<open>i \<le> j\<close> using jge cdi ik by auto
	+ show \<open>i' \<le> j'\<close> using cs_order_le[OF assms(1,2) csi[symmetric] csj _ ij] cd_not_ret[OF cdi] by simp
	+ qed
	+ have \<open>cs\<^bsup>\<pi>\<^esup> (k + n) = cs\<^bsup>\<pi>\<^esup> j @ cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n\<close> using cs_split_shift_cd[OF cdj jk _ jge] n0 by auto
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>'\<^esup> (k' + n') = cs\<^bsup>\<pi>'\<^esup> j' @ cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> using cs_split_shift_cd[OF cdj' jk' _ jge'] n0' by auto
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>\<^esup> (k+n) = cs\<^bsup>\<pi>'\<^esup> (k'+n')\<close> using csj assms(4) by auto
	+ thus \<open>False\<close> using ne by simp
	+qed
	+
	+lemma cs_eq_is_eq_shifted: assumes \<open>is_path \<pi>\<close> and \<open>is_path \<pi>'\<close> and \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> and \<open>cs\<^bsup>\<pi>\<^esup> (k+n) = cs\<^bsup>\<pi>'\<^esup> (k'+n')\<close> shows \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n'\<close>
	+proof (rule ccontr)
	+ assume ne: \<open>cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n \<noteq> cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close>
	+ have nretkn:\<open>\<pi> (k+n) \<noteq> return\<close> proof
	+ assume 1:\<open>\<pi> (k+n) = return\<close>
	+ hence 2:\<open>\<pi>' (k'+n') = return\<close> using assms(4) last_cs by metis
	+ hence \<open>(\<pi>\<guillemotleft>k) n = return\<close> \<open>(\<pi>'\<guillemotleft>k') n' = return\<close> using 1 by auto
	+ hence \<open>cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n = cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> using cs_return by metis
	+ thus \<open>False\<close> using ne by simp
	+ qed
	+ hence nretk: \<open>\<pi> k \<noteq> return\<close> using term_path_stable[OF assms(1), of \<open>k\<close> \<open>k +n\<close>] by auto
	+ have nretkn': \<open>\<pi>' (k'+n') \<noteq> return\<close> proof
	+ assume 1:\<open>\<pi>' (k'+n') = return\<close>
	+ hence 2:\<open>\<pi> (k+n) = return\<close> using assms(4) last_cs by metis
	+ hence \<open>(\<pi>\<guillemotleft>k) n = return\<close> \<open>(\<pi>'\<guillemotleft>k') n' = return\<close> using 1 by auto
	+ hence \<open>cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n = cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> using cs_return by metis
	+ thus \<open>False\<close> using ne by simp
	+ qed
	+ hence nretk': \<open>\<pi>' k' \<noteq> return\<close> using term_path_stable[OF assms(2), of \<open>k'\<close> \<open>k' +n'\<close>] by auto
	+ have n0:\<open>n > 0\<close> proof (rule ccontr)
	+ assume *: \<open>\<not> 0 < n\<close>
	+ hence \<open>cs\<^bsup>\<pi>'\<^esup> k' = cs\<^bsup>\<pi>'\<^esup> (k'+ n')\<close> using assms(3,4) by auto
	+ hence n0: \<open>n = 0\<close> \<open>n' = 0\<close> using cs_inj[OF assms(2) nretkn', of \<open>k'\<close>] * by auto
	+ have \<open>cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n = cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> unfolding n0 cs_0 by (auto , metis last_cs assms(3))
	+ thus \<open>False\<close> using ne by simp
	+ qed
	+ have n0':\<open>n' > 0\<close> proof (rule ccontr)
	+ assume *: \<open>\<not> 0 < n'\<close>
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>\<^esup> (k+ n)\<close> using assms(3,4) by auto
	+ hence n0: \<open>n = 0\<close> \<open>n' = 0\<close> using cs_inj[OF assms(1) nretkn, of \<open>k\<close>] * by auto
	+ have \<open>cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n = cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> unfolding n0 cs_0 by (auto , metis last_cs assms(3))
	+ thus \<open>False\<close> using ne by simp
	+ qed
	+ have cdle: \<open>\<exists>j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> j < k\<close> (is \<open>\<exists> j. ?P j\<close>) proof (rule ccontr)
	+ assume \<open>\<not> (\<exists>j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> j < k)\<close>
	+ hence allge: \<open>\<forall>j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<longrightarrow> k \<le> j\<close> by auto
	+ have allge': \<open>\<forall>j'. (k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j' \<longrightarrow> k' \<le> j'\<close> proof (rule, rule)
	+ fix j'
	+ assume *: \<open>k' + n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close>
	+ obtain j where cdj: \<open>k+n cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> and csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> using cs_path_swap_cd[OF assms(2,1) assms(4)[symmetric] *] by metis
	+ hence kj:\<open>k \<le> j\<close> using allge by auto
	+ thus kj': \<open>k' \<le> j'\<close> using cs_order_le[OF assms(1,2,3) csj nretk] by simp
	+ qed
	+ have \<open>cs\<^bsup>\<pi>\<^esup> (k + n) = cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n\<close> using cs_split_shift_nocd[OF assms(1) _ allge] n0 by auto
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>'\<^esup> (k' + n') = cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> using cs_split_shift_nocd[OF assms(2) _ allge'] n0' by auto
	+ ultimately
	+ show \<open>False\<close> using ne assms(4) by auto
	+ qed
	+ define j where \<open>j == GREATEST j. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j \<and> j < k\<close>
	+ have cdj:\<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> and jk: \<open>j < k\<close> and jge:\<open>\<forall> j'< k. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j' \<longrightarrow> j' \<le> j\<close> proof -
	+ have bound: \<open>\<forall> y. ?P y \<longrightarrow> y \<le> k\<close> by auto
	+ show \<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> using GreatestI_nat[of \<open>?P\<close>] bound j_def cdle by blast
	+ show \<open>j < k\<close> using GreatestI_nat[of \<open>?P\<close>] bound j_def cdle by blast
	+ show \<open>\<forall> j'< k. (k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> j' \<longrightarrow> j' \<le> j\<close> using Greatest_le_nat[of \<open>?P\<close>] bound j_def by blast
	+ qed
	+ obtain j' where cdj':\<open>(k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> j'\<close> and csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> using cs_path_swap_cd assms cdj by blast
	+ have jge':\<open>\<forall> i'< k'. (k'+n') cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i' \<longrightarrow> i' \<le> j'\<close> proof(rule,rule,rule)
	+ fix i'
	+ assume ik': \<open>i' < k'\<close> and cdi': \<open>k' + n' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i'\<close>
	+ then obtain i where cdi:\<open>(k+n) cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> and csi: \<open> cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i\<close> using cs_path_swap_cd[OF assms(2,1) assms(4)[symmetric]] by blast
	+ have nreti': \<open>\<pi>' i' \<noteq> return\<close> by (metis cd_not_ret cdi')
	+ have ik: \<open>i < k\<close> using cs_order[OF assms(2,1) csi _ nreti' ik'] assms(3) by auto
	+ have ij: \<open>i \<le> j\<close> using jge cdi ik by auto
	+ show \<open>i' \<le> j'\<close> using cs_order_le[OF assms(1,2) csi[symmetric] csj _ ij] cd_not_ret[OF cdi] by simp
	+ qed
	+ have jk': \<open>j' < k'\<close> using cs_order[OF assms(1,2) csj assms(3) cd_not_ret[OF cdj] jk] .
	+ have \<open>cs\<^bsup>\<pi>\<^esup> (k + n) = cs\<^bsup>\<pi>\<^esup> j @ cs\<^bsup>\<pi> \<guillemotleft> k\<^esup> n\<close> using cs_split_shift_cd[OF cdj jk _ jge] n0 by auto
	+ moreover
	+ have \<open>cs\<^bsup>\<pi>'\<^esup> (k' + n') = cs\<^bsup>\<pi>'\<^esup> j' @ cs\<^bsup>\<pi>' \<guillemotleft> k'\<^esup> n'\<close> using cs_split_shift_cd[OF cdj' jk' _ jge'] n0' by auto
	+ ultimately
	+ have \<open>cs\<^bsup>\<pi>\<guillemotleft>k\<^esup> n = cs\<^bsup>\<pi>'\<guillemotleft>k'\<^esup> n'\<close> using csj assms(4) by auto
	+ thus \<open>False\<close> using ne by simp
	+qed
	+
	+lemma converged_cd_diverge_cs: assumes \<open>is_path \<pi>\<close> and \<open>is_path \<pi>'\<close> and \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> and \<open>j<l\<close> and \<open>\<not> (\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l')\<close> and \<open>l < m\<close> and \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close>
	+obtains k k' where \<open>j\<le>k\<close> \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> and \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> and \<open>\<pi> (Suc k) \<noteq> \<pi>' (Suc k')\<close>
	+ proof -
	+ have \<open>is_path (\<pi>\<guillemotleft>j)\<close> \<open>is_path (\<pi>'\<guillemotleft>j')\<close> using assms(1,2) path_path_shift by auto
	+ moreover
	+ have \<open>(\<pi>\<guillemotleft>j) 0 = (\<pi>'\<guillemotleft>j') 0\<close> using assms(3) last_cs by (metis path_shift_def add.right_neutral)
	+ moreover
	+ have \<open>\<not>(\<exists>l'. cs\<^bsup>\<pi>\<guillemotleft>j\<^esup> (l-j) = cs\<^bsup>\<pi>'\<guillemotleft>j'\<^esup> l')\<close> proof
	+ assume \<open>\<exists>l'. cs\<^bsup>\<pi> \<guillemotleft> j\<^esup> (l - j) = cs\<^bsup>\<pi>' \<guillemotleft> j'\<^esup> l'\<close>
	+ then obtain l' where csl: \<open>cs\<^bsup>\<pi>\<guillemotleft>j\<^esup> (l - j) = cs\<^bsup>\<pi>'\<guillemotleft>j'\<^esup> l'\<close> by blast
	+
	+ have \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> (j' + l')\<close> using shifted_cs_eq_is_eq[OF assms(1,2,3) csl] assms(4) by auto
	+ thus \<open>False\<close> using assms(5) by blast
	+ qed
	+ moreover
	+ have \<open>l-j < m-j\<close> using assms by auto
	+ moreover
	+ have \<open>\<pi> j \<noteq> return\<close> using cs_return assms(1-5) term_path_stable by (metis nat_less_le)
	+ hence \<open>j'<m'\<close> using cs_order[OF assms(1,2,3,7)] assms by auto
	+ hence \<open>cs\<^bsup>\<pi>\<guillemotleft>j\<^esup> (m-j) = cs\<^bsup>\<pi>'\<guillemotleft>j'\<^esup> (m'-j')\<close> using cs_eq_is_eq_shifted[OF assms(1,2,3),of \<open>m-j\<close> \<open>m'-j'\<close>] assms(4,6,7) by auto
	+ ultimately
	+ obtain k k' where csk: \<open>cs\<^bsup>\<pi>\<guillemotleft>j\<^esup> k = cs\<^bsup>\<pi>'\<guillemotleft>j'\<^esup> k'\<close> and lcdk: \<open>l-j cd\<^bsup>\<pi>\<guillemotleft>j\<^esup>\<rightarrow> k\<close> and suc:\<open>(\<pi>\<guillemotleft>j) (Suc k) \<noteq> (\<pi>'\<guillemotleft>j') (Suc k')\<close> using converged_cd_diverge by blast
	+
	+ have \<open>cs\<^bsup>\<pi>\<^esup> (j+k) = cs\<^bsup>\<pi>'\<^esup> (j'+k')\<close> using shifted_cs_eq_is_eq[OF assms(1-3) csk] .
	+ moreover
	+ have \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> j+k\<close> using lcdk assms(1,2,4) by (metis add.commute add_diff_cancel_right' cd_path_shift le_add1)
	+ moreover
	+ have \<open>\<pi> (Suc (j+k)) \<noteq> \<pi>' (Suc (j'+ k'))\<close> using suc by auto
	+ moreover
	+ have \<open>j \<le> j+k\<close> by auto
	+ ultimately
	+ show \<open>thesis\<close> using that[of \<open>j+k\<close> \<open>j'+k'\<close>] by auto
	+qed
	+
	+
	+lemma cs_ipd_conv: assumes csk: \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> and ipd: \<open>\<pi> l = ipd (\<pi> k)\<close> \<open>\<pi>' l' = ipd(\<pi>' k')\<close>
	+ and nipd: \<open>\<forall>n\<in>{k..<l}. \<pi> n \<noteq> ipd (\<pi> k)\<close> \<open>\<forall>n'\<in>{k'..<l'}. \<pi>' n' \<noteq> ipd (\<pi>' k')\<close> and kl: \<open>k < l\<close> \<open>k' < l'\<close>
	+shows \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> using cs_ipd[OF ipd(1) nipd(1) kl(1)] cs_ipd[OF ipd(2) nipd(2) kl(2)] csk ipd by (metis (no_types) last_cs)
	+
	+lemma cp_eq_cs: assumes \<open>((\<sigma>,k),(\<sigma>',k'))\<in>cp\<close> shows \<open>cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k'\<close>
	+ using assms
	+ apply(induction rule: cp.induct)
	+ apply blast+
	+ apply simp
	+ done
	+
	+lemma cd_cs_swap: assumes \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<close> \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close> \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> shows \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> k'\<close> proof -
	+ have \<open>\<exists> i. l icd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> using assms(1) excd_impl_exicd by blast
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> l \<noteq> [\<pi> l]\<close> by auto
	+ hence \<open>cs\<^bsup>\<pi>'\<^esup> l' \<noteq> [\<pi>' l']\<close> using assms last_cs by metis
	+ hence \<open>\<exists> i'. l' icd\<^bsup>\<pi>'\<^esup>\<rightarrow> i'\<close> by (metis cs_cases)
	+ hence path': \<open>is_path \<pi>'\<close> unfolding is_icdi_def is_cdi_def by auto
	+ from cd_in_cs[OF assms(1)]
	+ obtain ys where csl: \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>\<^esup> k @ ys @ [\<pi> l]\<close> by blast
	+ obtain xs where csk: \<open>cs\<^bsup>\<pi>\<^esup> k = xs@[\<pi> k]\<close> by (metis append_butlast_last_id cs_not_nil last_cs)
	+ have \<pi>l: \<open>\<pi> l = \<pi>' l'\<close> using assms last_cs by metis
	+ have csl': \<open>cs\<^bsup>\<pi>'\<^esup> l' = xs@[\<pi> k]@ys@[\<pi>' l']\<close> by (metis \<pi>l append_eq_appendI assms(2) csk csl)
	+ from cs_split[of \<open>\<pi>'\<close> \<open>l'\<close> \<open>xs\<close> \<open>\<pi> k\<close> \<open>ys\<close>]
	+ obtain m where csm: \<open>cs\<^bsup>\<pi>'\<^esup> m = xs @ [\<pi> k]\<close> and lcdm: \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> m\<close> using csl' by metis
	+ have csm': \<open>cs\<^bsup>\<pi>'\<^esup> m = cs\<^bsup>\<pi>'\<^esup> k'\<close> by (metis assms(3) csk csm)
	+ have \<open>\<pi>' m \<noteq> return\<close> using lcdm unfolding is_cdi_def using term_path_stable by (metis nat_less_le)
	+ hence \<open>m = k'\<close> using cs_inj path' csm' by auto
	+ thus \<open>?thesis\<close> using lcdm by auto
	+qed
	+
	+
	+subsection \<open>Facts about Observations\<close>
	+lemma kth_obs_not_none: assumes \<open>is_kth_obs (path \<sigma>) k i\<close> obtains a where \<open>obsp \<sigma> i = Some a\<close> using assms unfolding is_kth_obs_def obsp_def by auto
	+
	+lemma kth_obs_unique: \<open>is_kth_obs \<pi> k i \<Longrightarrow> is_kth_obs \<pi> k j \<Longrightarrow> i = j\<close> proof (induction \<open>i\<close> \<open>j\<close> rule: nat_sym_cases)
	+ case sym thus \<open>?case\<close> by simp
	+next
	+ case eq thus \<open>?case\<close> by simp
	+next
	+ case (less i j)
	+ have \<open>obs_ids \<pi> \<inter> {..<i} \<subseteq> obs_ids \<pi> \<inter> {..<j}\<close> using less(1) by auto
	+ moreover
	+ have \<open>i \<in> obs_ids \<pi> \<inter> {..<j}\<close> using less unfolding is_kth_obs_def obs_ids_def by auto
	+ moreover
	+ have \<open>i \<notin> obs_ids \<pi> \<inter> {..<i}\<close> by auto
	+ moreover
	+ have \<open>card (obs_ids \<pi> \<inter> {..<i}) = card (obs_ids \<pi> \<inter> {..<j})\<close> using less.prems unfolding is_kth_obs_def by auto
	+ moreover
	+ have \<open>finite (obs_ids \<pi> \<inter> {..<i})\<close> \<open>finite (obs_ids \<pi> \<inter> {..<j})\<close> by auto
	+ ultimately
	+ have \<open>False\<close> by (metis card_subset_eq)
	+ thus \<open>?case\<close> ..
	+qed
	+
	+lemma obs_none_no_kth_obs: assumes \<open>obs \<sigma> k = None\<close> shows \<open>\<not> (\<exists> i. is_kth_obs (path \<sigma>) k i)\<close>
	+ apply rule
	+ using assms
	+ unfolding obs_def obsp_def
	+ apply (auto split: option.split_asm)
	+ by (metis assms kth_obs_not_none kth_obs_unique obs_def option.distinct(2) the_equality)
	+
	+lemma obs_some_kth_obs : assumes \<open>obs \<sigma> k \<noteq> None\<close> obtains i where \<open>is_kth_obs (path \<sigma>) k i\<close> by (metis obs_def assms)
	+
	+lemma not_none_is_obs: assumes \<open>att(\<pi> i) \<noteq> None\<close> shows \<open>is_kth_obs \<pi> (card (obs_ids \<pi> \<inter> {..<i})) i\<close> unfolding is_kth_obs_def using assms by auto
	+
	+lemma in_obs_ids_is_kth_obs: assumes \<open>i \<in> obs_ids \<pi>\<close> obtains k where \<open>is_kth_obs \<pi> k i\<close> proof
	+ have \<open>att (\<pi> i) \<noteq> None\<close> using assms obs_ids_def by auto
	+ thus \<open>is_kth_obs \<pi> (card (obs_ids \<pi> \<inter> {..<i})) i\<close> using not_none_is_obs by auto
	+qed
	+
	+lemma kth_obs_stable: assumes \<open>is_kth_obs \<pi> l j\<close> \<open>k < l\<close> shows \<open>\<exists> i. is_kth_obs \<pi> k i\<close> using assms proof (induction \<open>l\<close> arbitrary: \<open>j\<close> rule: less_induct )
	+ case (less l j)
	+ have cardl: \<open>card (obs_ids \<pi> \<inter> {..<j}) = l\<close> using less is_kth_obs_def by auto
	+ then obtain i where ex: \<open>i \<in> obs_ids \<pi> \<inter> {..<j}\<close> (is \<open>?P i\<close>) using less(3) by (metis card.empty empty_iff less_irrefl subsetI subset_antisym zero_diff zero_less_diff)
	+ have bound: \<open>\<forall> i. i \<in> obs_ids \<pi> \<inter> {..<j} \<longrightarrow> i \<le> j\<close> by auto
	+ let \<open>?i\<close> = \<open>GREATEST i. i \<in> obs_ids \<pi> \<inter> {..<j}\<close>
	+ have *: \<open>?i < j\<close> \<open>?i \<in> obs_ids \<pi>\<close> using GreatestI_nat[of \<open>?P\<close> \<open>i\<close> \<open>j\<close>] ex bound by auto
	+ have **: \<open>\<forall> i. i \<in> obs_ids \<pi> \<and> i<j \<longrightarrow> i \<le> ?i\<close> using Greatest_le_nat[of \<open>?P\<close> _ \<open>j\<close>] ex bound by auto
	+ have \<open>(obs_ids \<pi> \<inter> {..<?i}) \<union> {?i} = obs_ids \<pi> \<inter> {..<j}\<close> apply rule apply auto using [simplified] apply simp+ using *[simplified] by auto
	+ moreover
	+ have \<open>?i \<notin> (obs_ids \<pi> \<inter> {..<?i})\<close> by auto
	+ ultimately
	+ have \<open>Suc (card (obs_ids \<pi> \<inter> {..<?i})) = l\<close> using cardl by (metis Un_empty_right Un_insert_right card_insert_disjoint finite_Int finite_lessThan)
	+ hence \<open>card (obs_ids \<pi> \<inter> {..<?i}) = l - 1\<close> by auto
	+ hence iko: \<open>is_kth_obs \<pi> (l - 1) ?i\<close> using *(2) unfolding is_kth_obs_def obs_ids_def by auto
	+ have ll: \<open>l - 1 < l\<close> by (metis One_nat_def diff_Suc_less less.prems(2) not_gr0 not_less0)
	+ note IV=less(1)[OF ll iko]
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>k < l - 1\<close> thus \<open>?thesis\<close> using IV by simp
	+ next
	+ assume \<open>\<not> k < l - 1\<close>
	+ hence \<open>k = l - 1\<close> using less by auto
	+ thus \<open>?thesis\<close> using iko by blast
	+ qed
	+qed
	+
	+lemma kth_obs_mono: assumes \<open>is_kth_obs \<pi> k i\<close> \<open>is_kth_obs \<pi> l j\<close> \<open>k < l\<close> shows \<open>i < j\<close> proof (rule ccontr)
	+ assume \<open>\<not> i < j\<close>
	+ hence \<open>{..<j} \<subseteq> {..<i}\<close> by auto
	+ hence \<open>obs_ids \<pi> \<inter> {..<j} \<subseteq> obs_ids \<pi> \<inter> {..<i}\<close> by auto
	+ moreover
	+ have \<open>finite (obs_ids \<pi> \<inter> {..<i})\<close> by auto
	+ ultimately
	+ have \<open>card (obs_ids \<pi> \<inter> {..<j}) \<le> card (obs_ids \<pi> \<inter> {..<i})\<close> by (metis card_mono)
	+ thus \<open>False\<close> using assms unfolding is_kth_obs_def by auto
	+qed
	+
	+lemma kth_obs_le_iff: assumes \<open>is_kth_obs \<pi> k i\<close> \<open>is_kth_obs \<pi> l j\<close> shows \<open>k < l \<longleftrightarrow> i < j\<close> by (metis assms kth_obs_unique kth_obs_mono not_less_iff_gr_or_eq)
	+
	+lemma ret_obs_all_obs: assumes path: \<open>is_path \<pi>\<close> and iki: \<open>is_kth_obs \<pi> k i\<close> and ret: \<open>\<pi> i = return\<close> and kl: \<open>k < l\<close> obtains j where \<open>is_kth_obs \<pi> l j\<close>
	+proof-
	+ show \<open>thesis\<close>
	+ using kl iki ret proof (induction \<open>l - k\<close> arbitrary: \<open>k\<close> \<open>i\<close> rule: less_induct)
	+ case (less k i)
	+ note kl = \<open>k < l\<close>
	+ note iki = \<open>is_kth_obs \<pi> k i\<close>
	+ note ret = \<open>\<pi> i = return\<close>
	+ have card: \<open>card (obs_ids \<pi> \<inter> {..<i}) = k\<close> and att_ret: \<open>att return \<noteq> None\<close>using iki ret unfolding is_kth_obs_def by auto
	+ have rets: \<open>\<pi> (Suc i) = return\<close> using path ret term_path_stable by auto
	+ hence attsuc: \<open>att (\<pi> (Suc i)) \<noteq> None\<close> using att_ret by auto
	+ hence *: \<open>i \<in> obs_ids \<pi>\<close> using att_ret ret unfolding obs_ids_def by auto
	+ have \<open>{..< Suc i} = insert i {..<i}\<close> by auto
	+ hence a: \<open>obs_ids \<pi> \<inter> {..< Suc i} = insert i (obs_ids \<pi> \<inter> {..<i})\<close> using * by auto
	+ have b: \<open>i \<notin> obs_ids \<pi> \<inter> {..<i}\<close> by auto
	+ have \<open>finite (obs_ids \<pi> \<inter> {..<i})\<close> by auto
	+ hence \<open>card (obs_ids \<pi> \<inter> {..<Suc i}) = Suc k\<close> by (metis card card_insert_disjoint a b)
	+ hence iksuc: \<open>is_kth_obs \<pi> (Suc k) (Suc i)\<close> using attsuc unfolding is_kth_obs_def by auto
	+ have suckl: \<open>Suc k \<le> l\<close> using kl by auto
	+ note less
	+ thus \<open>thesis\<close> proof (cases \<open>Suc k < l\<close>)
	+ assume skl: \<open>Suc k < l\<close>
	+ from less(1)[OF _ skl iksuc rets] skl
	+ show \<open>thesis\<close> by auto
	+ next
	+ assume \<open>\<not> Suc k < l\<close>
	+ hence \<open>Suc k = l\<close> using suckl by auto
	+ thus \<open>thesis\<close> using iksuc that by auto
	+ qed
	+ qed
	+qed
	+
	+lemma no_kth_obs_missing_cs: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and iki: \<open>is_kth_obs \<pi> k i\<close> and not_in_\<pi>': \<open>\<not>(\<exists>i'. is_kth_obs \<pi>' k i')\<close> obtains l j where \<open>is_kth_obs \<pi> l j\<close> \<open>\<not> (\<exists> j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close>
	+proof (rule ccontr)
	+ assume \<open>\<not> thesis\<close>
	+ hence all_in_\<pi>': \<open>\<forall> l j. is_kth_obs \<pi> l j \<longrightarrow> (\<exists> j' . cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close> using that by blast
	+ then obtain i' where csi: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> using assms by blast
	+ hence \<open>att(\<pi>' i') \<noteq> None\<close> using iki by (metis is_kth_obs_def last_cs)
	+ then obtain k' where ik': \<open>is_kth_obs \<pi>' k' i'\<close> by (metis not_none_is_obs)
	+ hence kk': \<open>k' < k\<close> using not_in_\<pi>' kth_obs_stable by (auto, metis not_less_iff_gr_or_eq)
	+ show \<open>False\<close> proof (cases \<open>\<pi> i = return\<close>)
	+ assume \<open>\<pi> i \<noteq> return\<close>
	+ thus \<open>False\<close> using kk' ik' csi iki proof (induction \<open>k\<close> arbitrary: \<open>i\<close> \<open>i'\<close> \<open>k'\<close> )
	+ case 0 thus \<open>?case\<close> by simp
	+ next
	+ case (Suc k i i' k')
	+ then obtain j where ikj: \<open>is_kth_obs \<pi> k j\<close> by (metis kth_obs_stable lessI)
	+ then obtain j' where csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> using all_in_\<pi>' by blast
	+ hence \<open>att(\<pi>' j') \<noteq> None\<close> using ikj by (metis is_kth_obs_def last_cs)
	+ then obtain k2 where ik2: \<open>is_kth_obs \<pi>' k2 j'\<close> by (metis not_none_is_obs)
	+ have ji: \<open>j < i\<close> using kth_obs_mono [OF ikj \<open>is_kth_obs \<pi> (Suc k) i\<close>] by auto
	+ hence nretj: \<open>\<pi> j \<noteq> return\<close> using Suc(2) term_path_stable less_imp_le path(1) by metis
	+ have ji': \<open>j' < i'\<close> using cs_order[OF path _ _ nretj, of \<open>j'\<close> \<open>i\<close> \<open>i'\<close>] csj \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> ji by auto
	+ have \<open>k2 \<noteq> k'\<close> using ik2 Suc(4) ji' kth_obs_unique[of \<open>\<pi>'\<close> \<open>k'\<close> \<open>i'\<close> \<open>j'\<close>] by (metis less_irrefl)
	+ hence k2k': \<open>k2 < k'\<close> using kth_obs_mono[OF \<open>is_kth_obs \<pi>' k' i'\<close> ik2] ji' by (metis not_less_iff_gr_or_eq)
	+ hence k2k: \<open>k2 < k\<close> using Suc by auto
	+ from Suc.IH[OF nretj k2k ik2 csj ikj] show \<open>False\<close> .
	+ qed
	+ next
	+ assume \<open>\<pi> i = return\<close>
	+ hence reti': \<open>\<pi>' i' = return\<close> by (metis csi last_cs)
	+ from ret_obs_all_obs[OF path(2) ik' reti' kk', of \<open>False\<close>] not_in_\<pi>'
	+ show \<open>False\<close> by blast
	+ qed
	+qed
	+
	+lemma kth_obs_cs_missing_cs: assumes path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> and iki: \<open>is_kth_obs \<pi> k i\<close> and iki': \<open>is_kth_obs \<pi>' k i'\<close> and csi: \<open>cs\<^bsup>\<pi>\<^esup> i \<noteq> cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+obtains l j where \<open>j \<le> i\<close> \<open>is_kth_obs \<pi> l j\<close> \<open>\<not> (\<exists> j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close> \| l' j' where \<open>j' \<le> i'\<close> \<open>is_kth_obs \<pi>' l' j'\<close> \<open>\<not> (\<exists> j. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close>
	+proof (rule ccontr)
	+ assume nt: \<open>\<not> thesis\<close>
	+ show \<open>False\<close> using iki iki' csi that proof (induction \<open>k\<close> arbitrary: \<open>i\<close> \<open>i'\<close> rule: less_induct)
	+ case (less k i i')
	+ hence all_in_\<pi>': \<open>\<forall> l j. j\<le>i \<and> is_kth_obs \<pi> l j \<longrightarrow> (\<exists> j' . cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close>
	+ and all_in_\<pi>: \<open>\<forall> l' j'. j' \<le> i' \<and> is_kth_obs \<pi>' l' j' \<longrightarrow> (\<exists> j . cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close> by (metis nt) (metis nt less(6))
	+ obtain j j' where csji: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> i'\<close> and csij: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> j'\<close> using all_in_\<pi> all_in_\<pi>' less by blast
	+ then obtain l l' where ilj: \<open>is_kth_obs \<pi> l j\<close> and ilj': \<open>is_kth_obs \<pi>' l' j'\<close> by (metis is_kth_obs_def last_cs less.prems(1,2))
	+ have lnk: \<open>l \<noteq> k\<close> using ilj csji less(2) less(4) kth_obs_unique by auto
	+ have lnk': \<open>l' \<noteq> k\<close> using ilj' csij less(3) less(4) kth_obs_unique by auto
	+ have cseq: \<open>\<forall> l j j'. l < k \<and> is_kth_obs \<pi> l j \<and> is_kth_obs \<pi>' l j' \<longrightarrow> cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> proof -
	+ { fix t p p' assume tk: \<open>t < k\<close> and ikp: \<open>is_kth_obs \<pi> t p\<close> and ikp': \<open>is_kth_obs \<pi>' t p'\<close>
	+ hence pi: \<open>p < i\<close> and pi': \<open>p' < i'\<close> by (metis kth_obs_mono less.prems(1)) (metis kth_obs_mono less.prems(2) tk ikp')
	+ have *: \<open>\<And>j l. j \<le> p \<Longrightarrow> is_kth_obs \<pi> l j \<Longrightarrow> \<exists>j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> using pi all_in_\<pi>' by auto
	+ have **: \<open>\<And>j' l'. j' \<le> p' \<Longrightarrow> is_kth_obs \<pi>' l' j' \<Longrightarrow> \<exists>j. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> using pi' all_in_\<pi> by auto
	+ have \<open>cs\<^bsup>\<pi>\<^esup> p = cs\<^bsup>\<pi>'\<^esup> p'\<close> apply(rule ccontr) using less(1)[OF tk ikp ikp'] * ** by blast
	+ }
	+ thus \<open>?thesis\<close> by blast
	+ qed
	+ have ii'nret: \<open>\<pi> i \<noteq> return \<or> \<pi>' i' \<noteq> return\<close> using less cs_return by auto
	+ have a: \<open>k < l \<or> k < l'\<close> proof (rule ccontr)
	+ assume \<open>\<not>(k < l \<or> k < l')\<close>
	+ hence *: \<open>l < k\<close> \<open>l' < k\<close> using lnk lnk' by auto
	+ hence ji: \<open>j < i\<close> and ji': \<open>j' < i'\<close> using ilj ilj' less(2,3) kth_obs_mono by auto
	+ show \<open>False\<close> using ii'nret proof
	+ assume nreti: \<open>\<pi> i \<noteq> return\<close>
	+ hence nretj': \<open>\<pi>' j' \<noteq> return\<close> using last_cs csij by metis
	+ show \<open>False\<close> using cs_order[OF path(2,1) csij[symmetric] csji[symmetric] nretj' ji'] ji by simp
	+ next
	+ assume nreti': \<open>\<pi>' i' \<noteq> return\<close>
	+ hence nretj': \<open>\<pi> j \<noteq> return\<close> using last_cs csji by metis
	+ show \<open>False\<close> using cs_order[OF path csji csij nretj' ji] ji' by simp
	+ qed
	+ qed
	+ have \<open>l < k \<or> l' < k\<close> proof (rule ccontr)
	+ assume \<open>\<not> (l< k \<or> l' < k)\<close>
	+ hence \<open>k < l\<close> \<open>k < l'\<close> using lnk lnk' by auto
	+ hence ji: \<open>i < j\<close> and ji': \<open>i' < j'\<close> using ilj ilj' less(2,3) kth_obs_mono by auto
	+ show \<open>False\<close> using ii'nret proof
	+ assume nreti: \<open>\<pi> i \<noteq> return\<close>
	+ show \<open>False\<close> using cs_order[OF path csij csji nreti ji] ji' by simp
	+ next
	+ assume nreti': \<open>\<pi>' i' \<noteq> return\<close>
	+ show \<open>False\<close> using cs_order[OF path(2,1) csji[symmetric] csij[symmetric] nreti' ji'] ji by simp
	+ qed
	+ qed
	+ hence \<open>k < l \<and> l' < k \<or> k < l' \<and> l < k\<close> using a by auto
	+ thus \<open>False\<close> proof
	+ assume \<open>k < l \<and> l' < k\<close>
	+ hence kl: \<open>k < l\<close> and lk': \<open>l' < k\<close> by auto
	+ hence ij: \<open>i < j\<close> and ji': \<open>j' < i'\<close> using less(2,3) ilj ilj' kth_obs_mono by auto
	+ have nreti: \<open>\<pi> i \<noteq> return\<close> by (metis csji ii'nret ij last_cs path(1) term_path_stable less_imp_le)
	+ obtain h where ilh: \<open>is_kth_obs \<pi> l' h\<close> using ji' all_in_\<pi> ilj' no_kth_obs_missing_cs path(1) path(2) by (metis kl lk' ilj kth_obs_stable)
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> h = cs\<^bsup>\<pi>'\<^esup> j'\<close> using cseq lk' ilj' by blast
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>\<^esup> h\<close> using csij by auto
	+ hence hi: \<open>h = i\<close> using cs_inj nreti path(1) by metis
	+ have \<open>l' = k\<close> using less(2) ilh unfolding hi by (metis is_kth_obs_def)
	+ thus \<open>False\<close> using lk' by simp
	+ next
	+ assume \<open>k < l' \<and> l < k\<close>
	+ hence kl': \<open>k < l'\<close> and lk: \<open>l < k\<close> by auto
	+ hence ij': \<open>i' < j'\<close> and ji: \<open>j < i\<close> using less(2,3) ilj ilj' kth_obs_mono by auto
	+ have nreti': \<open>\<pi>' i' \<noteq> return\<close> by (metis csij ii'nret ij' last_cs path(2) term_path_stable less_imp_le)
	+ obtain h' where ilh': \<open>is_kth_obs \<pi>' l h'\<close> using all_in_\<pi>' ilj no_kth_obs_missing_cs path(1) path(2) kl' lk ilj' kth_obs_stable by metis
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> h'\<close> using cseq lk ilj by blast
	+ hence \<open>cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>'\<^esup> h'\<close> using csji by auto
	+ hence hi: \<open>h' = i'\<close> using cs_inj nreti' path(2) by metis
	+ have \<open>l = k\<close> using less(3) ilh' unfolding hi by (metis is_kth_obs_def)
	+ thus \<open>False\<close> using lk by simp
	+ qed
	+ qed
	+qed
	+
	+
	+subsection \<open>Facts about Data\<close>
	+
	+lemma reads_restrict1: \<open>\<sigma> \<restriction> (reads n) = \<sigma>' \<restriction> (reads n) \<Longrightarrow> \<forall> x \<in> reads n. \<sigma> x = \<sigma>' x\<close> by (metis restrict_def)
	+
	+lemma reads_restrict2: \<open>\<forall> x \<in> reads n. \<sigma> x = \<sigma>' x \<Longrightarrow> \<sigma> \<restriction> (reads n) = \<sigma>' \<restriction> (reads n)\<close> unfolding restrict_def by auto
	+
	+lemma reads_restrict: \<open>(\<sigma> \<restriction> (reads n) = \<sigma>' \<restriction> (reads n)) = (\<forall> x \<in> reads n. \<sigma> x = \<sigma>' x)\<close> using reads_restrict1 reads_restrict2 by metis
	+
	+lemma reads_restr_suc: \<open>\<sigma> \<restriction> (reads n) = \<sigma>' \<restriction> (reads n) \<Longrightarrow> suc n \<sigma> = suc n \<sigma>'\<close> by (metis reads_restrict uses_suc)
	+
	+lemma reads_restr_sem: \<open>\<sigma> \<restriction> (reads n) = \<sigma>' \<restriction> (reads n) \<Longrightarrow> \<forall> v \<in> writes n. sem n \<sigma> v = sem n \<sigma>' v\<close> by (metis reads_restrict1 uses_writes)
	+
	+lemma reads_obsp: assumes \<open>path \<sigma> k = path \<sigma>' k'\<close> \<open>\<sigma>\<^bsup>k\<^esup> \<restriction> (reads (path \<sigma> k)) = \<sigma>'\<^bsup>k'\<^esup> \<restriction> (reads (path \<sigma> k))\<close> shows \<open>obsp \<sigma> k = obsp \<sigma>' k'\<close>
	+ using assms(2) uses_att
	+ unfolding obsp_def assms(1) reads_restrict
	+ apply (cases \<open>att (path \<sigma>' k')\<close>)
	+ by auto
	+
	+lemma no_writes_unchanged0: assumes \<open>\<forall> l<k. v\<notin> writes(path \<sigma> l)\<close> shows \<open>(\<sigma>\<^bsup>k\<^esup>) v = \<sigma> v\<close> using assms
	+proof (induction \<open>k\<close>)
	+ case 0 thus \<open>?case\<close> by(auto simp add: kth_state_def)
	+next
	+ case (Suc k)
	+ hence \<open>(\<sigma>\<^bsup>k\<^esup>) v = \<sigma> v\<close> by auto
	+ moreover
	+ have \<open>\<sigma>\<^bsup>Suc k\<^esup> = snd ( step (path \<sigma> k,\<sigma>\<^bsup>k\<^esup>))\<close> by (metis kth_state_suc)
	+ hence \<open>\<sigma>\<^bsup>Suc k\<^esup> = sem (path \<sigma> k) (\<sigma>\<^bsup>k\<^esup>)\<close> by (metis step_suc_sem snd_conv)
	+ moreover
	+ have \<open>v \<notin> writes (path \<sigma> k)\<close> using Suc.prems by blast
	+ ultimately
	+ show \<open>?case\<close> using writes by metis
	+qed
	+
	+lemma written_read_dd: assumes \<open>is_path \<pi>\<close> \<open>v \<in> reads (\<pi> k) \<close> \<open>v \<in> writes (\<pi> j)\<close> \<open>j<k\<close> obtains l where \<open>k dd\<^bsup>\<pi>,v\<^esup>\<rightarrow> l\<close>
	+proof -
	+ let \<open>?l\<close> = \<open>GREATEST l. l < k \<and> v \<in> writes (\<pi> l)\<close>
	+ have \<open>?l < k\<close> by (metis (no_types, lifting) GreatestI_ex_nat assms(3) assms(4) less_or_eq_imp_le)
	+ moreover
	+ have \<open>v \<in> writes (\<pi> ?l)\<close> by (metis (no_types, lifting) GreatestI_nat assms(3) assms(4) less_or_eq_imp_le)
	+ hence \<open>v \<in> reads (\<pi> k) \<inter> writes (\<pi> ?l)\<close> using assms(2) by auto
	+ moreover
	+ note is_ddi_def
	+ have \<open>\<forall> l \<in> {?l<..<k}. v \<notin> writes (\<pi> l)\<close> by (auto, metis (lifting, no_types) Greatest_le_nat le_antisym nat_less_le)
	+ ultimately
	+ have \<open>k dd\<^bsup>\<pi>,v\<^esup>\<rightarrow> ?l\<close> using assms(1) unfolding is_ddi_def by blast
	+ thus \<open>thesis\<close> using that by simp
	+qed
	+
	+lemma no_writes_unchanged: assumes \<open>k \<le> l\<close> \<open>\<forall> j \<in> {k..<l}. v\<notin> writes(path \<sigma> j)\<close> shows \<open>(\<sigma>\<^bsup>l\<^esup>) v = (\<sigma>\<^bsup>k\<^esup>) v\<close> using assms
	+proof (induction \<open>l - k\<close> arbitrary: \<open>l\<close>)
	+ case 0 thus \<open>?case\<close> by(auto)
	+next
	+ case (Suc lk l)
	+ hence kl: \<open>k < l\<close> by auto
	+ then obtain l' where lsuc: \<open>l = Suc l'\<close> using lessE by blast
	+ hence \<open>lk = l' - k\<close> using Suc by auto
	+ moreover
	+ have \<open>\<forall> j \<in> {k..<l'}. v \<notin> writes (path \<sigma> j)\<close> using Suc(4) lsuc by auto
	+ ultimately
	+ have \<open>(\<sigma>\<^bsup>l'\<^esup>) v = (\<sigma>\<^bsup>k\<^esup>) v\<close> using Suc(1)[of \<open>l'\<close>] lsuc kl by fastforce
	+ moreover
	+ have \<open>\<sigma>\<^bsup>l\<^esup> = snd ( step (path \<sigma> l',\<sigma>\<^bsup>l'\<^esup>))\<close> by (metis kth_state_suc lsuc)
	+ hence \<open>\<sigma>\<^bsup>l\<^esup> = sem (path \<sigma> l') (\<sigma>\<^bsup>l'\<^esup>)\<close> by (metis step_suc_sem snd_conv)
	+ moreover
	+ have \<open>l' < l\<close> \<open>k \<le> l'\<close> using kl lsuc by auto
	+ hence \<open>v \<notin> writes (path \<sigma> l')\<close> using Suc.prems(2) by auto
	+ ultimately
	+ show \<open>?case\<close> using writes by metis
	+qed
	+
	+lemma ddi_value: assumes \<open>l dd\<^bsup>(path \<sigma>),v\<^esup>\<rightarrow> k\<close> shows \<open>(\<sigma>\<^bsup>l\<^esup>) v = (\<sigma>\<^bsup>Suc k\<^esup> ) v\<close>
	+using assms no_writes_unchanged[of \<open>Suc k\<close> \<open>l\<close> \<open>v\<close> \<open>\<sigma>\<close>] unfolding is_ddi_def by auto
	+
	+lemma written_value: assumes \<open>path \<sigma> l = path \<sigma>' l'\<close> \<open>\<sigma>\<^bsup>l\<^esup> \<restriction> reads (path \<sigma> l) = \<sigma>'\<^bsup>l'\<^esup> \<restriction> reads (path \<sigma> l)\<close> \<open>v \<in> writes (path \<sigma> l)\<close>
	+shows \<open>(\<sigma>\<^bsup>Suc l\<^esup> ) v = (\<sigma>'\<^bsup>Suc l'\<^esup> ) v\<close>
	+by (metis assms reads_restr_sem snd_conv step_suc_sem kth_state_suc)
	+
	+
	+subsection \<open>Facts about Contradicting Paths\<close>
	+
	+lemma obsp_contradict: assumes csk: \<open>cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k'\<close> and obs: \<open>obsp \<sigma> k \<noteq> obsp \<sigma>' k'\<close> shows \<open>(\<sigma>', k') \<cc> (\<sigma>, k)\<close>
	+proof -
	+ have pk: \<open>path \<sigma> k = path \<sigma>' k'\<close> using assms last_cs by metis
	+ hence \<open>\<sigma>\<^bsup>k\<^esup>\<restriction>(reads (path \<sigma> k)) \<noteq> \<sigma>'\<^bsup>k'\<^esup>\<restriction>(reads (path \<sigma> k))\<close> using obs reads_obsp[OF pk] by auto
	+ thus \<open>(\<sigma>',k') \<cc> (\<sigma>,k)\<close> using contradicts.intros(2)[OF csk[symmetric]] by auto
	+qed
	+
	+lemma missing_cs_contradicts: assumes notin: \<open>\<not>(\<exists> k'. cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k')\<close> and converge: \<open>k<n\<close> \<open>cs\<^bsup>path \<sigma>\<^esup> n = cs\<^bsup>path \<sigma>'\<^esup> n'\<close> shows \<open>\<exists> j'. (\<sigma>', j') \<cc> (\<sigma>, k)\<close>
	+proof -
	+ let \<open>?\<pi>\<close> = \<open>path \<sigma>\<close>
	+ let \<open>?\<pi>'\<close> = \<open>path \<sigma>'\<close>
	+ have init: \<open>?\<pi> 0 = ?\<pi>' 0\<close> unfolding path_def by auto
	+ have path: \<open>is_path ?\<pi>\<close> \<open>is_path ?\<pi>'\<close> using path_is_path by auto
	+ obtain j j' where csj: \<open>cs\<^bsup>?\<pi>\<^esup> j = cs\<^bsup>?\<pi>'\<^esup> j'\<close> and cd: \<open>k cd\<^bsup>?\<pi>\<^esup>\<rightarrow>j\<close> and suc: \<open>?\<pi> (Suc j) \<noteq> ?\<pi>' (Suc j')\<close> using converged_cd_diverge[OF path init notin converge] .
	+ have less: \<open>cs\<^bsup>?\<pi>\<^esup> j \<prec> cs\<^bsup>?\<pi>\<^esup> k\<close> using cd cd_is_cs_less by auto
	+ have nretj: \<open>?\<pi> j \<noteq> return\<close> by (metis cd is_cdi_def term_path_stable less_imp_le)
	+ have cs: \<open>?\<pi> \<exclamdown> cs\<^bsup>?\<pi>'\<^esup> j' = j\<close> using csj cs_select_id nretj path_is_path by metis
	+ have \<open>(\<sigma>',j') \<cc> (\<sigma>,k)\<close> using contradicts.intros(1)[of \<open>?\<pi>'\<close> \<open>j'\<close> \<open>?\<pi>\<close> \<open>k\<close> \<open>\<sigma>\<close> \<open>\<sigma>'\<close>,unfolded cs] less suc csj by metis
	+ thus \<open>?thesis\<close> by blast
	+qed
	+
	+theorem obs_neq_contradicts_term: fixes \<sigma> \<sigma>' defines \<pi>: \<open>\<pi> \<equiv> path \<sigma>\<close> and \<pi>': \<open>\<pi>' \<equiv> path \<sigma>'\<close> assumes ret: \<open>\<pi> n = return\<close> \<open>\<pi>' n' = return\<close> and obsne: \<open>obs \<sigma> \<noteq> obs \<sigma>'\<close>
	+shows \<open>\<exists> k k'. ((\<sigma>', k') \<cc> (\<sigma> ,k) \<and> \<pi> k \<in> dom (att)) \<or> ((\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> \<pi>' k' \<in> dom (att))\<close>
	+proof -
	+ have path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> using \<pi> \<pi>' path_is_path by auto
	+ obtain k1 where neq: \<open>obs \<sigma> k1 \<noteq> obs \<sigma>' k1\<close> using obsne ext[of \<open>obs \<sigma>\<close> \<open>obs \<sigma>'\<close>] by blast
	+ hence \<open>(\<exists>k i i'. is_kth_obs \<pi> k i \<and> is_kth_obs \<pi>' k i' \<and> obsp \<sigma> i \<noteq> obsp \<sigma>' i' \<and> cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')
	+ \<or> (\<exists> k i. is_kth_obs \<pi> k i \<and> \<not> (\<exists> i'. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))
	+ \<or> (\<exists> k i'. is_kth_obs \<pi>' k i' \<and> \<not> (\<exists> i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))\<close>
	+ proof(cases rule: option_neq_cases)
	+ case (none2 x)
	+ have notin\<pi>': \<open>\<not> (\<exists> l. is_kth_obs \<pi>' k1 l)\<close> using none2(2) \<pi>' obs_none_no_kth_obs by auto
	+ obtain i where in\<pi>: \<open>is_kth_obs \<pi> k1 i\<close> using obs_some_kth_obs[of \<open>\<sigma>\<close> \<open>k1\<close>] none2(1) \<pi> by auto
	+ obtain l j where \<open>is_kth_obs \<pi> l j\<close> \<open>\<not> (\<exists> j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close> using path in\<pi> notin\<pi>' by (metis no_kth_obs_missing_cs)
	+ thus \<open>?thesis\<close> by blast
	+ next
	+ case (none1 x)
	+ have notin\<pi>: \<open>\<not> (\<exists> l. is_kth_obs \<pi> k1 l)\<close> using none1(1) \<pi> obs_none_no_kth_obs by auto
	+ obtain i' where in\<pi>': \<open>is_kth_obs \<pi>' k1 i'\<close> using obs_some_kth_obs[of \<open>\<sigma>'\<close> \<open>k1\<close>] none1(2) \<pi>' by auto
	+ obtain l j where \<open>is_kth_obs \<pi>' l j\<close> \<open>\<not> (\<exists> j'. cs\<^bsup>\<pi>\<^esup> j' = cs\<^bsup>\<pi>'\<^esup> j)\<close> using path in\<pi>' notin\<pi> by (metis no_kth_obs_missing_cs)
	+ thus \<open>?thesis\<close> by blast
	+ next
	+ case (some x y)
	+ obtain i where in\<pi>: \<open>is_kth_obs \<pi> k1 i\<close> using obs_some_kth_obs[of \<open>\<sigma>\<close> \<open>k1\<close>] some \<pi> by auto
	+ obtain i' where in\<pi>': \<open>is_kth_obs \<pi>' k1 i'\<close> using obs_some_kth_obs[of \<open>\<sigma>'\<close> \<open>k1\<close>] some \<pi>' by auto
	+ show \<open>?thesis\<close> proof (cases)
	+ assume *: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+ have \<open>obsp \<sigma> i = obs \<sigma> k1\<close> by (metis obs_def \<pi> in\<pi> kth_obs_unique the_equality)
	+ moreover
	+ have \<open>obsp \<sigma>' i' = obs \<sigma>' k1\<close> by (metis obs_def \<pi>' in\<pi>' kth_obs_unique the_equality)
	+ ultimately
	+ have \<open>obsp \<sigma> i \<noteq> obsp \<sigma>' i'\<close> using neq by auto
	+ thus \<open>?thesis\<close> using * in\<pi> in\<pi>' by blast
	+ next
	+ assume *: \<open>cs\<^bsup>\<pi>\<^esup> i \<noteq> cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+ note kth_obs_cs_missing_cs[OF path in\<pi> in\<pi>' *]
	+ thus \<open>?thesis\<close> by metis
	+ qed
	+ qed
	+ thus \<open>?thesis\<close> proof (cases rule: three_cases)
	+ case 1
	+ then obtain k i i' where iki: \<open>is_kth_obs \<pi> k i\<close> \<open>is_kth_obs \<pi>' k i'\<close> and obsne: \<open>obsp \<sigma> i \<noteq> obsp \<sigma>' i'\<close> and csi: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> by auto
	+ note obsp_contradict[OF csi[unfolded \<pi> \<pi>'] obsne]
	+ moreover
	+ have \<open>\<pi> i \<in> dom att\<close> using iki unfolding is_kth_obs_def by auto
	+ ultimately
	+ show \<open>?thesis\<close> by blast
	+ next
	+ case 2
	+ then obtain k i where iki: \<open>is_kth_obs \<pi> k i\<close> and notin\<pi>': \<open>\<not> (\<exists>i'. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')\<close> by auto
	+ let \<open>?n\<close> = \<open>Suc (max n i)\<close>
	+ have nn: \<open>n < ?n\<close> by auto
	+ have iln: \<open>i < ?n\<close> by auto
	+ have retn: \<open>\<pi> ?n = return\<close> using ret term_path_stable path by auto
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> ?n = cs\<^bsup>\<pi>'\<^esup> n'\<close> using ret(2) cs_return by auto
	+ then obtain i' where \<open>(\<sigma>',i') \<cc> (\<sigma>,i)\<close> using missing_cs_contradicts[OF notin\<pi>'[unfolded \<pi> \<pi>'] iln] \<pi> \<pi>' by auto
	+ moreover
	+ have \<open>\<pi> i \<in> dom att\<close> using iki is_kth_obs_def by auto
	+ ultimately
	+ show \<open>?thesis\<close> by blast
	+ next
	+ case 3
	+ then obtain k i' where iki: \<open>is_kth_obs \<pi>' k i'\<close> and notin\<pi>': \<open>\<not> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')\<close> by auto
	+ let \<open>?n\<close> = \<open>Suc (max n' i')\<close>
	+ have nn: \<open>n' < ?n\<close> by auto
	+ have iln: \<open>i' < ?n\<close> by auto
	+ have retn: \<open>\<pi>' ?n = return\<close> using ret term_path_stable path by auto
	+ hence \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> ?n\<close> using ret(1) cs_return by auto
	+ then obtain i where \<open>(\<sigma>,i) \<cc> (\<sigma>',i')\<close> using missing_cs_contradicts notin\<pi>' iln \<pi> \<pi>' by metis
	+ moreover
	+ have \<open>\<pi>' i' \<in> dom att\<close> using iki is_kth_obs_def by auto
	+ ultimately
	+ show \<open>?thesis\<close> by blast
	+ qed
	+qed
	+
	+lemma obs_neq_some_contradicts': fixes \<sigma> \<sigma>' defines \<pi>: \<open>\<pi> \<equiv> path \<sigma>\<close> and \<pi>': \<open>\<pi>' \<equiv> path \<sigma>'\<close>
	+assumes obsnecs: \<open>obsp \<sigma> i \<noteq> obsp \<sigma>' i' \<or> cs\<^bsup>\<pi>\<^esup> i \<noteq> cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+and iki: \<open>is_kth_obs \<pi> k i\<close> and iki': \<open>is_kth_obs \<pi>' k i'\<close>
	+shows \<open>\<exists> k k'. ((\<sigma>', k') \<cc> (\<sigma> ,k) \<and> \<pi> k \<in> dom att) \<or> ((\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> \<pi>' k' \<in> dom att)\<close>
	+using obsnecs iki iki' proof (induction \<open>k\<close> arbitrary: \<open>i\<close> \<open>i'\<close> rule: less_induct )
	+ case (less k i i')
	+ note iki = \<open>is_kth_obs \<pi> k i\<close>
	+ and iki' = \<open>is_kth_obs \<pi>' k i'\<close>
	+ have domi: \<open>\<pi> i \<in> dom att\<close> by (metis is_kth_obs_def domIff iki)
	+ have domi': \<open>\<pi>' i' \<in> dom att\<close> by (metis is_kth_obs_def domIff iki')
	+ note obsnecs = \<open>obsp \<sigma> i \<noteq> obsp \<sigma>' i' \<or> cs\<^bsup>\<pi>\<^esup> i \<noteq> cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+ show \<open>?thesis\<close> proof cases
	+ assume csi: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+ hence *: \<open>obsp \<sigma> i \<noteq> obsp \<sigma>' i'\<close> using obsnecs by auto
	+ note obsp_contradict[OF _ *] csi domi \<pi> \<pi>'
	+ thus \<open>?thesis\<close> by blast
	+ next
	+ assume ncsi: \<open>cs\<^bsup>\<pi>\<^esup> i \<noteq> cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+ have path: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> using \<pi> \<pi>' path_is_path by auto
	+ have \<pi>0: \<open>\<pi> 0 = \<pi>' 0\<close> unfolding \<pi> \<pi>' path_def by auto
	+ note kth_obs_cs_missing_cs[of \<open>\<pi>\<close> \<open>\<pi>'\<close> \<open>k\<close> \<open>i\<close> \<open>i'\<close>] \<pi> \<pi>' path_is_path iki iki' ncsi
	+ hence \<open>(\<exists> l j .j \<le> i \<and> is_kth_obs \<pi> l j \<and> \<not> (\<exists> j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')) \<or> (\<exists> l' j'. j' \<le> i' \<and> is_kth_obs \<pi>' l' j' \<and> \<not> (\<exists> j. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'))\<close> by metis
	+ thus \<open>?thesis\<close> proof
	+ assume \<open>\<exists>l j. j \<le> i \<and> is_kth_obs \<pi> l j \<and> \<not> (\<exists>j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close>
	+ then obtain l j where ji: \<open>j\<le>i\<close> and iobs: \<open>is_kth_obs \<pi> l j\<close> and notin: \<open>\<not> (\<exists>j'. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close> by blast
	+ have dom: \<open>\<pi> j \<in> dom att\<close> using iobs is_kth_obs_def by auto
	+ obtain n n' where nj: \<open>n < j\<close> and csn: \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and sucn: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close> and cdloop: \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> n \<or> (\<forall> j'> n'. j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n')\<close>
	+ using missing_cd_or_loop[OF path \<pi>0 notin] by blast
	+ show \<open>?thesis\<close> using cdloop proof
	+ assume cdjn: \<open>j cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close>
	+ hence csnj: \<open>cs\<^bsup>\<pi>'\<^esup> n' \<prec> cs\<^bsup>\<pi>\<^esup> j\<close> using csn by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi> (Suc (\<pi> \<exclamdown> cs\<^bsup>\<pi>'\<^esup> n')) = \<pi> (Suc n)\<close> using csn by (metis cdjn cd_not_ret cs_select_id path(1))
	+ have \<open>(\<sigma>',n') \<cc> (\<sigma>,j)\<close> using csnj apply(rule contradicts.intros(1)) using cssel \<pi> \<pi>' sucn by auto
	+ thus \<open>?thesis\<close> using dom by auto
	+ next
	+ assume loop: \<open>\<forall> j'>n'. j' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close>
	+ show \<open>?thesis\<close> proof cases
	+ assume in': \<open>i' \<le> n'\<close>
	+ have nreti': \<open>\<pi>' i' \<noteq> return\<close> by( metis le_eq_less_or_eq lessI loop not_le path(2) ret_no_cd term_path_stable)
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>\<exists> \<iota>. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> \<iota>\<close>
	+ then obtain \<iota> where cs\<iota>: \<open>cs\<^bsup>\<pi>\<^esup> \<iota> = cs\<^bsup>\<pi>'\<^esup> i'\<close> by metis
	+ have \<iota>n: \<open>\<iota> \<le> n\<close> using cs_order_le[OF path(2,1) cs\<iota>[symmetric] csn[symmetric] nreti' in'] .
	+ hence \<iota>i: \<open>\<iota> < i\<close> using nj ji by auto
	+ have dom\<iota>: \<open>\<pi> \<iota> \<in> dom att\<close> using domi' cs\<iota> last_cs by metis
	+ obtain \<kappa> where i\<kappa>\<iota>: \<open>is_kth_obs \<pi> \<kappa> \<iota>\<close> using dom\<iota> by (metis is_kth_obs_def domIff)
	+ hence \<kappa>k: \<open>\<kappa> < k\<close> using \<iota>i iki by (metis kth_obs_le_iff)
	+ obtain \<iota>' where i\<kappa>\<iota>': \<open>is_kth_obs \<pi>' \<kappa> \<iota>'\<close> using \<kappa>k iki' by (metis kth_obs_stable)
	+ have \<open>\<iota>' < i'\<close> using \<kappa>k iki' i\<kappa>\<iota>' by (metis kth_obs_le_iff)
	+ hence cs\<iota>': \<open>cs\<^bsup>\<pi>\<^esup> \<iota> \<noteq> cs\<^bsup>\<pi>'\<^esup> \<iota>'\<close> unfolding cs\<iota> using cs_inj[OF path(2) nreti', of \<open>\<iota>'\<close>] by blast
	+ thus \<open>?thesis\<close> using less(1)[OF \<kappa>k _ i\<kappa>\<iota> i\<kappa>\<iota>'] by auto
	+ next
	+ assume notin'': \<open>\<not>(\<exists> \<iota>. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> \<iota>)\<close>
	+ obtain \<iota> \<iota>' where \<iota>i': \<open>\<iota>' < i'\<close> and cs\<iota>: \<open>cs\<^bsup>\<pi>\<^esup> \<iota> = cs\<^bsup>\<pi>'\<^esup> \<iota>'\<close> and suc\<iota>: \<open>\<pi> (Suc \<iota>) \<noteq> \<pi>' (Suc \<iota>')\<close> and cdloop': \<open>i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> \<iota>' \<or> (\<forall> j>\<iota>. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> \<iota>)\<close>
	+ using missing_cd_or_loop[OF path(2,1) \<pi>0[symmetric] notin''] by metis
	+ show \<open>?thesis\<close> using cdloop' proof
	+ assume cdjn: \<open>i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> \<iota>'\<close>
	+ hence csnj: \<open>cs\<^bsup>\<pi>\<^esup> \<iota> \<prec> cs\<^bsup>\<pi>'\<^esup> i'\<close> using cs\<iota> by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi>' (Suc (\<pi>' \<exclamdown> cs\<^bsup>\<pi>\<^esup> \<iota>)) = \<pi>' (Suc \<iota>')\<close> using cs\<iota> by (metis cdjn cd_not_ret cs_select_id path(2))
	+ have \<open>(\<sigma>,\<iota>) \<cc> (\<sigma>',i')\<close> using csnj apply(rule contradicts.intros(1)) using cssel \<pi> \<pi>' suc\<iota> by auto
	+ thus \<open>?thesis\<close> using domi' by auto
	+ next
	+ assume loop': \<open>\<forall> j>\<iota>. j cd\<^bsup>\<pi>\<^esup>\<rightarrow> \<iota>\<close>
	+ have \<iota>n': \<open>\<iota>' < n'\<close> using in' \<iota>i' by auto
	+ have nret\<iota>': \<open>\<pi>' \<iota>' \<noteq> return\<close> by (metis cs\<iota> last_cs le_eq_less_or_eq lessI path(1) path(2) suc\<iota> term_path_stable)
	+ have \<open>\<iota> < n\<close> using cs_order[OF path(2,1) cs\<iota>[symmetric] csn[symmetric] nret\<iota>' \<iota>n'] .
	+ hence \<open>\<iota> < i\<close> using nj ji by auto
	+ hence cdi\<iota>: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> \<iota>\<close> using loop' by auto
	+ hence cs\<iota>i: \<open>cs\<^bsup>\<pi>'\<^esup> \<iota>' \<prec> cs\<^bsup>\<pi>\<^esup> i\<close> using cs\<iota> by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi> (Suc (\<pi> \<exclamdown> cs\<^bsup>\<pi>'\<^esup> \<iota>')) = \<pi> (Suc \<iota>)\<close> using cs\<iota> by (metis cdi\<iota> cd_not_ret cs_select_id path(1))
	+ have \<open>(\<sigma>',\<iota>') \<cc> (\<sigma>,i)\<close> using cs\<iota>i apply(rule contradicts.intros(1)) using cssel \<pi> \<pi>' suc\<iota> by auto
	+ thus \<open>?thesis\<close> using domi by auto
	+ qed
	+ qed
	+ next
	+ assume \<open>\<not> i' \<le> n'\<close>
	+ hence ni': \<open>n'< i'\<close> by simp
	+ hence cdin: \<open>i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> using loop by auto
	+ hence csni: \<open>cs\<^bsup>\<pi>\<^esup> n \<prec> cs\<^bsup>\<pi>'\<^esup> i'\<close> using csn by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi>' (Suc (\<pi>' \<exclamdown> cs\<^bsup>\<pi>\<^esup> n)) = \<pi>' (Suc n')\<close> using csn by (metis cdin cd_not_ret cs_select_id path(2))
	+ have \<open>(\<sigma>,n) \<cc> (\<sigma>',i')\<close> using csni apply(rule contradicts.intros(1)) using cssel \<pi> \<pi>' sucn by auto
	+ thus \<open>?thesis\<close> using domi' by auto
	+ qed
	+ qed
	+ next
	+ \<comment> \<open>Symmetric case as above, indices might be messy.\<close>
	+ assume \<open>\<exists>l j. j \<le> i' \<and> is_kth_obs \<pi>' l j \<and> \<not> (\<exists>j'. cs\<^bsup>\<pi>\<^esup> j' = cs\<^bsup>\<pi>'\<^esup> j)\<close>
	+ then obtain l j where ji': \<open>j\<le>i'\<close> and iobs: \<open>is_kth_obs \<pi>' l j\<close> and notin: \<open>\<not> (\<exists>j'. cs\<^bsup>\<pi>'\<^esup> j = cs\<^bsup>\<pi>\<^esup> j')\<close> by metis
	+ have dom: \<open>\<pi>' j \<in> dom att\<close> using iobs is_kth_obs_def by auto
	+ obtain n n' where nj: \<open>n < j\<close> and csn: \<open>cs\<^bsup>\<pi>'\<^esup> n = cs\<^bsup>\<pi>\<^esup> n'\<close> and sucn: \<open>\<pi>' (Suc n) \<noteq> \<pi> (Suc n')\<close> and cdloop: \<open>j cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n \<or> (\<forall> j'> n'. j' cd\<^bsup>\<pi>\<^esup>\<rightarrow> n')\<close>
	+ using missing_cd_or_loop[OF path(2,1) \<pi>0[symmetric] ] notin by metis
	+ show \<open>?thesis\<close> using cdloop proof
	+ assume cdjn: \<open>j cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n\<close>
	+ hence csnj: \<open>cs\<^bsup>\<pi>\<^esup> n' \<prec> cs\<^bsup>\<pi>'\<^esup> j\<close> using csn by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi>' (Suc (\<pi>' \<exclamdown> cs\<^bsup>\<pi>\<^esup> n')) = \<pi>' (Suc n)\<close> using csn by (metis cdjn cd_not_ret cs_select_id path(2))
	+ have \<open>(\<sigma>,n') \<cc> (\<sigma>',j)\<close> using csnj apply(rule contradicts.intros(1)) using cssel \<pi>' \<pi> sucn by auto
	+ thus \<open>?thesis\<close> using dom by auto
	+ next
	+ assume loop: \<open>\<forall> j'>n'. j' cd\<^bsup>\<pi>\<^esup>\<rightarrow> n'\<close>
	+ show \<open>?thesis\<close> proof cases
	+ assume in': \<open>i \<le> n'\<close>
	+ have nreti: \<open>\<pi> i \<noteq> return\<close> by (metis le_eq_less_or_eq lessI loop not_le path(1) ret_no_cd term_path_stable)
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>\<exists> \<iota>. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> \<iota>\<close>
	+ then obtain \<iota> where cs\<iota>: \<open>cs\<^bsup>\<pi>'\<^esup> \<iota> = cs\<^bsup>\<pi>\<^esup> i\<close> by metis
	+ have \<iota>n: \<open>\<iota> \<le> n\<close> using cs_order_le[OF path cs\<iota>[symmetric] csn[symmetric] nreti in'] .
	+ hence \<iota>i': \<open>\<iota> < i'\<close> using nj ji' by auto
	+ have dom\<iota>: \<open>\<pi>' \<iota> \<in> dom att\<close> using domi cs\<iota> last_cs by metis
	+ obtain \<kappa> where i\<kappa>\<iota>: \<open>is_kth_obs \<pi>' \<kappa> \<iota>\<close> using dom\<iota> by (metis is_kth_obs_def domIff)
	+ hence \<kappa>k: \<open>\<kappa> < k\<close> using \<iota>i' iki' by (metis kth_obs_le_iff)
	+ obtain \<iota>' where i\<kappa>\<iota>': \<open>is_kth_obs \<pi> \<kappa> \<iota>'\<close> using \<kappa>k iki by (metis kth_obs_stable)
	+ have \<open>\<iota>' < i\<close> using \<kappa>k iki i\<kappa>\<iota>' by (metis kth_obs_le_iff)
	+ hence cs\<iota>': \<open>cs\<^bsup>\<pi>'\<^esup> \<iota> \<noteq> cs\<^bsup>\<pi>\<^esup> \<iota>'\<close> unfolding cs\<iota> using cs_inj[OF path(1) nreti, of \<open>\<iota>'\<close>] by blast
	+ thus \<open>?thesis\<close> using less(1)[OF \<kappa>k _ i\<kappa>\<iota>' i\<kappa>\<iota>] by auto
	+ next
	+ assume notin'': \<open>\<not>(\<exists> \<iota>. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> \<iota>)\<close>
	+ obtain \<iota> \<iota>' where \<iota>i: \<open>\<iota>' < i\<close> and cs\<iota>: \<open>cs\<^bsup>\<pi>'\<^esup> \<iota> = cs\<^bsup>\<pi>\<^esup> \<iota>'\<close> and suc\<iota>: \<open>\<pi>' (Suc \<iota>) \<noteq> \<pi> (Suc \<iota>')\<close> and cdloop': \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> \<iota>' \<or> (\<forall> j>\<iota>. j cd\<^bsup>\<pi>'\<^esup>\<rightarrow> \<iota>)\<close>
	+ using missing_cd_or_loop[OF path \<pi>0 notin''] by metis
	+ show \<open>?thesis\<close> using cdloop' proof
	+ assume cdjn: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> \<iota>'\<close>
	+ hence csnj: \<open>cs\<^bsup>\<pi>'\<^esup> \<iota> \<prec> cs\<^bsup>\<pi>\<^esup> i\<close> using cs\<iota> by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi> (Suc (\<pi> \<exclamdown> cs\<^bsup>\<pi>'\<^esup> \<iota>)) = \<pi> (Suc \<iota>')\<close> using cs\<iota> by (metis cdjn cd_not_ret cs_select_id path(1))
	+ have \<open>(\<sigma>',\<iota>) \<cc> (\<sigma>,i)\<close> using csnj apply(rule contradicts.intros(1)) using cssel \<pi>' \<pi> suc\<iota> by auto
	+ thus \<open>?thesis\<close> using domi by auto
	+ next
	+ assume loop': \<open>\<forall> j>\<iota>. j cd\<^bsup>\<pi>'\<^esup>\<rightarrow> \<iota>\<close>
	+ have \<iota>n': \<open>\<iota>' < n'\<close> using in' \<iota>i by auto
	+ have nret\<iota>': \<open>\<pi> \<iota>' \<noteq> return\<close> by (metis cs\<iota> last_cs le_eq_less_or_eq lessI path(1) path(2) suc\<iota> term_path_stable)
	+ have \<open>\<iota> < n\<close> using cs_order[OF path cs\<iota>[symmetric] csn[symmetric] nret\<iota>' \<iota>n'] .
	+ hence \<open>\<iota> < i'\<close> using nj ji' by auto
	+ hence cdi\<iota>: \<open>i' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> \<iota>\<close> using loop' by auto
	+ hence cs\<iota>i': \<open>cs\<^bsup>\<pi>\<^esup> \<iota>' \<prec> cs\<^bsup>\<pi>'\<^esup> i'\<close> using cs\<iota> by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi>' (Suc (\<pi>' \<exclamdown> cs\<^bsup>\<pi>\<^esup> \<iota>')) = \<pi>' (Suc \<iota>)\<close> using cs\<iota> by (metis cdi\<iota> cd_not_ret cs_select_id path(2))
	+ have \<open>(\<sigma>,\<iota>') \<cc> (\<sigma>',i')\<close> using cs\<iota>i' apply(rule contradicts.intros(1)) using cssel \<pi>' \<pi> suc\<iota> by auto
	+ thus \<open>?thesis\<close> using domi' by auto
	+ qed
	+ qed
	+ next
	+ assume \<open>\<not> i \<le> n'\<close>
	+ hence ni: \<open>n'< i\<close> by simp
	+ hence cdin: \<open>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> n'\<close> using loop by auto
	+ hence csni': \<open>cs\<^bsup>\<pi>'\<^esup> n \<prec> cs\<^bsup>\<pi>\<^esup> i\<close> using csn by (metis cd_is_cs_less)
	+ have cssel: \<open>\<pi> (Suc (\<pi> \<exclamdown> cs\<^bsup>\<pi>'\<^esup> n)) = \<pi> (Suc n')\<close> using csn by (metis cdin cd_not_ret cs_select_id path(1))
	+ have \<open>(\<sigma>',n) \<cc> (\<sigma>,i)\<close> using csni' apply(rule contradicts.intros(1)) using cssel \<pi>' \<pi> sucn by auto
	+ thus \<open>?thesis\<close> using domi by auto
	+ qed
	+ qed
	+ qed
	+ qed
	+qed
	+
	+theorem obs_neq_some_contradicts: fixes \<sigma> \<sigma>' defines \<pi>: \<open>\<pi> \<equiv> path \<sigma>\<close> and \<pi>': \<open>\<pi>' \<equiv> path \<sigma>'\<close>
	+assumes obsne: \<open>obs \<sigma> k \<noteq> obs \<sigma>' k\<close> and not_none: \<open>obs \<sigma> k \<noteq> None\<close> \<open>obs \<sigma>' k \<noteq> None\<close>
	+shows \<open>\<exists> k k'. ((\<sigma>', k') \<cc> (\<sigma> ,k) \<and> \<pi> k \<in> dom att) \<or> ((\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> \<pi>' k' \<in> dom att)\<close>
	+proof -
	+ obtain i where iki: \<open>is_kth_obs \<pi> k i\<close> using not_none(1) by (metis \<pi> obs_some_kth_obs)
	+ obtain i' where iki': \<open>is_kth_obs \<pi>' k i'\<close> using not_none(2) by (metis \<pi>' obs_some_kth_obs)
	+ have \<open>obsp \<sigma> i = obs \<sigma> k\<close> by (metis \<pi> iki kth_obs_unique obs_def the_equality)
	+ moreover
	+ have \<open>obsp \<sigma>' i' = obs \<sigma>' k\<close> by (metis \<pi>' iki' kth_obs_unique obs_def the_equality)
	+ ultimately
	+ have obspne: \<open>obsp \<sigma> i \<noteq> obsp \<sigma>' i'\<close> using obsne by auto
	+ show \<open>?thesis\<close> using obs_neq_some_contradicts'[OF _ iki[unfolded \<pi>] iki'[unfolded \<pi>']] using obspne \<pi> \<pi>' by metis
	+qed
	+
	+theorem obs_neq_ret_contradicts: fixes \<sigma> \<sigma>' defines \<pi>: \<open>\<pi> \<equiv> path \<sigma>\<close> and \<pi>': \<open>\<pi>' \<equiv> path \<sigma>'\<close>
	+assumes ret: \<open>\<pi> n = return\<close> and obsne: \<open>obs \<sigma>' i \<noteq> obs \<sigma> i\<close> and obs:\<open>obs \<sigma>' i \<noteq> None\<close>
	+shows \<open>\<exists> k k'. ((\<sigma>', k') \<cc> (\<sigma> ,k) \<and> \<pi> k \<in> dom (att)) \<or> ((\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> \<pi>' k' \<in> dom (att))\<close>
	+proof (cases \<open>\<exists> j k'. is_kth_obs \<pi>' j k' \<and> (\<nexists> k. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k')\<close>)
	+ case True
	+ obtain l k' where jk': \<open>is_kth_obs \<pi>' l k'\<close> and unmatched: \<open>(\<nexists> k. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k')\<close> using True by blast
	+ have \<pi>0: \<open>\<pi> 0 = \<pi>' 0\<close> using \<pi> \<pi>' path0 by auto
	+ obtain j j' where csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j'\<close> and cd: \<open>k' cd\<^bsup>\<pi>'\<^esup>\<rightarrow>j'\<close> and suc: \<open>\<pi> (Suc j) \<noteq> \<pi>' (Suc j')\<close>
	+ using converged_cd_diverge_return[of \<open>\<pi>'\<close> \<open>\<pi>\<close> \<open>k'\<close> \<open>n\<close>] ret unmatched path_is_path \<pi> \<pi>' \<pi>0 by metis
	+ hence *: \<open>(\<sigma>, j) \<cc> (\<sigma>' ,k')\<close> using contradicts.intros(1)[of \<open>\<pi>\<close> \<open>j\<close> \<open>\<pi>'\<close> \<open>k'\<close> \<open>\<sigma>'\<close> \<open>\<sigma>\<close>, unfolded csj] \<pi> \<pi>'
	+ using cd_is_cs_less cd_not_ret cs_select_id by auto
	+ have \<open>\<pi>' k' \<in> dom(att)\<close> using jk' by (meson domIff is_kth_obs_def)
	+ thus \<open>?thesis\<close> using * by blast
	+next
	+ case False
	+ hence *: \<open>\<And> j k'. is_kth_obs \<pi>' j k' \<Longrightarrow> \<exists> k. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> by auto
	+ obtain k' where k': \<open>is_kth_obs \<pi>' i k'\<close> using obs \<pi>' obs_some_kth_obs by blast
	+ obtain l where \<open>is_kth_obs \<pi> i l\<close> using * \<pi> \<pi>' k' no_kth_obs_missing_cs path_is_path by metis
	+ thus \<open>?thesis\<close> using \<pi> \<pi>' obs obs_neq_some_contradicts obs_none_no_kth_obs obsne by metis
	+qed
	+
	+
	+subsection \<open>Facts about Critical Observable Paths\<close>
	+
	+lemma contradicting_in_cp: assumes leq:\<open>\<sigma> =\<^sub>L \<sigma>'\<close> and cseq: \<open>cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k'\<close>
	+and readv: \<open>v\<in>reads(path \<sigma> k)\<close> and vneq: \<open>(\<sigma>\<^bsup>k\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v\<close> shows \<open>((\<sigma>,k),(\<sigma>',k')) \<in> cp\<close>
	+ using cseq readv vneq proof(induction \<open>k+k'\<close> arbitrary: \<open>k\<close> \<open>k'\<close> \<open>v\<close> rule: less_induct)
	+ fix k k' v
	+ assume csk: \<open>cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k'\<close>
	+ assume vread: \<open>v \<in> reads (path \<sigma> k)\<close>
	+ assume vneq: \<open>(\<sigma>\<^bsup>k\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v\<close>
	+ assume IH: \<open>\<And>ka k'a v. ka + k'a < k + k' \<Longrightarrow> cs\<^bsup>path \<sigma>\<^esup> ka = cs\<^bsup>path \<sigma>'\<^esup> k'a \<Longrightarrow> v \<in> reads (path \<sigma> ka) \<Longrightarrow> (\<sigma>\<^bsup>ka\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'a\<^esup>) v \<Longrightarrow> ((\<sigma>, ka), \<sigma>', k'a) \<in> cp\<close>
	+
	+ define \<pi> where \<open>\<pi> \<equiv> path \<sigma>\<close>
	+ define \<pi>' where \<open>\<pi>' \<equiv> path \<sigma>'\<close>
	+ have path: \<open>\<pi> = path \<sigma>\<close> \<open>\<pi>' = path \<sigma>'\<close> using \<pi>_def \<pi>'_def path_is_path by auto
	+ have ip: \<open>is_path \<pi>\<close> \<open>is_path \<pi>'\<close> using path path_is_path by auto
	+
	+ have \<pi>0: \<open>\<pi>' 0 = \<pi> 0\<close> unfolding path path_def by auto
	+ have vread': \<open>v \<in> reads (path \<sigma>' k')\<close> using csk vread by (metis last_cs)
	+ have cseq: \<open>cs\<^bsup>\<pi>'\<^esup> k' = cs\<^bsup>\<pi>\<^esup> k\<close> using csk path by simp
	+
	+ show \<open>((\<sigma>, k), \<sigma>', k') \<in> cp\<close> proof cases
	+ assume vnw: \<open>\<forall> l < k. v\<notin>writes (\<pi> l)\<close>
	+ hence \<sigma>v: \<open>(\<sigma>\<^bsup>k\<^esup>) v = \<sigma> v\<close> by (metis no_writes_unchanged0 path(1))
	+ show \<open>?thesis\<close> proof cases
	+ assume vnw': \<open>\<forall> l < k'. v\<notin>writes (\<pi>' l)\<close>
	+ hence \<sigma>v': \<open>(\<sigma>'\<^bsup>k'\<^esup>) v = \<sigma>' v\<close> by (metis no_writes_unchanged0 path(2))
	+ with \<sigma>v vneq have \<open>\<sigma> v \<noteq> \<sigma>' v\<close> by auto
	+ hence vhigh: \<open>v \<in> hvars\<close> using leq unfolding loweq_def restrict_def by (auto,metis)
	+ thus \<open>?thesis\<close> using cp.intros(1)[OF leq csk vread vneq] vnw vnw' path by simp
	+ next
	+ assume \<open>\<not>(\<forall> l < k'. v\<notin>writes (\<pi>' l))\<close>
	+ then obtain l' where kddl': \<open>k' dd\<^bsup>\<pi>',v\<^esup>\<rightarrow> l'\<close> using path(2) path_is_path written_read_dd vread' by blast
	+ hence lv': \<open>v \<in> writes (\<pi>' l')\<close> unfolding is_ddi_def by auto
	+ have lk': \<open>l' < k'\<close> by (metis is_ddi_def kddl')
	+ have nret: \<open>\<pi>' l' \<noteq> return\<close> using lv' writes_return by auto
	+
	+ have notin\<pi>: \<open>\<not> (\<exists>l. cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>\<^esup> l)\<close> proof
	+ assume \<open>\<exists>l. cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>\<^esup> l\<close>
	+ then guess l ..
	+ note csl = \<open>cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>\<^esup> l\<close>
	+ have lk: \<open>l < k\<close> using lk' cseq ip cs_order[of \<open>\<pi>'\<close> \<open>\<pi>\<close> \<open>l'\<close> \<open>l\<close> \<open>k'\<close> \<open>k\<close>] csl nret path by force
	+
	+ have \<open>v \<in> writes (\<pi> l)\<close> using csl lv' last_cs by metis
	+ thus \<open>False\<close> using lk vnw by blast
	+ qed
	+
	+ from converged_cd_diverge[OF ip(2,1) \<pi>0 notin\<pi> lk' cseq]
	+ obtain i i' where csi: \<open>cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i\<close> and lcdi: \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> i'\<close> and div: \<open>\<pi>' (Suc i') \<noteq> \<pi> (Suc i)\<close> .
	+
	+ have 1: \<open>\<pi> (Suc i) = suc (\<pi> i) (\<sigma>\<^bsup>i\<^esup>)\<close> by (metis step_suc_sem fst_conv path(1) path_suc)
	+ have 2: \<open>\<pi>' (Suc i') = suc (\<pi>' i') (\<sigma>'\<^bsup>i'\<^esup>)\<close> by (metis step_suc_sem fst_conv path(2) path_suc)
	+ have 3: \<open>\<pi>' i' = \<pi> i\<close> using csi last_cs by metis
	+ have nreads: \<open>\<sigma>\<^bsup>i\<^esup> \<restriction> reads (\<pi> i) \<noteq> \<sigma>'\<^bsup>i'\<^esup> \<restriction> reads (\<pi> i)\<close> by (metis 1 2 3 div reads_restr_suc)
	+ then obtain v' where v'read: \<open>v'\<in> reads(path \<sigma> i)\<close> \<open>(\<sigma>\<^bsup>i\<^esup>) v' \<noteq> (\<sigma>'\<^bsup>i'\<^esup>) v'\<close> unfolding path by (metis reads_restrict)
	+
	+ have nreti: \<open>\<pi>' i' \<noteq> return\<close> by (metis csi div ip(1) ip(2) last_cs lessI term_path_stable less_imp_le)
	+ have ik': \<open>i' < k'\<close> using lcdi lk' is_cdi_def by auto
	+ have ik: \<open>i < k\<close> using cs_order[OF ip(2,1) csi cseq nreti ik'] .
	+
	+ have cpi: \<open>((\<sigma>, i), (\<sigma>', i')) \<in> cp\<close> using IH[of \<open>i\<close> \<open>i'\<close>] v'read csi ik ik' path by auto
	+ hence cpi': \<open>((\<sigma>', i'), (\<sigma>, i)) \<in> cp\<close> using cp.intros(4) by blast
	+
	+ have nwvi: \<open>\<forall>j'\<in>{LEAST i'. i < i' \<and> (\<exists>i. cs\<^bsup>path \<sigma>'\<^esup> i = cs\<^bsup>path \<sigma>\<^esup> i')..<k}. v \<notin> writes (path \<sigma> j')\<close> using vnw[unfolded path]
	+ by (metis (poly_guards_query) atLeastLessThan_iff)
	+
	+ from cp.intros(3)[OF cpi' kddl'[unfolded path] lcdi[unfolded path] csk[symmetric] div[unfolded path] vneq[symmetric] nwvi]
	+
	+ show \<open>?thesis\<close> using cp.intros(4) by simp
	+ qed
	+ next
	+ assume wv: \<open>\<not> (\<forall> l<k. v \<notin> writes (\<pi> l))\<close>
	+ then obtain l where kddl: \<open>k dd\<^bsup>\<pi>,v\<^esup>\<rightarrow> l\<close> using path(1) path_is_path written_read_dd vread by blast
	+ hence lv: \<open>v \<in> writes (\<pi> l)\<close> unfolding is_ddi_def by auto
	+ have lk: \<open>l < k\<close> by (metis is_ddi_def kddl)
	+ have nret: \<open>\<pi> l \<noteq> return\<close> using lv writes_return by auto
	+ have nwb: \<open>\<forall> i \<in> {Suc l..< k}. v\<notin>writes(\<pi> i)\<close> using kddl unfolding is_ddi_def by auto
	+ have \<sigma>vk: \<open>(\<sigma>\<^bsup>k\<^esup>) v = (\<sigma>\<^bsup>Suc l\<^esup> ) v\<close> using kddl ddi_value path(1) by auto
	+
	+ show \<open>?thesis\<close> proof cases
	+ assume vnw': \<open>\<forall> l < k'. v\<notin>writes (\<pi>' l)\<close>
	+ hence \<sigma>v': \<open>(\<sigma>'\<^bsup>k'\<^esup>) v = \<sigma>' v\<close> by (metis no_writes_unchanged0 path(2))
	+
	+ have notin\<pi>': \<open>\<not> (\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l')\<close> proof
	+ assume \<open>\<exists>l'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close>
	+ then guess l' ..
	+ note csl = \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close>
	+ have lk: \<open>l' < k'\<close> using lk cseq ip cs_order[of \<open>\<pi>\<close> \<open>\<pi>'\<close> \<open>l\<close> \<open>l'\<close> \<open>k\<close> \<open>k'\<close>] csl nret by metis
	+
	+ have \<open>v \<in> writes (\<pi>' l')\<close> using csl lv last_cs by metis
	+ thus \<open>False\<close> using lk vnw' by blast
	+ qed
	+
	+ from converged_cd_diverge[OF ip(1,2) \<pi>0[symmetric] notin\<pi>' lk cseq[symmetric]]
	+ obtain i i' where csi: \<open>cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i\<close> and lcdi: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> i\<close> and div: \<open>\<pi> (Suc i) \<noteq> \<pi>' (Suc i')\<close> by metis
	+
	+ have 1: \<open>\<pi> (Suc i) = suc (\<pi> i) (\<sigma>\<^bsup>i\<^esup>)\<close> by (metis step_suc_sem fst_conv path(1) path_suc)
	+ have 2: \<open>\<pi>' (Suc i') = suc (\<pi>' i') (\<sigma>'\<^bsup>i'\<^esup>)\<close> by (metis step_suc_sem fst_conv path(2) path_suc)
	+ have 3: \<open>\<pi>' i' = \<pi> i\<close> using csi last_cs by metis
	+ have nreads: \<open>\<sigma>\<^bsup>i\<^esup> \<restriction> reads (\<pi> i) \<noteq> \<sigma>'\<^bsup>i'\<^esup> \<restriction> reads (\<pi> i)\<close> by (metis 1 2 3 div reads_restr_suc)
	+ have contri: \<open>(\<sigma>',i') \<cc> (\<sigma>,i)\<close> using contradicts.intros(2)[OF csi path nreads] .
	+
	+ have nreti: \<open>\<pi> i \<noteq> return\<close> by (metis csi div ip(1) ip(2) last_cs lessI term_path_stable less_imp_le)
	+ have ik: \<open>i < k\<close> using lcdi lk is_cdi_def by auto
	+ have ik': \<open>i' < k'\<close> using cs_order[OF ip(1,2) csi[symmetric] cseq[symmetric] nreti ik] .
	+ have nreads: \<open>\<sigma>\<^bsup>i\<^esup> \<restriction> reads (\<pi> i) \<noteq> \<sigma>'\<^bsup>i'\<^esup> \<restriction> reads (\<pi> i)\<close> by (metis 1 2 3 div reads_restr_suc)
	+ then obtain v' where v'read: \<open>v'\<in> reads(path \<sigma> i)\<close> \<open>(\<sigma>\<^bsup>i\<^esup>) v' \<noteq> (\<sigma>'\<^bsup>i'\<^esup>) v'\<close> unfolding path by (metis reads_restrict)
	+
	+
	+ have cpi: \<open>((\<sigma>, i), (\<sigma>', i')) \<in> cp\<close> using IH[of \<open>i\<close> \<open>i'\<close>] v'read csi ik ik' path by auto
	+ hence cpi': \<open>((\<sigma>', i'), (\<sigma>, i)) \<in> cp\<close> using cp.intros(4) by blast
	+
	+ have vnwi: \<open>\<forall>j'\<in>{LEAST i'a. i' < i'a \<and> (\<exists>i. cs\<^bsup>path \<sigma>\<^esup> i = cs\<^bsup>path \<sigma>'\<^esup> i'a)..<k'}. v \<notin> writes (path \<sigma>' j')\<close> using vnw'[unfolded path]
	+ by (metis (poly_guards_query) atLeastLessThan_iff)
	+
	+ from cp.intros(3)[OF cpi kddl[unfolded path] lcdi[unfolded path] csk div[unfolded path] vneq vnwi]
	+
	+ show \<open>?thesis\<close> using cp.intros(4) by simp
	+ next
	+ assume \<open>\<not> (\<forall> l<k'. v \<notin> writes (\<pi>' l))\<close>
	+ then obtain l' where kddl': \<open>k' dd\<^bsup>\<pi>',v\<^esup>\<rightarrow> l'\<close> using path(2) path_is_path written_read_dd vread' by blast
	+ hence lv': \<open>v \<in> writes (\<pi>' l')\<close> unfolding is_ddi_def by auto
	+ have lk': \<open>l' < k'\<close> by (metis is_ddi_def kddl')
	+ have nretl': \<open>\<pi>' l' \<noteq> return\<close> using lv' writes_return by auto
	+ have nwb': \<open>\<forall> i' \<in> {Suc l'..< k'}. v\<notin>writes(\<pi>' i')\<close> using kddl' unfolding is_ddi_def by auto
	+ have \<sigma>vk': \<open>(\<sigma>'\<^bsup>k'\<^esup>) v = (\<sigma>'\<^bsup>Suc l'\<^esup> ) v\<close> using kddl' ddi_value path(2) by auto
	+
	+ show \<open>?thesis\<close> proof cases
	+ assume csl: \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> l'\<close>
	+ hence \<pi>l: \<open>\<pi> l = \<pi>' l'\<close> by (metis last_cs)
	+ have \<sigma>vls: \<open>(\<sigma>\<^bsup>Suc l\<^esup> ) v \<noteq> (\<sigma>'\<^bsup>Suc l'\<^esup> ) v\<close> by (metis \<sigma>vk \<sigma>vk' vneq)
	+ have r\<sigma>: \<open>\<sigma>\<^bsup>l\<^esup> \<restriction> reads (\<pi> l) \<noteq> \<sigma>'\<^bsup>l'\<^esup> \<restriction> reads (\<pi> l)\<close> using path \<pi>l \<sigma>vls written_value lv by blast
	+ then obtain v' where v'read: \<open>v'\<in> reads(path \<sigma> l)\<close> \<open>(\<sigma>\<^bsup>l\<^esup>) v' \<noteq> (\<sigma>'\<^bsup>l'\<^esup>) v'\<close> unfolding path by (metis reads_restrict)
	+
	+
	+ have cpl: \<open>((\<sigma>, l), (\<sigma>', l')) \<in> cp\<close> using IH[of \<open>l\<close> \<open>l'\<close>] v'read csl lk lk' path by auto
	+ show \<open>((\<sigma>, k), (\<sigma>', k')) \<in> cp\<close> using cp.intros(2)[OF cpl kddl[unfolded path] kddl'[unfolded path] csk vneq] .
	+ next
	+ assume csl: \<open>cs\<^bsup>\<pi>\<^esup> l \<noteq> cs\<^bsup>\<pi>'\<^esup> l'\<close>
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>\<exists> i'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> i'\<close>
	+ then obtain i' where csli': \<open>cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> i'\<close> by blast
	+ have ilne': \<open>i' \<noteq> l'\<close> using csl csli' by auto
	+ have ij': \<open>i' < k'\<close> using cs_order[OF ip csli' cseq[symmetric] nret lk] .
	+ have iv': \<open>v \<in> writes(\<pi>' i')\<close> using lv csli' last_cs by metis
	+ have il': \<open>i' < l'\<close> using kddl' ilne' ij' iv' unfolding is_ddi_def by auto
	+ have nreti': \<open>\<pi>' i' \<noteq> return\<close> using csli' nret last_cs by metis
	+
	+ have l'notin\<pi>: \<open>\<not>(\<exists>i. cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>\<^esup> i )\<close> proof
	+ assume \<open>\<exists>i. cs\<^bsup>\<pi>'\<^esup> l' = cs\<^bsup>\<pi>\<^esup> i\<close>
	+ then obtain i where csil: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> l'\<close> by metis
	+ have ik: \<open>i < k\<close> using cs_order[OF ip(2,1) csil[symmetric] cseq nretl' lk'] .
	+ have li: \<open>l < i\<close> using cs_order[OF ip(2,1) csli'[symmetric] csil[symmetric] nreti' il'] .
	+ have iv: \<open>v \<in> writes(\<pi> i)\<close> using lv' csil last_cs by metis
	+ show \<open>False\<close> using kddl ik li iv is_ddi_def by auto
	+ qed
	+
	+ obtain n n' where csn: \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and lcdn': \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> and sucn: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close> and in': \<open>i' \<le> n'\<close>
	+ using converged_cd_diverge_cs [OF ip(2,1) csli'[symmetric] il' l'notin\<pi> lk' cseq] by metis
	+
	+ \<comment> \<open>Can apply the IH to n and n'\<close>
	+
	+ have 1: \<open>\<pi> (Suc n) = suc (\<pi> n) (\<sigma>\<^bsup>n\<^esup>)\<close> by (metis step_suc_sem fst_conv path(1) path_suc)
	+ have 2: \<open>\<pi>' (Suc n') = suc (\<pi>' n') (\<sigma>'\<^bsup>n'\<^esup>)\<close> by (metis step_suc_sem fst_conv path(2) path_suc)
	+ have 3: \<open>\<pi>' n' = \<pi> n\<close> using csn last_cs by metis
	+ have nreads: \<open>\<sigma>\<^bsup>n\<^esup> \<restriction> reads (\<pi> n) \<noteq> \<sigma>'\<^bsup>n'\<^esup> \<restriction> reads (\<pi> n)\<close> by (metis 1 2 3 sucn reads_restr_suc)
	+ then obtain v' where v'read: \<open>v'\<in>reads (path \<sigma> n)\<close> \<open>(\<sigma>\<^bsup>n\<^esup>) v' \<noteq> (\<sigma>'\<^bsup>n'\<^esup>) v'\<close> by (metis path(1) reads_restrict)
	+ moreover
	+ have nl': \<open>n' < l'\<close> using lcdn' is_cdi_def by auto
	+ have nk': \<open>n' < k'\<close> using nl' lk' by simp
	+ have nretn': \<open>\<pi>' n' \<noteq> return\<close> by (metis ip(2) nl' nretl' term_path_stable less_imp_le)
	+ have nk: \<open>n < k\<close> using cs_order[OF ip(2,1) csn[symmetric] cseq nretn' nk'] .
	+ hence lenn: \<open>n+n' < k+k'\<close> using nk' by auto
	+ ultimately
	+ have \<open>((\<sigma>, n), (\<sigma>', n')) \<in> cp\<close> using IH csn path by auto
	+ hence ncp: \<open>((\<sigma>', n'), (\<sigma>, n)) \<in> cp\<close> using cp.intros(4) by auto
	+
	+ have nles: \<open>n < (LEAST i'. n < i' \<and> (\<exists>i. cs\<^bsup>\<pi>'\<^esup> i = cs\<^bsup>\<pi>\<^esup> i'))\<close> (is \<open>_ < (LEAST i. ?P i)\<close>) using nk cseq LeastI[of \<open>?P\<close> \<open>k\<close>] by metis
	+ moreover
	+ have ln: \<open>l \<le> n\<close> using cs_order_le[OF ip(2,1) csli'[symmetric] csn[symmetric] nreti' in'] .
	+ ultimately
	+ have lles: \<open>Suc l \<le> (LEAST i'. n < i' \<and> (\<exists>i. cs\<^bsup>\<pi>'\<^esup> i = cs\<^bsup>\<pi>\<^esup> i'))\<close> by auto
	+
	+ have nwcseq: \<open>\<forall>j'\<in>{LEAST i'. n < i' \<and> (\<exists>i. cs\<^bsup>\<pi>'\<^esup> i = cs\<^bsup>\<pi>\<^esup> i')..<k}. v \<notin> writes (\<pi> j')\<close> proof
	+ fix j' assume *: \<open>j' \<in> {LEAST i'. n < i' \<and> (\<exists>i. cs\<^bsup>\<pi>'\<^esup> i = cs\<^bsup>\<pi>\<^esup> i')..<k}\<close>
	+ hence \<open>(LEAST i'. n < i' \<and> (\<exists>i. cs\<^bsup>\<pi>'\<^esup> i = cs\<^bsup>\<pi>\<^esup> i')) \<le> j'\<close> by (metis (poly_guards_query) atLeastLessThan_iff)
	+ hence \<open>Suc l \<le> j'\<close> using lles by auto
	+ moreover
	+ have \<open>j' < k\<close> using * by (metis (poly_guards_query) atLeastLessThan_iff)
	+ ultimately have \<open>j'\<in> {Suc l..<k}\<close> by (metis (poly_guards_query) atLeastLessThan_iff)
	+ thus \<open>v\<notin>writes (\<pi> j')\<close> using nwb by auto
	+ qed
	+
	+ from cp.intros(3)[OF ncp,folded path,OF kddl' lcdn' cseq sucn[symmetric] vneq[symmetric] nwcseq]
	+ have \<open>((\<sigma>', k'), \<sigma>, k) \<in> cp\<close> .
	+ thus \<open>((\<sigma>, k), (\<sigma>', k')) \<in> cp\<close> using cp.intros(4) by auto
	+ next
	+ assume lnotin\<pi>': \<open>\<not> (\<exists>i'. cs\<^bsup>\<pi>\<^esup> l = cs\<^bsup>\<pi>'\<^esup> i')\<close>
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>\<exists> i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> l'\<close>
	+ then obtain i where csli: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> l'\<close> by blast
	+ have ilne: \<open>i \<noteq> l\<close> using csl csli by auto
	+ have ij: \<open>i < k\<close> using cs_order[OF ip(2,1) csli[symmetric] cseq nretl' lk'] .
	+ have iv: \<open>v \<in> writes(\<pi> i)\<close> using lv' csli last_cs by metis
	+ have il: \<open>i < l\<close> using kddl ilne ij iv unfolding is_ddi_def by auto
	+ have nreti: \<open>\<pi> i \<noteq> return\<close> using csli nretl' last_cs by metis
	+
	+ obtain n n' where csn: \<open>cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and lcdn: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> and sucn: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close> and ilen: \<open>i \<le> n\<close>
	+ using converged_cd_diverge_cs [OF ip csli il lnotin\<pi>' lk cseq[symmetric]] by metis
	+
	+ \<comment> \<open>Can apply the IH to n and n'\<close>
	+
	+ have 1: \<open>\<pi> (Suc n) = suc (\<pi> n) (\<sigma>\<^bsup>n\<^esup>)\<close> by (metis step_suc_sem fst_conv path(1) path_suc)
	+ have 2: \<open>\<pi>' (Suc n') = suc (\<pi>' n') (\<sigma>'\<^bsup>n'\<^esup>)\<close> by (metis step_suc_sem fst_conv path(2) path_suc)
	+ have 3: \<open>\<pi>' n' = \<pi> n\<close> using csn last_cs by metis
	+ have nreads: \<open>\<sigma>\<^bsup>n\<^esup> \<restriction> reads (\<pi> n) \<noteq> \<sigma>'\<^bsup>n'\<^esup> \<restriction> reads (\<pi> n)\<close> by (metis 1 2 3 sucn reads_restr_suc)
	+ then obtain v' where v'read: \<open>v'\<in>reads (path \<sigma> n)\<close> \<open>(\<sigma>\<^bsup>n\<^esup>) v' \<noteq> (\<sigma>'\<^bsup>n'\<^esup>) v'\<close> by (metis path(1) reads_restrict)
	+ moreover
	+ have nl: \<open>n < l\<close> using lcdn is_cdi_def by auto
	+ have nk: \<open>n < k\<close> using nl lk by simp
	+ have nretn: \<open>\<pi> n \<noteq> return\<close> by (metis ip(1) nl nret term_path_stable less_imp_le)
	+ have nk': \<open>n' < k'\<close> using cs_order[OF ip csn cseq[symmetric] nretn nk] .
	+ hence lenn: \<open>n+n' < k+k'\<close> using nk by auto
	+ ultimately
	+ have ncp: \<open>((\<sigma>, n), (\<sigma>', n')) \<in> cp\<close> using IH csn path by auto
	+
	+ have nles': \<open>n' < (LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))\<close> (is \<open>_ < (LEAST i. ?P i)\<close>) using nk' cseq LeastI[of \<open>?P\<close> \<open>k'\<close>] by metis
	+ moreover
	+ have ln': \<open>l' \<le> n'\<close> using cs_order_le[OF ip csli csn nreti ilen] .
	+ ultimately
	+ have lles': \<open>Suc l' \<le> (LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))\<close> by auto
	+
	+ have nwcseq': \<open>\<forall>j'\<in>{(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))..<k'}. v \<notin> writes (\<pi>' j')\<close> proof
	+ fix j' assume *: \<open>j' \<in> {(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))..<k'}\<close>
	+ hence \<open>(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')) \<le> j'\<close> by (metis (poly_guards_query) atLeastLessThan_iff)
	+ hence \<open>Suc l' \<le> j'\<close> using lles' by auto
	+ moreover
	+ have \<open>j' < k'\<close> using * by (metis (poly_guards_query) atLeastLessThan_iff)
	+ ultimately have \<open>j'\<in> {Suc l'..<k'}\<close> by (metis (poly_guards_query) atLeastLessThan_iff)
	+ thus \<open>v\<notin>writes (\<pi>' j')\<close> using nwb' by auto
	+ qed
	+
	+ from cp.intros(3)[OF ncp,folded path, OF kddl lcdn cseq[symmetric] sucn vneq nwcseq']
	+
	+ show \<open>((\<sigma>, k), (\<sigma>', k')) \<in> cp\<close> .
	+ next
	+ assume l'notin\<pi>: \<open>\<not> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> l')\<close>
	+ define m where \<open>m \<equiv> 0::nat\<close>
	+ define m' where \<open>m' \<equiv> 0::nat\<close>
	+ have csm: \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close> unfolding m_def m'_def cs_0 by (metis \<pi>0)
	+ have ml: \<open>m<l \<or> m'<l'\<close> using csm csl unfolding m_def m'_def by (metis neq0_conv)
	+ have \<open>\<exists> n n'. cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n' \<and> \<pi> (Suc n) \<noteq> \<pi>' (Suc n') \<and>
	+ (l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n \<and> (\<forall>j'\<in>{(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))..<k'}. v\<notin>writes (\<pi>' j'))
	+ \<or> l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n' \<and> (\<forall>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}. v\<notin>writes (\<pi> j)))\<close>
	+ using csm ml proof (induction \<open>k+k'-(m+m')\<close> arbitrary: \<open>m\<close> \<open>m'\<close> rule: less_induct)
	+ case (less m m')
	+ note csm = \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m'\<close>
	+ note lm = \<open>m < l \<or> m' < l'\<close>
	+ note IH = \<open>\<And> n n'.
	+ k + k' - (n + n') < k + k' - (m + m') \<Longrightarrow>
	+ cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n' \<Longrightarrow>
	+ n < l \<or> n' < l' \<Longrightarrow> ?thesis\<close>
	+ show \<open>?thesis\<close> using lm proof
	+ assume ml: \<open>m < l\<close>
	+ obtain n n' where mn: \<open>m \<le> n\<close> and csn: \<open> cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and lcdn: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> and suc: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close>
	+ using converged_cd_diverge_cs[OF ip csm ml lnotin\<pi>' lk cseq[symmetric]] .
	+ have nl: \<open>n < l\<close> using lcdn is_cdi_def by auto
	+ hence nk: \<open>n<k\<close> using lk by auto
	+ have nretn: \<open>\<pi> n \<noteq> return\<close> using lcdn by (metis cd_not_ret)
	+ have nk': \<open>n'<k'\<close> using cs_order[OF ip csn cseq[symmetric] nretn nk] .
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>\<forall>j'\<in>{(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))..<k'}. v\<notin>writes (\<pi>' j')\<close>
	+ thus \<open>?thesis\<close> using lcdn csn suc by blast
	+ next
	+ assume \<open>\<not>(\<forall>j'\<in>{(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))..<k'}. v\<notin>writes (\<pi>' j'))\<close>
	+ then obtain j' where jin': \<open>j'\<in>{(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))..<k'}\<close> and vwrite: \<open>v\<in>writes (\<pi>' j')\<close> by blast
	+ define i' where \<open>i' \<equiv> LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')\<close>
	+ have Pk': \<open>n' < k' \<and> (\<exists> k. cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k')\<close> (is \<open>?P k'\<close>) using nk' cseq[symmetric] by blast
	+ have ni': \<open>n' < i'\<close> using LeastI[of \<open>?P\<close>, OF Pk'] i'_def by auto
	+ obtain i where csi: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> using LeastI[of \<open>?P\<close>, OF Pk'] i'_def by blast
	+ have ij': \<open>i'\<le>j'\<close> using jin'[folded i'_def] by auto
	+ have jk': \<open>j'<k'\<close> using jin'[folded i'_def] by auto
	+ have jl': \<open>j' \<le> l'\<close> using kddl' jk' vwrite unfolding is_ddi_def by auto
	+ have nretn': \<open>\<pi>' n' \<noteq> return\<close> using nretn csn last_cs by metis
	+ have iln: \<open>n<i\<close> using cs_order[OF ip(2,1) csn[symmetric] csi[symmetric] nretn' ni'] .
	+ hence mi: \<open>m < i\<close> using mn by auto
	+ have nretm: \<open>\<pi> m \<noteq> return\<close> by (metis ip(1) mn nretn term_path_stable)
	+ have mi': \<open>m'<i'\<close> using cs_order[OF ip csm csi nretm mi] .
	+ have ik': \<open>i' < k'\<close> using ij' jk' by auto
	+ have nreti': \<open>\<pi>' i' \<noteq> return\<close> by (metis ij' jl' nretl' ip(2) term_path_stable)
	+ have ik: \<open>i < k\<close> using cs_order[OF ip(2,1) csi[symmetric] cseq nreti' ik'] .
	+ show \<open>?thesis\<close> proof cases
	+ assume il:\<open>i < l\<close>
	+ have le: \<open>k + k' - (i +i') < k+k' - (m+m')\<close> using mi mi' ik ik' by auto
	+ show \<open>?thesis\<close> using IH[OF le] using csi il by blast
	+ next
	+ assume \<open>\<not> i < l\<close>
	+ hence li: \<open>l \<le> i\<close> by auto
	+ have \<open>i' \<le> l'\<close> using ij' jl' by auto
	+ hence il': \<open>i' < l'\<close> using csi l'notin\<pi> by fastforce
	+ obtain n n' where in': \<open>i' \<le> n'\<close> and csn: \<open> cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and lcdn': \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> and suc: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close>
	+ using converged_cd_diverge_cs[OF ip(2,1) csi[symmetric] il' _ lk' cseq] l'notin\<pi> by metis
	+ have nk': \<open>n' < k'\<close> using lcdn' is_cdi_def lk' by auto
	+ have nretn': \<open>\<pi>' n' \<noteq> return\<close> by (metis cd_not_ret lcdn')
	+ have nk: \<open>n < k\<close> using cs_order[OF ip(2,1) csn[symmetric] cseq nretn' nk'] .
	+ define j where \<open>j \<equiv> LEAST j. n < j \<and> (\<exists>j'. cs\<^bsup>\<pi>'\<^esup> j' = cs\<^bsup>\<pi>\<^esup> j)\<close>
	+ have Pk: \<open>n < k \<and> (\<exists>j'. cs\<^bsup>\<pi>'\<^esup> j' = cs\<^bsup>\<pi>\<^esup> k)\<close> (is \<open>?P k\<close>) using nk cseq by blast
	+ have nj: \<open>n<j\<close> using LeastI[of \<open>?P\<close>, OF Pk] j_def by auto
	+ have ilen: \<open>i \<le> n\<close> using cs_order_le[OF ip(2,1) csi[symmetric] csn[symmetric] nreti' in'] .
	+ hence lj: \<open>l<j\<close> using li nj by simp
	+ have \<open>\<forall>l\<in>{l<..<k}. v \<notin> writes (\<pi> l)\<close> using kddl unfolding is_ddi_def by simp
	+ hence nw: \<open>\<forall>l\<in>{j..<k}. v \<notin> writes (\<pi> l)\<close> using lj by auto
	+ show \<open>?thesis\<close> using csn lcdn' suc nw[unfolded j_def] by blast
	+ qed
	+ qed
	+ next
	+ assume ml': \<open>m' < l'\<close>
	+ obtain n n' where mn': \<open>m' \<le> n'\<close> and csn: \<open> cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and lcdn': \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> and suc: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close>
	+ using converged_cd_diverge_cs[OF ip(2,1) csm[symmetric] ml' _ lk' cseq] l'notin\<pi> by metis
	+ have nl': \<open>n' < l'\<close> using lcdn' is_cdi_def by auto
	+ hence nk': \<open>n'<k'\<close> using lk' by auto
	+ have nretn': \<open>\<pi>' n' \<noteq> return\<close> using lcdn' by (metis cd_not_ret)
	+ have nk: \<open>n<k\<close> using cs_order[OF ip(2,1) csn[symmetric] cseq nretn' nk'] .
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>\<forall>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}. v\<notin>writes (\<pi> j)\<close>
	+ thus \<open>?thesis\<close> using lcdn' csn suc by blast
	+ next
	+ assume \<open>\<not>(\<forall>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}. v\<notin>writes (\<pi> j))\<close>
	+ then obtain j where jin: \<open>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}\<close> and vwrite: \<open>v\<in>writes (\<pi> j)\<close> by blast
	+ define i where \<open>i \<equiv> LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i)\<close>
	+ have Pk: \<open>n < k \<and> (\<exists> k'. cs\<^bsup>\<pi>'\<^esup> k' = cs\<^bsup>\<pi>\<^esup> k)\<close> (is \<open>?P k\<close>) using nk cseq by blast
	+ have ni: \<open>n < i\<close> using LeastI[of \<open>?P\<close>, OF Pk] i_def by auto
	+ obtain i' where csi: \<open>cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'\<close> using LeastI[of \<open>?P\<close>, OF Pk] i_def by metis
	+ have ij: \<open>i\<le>j\<close> using jin[folded i_def] by auto
	+ have jk: \<open>j<k\<close> using jin[folded i_def] by auto
	+ have jl: \<open>j \<le> l\<close> using kddl jk vwrite unfolding is_ddi_def by auto
	+ have nretn: \<open>\<pi> n \<noteq> return\<close> using nretn' csn last_cs by metis
	+ have iln': \<open>n'<i'\<close> using cs_order[OF ip csn csi nretn ni] .
	+ hence mi': \<open>m' < i'\<close> using mn' by auto
	+ have nretm': \<open>\<pi>' m' \<noteq> return\<close> by (metis ip(2) mn' nretn' term_path_stable)
	+ have mi: \<open>m<i\<close> using cs_order[OF ip(2,1) csm[symmetric] csi[symmetric] nretm' mi'] .
	+ have ik: \<open>i < k\<close> using ij jk by auto
	+ have nreti: \<open>\<pi> i \<noteq> return\<close> by (metis ij ip(1) jl nret term_path_stable)
	+ have ik': \<open>i' < k'\<close> using cs_order[OF ip csi cseq[symmetric] nreti ik] .
	+ show \<open>?thesis\<close> proof cases
	+ assume il':\<open>i' < l'\<close>
	+ have le: \<open>k + k' - (i +i') < k+k' - (m+m')\<close> using mi mi' ik ik' by auto
	+ show \<open>?thesis\<close> using IH[OF le] using csi il' by blast
	+ next
	+ assume \<open>\<not> i' < l'\<close>
	+ hence li': \<open>l' \<le> i'\<close> by auto
	+ have \<open>i \<le> l\<close> using ij jl by auto
	+ hence il: \<open>i < l\<close> using csi lnotin\<pi>' by fastforce
	+ obtain n n' where ilen: \<open>i \<le> n\<close> and csn: \<open> cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and lcdn: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> and suc: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close>
	+ using converged_cd_diverge_cs[OF ip csi il _ lk cseq[symmetric]] lnotin\<pi>' by metis
	+ have nk: \<open>n < k\<close> using lcdn is_cdi_def lk by auto
	+ have nretn: \<open>\<pi> n \<noteq> return\<close> by (metis cd_not_ret lcdn)
	+ have nk': \<open>n' < k'\<close> using cs_order[OF ip csn cseq[symmetric] nretn nk] .
	+ define j' where \<open>j' \<equiv> LEAST j'. n' < j' \<and> (\<exists>j. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> j')\<close>
	+ have Pk': \<open>n' < k' \<and> (\<exists>j. cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> k')\<close> (is \<open>?P k'\<close>) using nk' cseq[symmetric] by blast
	+ have nj': \<open>n'<j'\<close> using LeastI[of \<open>?P\<close>, OF Pk'] j'_def by auto
	+ have in': \<open>i' \<le> n'\<close> using cs_order_le[OF ip csi csn nreti ilen] .
	+ hence lj': \<open>l'<j'\<close> using li' nj' by simp
	+ have \<open>\<forall>l\<in>{l'<..<k'}. v \<notin> writes (\<pi>' l)\<close> using kddl' unfolding is_ddi_def by simp
	+ hence nw': \<open>\<forall>l\<in>{j'..<k'}. v \<notin> writes (\<pi>' l)\<close> using lj' by auto
	+ show \<open>?thesis\<close> using csn lcdn suc nw'[unfolded j'_def] by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ then obtain n n' where csn: \<open> cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n'\<close> and suc: \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close>
	+ and cdor:
	+ \<open>(l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n \<and> (\<forall>j'\<in>{(LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i'))..<k'}. v\<notin>writes (\<pi>' j'))
	+ \<or> l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n' \<and> (\<forall>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}. v\<notin>writes (\<pi> j)))\<close>
	+ by blast
	+ show \<open>?thesis\<close> using cdor proof
	+ assume *: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n \<and> (\<forall>j'\<in>{LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')..<k'}. v \<notin> local.writes (\<pi>' j'))\<close>
	+ hence lcdn: \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> by blast
	+ have nowrite: \<open>\<forall>j'\<in>{LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')..<k'}. v \<notin> local.writes (\<pi>' j')\<close> using * by blast
	+ show \<open>?thesis\<close> proof (rule cp.intros(3)[of \<open>\<sigma>\<close> \<open>n\<close> \<open>\<sigma>'\<close> \<open>n'\<close>,folded path])
	+ show \<open>l cd\<^bsup>\<pi>\<^esup>\<rightarrow> n\<close> using lcdn .
	+ show \<open>k dd\<^bsup>\<pi>,v\<^esup>\<rightarrow> l\<close> using kddl .
	+ show \<open>cs\<^bsup>\<pi>\<^esup> k = cs\<^bsup>\<pi>'\<^esup> k'\<close> using cseq by simp
	+ show \<open>\<pi> (Suc n) \<noteq> \<pi>' (Suc n')\<close> using suc by simp
	+ show \<open>\<forall>j'\<in>{LEAST i'. n' < i' \<and> (\<exists>i. cs\<^bsup>\<pi>\<^esup> i = cs\<^bsup>\<pi>'\<^esup> i')..<k'}. v \<notin> local.writes (\<pi>' j')\<close> using nowrite .
	+ show \<open>(\<sigma>\<^bsup>k\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v\<close> using vneq .
	+ have nk: \<open>n < k\<close> using lcdn lk is_cdi_def by auto
	+ have nretn: \<open>\<pi> n \<noteq> return\<close> using cd_not_ret lcdn by metis
	+ have nk': \<open>n' < k'\<close> using cs_order[OF ip csn cseq[symmetric] nretn nk] .
	+ hence le: \<open>n + n' < k + k'\<close> using nk by auto
	+ moreover
	+ have 1: \<open>\<pi> (Suc n) = suc (\<pi> n) (\<sigma>\<^bsup>n\<^esup>)\<close> by (metis step_suc_sem fst_conv path(1) path_suc)
	+ have 2: \<open>\<pi>' (Suc n') = suc (\<pi>' n') (\<sigma>'\<^bsup>n'\<^esup>)\<close> by (metis step_suc_sem fst_conv path(2) path_suc)
	+ have 3: \<open>\<pi>' n' = \<pi> n\<close> using csn last_cs by metis
	+ have nreads: \<open>\<sigma>\<^bsup>n\<^esup> \<restriction> reads (\<pi> n) \<noteq> \<sigma>'\<^bsup>n'\<^esup> \<restriction> reads (\<pi> n)\<close> by (metis 1 2 3 suc reads_restr_suc)
	+ then obtain v' where v'read: \<open>v'\<in>reads (path \<sigma> n)\<close> \<open>(\<sigma>\<^bsup>n\<^esup>) v' \<noteq> (\<sigma>'\<^bsup>n'\<^esup>) v'\<close> by (metis path(1) reads_restrict)
	+ ultimately
	+ show \<open>((\<sigma>, n), (\<sigma>', n')) \<in> cp\<close> using IH csn path by auto
	+ qed
	+ next
	+ assume *: \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n' \<and> (\<forall>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}. v\<notin>writes (\<pi> j))\<close>
	+ hence lcdn': \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> by blast
	+ have nowrite: \<open>\<forall>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}. v\<notin>writes (\<pi> j)\<close> using * by blast
	+ show \<open>?thesis\<close> proof (rule cp.intros(4), rule cp.intros(3)[of \<open>\<sigma>'\<close> \<open>n'\<close> \<open>\<sigma>\<close> \<open>n\<close>,folded path])
	+ show \<open>l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> n'\<close> using lcdn' .
	+ show \<open>k' dd\<^bsup>\<pi>',v\<^esup>\<rightarrow> l'\<close> using kddl' .
	+ show \<open>cs\<^bsup>\<pi>'\<^esup> k' = cs\<^bsup>\<pi>\<^esup> k\<close> using cseq .
	+ show \<open>\<pi>' (Suc n') \<noteq> \<pi> (Suc n)\<close> using suc by simp
	+ show \<open>\<forall>j\<in>{(LEAST i. n < i \<and> (\<exists>i'. cs\<^bsup>\<pi>'\<^esup> i' = cs\<^bsup>\<pi>\<^esup> i))..<k}. v\<notin>writes (\<pi> j)\<close> using nowrite .
	+ show \<open>(\<sigma>'\<^bsup>k'\<^esup>) v \<noteq> (\<sigma>\<^bsup>k\<^esup>) v\<close> using vneq by simp
	+ have nk': \<open>n' < k'\<close> using lcdn' lk' is_cdi_def by auto
	+ have nretn': \<open>\<pi>' n' \<noteq> return\<close> using cd_not_ret lcdn' by metis
	+ have nk: \<open>n < k\<close> using cs_order[OF ip(2,1) csn[symmetric] cseq nretn' nk'] .
	+ hence le: \<open>n + n' < k + k'\<close> using nk' by auto
	+ moreover
	+ have 1: \<open>\<pi> (Suc n) = suc (\<pi> n) (\<sigma>\<^bsup>n\<^esup>)\<close> by (metis step_suc_sem fst_conv path(1) path_suc)
	+ have 2: \<open>\<pi>' (Suc n') = suc (\<pi>' n') (\<sigma>'\<^bsup>n'\<^esup>)\<close> by (metis step_suc_sem fst_conv path(2) path_suc)
	+ have 3: \<open>\<pi>' n' = \<pi> n\<close> using csn last_cs by metis
	+ have nreads: \<open>\<sigma>\<^bsup>n\<^esup> \<restriction> reads (\<pi> n) \<noteq> \<sigma>'\<^bsup>n'\<^esup> \<restriction> reads (\<pi> n)\<close> by (metis 1 2 3 suc reads_restr_suc)
	+ then obtain v' where v'read: \<open>v'\<in>reads (path \<sigma> n)\<close> \<open>(\<sigma>\<^bsup>n\<^esup>) v' \<noteq> (\<sigma>'\<^bsup>n'\<^esup>) v'\<close> by (metis path(1) reads_restrict)
	+ ultimately
	+ have \<open>((\<sigma>, n), (\<sigma>', n')) \<in> cp\<close> using IH csn path by auto
	+ thus \<open>((\<sigma>', n'), \<sigma>, n) \<in> cp\<close> using cp.intros(4) by simp
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+qed
	+
	+
	+theorem contradicting_in_cop: assumes \<open>\<sigma> =\<^sub>L \<sigma>'\<close> and \<open>(\<sigma>',k') \<cc> (\<sigma>,k)\<close> and \<open>path \<sigma> k \<in> dom att\<close>
	+shows \<open>((\<sigma>,k),\<sigma>',k') \<in> cop\<close> using assms(2) proof(cases)
	+ case (1 \<pi>' \<pi>)
	+ define j where \<open>j \<equiv> \<pi> \<exclamdown> cs\<^bsup>\<pi>'\<^esup> k'\<close>
	+ have csj: \<open>cs\<^bsup>\<pi>\<^esup> j = cs\<^bsup>\<pi>'\<^esup> k'\<close> unfolding j_def using 1 by (metis cs_not_nil cs_select_is_cs(1) path_is_path)
	+ have suc: \<open>\<pi> (Suc j) \<noteq> \<pi>' (Suc k')\<close> using 1 j_def by simp
	+ have kcdj: \<open>k cd\<^bsup>\<pi>\<^esup>\<rightarrow> j\<close> by (metis cs_not_nil cs_select_is_cs(2) 1(1,2) j_def path_is_path)
	+ obtain v where readv: \<open>v\<in>reads(path \<sigma> j)\<close> and vneq: \<open>(\<sigma>\<^bsup>j\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v\<close> using suc csj unfolding 1 by (metis IFC_def.suc_def 1(2) 1(3) last_cs path_suc reads_restr_suc reads_restrict)
	+ have \<open>((\<sigma>,j),\<sigma>',k') \<in> cp\<close> apply (rule contradicting_in_cp[OF assms(1)]) using readv vneq csj 1 by auto
	+ thus \<open>((\<sigma>,k),\<sigma>',k') \<in> cop\<close> using kcdj suc assms(3) cop.intros(2) unfolding 1 by auto
	+ next
	+ case (2 \<pi>' \<pi>)
	+ obtain v where readv: \<open>v\<in>reads(path \<sigma> k)\<close> and vneq: \<open>(\<sigma>\<^bsup>k\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v\<close> using 2(2-4) by (metis reads_restrict)
	+ have \<open>((\<sigma>,k),\<sigma>',k') \<in> cp\<close> apply (rule contradicting_in_cp[OF assms(1)]) using readv vneq 2 by auto
	+ thus \<open>((\<sigma>,k),\<sigma>',k') \<in> cop\<close> using assms(3) cop.intros(1) unfolding 2 by auto
	+qed
	+
	+
	+theorem cop_correct_term: fixes \<sigma> \<sigma>' defines \<pi>: \<open>\<pi> \<equiv> path \<sigma>\<close> and \<pi>': \<open>\<pi>' \<equiv> path \<sigma>'\<close>
	+assumes ret: \<open>\<pi> n = return\<close> \<open>\<pi>' n' = return\<close> and obsne: \<open>obs \<sigma> \<noteq> obs \<sigma>'\<close> and leq: \<open>\<sigma> =\<^sub>L \<sigma>'\<close>
	+shows \<open>\<exists> k k'. ((\<sigma>,k),\<sigma>',k')\<in> cop \<or> ((\<sigma>',k'),\<sigma>,k)\<in> cop\<close>
	+proof -
	+ have *: \<open>\<exists> k k'. ((\<sigma>', k') \<cc> (\<sigma> ,k) \<and> \<pi> k \<in> dom (att)) \<or> ((\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> \<pi>' k' \<in> dom (att))\<close> using obs_neq_contradicts_term ret obsne \<pi> \<pi>' by auto
	+ have leq' :\<open>\<sigma>' =\<^sub>L \<sigma>\<close> using leq unfolding loweq_def by auto
	+ from * contradicting_in_cop[OF leq] contradicting_in_cop[OF leq'] show \<open>?thesis\<close> unfolding \<pi> \<pi>' by metis
	+qed
	+
	+
	+theorem cop_correct_ret: fixes \<sigma> \<sigma>' defines \<pi>: \<open>\<pi> \<equiv> path \<sigma>\<close> and \<pi>': \<open>\<pi>' \<equiv> path \<sigma>'\<close>
	+assumes ret: \<open>\<pi> n = return\<close> and obsne: \<open>obs \<sigma> i \<noteq> obs \<sigma>' i\<close> and obs: \<open>obs \<sigma>' i \<noteq> None\<close> and leq: \<open>\<sigma> =\<^sub>L \<sigma>'\<close>
	+shows \<open>\<exists> k k'. ((\<sigma>,k),\<sigma>',k')\<in> cop \<or> ((\<sigma>',k'),\<sigma>,k)\<in> cop\<close>
	+proof -
	+ have *: \<open>\<exists> k k'. ((\<sigma>', k') \<cc> (\<sigma> ,k) \<and> \<pi> k \<in> dom (att)) \<or> ((\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> \<pi>' k' \<in> dom (att))\<close>
	+ by (metis (no_types, lifting) \<pi> \<pi>' obs obs_neq_ret_contradicts obsne ret)
	+ have leq' :\<open>\<sigma>' =\<^sub>L \<sigma>\<close> using leq unfolding loweq_def by auto
	+ from * contradicting_in_cop[OF leq] contradicting_in_cop[OF leq'] show \<open>?thesis\<close> unfolding \<pi> \<pi>' by metis
	+qed
	+
	+
	+theorem cop_correct_nterm: assumes obsne: \<open>obs \<sigma> k \<noteq> obs \<sigma>' k\<close> \<open>obs \<sigma> k \<noteq> None\<close> \<open>obs \<sigma>' k \<noteq> None\<close>
	+and leq: \<open>\<sigma> =\<^sub>L \<sigma>'\<close>
	+shows \<open>\<exists> k k'. ((\<sigma>,k),\<sigma>',k')\<in> cop \<or> ((\<sigma>',k'),\<sigma>,k)\<in> cop\<close>
	+proof -
	+ obtain k k' where \<open>((\<sigma>', k') \<cc> (\<sigma> ,k) \<and> path \<sigma> k \<in> dom att) \<or> ((\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> path \<sigma>' k' \<in> dom att)\<close>
	+ using obs_neq_some_contradicts[OF obsne] by metis
	+ thus \<open>?thesis\<close> proof
	+ assume *: \<open>(\<sigma>', k') \<cc> (\<sigma> ,k) \<and> path \<sigma> k \<in> dom att\<close>
	+ hence \<open>((\<sigma>,k),\<sigma>',k') \<in> cop\<close> using leq by (metis contradicting_in_cop)
	+ thus \<open>?thesis\<close> using * by blast
	+ next
	+ assume *: \<open>(\<sigma>, k) \<cc> (\<sigma>' ,k') \<and> path \<sigma>' k' \<in> dom att\<close>
	+ hence \<open>((\<sigma>',k'),\<sigma>,k) \<in> cop\<close> using leq by (metis contradicting_in_cop loweq_def)
	+ thus \<open>?thesis\<close> using * by blast
	+ qed
	+qed
	+
	+
	+subsection \<open>Correctness of the Characterisation\<close>
	+text_raw \<open>\label{sec:cor-cp}\<close>
	+
	+text \<open>The following is our main correctness result. If there exist no critical observable paths,
	+then the program is secure.\<close>
	+
	+theorem cop_correct: assumes \<open>cop = empty\<close> shows \<open>secure\<close> proof (rule ccontr)
	+ assume \<open>\<not> secure\<close>
	+ then obtain \<sigma> \<sigma>' where leq: \<open> \<sigma> =\<^sub>L \<sigma>'\<close>
	+ and **: \<open>\<not> obs \<sigma> \<approx> obs \<sigma>' \<or> (terminates \<sigma> \<and> \<not> obs \<sigma>' \<lesssim> obs \<sigma>)\<close>
	+ unfolding secure_def by blast
	+ show \<open>False\<close> using ** proof
	+ assume \<open>\<not> obs \<sigma> \<approx> obs \<sigma>'\<close>
	+ then obtain k where \<open>obs \<sigma> k \<noteq> obs \<sigma>' k \<and> obs \<sigma> k \<noteq> None \<and> obs \<sigma>' k \<noteq> None\<close>
	+ unfolding obs_comp_def obs_prefix_def
	+ by (metis kth_obs_stable linorder_neqE_nat obs_none_no_kth_obs obs_some_kth_obs)
	+ thus \<open>False\<close> using cop_correct_nterm leq assms by auto
	+ next
	+ assume *: \<open>terminates \<sigma> \<and> \<not> obs \<sigma>' \<lesssim> obs \<sigma>\<close>
	+ then obtain n where ret: \<open>path \<sigma> n = return\<close>
	+ unfolding terminates_def by auto
	+ obtain k where \<open>obs \<sigma> k \<noteq> obs \<sigma>' k \<and> obs \<sigma>' k \<noteq> None\<close> using * unfolding obs_prefix_def by metis
	+ thus \<open>False\<close> using cop_correct_ret ret leq assms by (metis empty_iff)
	+ qed
	+qed
	+
	+
	+text \<open>Our characterisation is not only correct, it is also precise in the way that \<open>cp\<close> characterises
	+exactly the matching indices in executions for low equivalent input states where diverging data is read.
	+This follows easily as the inverse implication to lemma \<open>contradicting_in_cp\<close> can be shown by simple induction.\<close>
	+
	+theorem cp_iff_reads_contradict: \<open>((\<sigma>,k),(\<sigma>',k')) \<in> cp \<longleftrightarrow> \<sigma> =\<^sub>L \<sigma>' \<and> cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k' \<and> (\<exists> v\<in>reads(path \<sigma> k). (\<sigma>\<^bsup>k\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v)\<close>
	+proof
	+ assume \<open>\<sigma> =\<^sub>L \<sigma>' \<and> cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k' \<and> (\<exists>v\<in>reads (path \<sigma> k). (\<sigma>\<^bsup>k\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v)\<close>
	+ thus \<open>((\<sigma>, k), \<sigma>', k') \<in> cp\<close> using contradicting_in_cp by blast
	+next
	+ assume \<open>((\<sigma>, k), \<sigma>', k') \<in> cp\<close>
	+ thus \<open>\<sigma> =\<^sub>L \<sigma>' \<and> cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k' \<and> (\<exists>v\<in>reads (path \<sigma> k). (\<sigma>\<^bsup>k\<^esup>) v \<noteq> (\<sigma>'\<^bsup>k'\<^esup>) v)\<close>
	+ proof (induction)
	+ case (1 \<sigma> \<sigma>' n n' h)
	+ then show \<open>?case\<close> by blast
	+ next
	+ case (2 \<sigma> k \<sigma>' k' n v n')
	+ have \<open>v\<in>reads (path \<sigma> n)\<close> using 2(2) unfolding is_ddi_def by auto
	+ then show \<open>?case\<close> using 2 by auto
	+ next
	+ case (3 \<sigma> k \<sigma>' k' n v l n')
	+ have \<open>v\<in>reads (path \<sigma> n)\<close> using 3(2) unfolding is_ddi_def by auto
	+ then show \<open>?case\<close> using 3(4,6,8) by auto
	+ next
	+ case (4 \<sigma> k \<sigma>' k')
	+ hence \<open>cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k'\<close> by simp
	+ hence \<open>path \<sigma>' k' = path \<sigma> k\<close> by (metis last_cs)
	+ moreover have \<open>\<sigma>' =\<^sub>L \<sigma>\<close> using 4(2) unfolding loweq_def by simp
	+ ultimately show \<open>?case\<close> using 4 by metis
	+ qed
	+qed
	+
	+
	+text \<open>In the same way the inverse implication to \<open>contradicting_in_cop\<close> follows easily
	+such that we obtain the following characterisation of \<open>cop\<close>.\<close>
	+
	+theorem cop_iff_contradicting: \<open>((\<sigma>,k),(\<sigma>',k')) \<in> cop \<longleftrightarrow> \<sigma> =\<^sub>L \<sigma>' \<and> (\<sigma>',k') \<cc> (\<sigma>,k) \<and> path \<sigma> k \<in> dom att\<close>
	+proof
	+ assume \<open>\<sigma> =\<^sub>L \<sigma>' \<and> (\<sigma>', k') \<cc> (\<sigma>, k) \<and> path \<sigma> k \<in> dom att\<close> thus \<open>((\<sigma>,k),(\<sigma>',k')) \<in> cop\<close> using contradicting_in_cop by simp
	+next
	+ assume \<open>((\<sigma>,k),(\<sigma>',k')) \<in> cop\<close>
	+ thus \<open> \<sigma> =\<^sub>L \<sigma>' \<and> (\<sigma>',k') \<cc> (\<sigma>,k) \<and> path \<sigma> k \<in> dom att\<close> proof (cases rule: cop.cases)
	+ case 1
	+ then show \<open>?thesis\<close> using cp_iff_reads_contradict contradicts.simps by (metis (full_types) reads_restrict1)
	+ next
	+ case (2 k)
	+ then show \<open>?thesis\<close> using cp_iff_reads_contradict contradicts.simps
	+ by (metis cd_is_cs_less cd_not_ret contradicts.intros(1) cs_select_id path_is_path)
	+ qed
	+qed
	+
	+
	+subsection \<open>Correctness of the Single Path Approximation\<close>
	+text_raw \<open>\label{sec:cor-scp}\<close>
	+
	+theorem cp_in_scp: assumes \<open>((\<sigma>,k),(\<sigma>',k'))\<in>cp\<close> shows \<open>(path \<sigma>,k)\<in>scp \<and> (path \<sigma>',k')\<in>scp\<close>
	+using assms proof(induction \<open>\<sigma>\<close> \<open>k\<close> \<open>\<sigma>'\<close> \<open>k'\<close> rule:cp.induct[case_names read_high dd dcd sym])
	+ case (read_high \<sigma> \<sigma>' k k' h)
	+ have \<open>\<sigma> h = (\<sigma>\<^bsup>k\<^esup>) h\<close> using read_high(5) by (simp add: no_writes_unchanged0)
	+ moreover have \<open>\<sigma>' h = (\<sigma>'\<^bsup>k'\<^esup>) h\<close> using read_high(6) by (simp add: no_writes_unchanged0)
	+ ultimately have \<open>\<sigma> h \<noteq> \<sigma>' h\<close> using read_high(4) by simp
	+ hence *: \<open>h\<in>hvars\<close> using read_high(1) unfolding loweq_def by (metis Compl_iff IFC_def.restrict_def)
	+ have 1: \<open>(path \<sigma>,k)\<in>scp\<close> using scp.intros(1) read_high(3,5) * by auto
	+ have \<open>path \<sigma> k = path \<sigma>' k'\<close> using read_high(2) by (metis last_cs)
	+ hence \<open>(path \<sigma>',k')\<in>scp\<close> using scp.intros(1) read_high(3,6) * by auto
	+ thus \<open>?case\<close> using 1 by auto
	+next
	+ case dd show \<open>?case\<close> using scp.intros(3) dd by auto
	+next
	+ case sym thus \<open>?case\<close> by blast
	+next
	+ case (dcd \<sigma> k \<sigma>' k' n v l n')
	+ note scp.intros(4) is_dcdi_via_def cd_cs_swap cs_ipd
	+ have 1: \<open>(path \<sigma>, n)\<in>scp\<close> using dcd.IH dcd.hyps(2) dcd.hyps(3) scp.intros(2) scp.intros(3) by blast
	+ have csk: \<open>cs\<^bsup>path \<sigma>\<^esup> k = cs\<^bsup>path \<sigma>'\<^esup> k'\<close> using cp_eq_cs[OF dcd(1)] .
	+ have kn: \<open>k<n\<close> and kl: \<open>k<l\<close> and ln: \<open>l<n\<close> using dcd(2,3) unfolding is_ddi_def is_cdi_def by auto
	+ have nret: \<open>path \<sigma> k \<noteq> return\<close> using cd_not_ret dcd.hyps(3) by auto
	+ have \<open>k' < n'\<close> using kn csk dcd(4) cs_order nret path_is_path last_cs by blast
	+ have 2: \<open>(path \<sigma>', n')\<in>scp\<close> proof cases
	+ assume j'ex: \<open>\<exists>j'\<in>{k'..<n'}. v \<in> writes (path \<sigma>' j')\<close>
	+ hence \<open>\<exists>j'. j'\<in>{k'..<n'} \<and> v \<in> writes (path \<sigma>' j')\<close> by auto
	+ note * = GreatestI_ex_nat[OF this]
	+ define j' where \<open>j' == GREATEST j'. j'\<in>{k'..<n'} \<and> v \<in> writes (path \<sigma>' j')\<close>
	+ note ** = *[of \<open>j'\<close>,folded j'_def]
	+ have \<open>k' \<le> j'\<close> \<open>j'<n'\<close> and j'write: \<open>v \<in> writes (path \<sigma>' j')\<close>
	+ using "*" atLeastLessThan_iff j'_def nat_less_le by auto
	+ have nowrite: \<open>\<forall> i'\<in>{j'<..<n'}. v \<notin> writes(path \<sigma>' i')\<close> proof (rule, rule ccontr)
	+ fix i' assume \<open>i' \<in> {j'<..<n'}\<close> \<open>\<not> v \<notin> local.writes (path \<sigma>' i')\<close>
	+ hence \<open>i' \<in> {k'..<n'} \<and> v \<in> local.writes (path \<sigma>' i')\<close> using \<open>k' \<le> j'\<close> by auto
	+ hence \<open>i' \<le> j'\<close> using Greatest_le_nat
	+ by (metis (no_types, lifting) atLeastLessThan_iff j'_def nat_less_le)
	+ thus \<open>False\<close> using \<open>i' \<in> {j'<..<n'}\<close> by auto
	+ qed
	+ have \<open>path \<sigma>' n' = path \<sigma> n\<close> using dcd(4) last_cs by metis
	+ hence \<open>v\<in>reads(path \<sigma>' n')\<close> using dcd(2) unfolding is_ddi_def by auto
	+ hence nddj': \<open>n' dd\<^bsup>path \<sigma>',v\<^esup>\<rightarrow> j'\<close> using dcd(2) unfolding is_ddi_def using nowrite \<open>j'<n'\<close> j'write by auto
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>j' cd\<^bsup>path \<sigma>'\<^esup>\<rightarrow> k'\<close>
	+ thus \<open>(path \<sigma>',n') \<in> scp\<close> using scp.intros(2) scp.intros(3) dcd.IH nddj' by fast
	+ next
	+ assume jcdk': \<open>\<not> j' cd\<^bsup>path \<sigma>'\<^esup>\<rightarrow> k'\<close>
	+ show \<open>?thesis\<close> proof cases
	+ assume \<open>j' = k'\<close>
	+ thus \<open>?thesis\<close> using scp.intros(3) dcd.IH nddj' by fastforce
	+ next
	+ assume \<open>j' \<noteq> k'\<close> hence \<open>k' < j'\<close> using \<open>k' \<le> j'\<close> by auto
	+ have \<open>path \<sigma>' j' \<noteq> return\<close> using j'write writes_return by auto
	+ hence ipdex':\<open>\<exists>j. j \<in>{k'..j'} \<and> path \<sigma>' j = ipd (path \<sigma>' k') \<close> using path_is_path \<open>k' < j'\<close> jcdk' is_cdi_def by blast
	+ define i' where \<open>i' == LEAST j. j\<in> {k'..j'} \<and> path \<sigma>' j = ipd (path \<sigma>' k')\<close>
	+ have iipd': \<open>i'\<in> {k'..j'}\<close> \<open>path \<sigma>' i' = ipd (path \<sigma>' k')\<close> unfolding i'_def using LeastI_ex[OF ipdex'] by simp_all
	+ have *:\<open>\<forall> i \<in> {k'..<i'}. path \<sigma>' i \<noteq> ipd (path \<sigma>' k')\<close> proof (rule, rule ccontr)
	+ fix i assume *: \<open>i \<in> {k'..<i'}\<close> \<open>\<not> path \<sigma>' i \<noteq> ipd (path \<sigma>' k')\<close>
	+ hence **: \<open>i \<in>{k'..j'} \<and> path \<sigma>' i = ipd (path \<sigma>' k')\<close> (is \<open>?P i\<close>) using iipd'(1) by auto
	+ thus \<open>False\<close> using Least_le[of \<open>?P\<close> \<open>i\<close>] i'_def * by auto
	+ qed
	+ have \<open>i' \<noteq> k'\<close> using iipd'(2) by (metis csk last_cs nret path_in_nodes ipd_not_self)
	+ hence \<open>k'<i'\<close> using iipd'(1) by simp
	+ hence csi': \<open>cs\<^bsup>path \<sigma>'\<^esup> i' = [n\<leftarrow>cs\<^bsup>path \<sigma>'\<^esup> k' . ipd n \<noteq> path \<sigma>' i'] @ [path \<sigma>' i']\<close>using cs_ipd[OF iipd'(2) *] by fast
	+
	+ have ncdk': \<open>\<not> n' cd\<^bsup>path \<sigma>'\<^esup>\<rightarrow> k'\<close> using \<open>j' < n'\<close> \<open>k' < j'\<close> cdi_prefix jcdk' less_imp_le_nat by blast
	+ hence ncdk: \<open>\<not> n cd\<^bsup>path \<sigma>\<^esup>\<rightarrow> k\<close> using cd_cs_swap csk dcd(4) by blast
	+ have ipdex: \<open>\<exists>i. i\<in>{k..n} \<and> path \<sigma> i = ipd (path \<sigma> k)\<close> (is \<open>\<exists>i. ?P i\<close>) proof cases
	+ assume *:\<open>path \<sigma> n = return\<close>
	+ from path_ret_ipd[of \<open>path \<sigma>\<close> \<open>k\<close> \<open>n\<close>,OF path_is_path nret *]
	+ obtain i where \<open>?P i\<close> by fastforce thus \<open>?thesis\<close> by auto
	+ next
	+ assume *:\<open>path \<sigma> n \<noteq> return\<close>
	+ show \<open>?thesis\<close> using not_cd_impl_ipd [of \<open>path \<sigma>\<close> \<open>k\<close> \<open>n\<close>, OF path_is_path \<open>k<n\<close> ncdk *] by auto
	+ qed
	+
	+ define i where \<open>i == LEAST j. j\<in> {k..n} \<and> path \<sigma> j = ipd (path \<sigma> k)\<close>
	+ have iipd: \<open>i\<in> {k..n}\<close> \<open>path \<sigma> i = ipd (path \<sigma> k)\<close> unfolding i_def using LeastI_ex[OF ipdex] by simp_all
	+ have **:\<open>\<forall> i' \<in> {k..<i}. path \<sigma> i' \<noteq> ipd (path \<sigma> k)\<close> proof (rule, rule ccontr)
	+ fix i' assume *: \<open>i' \<in> {k..<i}\<close> \<open>\<not> path \<sigma> i' \<noteq> ipd (path \<sigma> k)\<close>
	+ hence **: \<open>i' \<in>{k..n} \<and> path \<sigma> i' = ipd (path \<sigma> k)\<close> (is \<open>?P i'\<close>) using iipd(1) by auto
	+ thus \<open>False\<close> using Least_le[of \<open>?P\<close> \<open>i'\<close>] i_def * by auto
	+ qed
	+ have \<open>i \<noteq> k\<close> using iipd(2) by (metis nret path_in_nodes ipd_not_self)
	+ hence \<open>k<i\<close> using iipd(1) by simp
	+ hence \<open>cs\<^bsup>path \<sigma>\<^esup> i = [n\<leftarrow>cs\<^bsup>path \<sigma>\<^esup> k . ipd n \<noteq> path \<sigma> i] @ [path \<sigma> i]\<close>using cs_ipd[OF iipd(2) **] by fast
	+ hence csi: \<open>cs\<^bsup>path \<sigma>\<^esup> i = cs\<^bsup>path \<sigma>'\<^esup> i'\<close> using csi' csk unfolding iipd'(2) iipd(2) by (metis last_cs)
	+ hence \<open>(LEAST i'. k' < i' \<and> (\<exists>i. cs\<^bsup>path \<sigma>\<^esup> i = cs\<^bsup>path \<sigma>'\<^esup> i')) \<le> i'\<close> (is \<open>(LEAST x. ?P x) \<le> _\<close>)
	+ using \<open>k' < i'\<close> Least_le[of \<open>?P\<close> \<open>i'\<close>] by blast
	+ hence nw: \<open>\<forall>j'\<in>{i'..<n'}. v \<notin> writes (path \<sigma>' j')\<close> using dcd(7) allB_atLeastLessThan_lower by blast
	+ moreover have \<open>v \<in> writes (path \<sigma>' j')\<close> using nddj' unfolding is_ddi_def by auto
	+ moreover have \<open>i' \<le> j'\<close> using iipd'(1) by auto
	+ ultimately have \<open>False\<close> using \<open>j' < n'\<close> by auto
	+ thus \<open>?thesis\<close> ..
	+ qed
	+ qed
	+ next
	+ assume \<open>\<not> (\<exists>j'\<in>{k'..<n'}. v \<in> writes (path \<sigma>' j'))\<close>
	+
	+ hence \<open>n' dcd\<^bsup>path \<sigma>',v\<^esup>\<rightarrow> k' via (path \<sigma>) k\<close> unfolding is_dcdi_via_def using dcd(2-4) csk \<open>k'<n'\<close> path_is_path by metis
	+ thus \<open>?thesis\<close> using dcd.IH scp.intros(4) by blast
	+ qed
	+ with 1 show \<open>?case\<close> ..
	+qed
	+
	+
	+theorem cop_in_scop: assumes \<open>((\<sigma>,k),(\<sigma>',k'))\<in>cop\<close> shows \<open>(path \<sigma>,k)\<in>scop \<and> (path \<sigma>',k')\<in>scp\<close>
	+ using assms
	+ apply (induct rule: cop.induct)
	+ apply (simp add: cp_in_scp)
	+ using cp_in_scp scop.intros scp.intros(2)
	+ apply blast
	+ using cp_in_scp scop.intros scp.intros(2)
	+ apply blast
	+ done
	+
	+text \<open>The main correctness result for out single execution approximation follows directly.\<close>
	+
	+theorem scop_correct: assumes \<open>scop = empty\<close> shows \<open>secure\<close>
	+ using cop_correct assms cop_in_scop by fast
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/IFC_Tracking/PDG.thy b/thys/IFC_Tracking/PDG.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/IFC_Tracking/PDG.thy
	@@ -0,0 +1,63 @@
	+section \<open>Example: Program Dependence Graphs\<close>
	+text_raw \<open>\label{sec:pdg}\<close>
	+
	+text \<open>Program dependence graph (PDG) based slicing provides a very crude but direct approximation of
	+our characterisation. As such we can easily derive a corresponding correctness result.\<close>
	+
	+theory PDG imports IFC
	+begin
	+
	+context IFC
	+begin
	+
	+text \<open>We utilise our established dependencies on program paths to define the PDG. Note that PDGs
	+usually only contain immediate control dependencies instead of the transitive ones we use here.
	+However as slicing is considering reachability questions this does not affect the result.\<close>
	+inductive_set pdg where
	+\<open>\<lbrakk>i cd\<^bsup>\<pi>\<^esup>\<rightarrow> k\<rbrakk> \<Longrightarrow> (\<pi> k, \<pi> i) \<in> pdg\<close> \|
	+\<open>\<lbrakk>i dd\<^bsup>\<pi>,v\<^esup>\<rightarrow> k\<rbrakk> \<Longrightarrow> (\<pi> k, \<pi> i) \<in> pdg\<close>
	+
	+text \<open>The set of sources is the set of nodes reading high variables.\<close>
	+inductive_set sources where
	+\<open>n \<in> nodes \<Longrightarrow> h \<in> hvars \<Longrightarrow> h \<in> reads n \<Longrightarrow> n\<in> sources\<close>
	+
	+text \<open>The forward slice is the set of nodes reachable in the PDG from the set of sources. To ensure
	+security slicing aims to prove that no observable node is contained in the \<close>
	+inductive_set slice where
	+\<open>n\<in> sources \<Longrightarrow> n \<in> slice\<close> \|
	+\<open>m \<in> slice \<Longrightarrow> (m,n)\<in>pdg \<Longrightarrow> n \<in> slice\<close>
	+
	+
	+text \<open>As the PDG does not contain data control dependencies themselves we have to decompose these.\<close>
	+lemma dcd_pdg: assumes \<open>n dcd\<^bsup>\<pi>,v\<^esup>\<rightarrow> m via \<pi>' m'\<close> obtains l where \<open>(\<pi> m,l)\<in> pdg\<close> and \<open>(l,\<pi> n)\<in>pdg\<close>
	+proof -
	+ assume r: \<open>(\<And>l. (\<pi> m, l) \<in> pdg \<Longrightarrow> (l, \<pi> n) \<in> pdg \<Longrightarrow> thesis)\<close>
	+ obtain l' n' where ln: \<open>cs\<^bsup>\<pi>\<^esup> m = cs\<^bsup>\<pi>'\<^esup> m' \<and> cs\<^bsup>\<pi>\<^esup> n = cs\<^bsup>\<pi>'\<^esup> n' \<and> n' dd\<^bsup>\<pi>',v\<^esup>\<rightarrow> l' \<and> l' cd\<^bsup>\<pi>'\<^esup>\<rightarrow> m'\<close> using assms unfolding is_dcdi_via_def by metis
	+ hence mn: \<open>\<pi>' m' = \<pi> m \<and> \<pi>' n' = \<pi> n\<close> by (metis last_cs ln)
	+ have 1: \<open>(\<pi> m, \<pi>' l') \<in> pdg\<close> by (metis ln mn pdg.intros(1))
	+ have 2: \<open>(\<pi>' l', \<pi> n) \<in> pdg\<close> by (metis ln mn pdg.intros(2))
	+ show thesis using 1 2 r by auto
	+qed
	+
	+text \<open>By induction it directly follows that the slice is an approximation of the single critical paths.\<close>
	+lemma scp_slice: \<open>(\<pi>, i)\<in> scp \<Longrightarrow> \<pi> i \<in> slice\<close>
	+ apply (induction rule: scp.induct)
	+ apply (simp add: path_in_nodes slice.intros(1) sources.intros)
	+ using pdg.intros(1) slice.intros(2) apply blast
	+ using pdg.intros(2) slice.intros(2) apply blast
	+ by (metis dcd_pdg slice.intros(2))
	+
	+lemma scop_slice: \<open>(\<pi>, i) \<in> scop \<Longrightarrow> \<pi> i \<in> slice \<inter> dom(att)\<close> by (metis IntI scop.cases scp_slice)
	+
	+text \<open>The requirement targeted by slicing, that no observable node is contained in the slice,
	+is thereby a sound criteria for security.\<close>
	+lemma pdg_correct: assumes \<open>slice \<inter> dom(att) = {}\<close> shows \<open>secure\<close>
	+proof (rule ccontr)
	+ assume \<open>\<not> secure\<close>
	+ then obtain \<pi> i where \<open>(\<pi>, i) \<in> scop\<close> using scop_correct by force
	+ thus \<open>False\<close> using scop_slice assms by auto
	+qed
	+
	+end
	+
	+end
	\ No newline at end of file
	diff --git a/thys/IFC_Tracking/ROOT b/thys/IFC_Tracking/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/IFC_Tracking/ROOT
	@@ -0,0 +1,10 @@
	+chapter AFP
	+
	+session IFC_Tracking (AFP) = HOL +
	+ options [timeout = 600]
	+ theories
	+ IFC
	+ PDG
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/IFC_Tracking/document/root.bib b/thys/IFC_Tracking/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/IFC_Tracking/document/root.bib
	@@ -0,0 +1,17 @@
	+@inproceedings{Bohannon:2009:RN:1653662.1653673,
	+ author = {Bohannon, Aaron and Pierce, Benjamin C. and Sj\"{o}berg, Vilhelm and Weirich, Stephanie and Zdancewic, Steve},
	+ title = {Reactive Noninterference},
	+ booktitle = {Proceedings of the 16th ACM Conference on Computer and Communications Security},
	+ series = {CCS '09},
	+ year = {2009},
	+ isbn = {978-1-60558-894-0},
	+ location = {Chicago, Illinois, USA},
	+ pages = {79--90},
	+ numpages = {12},
	+ url = {http://doi.acm.org/10.1145/1653662.1653673},
	+ doi = {10.1145/1653662.1653673},
	+ acmid = {1653673},
	+ publisher = {ACM},
	+ address = {New York, NY, USA},
	+ keywords = {information flow, noninterference, reactive programming, web applications, web browsers},
	+}
	\ No newline at end of file
	diff --git a/thys/IFC_Tracking/document/root.tex b/thys/IFC_Tracking/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/IFC_Tracking/document/root.tex
	@@ -0,0 +1,97 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+\usepackage[left=2cm, right=2cm, top=3cm, bottom=3cm]{geometry}
	+\usepackage[T1]{fontenc}
	+
	+% further packages required for unusual symbols (see also
	+% isabellesym.sty), use only when needed
	+
	+\usepackage{amssymb}
	+ %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
	+ %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
	+ %\<triangleq>, \<yen>, \<lozenge>
	+
	+%\usepackage{eurosym}
	+ %for \<euro>
	+
	+\newcommand{\flqq}{\guillemotleft}
	+
	+\usepackage[english]{babel}
	+
	+
	+%\usepackage[only,bigsqcap]{stmaryrd}
	+ %for \<Sqinter>
	+
	+%\usepackage{eufrak}
	+ %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
	+
	+%\usepackage{textcomp}
	+ %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
	+ %\<currency>
	+
	+% This should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+
	+%\renewcommand{\isamarkupparagraph}[1]{\paragraph{#1}\mbox{}\\}
	+%\renewcommand{\isamarkupsubparagraph}[1]{\subparagraph{#1}\mbox{}\\}
	+
	+%\addto\extrasenglish{\renewcommand{\subsectionautorefname}{section}}
	+%\addto\extrasenglish{\renewcommand{\subsubsectionautorefname}{section}}
	+
	+
	+
	+\begin{document}
	+
	+\title{Information Flow Control via Dependency Tracking}
	+\author{Benedikt Nordhoff}
	+%\date{}
	+\maketitle
	+
	+\begin{abstract}
	+ We provide a characterisation of how information is propagated by program executions based on the
	+ tracking data and control dependencies within executions themselves. The characterisation might
	+ be used for deriving approximative safety properties to be targeted by static analyses or checked
	+ at runtime. We utilise a simple yet versatile control flow graph model as a program
	+ representation. As our model is not assumed to be finite it can be instantiated for a broad class
	+ of programs. The targeted security property is indistinguishable security where executions
	+ produce sequences of observations and only non-terminating executions are allowed to drop a tail
	+ of those.
	+
	+ A very crude approximation of our characterisation is slicing based on program dependence graphs,
	+ which we use as a minimal example and derive a corresponding soundness result.
	+
	+ For further details and applications refer to the authors upcoming dissertation.
	+\end{abstract}
	+
	+\newpage
	+
	+\tableofcontents
	+
	+\newpage
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+% generated text of all theories
	+\input{session}
	+
	+\nocite{Bohannon:2009:RN:1653662.1653673}
	+
	+% optional bibliography
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Metalogic_ProofChecker/BetaNorm.thy b/thys/Metalogic_ProofChecker/BetaNorm.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/BetaNorm.thy
	@@ -0,0 +1,584 @@
	+section "Beta Normalization"
	+
	+(*
	+ Much of this material is directly copied and adapted from @{dir "~~/src/HOL/Proofs/Lambda"}
	+
	+ Proofs are in a lot of cases very ugly as they were copied+fixed
	+*)
	+
	+theory BetaNorm
	+ imports Term
	+begin
	+
	+inductive beta :: "term \<Rightarrow> term \<Rightarrow> bool" (infixl "\<rightarrow>\<^sub>\<beta>" 50)
	+ where
	+ beta [simp, intro!]: "Abs T s $ t \<rightarrow>\<^sub>\<beta> subst_bv2 s 0 t"
	+ \| appL [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t \<Longrightarrow> s $ u \<rightarrow>\<^sub>\<beta> t $ u"
	+ \| appR [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t \<Longrightarrow> u $ s \<rightarrow>\<^sub>\<beta> u $ t"
	+ \| abs [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t \<Longrightarrow> Abs T s \<rightarrow>\<^sub>\<beta> Abs T t"
	+
	+abbreviation
	+ beta_reds :: "term \<Rightarrow> term \<Rightarrow> bool" (infixl "\<rightarrow>\<^sub>\<beta>\<^sup>*" 50) where
	+ "s \<rightarrow>\<^sub>\<beta>\<^sup>* t == beta\<^sup>\<^sup> s t"
	+
	+inductive_cases beta_cases [elim!]:
	+ "Bv i \<rightarrow>\<^sub>\<beta> t"
	+ "Fv idn S \<rightarrow>\<^sub>\<beta> t"
	+ "Abs T r \<rightarrow>\<^sub>\<beta> s"
	+ "s $ t \<rightarrow>\<^sub>\<beta> u"
	+
	+declare if_not_P [simp] not_less_eq [simp]
	+
	+lemma rtrancl_beta_Abs [intro!]:
	+ "s \<rightarrow>\<^sub>\<beta>\<^sup>* s' \<Longrightarrow> Abs T s \<rightarrow>\<^sub>\<beta>\<^sup>* Abs T s'"
	+ by (induct set: rtranclp) (blast intro: rtranclp.rtrancl_into_rtrancl)+
	+
	+lemma rtrancl_beta_AppL:
	+ "s \<rightarrow>\<^sub>\<beta>\<^sup>* s' \<Longrightarrow> s $ t \<rightarrow>\<^sub>\<beta>\<^sup>* s' $ t"
	+ by (induct set: rtranclp) (blast intro: rtranclp.rtrancl_into_rtrancl)+
	+
	+lemma rtrancl_beta_AppR:
	+ "t \<rightarrow>\<^sub>\<beta>\<^sup>* t' \<Longrightarrow> s $ t \<rightarrow>\<^sub>\<beta>\<^sup>* s $ t'"
	+ by (induct set: rtranclp) (blast intro: rtranclp.rtrancl_into_rtrancl)+
	+
	+lemma rtrancl_beta_App [intro]:
	+ "s \<rightarrow>\<^sub>\<beta>\<^sup>* s' \<Longrightarrow> t \<rightarrow>\<^sub>\<beta>\<^sup>* t' \<Longrightarrow> s $ t \<rightarrow>\<^sub>\<beta>\<^sup>* s' $ t'"
	+ by (blast intro!: rtrancl_beta_AppL rtrancl_beta_AppR intro: rtranclp_trans)
	+
	+theorem subst_bv2_preserves_beta [simp]:
	+ "r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> subst_bv2 r k u \<rightarrow>\<^sub>\<beta> subst_bv2 s k u"
	+ by (induct arbitrary: k u set: beta) (simp_all add: subst_bv2_subst_bv2[symmetric])
	+
	+theorem subst_bv2_preserves_beta': "r \<rightarrow>\<^sub>\<beta>\<^sup>* s \<Longrightarrow> subst_bv2 r i t \<rightarrow>\<^sub>\<beta>\<^sup>* subst_bv2 s i t"
	+ apply (induct set: rtranclp)
	+ apply (rule rtranclp.rtrancl_refl)
	+ apply (erule rtranclp.rtrancl_into_rtrancl)
	+ apply (erule subst_bv2_preserves_beta)
	+ done
	+
	+theorem lift_preserves_beta [simp]:
	+ "r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> lift r i \<rightarrow>\<^sub>\<beta> lift s i"
	+proof (induction arbitrary: i set: beta)
	+ case (beta T s t)
	+ then show ?case
	+ using lift_subst by force
	+qed auto
	+theorem lift_preserves_beta': "r \<rightarrow>\<^sub>\<beta>\<^sup>* s \<Longrightarrow> lift r i \<rightarrow>\<^sub>\<beta>\<^sup>* lift s i"
	+ apply (induct set: rtranclp)
	+ apply (rule rtranclp.rtrancl_refl)
	+ apply (erule rtranclp.rtrancl_into_rtrancl)
	+ apply (erule lift_preserves_beta)
	+ done
	+
	+theorem subst_bv2_preserves_beta2 [simp]: "r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> subst_bv2 t i r \<rightarrow>\<^sub>\<beta>\<^sup>* subst_bv2 t i s"
	+ apply (induct t arbitrary: r s i)
	+ apply (solves \<open>simp add: r_into_rtranclp\<close>)+
	+ using lift_preserves_beta by (auto simp add: rtrancl_beta_App)
	+
	+theorem subst_bv2_preserves_beta2': "r \<rightarrow>\<^sub>\<beta>\<^sup>* s \<Longrightarrow> subst_bv2 t i r \<rightarrow>\<^sub>\<beta>\<^sup>* subst_bv2 t i s"
	+ apply (induct set: rtranclp)
	+ apply (auto elim: rtranclp_trans subst_bv2_preserves_beta2)
	+ done
	+
	+lemma beta_preserves_typ_of1: "typ_of1 Ts r = Some T \<Longrightarrow> r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> typ_of1 Ts s = Some T"
	+proof (induction Ts r arbitrary: s T rule: typ_of1.induct)
	+ case (4 Ts T body)
	+ then show ?case
	+ by (smt beta_cases(3) typ_of1.simps(4) typ_of_Abs_body_typ')
	+next
	+ case (5 Ts f u)
	+ from this obtain argT where argT: "typ_of1 Ts u = Some argT" and "typ_of1 Ts f = Some (argT \<rightarrow> T)"
	+ by (meson typ_of1_split_App_obtains)
	+
	+ from 5 show ?case apply -
	+ apply (ind_cases "f $ u \<rightarrow>\<^sub>\<beta> s" for f u s)
	+ using \<open>typ_of1 Ts f = Some (argT \<rightarrow> T)\<close> argT typ_of1_subst_bv_gen'
	+ typ_of_Abs_body_typ' by (fastforce simp add: substn_subst_n)+
	+qed (use beta.cases in \<open>blast+\<close>)
	+
	+lemma beta_preserves_typ_of: "typ_of r = Some T \<Longrightarrow> r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> typ_of s = Some T"
	+ by (metis beta_preserves_typ_of1 typ_of_def)
	+
	+lemma beta_star_preserves_typ_of1: "r \<rightarrow>\<^sub>\<beta>\<^sup>* s \<Longrightarrow> typ_of1 Ts r = Some T \<Longrightarrow> typ_of1 Ts s = Some T"
	+proof (induction rule: rtranclp.induct)
	+ case (rtrancl_refl a)
	+ then show ?case
	+ by simp
	+next
	+ case (rtrancl_into_rtrancl a b c)
	+ then show ?case
	+ using beta_preserves_typ_of1 by blast
	+qed
	+(*
	+ Convert beta_norm to the inductive predicates. Then later show that one beta step can be justified
	+ using proves
	+*)
	+
	+lemma beta_reducible_imp_beta_step: "beta_reducible t \<Longrightarrow> \<exists>t'. t \<rightarrow>\<^sub>\<beta> t'"
	+proof (induction t)
	+ case (App t1 t2)
	+ then show ?case using App by (cases t1) auto
	+qed auto
	+
	+lemma beta_step_imp_beta_reducible: "t \<rightarrow>\<^sub>\<beta> t' \<Longrightarrow> beta_reducible t"
	+proof (induction t t' rule: beta.induct)
	+ case (beta T s t)
	+ then show ?case by simp
	+next
	+case (appL s t u)
	+ then show ?case by (cases s) auto
	+next
	+ case (appR s t u)
	+ then show ?case using beta_reducible.elims by blast
	+next
	+ case (abs s t T)
	+ then show ?case by simp
	+qed
	+
	+lemma beta_norm_imp_beta_reds: assumes "beta_norm t = Some t'" shows "t \<rightarrow>\<^sub>\<beta>\<^sup>* t'"
	+ using assms proof (induction arbitrary: t t' rule: beta_norm.fixp_induct)
	+ case 1
	+ then show ?case
	+ by (smt Option.is_none_def ccpo.admissibleI chain_fun flat_lub_def flat_ord_def fun_lub_def
	+ insertCI is_none_code(2) mem_Collect_eq option.lub_upper subsetI)
	+next
	+ case 2
	+ then show ?case
	+ by simp
	+next
	+ case (3 comp)
	+ then show ?case
	+ proof(cases t)
	+ next
	+ case (App f u)
	+ note fu = App
	+ then show ?thesis
	+ proof (cases "comp f")
	+ case None
	+ show ?thesis
	+ proof(cases f)
	+ case (Abs B b)
	+ then show ?thesis
	+ by (metis (mono_tags, lifting) "3.IH" "3.prems" Core.subst_bv_def Core.term.simps(29)
	+ Core.term.simps(30) beta fu rtranclp.rtrancl_into_rtrancl rtranclp.rtrancl_refl rtranclp_trans)
	+ qed (use 3 None in \<open>simp_all add: fu split: term.splits option.splits if_splits\<close>)
	+ next
	+ case (Some fo)
	+ then show ?thesis
	+ proof(cases fo)
	+ case (Ct n T)
	+ then show ?thesis
	+ proof(cases f)
	+ case (Abs B b)
	+ then show ?thesis
	+ by (metis (no_types, lifting) "3.IH" "3.prems" Core.subst_bv_def Core.term.simps(29)
	+ Core.term.simps(30) beta converse_rtranclp_into_rtranclp fu)
	+ qed (use 3 Some in \<open>auto simp add: fu split: term.splits option.splits if_split\<close>)
	+ next
	+ case (Fv n T)
	+ then show ?thesis
	+ proof(cases f)
	+ case (Abs B b)
	+ then show ?thesis
	+ by (metis (no_types, lifting) "3.IH" "3.prems" Core.subst_bv_def Core.term.simps(29)
	+ Core.term.simps(30) beta converse_rtranclp_into_rtranclp fu)
	+ qed (use 3 Some in \<open>auto simp add: fu split: term.splits option.splits if_split\<close>)
	+ next
	+ case (Bv n)
	+ then show ?thesis
	+ proof(cases f)
	+ case (Abs B b)
	+ then show ?thesis
	+ by (metis (no_types, lifting) "3.IH" "3.prems" Core.subst_bv_def Core.term.simps(29)
	+ Core.term.simps(30) beta converse_rtranclp_into_rtranclp fu)
	+ qed (use 3 Some in \<open>auto simp add: fu split: term.splits option.splits if_split\<close>)
	+ next
	+ case (Abs T t)
	+ then show ?thesis
	+ proof(cases f)
	+ case (Ct n C)
	+ show ?thesis
	+ by (metis "3.IH" Abs Core.term.simps(11) Ct Some beta_reducible.simps(7)
	+ beta_step_imp_beta_reducible converse_rtranclpE)
	+ next
	+ case (Fv n C)
	+ then show ?thesis
	+ by (metis "3.IH" Abs Fv Some beta_reducible.simps(1,4,8) beta_step_imp_beta_reducible
	+ converse_rtranclpE)
	+ next
	+ case (Bv n)
	+ then show ?thesis
	+ by (metis "3.IH" Abs Some beta_cases(1) converse_rtranclpE term.distinct(15))
	+ next
	+ case (Abs B b)
	+ then show ?thesis
	+ by (metis (no_types, lifting) "3.IH" "3.prems" Core.subst_bv_def Core.term.simps(29)
	+ Core.term.simps(30) beta converse_rtranclp_into_rtranclp fu)
	+ next
	+ case (App a b)
	+ then show ?thesis
	+ using 3 apply (simp add: fu Some split: term.splits option.splits if_splits; fast?)
	+ by (metis Core.subst_bv_def beta converse_rtranclp_into_rtranclp rtrancl_beta_AppL rtranclp_trans)
	+ qed
	+ next
	+ case AppO: (App f u)
	+ then show ?thesis
	+ proof(cases f)
	+ case (Ct n C)
	+ show ?thesis
	+ using 3 Some apply (simp add: Ct AppO fu split: term.splits option.splits if_split; fast?)
	+ by (metis Core.subst_bv_def beta converse_rtranclp_into_rtranclp)
	+ next
	+ case (Fv n C)
	+ then show ?thesis
	+ using 3 Some apply (simp add: Fv AppO fu split: term.splits option.splits if_split; fast?)
	+ by (metis Core.subst_bv_def beta converse_rtranclp_into_rtranclp)
	+ next
	+ case (Bv n)
	+ then show ?thesis
	+ using 3 Some apply (simp add: Bv AppO fu split: term.splits option.splits if_split; fast?)
	+ by (metis Core.subst_bv_def beta converse_rtranclp_into_rtranclp)
	+ next
	+ case (Abs B b)
	+ then show ?thesis
	+ using 3 Some apply (simp add: Abs AppO fu split: term.splits option.splits if_split; fast?)
	+ by (metis Core.subst_bv_def beta converse_rtranclp_into_rtranclp)
	+ next
	+ case (App a b)
	+ then show ?thesis
	+ using 3 Some apply (simp add: App AppO fu split: term.splits option.splits if_split; fast?)
	+ by (metis Core.subst_bv_def beta converse_rtranclp_into_rtranclp)
	+ qed
	+ qed
	+ qed
	+ qed auto
	+qed
	+
	+corollary "beta_norm t = Some t' \<Longrightarrow> typ_of1 Ts t = Some T \<Longrightarrow> typ_of1 Ts t' = Some T"
	+ using beta_norm_imp_beta_reds beta_star_preserves_typ_of1 by blast
	+
	+lemma beta_imp_beta_norm: assumes "t \<rightarrow>\<^sub>\<beta> t'" "\<not> beta_reducible t'" shows "beta_norm t = Some t'"
	+ using assms proof (induction rule: beta.induct)
	+ case (beta T s t)
	+ then show ?case using not_beta_reducible_imp_beta_norm_unchanged by (auto simp add: subst_bv_def substn_subst_n)
	+next
	+ case (appL s t u)
	+ hence t: "\<not> beta_reducible t" by (fastforce elim: beta_reducible.elims)
	+ hence IH: "beta_norm s = Some t" using appL.IH by simp
	+ from appL have u: "\<not> beta_reducible u"
	+ using beta_reducible.elims by blast
	+ show ?case
	+ apply (cases s; cases t)
	+ using not_beta_reducible_imp_beta_norm_unchanged IH t u appL.prems by auto
	+next
	+ case (appR s t u)
	+ hence t: "\<not> beta_reducible t"
	+ using beta_reducible.elims by blast
	+ hence IH: "beta_norm s = Some t" using appR.IH by simp
	+ from appR have u: "\<not> beta_reducible u"
	+ using beta_reducible.elims by blast
	+ show ?case
	+ apply (cases s; cases u)
	+ using not_beta_reducible_imp_beta_norm_unchanged IH t u appR.prems by auto
	+next
	+ case (abs s t T)
	+ then show ?case by auto
	+qed
	+
	+lemma beta_subst_bv1: "s \<rightarrow>\<^sub>\<beta> t \<Longrightarrow> subst_bv1 s lev x \<rightarrow>\<^sub>\<beta> subst_bv1 t lev x"
	+proof (induction s t arbitrary: lev rule: beta.induct)
	+ case (beta T s t)
	+ then show ?case
	+ using beta.beta subst_bv2_preserves_beta substn_subst_n by presburger
	+qed (auto simp add: subst_bv_def)
	+
	+lemma beta_subst_bv: "s \<rightarrow>\<^sub>\<beta> t \<Longrightarrow> subst_bv x s \<rightarrow>\<^sub>\<beta> subst_bv x t"
	+ by (simp add: substn_subst_0')
	+
	+(* typ_of to exclude terms like Bv 0 $ Bv 0
	+ Probably can get rid of one typ_of somehow
	+
	+ Problem: Not useable for subst_bv (at lev 0)
	+*)
	+lemma subst_bv1_beta:
	+ "subst_bv1 s (length (T#Ts)) x \<rightarrow>\<^sub>\<beta> subst_bv1 t (length (T#Ts)) x
	+ \<Longrightarrow> typ_of1 Ts s = Some ty
	+ \<Longrightarrow> typ_of1 Ts t = Some ty
	+ \<Longrightarrow> s \<rightarrow>\<^sub>\<beta> t"
	+proof (induction "subst_bv1 s (length (T#Ts)) x" "subst_bv1 t (length (T#Ts)) x"
	+ arbitrary: s t T T Ts ty rule: beta.induct)
	+ case (beta T s t)
	+ then show ?case
	+ by (metis beta.simps length_Cons loose_bvar_Suc no_loose_bvar_imp_no_subst_bv1 typ_of1_imp_no_loose_bvar)
	+next
	+ case (appL s t u)
	+ then show ?case
	+ by (metis beta.appL length_Cons loose_bvar_Suc no_loose_bvar_imp_no_subst_bv1 typ_of1_imp_no_loose_bvar)
	+next
	+ case (appR s t u)
	+ then show ?case
	+ by (metis beta.simps length_Cons loose_bvar_Suc no_loose_bvar_imp_no_subst_bv1 typ_of1_imp_no_loose_bvar)
	+next
	+ case (abs s t bT sa ta T Ts rT )
	+ obtain s' where "Abs bT s' = sa"
	+ using abs.hyps(3) abs.prems loose_bvar_Suc no_loose_bvar_imp_no_subst_bv1 typ_of1_imp_no_loose_bvar
	+ by (metis length_Cons)
	+ moreover obtain t' where "Abs bT t' = ta"
	+ using abs.hyps(4) abs.prems loose_bvar_Suc no_loose_bvar_imp_no_subst_bv1 typ_of1_imp_no_loose_bvar
	+ by (metis length_Cons)
	+ ultimately have "s' \<rightarrow>\<^sub>\<beta> t'"
	+ by (metis abs.hyps(1) abs.hyps(3) abs.hyps(4) abs.prems(1) abs.prems(2) length_Cons
	+ loose_bvar_Suc no_loose_bvar_imp_no_subst_bv1 term.inject(4) typ_of1_imp_no_loose_bvar)
	+ then show ?case
	+ using \<open>Abs bT s' = sa\<close> \<open>Abs bT t' = ta\<close> by blast
	+qed
	+
	+(* Longterm: Move to Term and unify with subst_bv2, so far only used for beta reduction *)
	+fun subst_bvs1' :: "term \<Rightarrow> nat \<Rightarrow> term list \<Rightarrow> term" where
	+ "subst_bvs1' (Bv i) lev args = (if i < lev then Bv i
	+ else if i - lev < length args then (nth args (i-lev))
	+ else Bv (i - length args))"
	+\| "subst_bvs1' (Abs T body) lev args = Abs T (subst_bvs1' body (lev + 1) (map (\<lambda>t. lift t 0) args))"
	+\| "subst_bvs1' (f $ t) lev u = subst_bvs1' f lev u $ subst_bvs1' t lev u"
	+\| "subst_bvs1' t _ _ = t"
	+
	+lemma subst_bvs1'_empty [simp]: "subst_bvs1' t lev [] = t"
	+ by (induction t lev "[]::term list" rule: subst_bvs1.induct)auto
	+
	+lemma subst_bvs1'_eq [simp]: "args \<noteq> [] \<Longrightarrow> subst_bvs1' (Bv k) k args = args ! 0"
	+ by simp
	+lemma subst_bvs1'_eq' [simp]: "i < length args \<Longrightarrow> subst_bvs1' (Bv (k+i)) k args = args ! i"
	+ by auto
	+
	+lemma subst_bvs1'_gt [simp]:
	+ "i + length args < j \<Longrightarrow> subst_bvs1' (Bv j) i args = Bv (j - length args)"
	+ by auto
	+
	+lemma subst_bv2_lt [simp]: "j < i \<Longrightarrow> subst_bvs1' (Bv j) i u = Bv j"
	+ by simp
	+
	+lemma subst_bvs1'_App[simp]: "subst_bvs1' (s$t) k args
	+ = subst_bvs1' s k args $ subst_bvs1' t k args"
	+ by simp
	+
	+lemma incr_bv_incr_bv:
	+ "i < k + 1 \<Longrightarrow> incr_bv inc2 (k+inc1) (incr_bv inc1 i t) = incr_bv inc1 i (incr_bv inc2 k t)"
	+proof (induction t arbitrary: i k)
	+ case (Abs T t)
	+ then show ?case
	+ by (metis Suc_eq_plus1 add_Suc add_mono1 incr_bv.simps(2))
	+qed auto
	+
	+lemma subst_bvs1_subst_bvs1': "subst_bvs1 t n s = subst_bvs1' t n (map (incr_bv n 0) s)"
	+proof (induction t arbitrary: n)
	+ case (Abs T t)
	+ then show ?case
	+ by (simp add: incr_boundvars_def incr_bv_combine)
	+ (metis One_nat_def comp_apply incr_bv_combine plus_1_eq_Suc)
	+qed (auto simp add: incr_boundvars_def incr_bv_combine)
	+
	+theorem subst_bvs1_subst_bvs1'_0: "subst_bvs1 t 0 s = subst_bvs1' t 0 s"
	+proof-
	+ have "subst_bvs1 t 0 s = subst_bvs1' t 0 (map (incr_bv 0 0) s)"
	+ using subst_bvs1_subst_bvs1' by blast
	+ moreover have "map (incr_bv 0 0) s = s"
	+ by (induction s) auto
	+ ultimately show ?thesis
	+ by simp
	+qed
	+
	+corollary subst_bvs_subst_bvs1': "subst_bvs s t = subst_bvs1' t 0 s"
	+ using subst_bvs_def subst_bvs1_subst_bvs1'_0 by simp
	+
	+lemma no_loose_bvar_subst_bvs1'_unchanged: "\<not> loose_bvar t lev \<Longrightarrow> subst_bvs1' t lev args = t"
	+ by (induction t lev args rule: subst_bvs1'.induct) auto
	+
	+(* This is enough when just substituting variables, however in the \<beta> case I will have to
	+ distribute subst_bvs through a single subst_bv(where the substituted term is not a var).
	+*)
	+lemma subst_bvs1'_step: "\<forall>x \<in> set (a#args) . is_closed x \<Longrightarrow>
	+ subst_bvs1' t lev (a#args) = subst_bvs1' (subst_bv2 t lev a) lev args"
	+proof (induction t lev args rule: subst_bvs1'.induct)
	+ case (1 i lev args)
	+ then show ?case
	+ using no_loose_bvar_subst_bvs1'_unchanged
	+ by (simp add: is_open_def)
	+ (metis Suc_diff_Suc le_add1 le_add_same_cancel1 less_antisym loose_bvar_leq not_less_eq)
	+qed (auto simp add: is_open_def)
	+
	+lemma not_loose_bvar_incr_bv: "\<not> loose_bvar a lev \<Longrightarrow> \<not> loose_bvar (incr_bv inc lev a) (lev+inc)"
	+ by (induction a lev rule: loose_bvar.induct) auto
	+
	+lemma not_loose_bvar_incr_bv_less:
	+ "i < j \<Longrightarrow> \<not> loose_bvar (incr_bv inc i a) (lev+inc) \<Longrightarrow> \<not> loose_bvar (incr_bv inc j a) (lev+inc)"
	+proof (induction inc i a arbitrary: lev j rule: incr_bv.induct)
	+ case (2 inc n T body)
	+ then show ?case
	+ by (metis Suc_eq_plus1 add_Suc add_mono1 incr_bv.simps(2) loose_bvar.simps(3))
	+qed (auto split: if_splits)
	+
	+lemma subst_bvs1'_step_work: "\<forall>x \<in> set args . is_closed x \<Longrightarrow> \<not> loose_bvar (subst_bv2 t lev a) lev \<Longrightarrow>
	+ subst_bvs1' t lev (a#args) = subst_bvs1' (subst_bv2 t lev a) lev args"
	+proof (induction t "lev" "args" arbitrary: a rule: subst_bvs1'.induct)
	+ case (1 i )
	+ then show ?case using no_loose_bvar_subst_bvs1'_unchanged
	+ by (auto simp add: is_open_def)
	+next
	+ case (2 T body lev args)
	+ then show ?case using no_loose_bvar_subst_bvs1'_unchanged
	+ by (auto simp add: is_open_def)
	+next
	+ case (3 f t lev u)
	+ then show ?case using no_loose_bvar_subst_bvs1'_unchanged
	+ by (auto simp add: is_open_def)
	+next
	+ case ("4_1" v va uu uv)
	+ then show ?case using no_loose_bvar_subst_bvs1'_unchanged
	+ by (auto simp add: is_open_def)
	+next
	+ case ("4_2" v va uu uv)
	+ then show ?case using no_loose_bvar_subst_bvs1'_unchanged
	+ by (auto simp add: is_open_def)
	+qed
	+
	+lemma is_closed_subst_bv2_unchanged: "is_closed t \<Longrightarrow> subst_bv2 t n u = t"
	+ by (metis is_open_def lift_def loose_bvar_Suc no_loose_bvar_no_incr subst_bv2_lift zero_induct)
	+
	+(* This might do it, should be able to connect a new substitution to the pushed in one *)
	+lemma subst_bvs1'_step_extend_lower_level: "\<forall>x \<in> set (a#args) . is_closed x \<Longrightarrow>
	+ subst_bv2 (subst_bvs1' t (Suc lev) args) lev a
	+ = subst_bvs1' t lev (a#args)"
	+proof (induction t lev "a#args" arbitrary: a args rule: subst_bvs1'.induct)
	+ case (1 i lev)
	+ have "subst_bv2 (subst_bvs1' (Bv i) (Suc lev) args) lev a =
	+ subst_bvs1' (Bv i) lev (a # args)"
	+ if "i < Suc lev"
	+ using that by auto
	+ moreover have "subst_bv2 (subst_bvs1' (Bv i) (Suc lev) args) lev a =
	+ subst_bvs1' (Bv i) lev (a # args)"
	+ if "i - Suc lev < length args" "\<not> i < Suc lev"
	+ proof-
	+ have "subst_bv2 (subst_bvs1' (Bv i) (Suc lev) args) lev a = subst_bv2 (args ! (i - Suc lev)) lev a"
	+ using that by simp
	+ also have "\<dots> = args ! (i - Suc lev)"
	+ using 1 that(1) by (auto simp add: is_closed_subst_bv2_unchanged)
	+ also have "subst_bvs1' (Bv i) lev (a # args) = args ! (i - Suc lev)"
	+ using that by auto
	+ finally show ?thesis
	+ by simp
	+ qed
	+ moreover have "subst_bv2(subst_bvs1' (Bv i) (Suc lev) args) lev a =
	+ subst_bvs1' (Bv i) lev (a # args)"
	+ if "i \<ge> Suc lev" "i - lev \<ge> length args" "\<not> i < Suc lev"
	+ using that 1 by (auto simp add: is_closed_subst_bv2_unchanged)
	+ ultimately show ?case by (auto simp add: is_open_def split: if_splits)
	+qed (auto simp add: is_open_def)
	+
	+corollary subst_bvs_extend_lower_level:
	+ "\<forall>x \<in> set (a#args) . is_closed x \<Longrightarrow>
	+ subst_bv a (subst_bvs1' t 1 args) = subst_bvs (a#args) t"
	+ using subst_bvs1'_step_extend_lower_level
	+ by (simp add: subst_bvs_subst_bvs1' substn_subst_0')
	+
	+lemma subst_bvs1'_preserves_beta:
	+ "\<forall>x \<in> set u . is_closed x \<Longrightarrow> r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> subst_bvs1' r k u \<rightarrow>\<^sub>\<beta> subst_bvs1' s k u"
	+proof (induction u arbitrary: r s )
	+ case Nil
	+ then show ?case by auto
	+next
	+ case (Cons a u)
	+ hence "subst_bv2 r k a \<rightarrow>\<^sub>\<beta> subst_bv2 s k a"
	+ by simp
	+ hence "subst_bvs1' (subst_bv2 r k a) k u \<rightarrow>\<^sub>\<beta> subst_bvs1' (subst_bv2 s k a) k u"
	+ using Cons by simp
	+ then show ?case
	+ by (simp add: subst_bvs1'_step[symmetric] Cons.prems(1))
	+qed
	+
	+lemma subst_bvs1'_fold: "\<forall>x \<in> set args . is_closed x \<Longrightarrow>
	+ subst_bvs1' t lev args = fold (\<lambda>arg t . subst_bv2 t lev arg) args t"
	+ by (induction args arbitrary: t) (simp_all add: subst_bvs1'_step)
	+
	+lemma subst_bvs1'_Abs[simp]: "\<forall>x \<in> set args . is_closed x \<Longrightarrow>
	+ subst_bvs1' (Abs T t) lev args = Abs T (subst_bvs1' t (Suc lev) args)"
	+ by (simp add: is_open_def map_idI)
	+
	+lemma subst_bvs_Abs[simp]: "\<forall>x \<in> set args . is_closed x \<Longrightarrow>
	+ subst_bvs args (Abs T t) = Abs T (subst_bvs1' t 1 args)"
	+ using subst_bvs1'_Abs subst_bvs_subst_bvs1' by auto
	+
	+lemma subst_bvs1'_incr_bv [simp]:
	+ "subst_bvs1' (incr_bv (length ss) k t) k ss = t"
	+proof (induct t arbitrary: k ss)
	+ case (Abs T t)
	+ then show ?case
	+ by simp (metis length_map)
	+qed auto
	+
	+lemma lift_subst_bvs1' [simp]:
	+ "j < i + 1 \<Longrightarrow> lift (subst_bvs1' t j ss) i
	+ = subst_bvs1' (lift t (i + length ss)) j (map (\<lambda>s . lift s i) ss)"
	+proof (induct t arbitrary: i j ss)
	+ case (Abs T t)
	+ hence I: "lift (subst_bvs1' t (Suc j) (map (\<lambda>t. lift t 0) ss)) (Suc i) =
	+ subst_bvs1' (lift t (Suc i + length (map (\<lambda>t. lift t 0) ss))) (Suc j) (map (\<lambda>a. lift a (Suc i)) (map (\<lambda>t. lift t 0) ss))"
	+ by auto
	+
	+ have "lift (subst_bvs1' (Abs T t) j ss) i
	+ = Abs T (lift (subst_bvs1' t (Suc j) (map (\<lambda>t. lift t 0) ss)) (Suc i))"
	+ by simp
	+ also have "\<dots> = Abs T
	+ (subst_bvs1' (lift t (Suc i + length (map (incr_bv 1 0) ss))) (Suc j)
	+ (map (incr_bv 1 (Suc i)) (map (incr_bv 1 0) ss)))"
	+ using I by auto
	+ also have "\<dots> = Abs T
	+ (subst_bvs1' (lift t (Suc i + length (map (incr_bv 1 0) ss))) (Suc j)
	+ (map (\<lambda>t. lift t 0) (map (\<lambda>t. lift t i) ss)))"
	+ proof-
	+ have "map (\<lambda>t . lift t (Suc i)) (map (\<lambda>t. lift t 0) ss) = map (\<lambda>t. lift t 0) (map (\<lambda>t. lift t i) ss)"
	+ using lift_lift by auto
	+ thus ?thesis unfolding lift_def
	+ by argo
	+ qed
	+ also have "\<dots> = subst_bvs1' (Abs T (lift t (Suc i + length (map (incr_bv 1 0) ss)))) j
	+ (map (\<lambda>t. lift t i) ss)"
	+ by auto
	+ finally show ?case
	+ by simp
	+qed (auto simp add: diff_Suc lift_lift split: nat.split)
	+
	+lemma lift_subst_bvs1'_lt:
	+ "i < j + 1 \<Longrightarrow> lift (subst_bvs1' t j ss) i
	+ = subst_bvs1' (lift t i) (j + 1) (map (\<lambda>s . lift s i) ss)"
	+proof (induct t arbitrary: i j ss)
	+ case (Abs T t)
	+ then show ?case using lift_lift
	+ by simp (smt comp_apply map_eq_conv zero_less_Suc)
	+qed auto
	+
	+lemma subst_bvs1'_subst_bv2:
	+ "i < j + 1 \<Longrightarrow>
	+ subst_bv2(subst_bvs1' t (Suc j) (map (\<lambda>v. lift v i) vs)) i (subst_bvs1' u j vs)
	+ = subst_bvs1' (subst_bv2 t i u) j vs"
	+proof(induction t arbitrary: i j u vs)
	+ case (Abs T t)
	+ then show ?case
	+ by simp (smt One_nat_def Suc_eq_plus1 Suc_less_eq comp_apply lift_lift lift_def
	+ lift_subst_bvs1'_lt map_eq_conv map_map zero_less_Suc)
	+qed (use subst_bv2_lift in auto)
	+
	+lemma fv_subst_bv2_upper_bound: "fv (subst_bv2 t lev u) \<subseteq> fv t \<union> fv u"
	+ by (induction t lev u rule: subst_bv2.induct) auto
	+lemma beta_fv: "s \<rightarrow>\<^sub>\<beta> t \<Longrightarrow> fv t \<subseteq> fv s"
	+ by (induction rule: beta.induct) (use fv_subst_bv2_upper_bound in auto)
	+
	+lemma loose_bvar1_subst_bvs1'_closeds: "\<not> loose_bvar1 t lev \<Longrightarrow> lev < k \<Longrightarrow> \<forall>x\<in>set us . is_closed x
	+ \<Longrightarrow> \<not> loose_bvar1 (subst_bvs1' t k us) lev"
	+ by (induction t k us arbitrary: lev rule: subst_bvs1'.induct)
	+ (use is_open_def loose_bvar_iff_exist_loose_bvar1 in \<open>auto simp add: is_open_def\<close>)
	+
	+lemma is_closed_subst_bvs1'_closeds: "\<not> is_dependent t \<Longrightarrow> \<forall>x\<in>set us . is_closed x
	+ \<Longrightarrow> \<not> is_dependent (subst_bvs1' t (Suc k) us)"
	+ by (simp add: is_dependent_def loose_bvar1_subst_bvs1'_closeds)
	+
	+end
	diff --git a/thys/Metalogic_ProofChecker/BetaNormProof.thy b/thys/Metalogic_ProofChecker/BetaNormProof.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/BetaNormProof.thy
	@@ -0,0 +1,59 @@
	+
	+text\<open>Facts about beta normalization involving theories\<close>
	+
	+theory BetaNormProof
	+ imports BetaNorm Theory
	+begin
	+
	+lemma beta_preserves_term_ok': "term_ok' \<Sigma> r \<Longrightarrow> r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> term_ok' \<Sigma> s"
	+proof (induction r arbitrary: s)
	+ case (Ct n T)
	+ then show ?case
	+ apply (simp add: tinstT_def split: option.splits)
	+ (* Seems like I miss a simp rule for Ct*)
	+ using beta_reducible.simps(7) beta_step_imp_beta_reducible by blast
	+next
	+ case (Fv n T)
	+ then show ?case
	+ by auto
	+next
	+ case (Bv n)
	+ then show ?case
	+ by auto
	+next
	+ case (Abs R r)
	+ then show ?case
	+ by auto
	+next
	+ case (App f u)
	+ then show ?case
	+ apply -
	+ apply (ind_cases "f $ u \<rightarrow>\<^sub>\<beta> s" for f u s)
	+ using term_ok'_subst_bv2 term_ok'.simps(4) term_ok'.simps(5) apply blast
	+ using term_ok'.simps(4) apply blast
	+ using term_ok'.simps(4) apply blast
	+ done
	+qed
	+
	+lemma beta_preserves_term_ok: "term_ok \<Theta> r \<Longrightarrow> r \<rightarrow>\<^sub>\<beta> s \<Longrightarrow> term_ok \<Theta> s"
	+proof -
	+ assume a1: "term_ok \<Theta> r"
	+ assume a2: "r \<rightarrow>\<^sub>\<beta> s"
	+ then have "None \<noteq> typ_of1 [] s"
	+ using a1 beta_preserves_typ_of1
	+ by (metis has_typ1_imp_typ_of1 has_typ_def option.distinct(1) term_ok_def wt_term_def)
	+ then show ?thesis
	+ using a2 a1 beta_preserves_term_ok' has_typ_iff_typ_of wt_term_def typ_of_def
	+ by (meson beta_preserves_typ_of term_ok_def wf_term_iff_term_ok')
	+qed
	+
	+lemma beta_star_preserves_term_ok': "r \<rightarrow>\<^sub>\<beta>\<^sup>* s \<Longrightarrow> term_ok' \<Sigma> r \<Longrightarrow> term_ok' \<Sigma> s"
	+ by (induction rule: rtranclp.induct) (auto simp add: beta_preserves_term_ok')
	+
	+corollary beta_star_preserves_term_ok: "r \<rightarrow>\<^sub>\<beta>\<^sup>* s \<Longrightarrow> term_ok thy r \<Longrightarrow> term_ok thy s"
	+ using beta_star_preserves_term_ok' beta_star_preserves_typ_of1 wt_term_def typ_of_def by auto
	+
	+corollary term_ok_beta_norm: "term_ok thy t \<Longrightarrow> beta_norm t = Some t'\<Longrightarrow> term_ok thy t'"
	+ using beta_norm_imp_beta_reds beta_star_preserves_term_ok by blast
	+
	+end
	diff --git a/thys/Metalogic_ProofChecker/CheckerExe.thy b/thys/Metalogic_ProofChecker/CheckerExe.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/CheckerExe.thy
	@@ -0,0 +1,293 @@
	+
	+theory CheckerExe
	+ imports TheoryExe ProofTerm
	+begin
	+
	+abbreviation "exetyp_ok \<Theta> \<equiv> exetyp_ok_sig (exesig \<Theta>)"
	+
	+lemma typ_ok_code:
	+ assumes "exe_wf_theory' \<Theta>"
	+ shows "typ_ok (translate_theory \<Theta>) ty = exetyp_ok \<Theta> ty"
	+ using assms typ_ok_sig_code
	+ by (metis exe_sig_conds_def exe_wf_theory.simps exe_wf_theory_code exesignature.exhaust
	+ exetheory.sel(1) sig.simps translate_theory.elims typ_ok_def wf_type_iff_typ_ok_sig)
	+
	+definition [simp]: "execlass_leq cs c1 c2 = List.member cs (c1,c2)"
	+lemma execlass_leq_code: "class_leq (set cs) c1 c2 = execlass_leq cs c1 c2"
	+ by (simp add: class_leq_def class_les_def member_def)
	+
	+definition "exesort_leq sub s1 s2 = (\<forall>c\<^sub>2 \<in> s2 . \<exists>c\<^sub>1 \<in> s1. execlass_leq sub c\<^sub>1 c\<^sub>2)"
	+lemma exesort_les_code: "sort_leq (set cs) c1 c2 = exesort_leq cs c1 c2"
	+ by (simp add: execlass_leq_code exesort_leq_def sort_leq_def)
	+
	+fun exehas_sort :: "exeosig \<Rightarrow> typ \<Rightarrow> sort \<Rightarrow> bool" where
	+"exehas_sort oss (Tv _ S) S' = exesort_leq (execlasses oss) S S'" \|
	+"exehas_sort oss (Ty a Ts) S =
	+ (case lookup (\<lambda>k. k=a) (exetcsigs oss) of
	+ None \<Rightarrow> False \|
	+ Some mgd \<Rightarrow> (\<forall>C \<in> S.
	+ case lookup (\<lambda>k. k=C) mgd of
	+ None \<Rightarrow> False
	+ \| Some Ss \<Rightarrow> list_all2 (exehas_sort oss) Ts Ss))"
	+
	+(* cleanup *)
	+lemma exehas_sort_imp_has_sort:
	+ assumes "exe_osig_conds (sub, tcs)"
	+ shows "exehas_sort (sub, tcs) T S \<Longrightarrow> has_sort (translate_osig (sub, tcs)) T S"
	+proof (induction T arbitrary: S)
	+ case (Ty n Ts)
	+ obtain sub' tcs' where sub'_tcs': "translate_osig (sub, tcs) = (sub', tcs')" by fastforce
	+ obtain mgd where mgd: "tcs' n = Some mgd"
	+ using Ty.prems sub'_tcs' apply (simp split: option.splits)
	+ by (metis assms exe_ars_conds_def exe_osig_conds_def in_alist_imp_in_map_of lookup_eq_map_of_ap
	+ map_of_SomeD snd_conv)
	+ show ?case
	+ proof (subst sub'_tcs', rule has_sort_Ty[of tcs', OF mgd], rule ballI)
	+ fix c assume asm: "c\<in>S"
	+
	+ have l: "lookup (\<lambda>k. k=n) (map (apsnd map_of) tcs) = Some mgd"
	+ by (metis assms lookup_eq_map_of_ap mgd snd_conv sub'_tcs' translate_ars.simps translate_osig.simps)
	+ hence "\<exists>x. (lookup (\<lambda>k. k=n) tcs) = Some x"
	+ by (induction tcs) auto
	+ from this obtain pre_mgd where pre_mgd: "(lookup (\<lambda>k. k=n) tcs) = Some pre_mgd"
	+ by blast
	+ have pre_mgd_mgd: "map_of pre_mgd = mgd"
	+ by (metis l assms exe_ars_conds_def
	+ exe_osig_conds_def in_alist_imp_in_map_of lookup_eq_map_of_ap map_of_SomeD
	+ option.sel pre_mgd snd_conv translate_ars.simps)
	+
	+ obtain Ss where Ss: "lookup (\<lambda>k. k=c) pre_mgd = Some Ss"
	+ using Ty.prems asm by (auto simp add: pre_mgd split: option.splits)
	+ hence cond: "list_all2 (exehas_sort (sub,tcs)) Ts Ss"
	+ using \<open>exehas_sort (sub, tcs) (Ty n Ts) S\<close>asm pre_mgd by (auto split: option.splits)
	+
	+ from Ss have "mgd c = Some Ss"
	+ by (simp add: lookup_eq_map_of_ap pre_mgd_mgd)
	+ then show "\<exists>Ss. mgd c = Some Ss \<and> list_all2 (has_sort (sub', tcs')) Ts Ss"
	+ using cond Ty.IH list.rel_mono_strong sub'_tcs' by force
	+ qed
	+next
	+ case (Tv n S)
	+ then show ?case
	+ by (metis assms exehas_sort.simps(1) exesort_les_code has_sort_Tv prod.collapse translate_osig.simps)
	+qed
	+
	+lemma has_sort_imp_exehas_sort:
	+ assumes "exe_osig_conds (sub, tcs)"
	+ shows "has_sort (translate_osig (sub, tcs)) T S \<Longrightarrow> exehas_sort (sub, tcs) T S"
	+proof (induction T arbitrary: S)
	+ case (Ty n Ts)
	+ obtain sub' tcs' where sub'_tcs': "translate_osig (sub, tcs) = (sub', tcs')" by fastforce
	+ obtain mgd where mgd: "tcs' n = Some mgd"
	+ using Ty.prems sub'_tcs' has_sort.simps by (auto split: option.splits)
	+ hence "lookup (\<lambda>k. k=n) (map (apsnd map_of) tcs) = Some mgd"
	+ by (metis assms lookup_eq_map_of_ap prod.inject sub'_tcs' translate_ars.simps translate_osig.simps)
	+ have l: "lookup (\<lambda>k. k=n) (map (apsnd map_of) tcs) = Some mgd"
	+ by (metis assms lookup_eq_map_of_ap mgd snd_conv sub'_tcs'
	+ translate_ars.simps translate_osig.simps)
	+ hence "\<exists>x. (lookup (\<lambda>k. k=n) tcs) = Some x"
	+ by (induction tcs) auto
	+ from this obtain pre_mgd where pre_mgd: "(lookup (\<lambda>k. k=n) tcs) = Some pre_mgd"
	+ by blast
	+ have pre_mgd_mgd: "map_of pre_mgd = mgd"
	+ by (metis l assms exe_ars_conds_def
	+ exe_osig_conds_def in_alist_imp_in_map_of lookup_eq_map_of_ap map_of_SomeD option.sel
	+ pre_mgd snd_conv translate_ars.simps)
	+
	+ {
	+ fix c assume asm: "c\<in>S"
	+
	+ obtain Ss where Ss: "lookup (\<lambda>k. k=c) pre_mgd = Some Ss"
	+ using \<open>c \<in> S\<close> \<open>map_of pre_mgd = mgd\<close> sub'_tcs' mgd assms Ty.prems has_sort.simps
	+ by (auto simp add: dom_map_of_conv_image_fst domIff eq_fst_iff exe_ars_conds_def
	+ map_of_eq_None_iff classes_translate lookup_eq_map_of_ap split: typ.splits
	+ dest!: domD intro!: domI)
	+ have l: "length Ts = length Ss"
	+ using asm mgd pre_mgd Ty.prems assms sub'_tcs' Ss list_all2_lengthD pre_mgd_mgd
	+ by (fastforce simp add: has_sort.simps lookup_eq_map_of_ap)
	+
	+ have 1: "\<forall>c \<in> S. \<exists>Ss . mgd c = Some Ss \<and> list_all2 (has_sort (sub', tcs')) Ts Ss"
	+ using mgd Ty.prems has_sort.simps sub'_tcs' by auto
	+
	+ have cond: "list_all2 (exehas_sort (sub,tcs)) Ts Ss"
	+ apply (rule list_all2_all_nthI)
	+ using l apply simp
	+ subgoal premises p for m
	+ apply (rule Ty.IH)
	+ using p apply simp
	+ using p Ty.prems assms 1
	+ by (metis Ss asm list_all2_conv_all_nth lookup_eq_map_of_ap option.sel pre_mgd_mgd sub'_tcs')
	+ done
	+ have "(\<forall>C \<in> S.
	+ case lookup (\<lambda>k. k=C) pre_mgd of
	+ None \<Rightarrow> False
	+ \| Some Ss \<Rightarrow> list_all2 (exehas_sort (sub,tcs)) Ts Ss)"
	+ by (metis "1" Ty.IH list_all2_conv_all_nth lookup_eq_map_of_ap nth_mem option.simps(5)
	+ pre_mgd_mgd sub'_tcs')
	+ }
	+
	+ then show ?case
	+ using pre_mgd by simp
	+next
	+ case (Tv n S)
	+ then show ?case
	+ using assms exesort_les_code has_sort_Tv_imp_sort_leq by fastforce
	+qed
	+
	+lemma has_sort_code:
	+ assumes "exe_osig_conds oss"
	+ shows "has_sort (translate_osig oss) T S = exehas_sort oss T S"
	+ by (metis assms exehas_sort_imp_has_sort has_sort_imp_exehas_sort prod.collapse)
	+
	+lemma has_sort_code':
	+ assumes "exe_wf_theory' \<Theta>"
	+ shows "has_sort (osig (sig (translate_theory \<Theta>))) T S
	+ = exehas_sort (exesorts (exesig \<Theta>)) T S"
	+ apply (cases \<Theta> rule: exetheory_full_exhaust) using assms has_sort_code by auto
	+
	+abbreviation "exeinst_ok \<Theta> insts \<equiv>
	+ distinct (map fst insts)
	+ \<and> list_all (exetyp_ok \<Theta>) (map snd insts)
	+ \<and> list_all (\<lambda>((idn, S), T) . exehas_sort (exesorts (exesig \<Theta>)) T S) insts"
	+
	+lemma inst_ok_code1:
	+ assumes "exe_wf_theory' \<Theta>"
	+ shows "list_all (exetyp_ok \<Theta>) (map snd insts) = list_all (typ_ok (translate_theory \<Theta>)) (map snd insts)"
	+ using assms typ_ok_code by (auto simp add: list_all_iff)
	+
	+lemma inst_ok_code2:
	+ assumes "exe_wf_theory' \<Theta>"
	+ shows "list_all (\<lambda>((idn, S), T) . has_sort (osig (sig (translate_theory \<Theta>))) T S) insts
	+ = list_all (\<lambda>((idn, S), T) . exehas_sort (exesorts (exesig \<Theta>)) T S) insts"
	+ using has_sort_code' assms by auto
	+
	+lemma inst_ok_code:
	+ assumes "exe_wf_theory' \<Theta>"
	+ shows "inst_ok (translate_theory \<Theta>) insts = exeinst_ok \<Theta> insts"
	+ using inst_ok_code1 inst_ok_code2 assms by auto
	+
	+definition [simp]: "exeterm_ok \<Theta> t \<equiv> exeterm_ok' (exesig \<Theta>) t \<and> typ_of t \<noteq> None"
	+lemma term_ok_code:
	+ assumes "exe_wf_theory' \<Theta>"
	+ shows "term_ok (translate_theory \<Theta>) t = exeterm_ok \<Theta> t"
	+ using assms apply (cases \<Theta> rule: exetheory_full_exhaust)
	+ by (metis exe_sig_conds_def exe_wf_theory'.simps exeterm_ok_def exetheory.sel(1)
	+ sig.simps term_okD1 term_okD2 term_okI wt_term_code translate_theory.simps)
	+
	+fun exereplay' :: "exetheory \<Rightarrow> (variable \<times> typ) list \<Rightarrow> variable set
	+ \<Rightarrow> term list \<Rightarrow> proofterm \<Rightarrow> term option" where
	+ "exereplay' thy _ _ Hs (PAxm t Tis) = (if exeinst_ok thy Tis \<and> exeterm_ok thy t
	+ then if t \<in> set (exeaxioms_of thy)
	+ then Some (forall_intro_vars (subst_typ' Tis t) [])
	+ else None else None)"
	+\| "exereplay' thy _ _ Hs (PBound n) = partial_nth Hs n"
	+\| "exereplay' thy vs ns Hs (Abst T p) = (if exetyp_ok thy T
	+ then (let (s',ns') = variant_variable (Free STR ''default'') ns in
	+ map_option (mk_all s' T) (exereplay' thy ((s', T) # vs) ns' Hs p))
	+ else None)"
	+\| "exereplay' thy vs ns Hs (Appt p t) =
	+ (let rep = exereplay' thy vs ns Hs p in
	+ let t' = subst_bvs (map (\<lambda>(x,y) . Fv x y) vs) t in
	+ case (rep, typ_of t') of
	+ (Some (Ct s (Ty fun1 [Ty fun2 [\<tau>, Ty propT1 Nil], Ty propT2 Nil]) $ b), Some \<tau>') \<Rightarrow>
	+ if s = STR ''Pure.all'' \<and> fun1 = STR ''fun'' \<and> fun2 = STR ''fun''
	+ \<and> propT1 = STR ''prop'' \<and> propT2 = STR ''prop''
	+ \<and> \<tau>=\<tau>' \<and> exeterm_ok thy t'
	+ then Some (b \<bullet> t') else None
	+ \| _ \<Rightarrow> None)"
	+\| "exereplay' thy vs ns Hs (AbsP t p) =
	+ (let t' = subst_bvs (map (\<lambda>(x,y) . Fv x y) vs) t in
	+ let rep = exereplay' thy vs ns (t'#Hs) p in
	+ (if typ_of t' = Some propT \<and> exeterm_ok thy t' then map_option (mk_imp t') rep else None))"
	+\| "exereplay' thy vs ns Hs (AppP p1 p2) =
	+ (let rep1 = Option.bind (exereplay' thy vs ns Hs p1) beta_eta_norm in
	+ let rep2 = Option.bind (exereplay' thy vs ns Hs p2) beta_eta_norm in
	+ (case (rep1, rep2) of (
	+ Some (Ct imp (Ty fn1 [Ty prp1 [], Ty fn2 [Ty prp2 [], Ty prp3 []]]) $ A $ B),
	+ Some A') \<Rightarrow>
	+ if imp = STR ''Pure.imp'' \<and> fn1 = STR ''fun'' \<and> fn2 = STR ''fun''
	+ \<and> prp1 = STR ''prop'' \<and> prp2 = STR ''prop'' \<and> prp3 = STR ''prop'' \<and> A=A'
	+ then Some B else None
	+ \| _ \<Rightarrow> None))"
	+\| "exereplay' thy vs ns Hs (OfClass ty c) = (if exehas_sort (exesorts (exesig thy)) ty {c}
	+ \<and> exetyp_ok thy ty
	+ then (case lookup (\<lambda>k. k=const_of_class c) (execonst_type_of (exesig thy)) of
	+ Some (Ty fun [Ty it [ity], Ty prop []]) \<Rightarrow>
	+ if ity = tvariable STR '''a'' \<and> fun = STR ''fun'' \<and> prop = STR ''prop'' \<and> it = STR ''itself''
	+ then Some (mk_of_class ty c) else None \| _ \<Rightarrow> None) else None)"
	+\| "exereplay' thy vs ns Hs (Hyp t) = (if t\<in>set Hs then Some t else None)"
	+
	+lemma of_class_code1:
	+ assumes "exe_wf_theory' thy"
	+ shows "(has_sort (osig (sig (translate_theory thy))) ty {c} \<and> typ_ok (translate_theory thy) ty)
	+ = (exehas_sort (exesorts (exesig thy)) ty {c} \<and> exetyp_ok thy ty)"
	+proof-
	+ have "has_sort (osig (sig (translate_theory thy))) ty {c}
	+ = exehas_sort (exesorts (exesig thy)) ty {c}"
	+ using has_sort_code' assms by simp
	+ moreover have "typ_ok (translate_theory thy) ty = exetyp_ok thy ty"
	+ using typ_ok_code assms by simp
	+ ultimately show ?thesis
	+ by auto
	+qed
	+
	+lemma of_class_code2:
	+ assumes "exe_wf_theory' thy"
	+ shows "const_type (sig (translate_theory thy)) (const_of_class c)
	+ = lookup (\<lambda>k. k=const_of_class c) (execonst_type_of (exesig thy))"
	+ by (metis assms const_type_of_lookup_code exe_wf_theory_code
	+ exe_wf_theory_translate_imp_wf_theory exetheory.sel(1) illformed_theory_not_wf_theory
	+ sig.simps translate_theory.elims)
	+
	+lemma replay'_code:
	+ assumes "exe_wf_theory' thy"
	+ shows "replay' (translate_theory thy) vs ns Hs P = exereplay' thy vs ns Hs P"
	+proof (induction P arbitrary: vs ns Hs)
	+ case (PAxm ax tys)
	+ have wf: "wf_theory (translate_theory thy)"
	+ by (simp add: assms exe_wf_theory_code exe_wf_theory_translate_imp_wf_theory)
	+ moreover have inst: "inst_ok (translate_theory thy) tys \<longleftrightarrow> exeinst_ok thy tys"
	+ by (simp add: assms inst_ok_code1 inst_ok_code2)
	+ moreover have tok: "term_ok (translate_theory thy) ax \<longleftrightarrow> exeterm_ok thy ax"
	+ using assms term_ok_code by blast
	+ moreover have ax: "ax \<in> axioms (translate_theory thy) \<longleftrightarrow> ax \<in> set (exeaxioms_of thy)"
	+ by (metis axioms.simps wf exetheory.sel(2) illformed_theory_not_wf_theory translate_theory.elims)
	+ ultimately show ?case
	+ by simp
	+qed (use assms term_ok_code typ_ok_code of_class_code1 of_class_code2
	+ in \<open>auto simp only: replay'.simps exereplay'.simps split: if_splits\<close>)
	+
	+abbreviation "exereplay'' thy vs ns Hs P \<equiv> Option.bind (exereplay' thy vs ns Hs P) beta_eta_norm"
	+lemma replay''_code:
	+ assumes "exe_wf_theory' thy"
	+ shows "replay'' (translate_theory thy) vs ns Hs P = exereplay'' thy vs ns Hs P"
	+ by (simp add: assms replay'_code)
	+
	+definition [simp]: "exereplay thy P \<equiv>
	+ (if \<forall>x\<in>set (hyps P) . exeterm_ok thy x \<and> typ_of x = Some propT then
	+ exereplay'' thy [] (fst ` (fv_Proof P \<union> FV (set (hyps P)))) (hyps P) P else None)"
	+
	+lemma replay_code:
	+ assumes "exe_wf_theory' thy"
	+ shows "replay (translate_theory thy) P = exereplay thy P"
	+ using assms replay''_code term_ok_code by auto
	+
	+definition "exe_replay' e P = exereplay'' e [] (fst ` fv_Proof P) [] P"
	+
	+definition "exe_check_proof e P res \<equiv>
	+ exe_wf_theory' e \<and> exereplay e P = Some res"
	+
	+lemma exe_check_proof_iff_check_proof:
	+ "exe_check_proof e P res \<longleftrightarrow> check_proof (translate_theory e) P res"
	+ using check_proof_def exe_check_proof_def wf_theory_translate_iff_exe_wf_theory
	+ by (metis exe_wf_theory_code replay_code)
	+
	+lemma check_proof_sound:
	+ shows "exe_check_proof e P res \<Longrightarrow> translate_theory e, set (hyps P) \<turnstile> res"
	+ by (simp add: check_proof_sound exe_check_proof_iff_check_proof)
	+
	+lemma check_proof_really_sound:
	+ shows "exe_check_proof e P res \<Longrightarrow> translate_theory e, set (hyps P) \<tturnstile> res"
	+ by (simp add: check_proof_really_sound exe_check_proof_iff_check_proof)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/CodeGen.thy b/thys/Metalogic_ProofChecker/CodeGen.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/CodeGen.thy
	@@ -0,0 +1,24 @@
	+
	+section "Code Generation"
	+
	+theory CodeGen
	+ imports ProofTerm TheoryExe CheckerExe Instances
	+ "HOL-Library.Code_Target_Int"
	+ "HOL-Library.Code_Target_Nat"
	+begin
	+
	+declare typ_of_def[code]
	+
	+export_code exe_check_proof exereplay exe_wf_theory
	+ Bv PBound Tv Free ExeTheory ExeSignature (* To have acces to type constructors in interace*)
	+ in SML module_name ExportCheck file_prefix export
	+
	+(*
	+ Need to change the following yourself, to open the interface
	+
	+ datatype int = Int_of_integer of IntInf.int;
	+ datatype nat = Nat of IntInf.int;
	+ datatype 'a set = Set of 'a list \| Coset of 'a list;
	+*)
	+
	+end
	diff --git a/thys/Metalogic_ProofChecker/Core.thy b/thys/Metalogic_ProofChecker/Core.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Core.thy
	@@ -0,0 +1,315 @@
	+
	+section \<open>Core Inference system\<close>
	+
	+text \<open>Contains just the stuff necessary for the definition of the Inference system\<close>
	+
	+theory Core
	+ imports Main
	+begin
	+
	+text \<open>Basic types \<close>
	+type_synonym name = String.literal
	+type_synonym indexname = "name \<times> int"
	+
	+type_synonym "class" = String.literal
	+
	+type_synonym "sort" = "class set"
	+abbreviation "full_sort \<equiv> ({}::sort)"
	+
	+(* Name duplication with Fv in term, change later*)
	+datatype variable = Free name \| Var indexname
	+
	+datatype "typ" =
	+ is_Ty: Ty name "typ list" \|
	+ is_Tv: Tv variable sort
	+
	+datatype "term" =
	+ is_Ct: Ct name "typ" \|
	+ is_Fv: Fv variable "typ" \|
	+ is_Bv: Bv nat \|
	+ is_Abs: Abs "typ" "term" \|
	+ is_App: App "term" "term" (infixl "$" 100)
	+
	+abbreviation "mk_fun_typ S T \<equiv> Ty STR ''fun'' [S,T]"
	+notation mk_fun_typ (infixr "\<rightarrow>" 100)
	+
	+text \<open>Collect variables in a term\<close>
	+
	+fun fv :: "term \<Rightarrow> (variable \<times> typ) set" where
	+ "fv (Ct _ _) = {}"
	+\| "fv (Fv v T) = {(v, T)}"
	+\| "fv (Bv _) = {}"
	+\| "fv (Abs _ body) = fv body"
	+\| "fv (t $ u) = fv t \<union> fv u"
	+definition [simp]: "FV S = (\<Union>s\<in>S . fv s)"
	+
	+text \<open>Typ/term instantiations\<close>
	+
	+fun tsubstT :: "typ \<Rightarrow> (variable \<Rightarrow> sort \<Rightarrow> typ) \<Rightarrow> typ" where
	+ "tsubstT (Tv a s) \<rho> = \<rho> a s"
	+\| "tsubstT (Ty \<kappa> \<sigma>s) \<rho> = Ty \<kappa> (map (\<lambda>\<sigma>. tsubstT \<sigma> \<rho>) \<sigma>s)"
	+definition "tinstT T1 T2 \<equiv> \<exists>\<rho>. tsubstT T2 \<rho> = T1"
	+
	+fun tsubst :: "term \<Rightarrow> (variable \<Rightarrow> sort \<Rightarrow> typ) \<Rightarrow> term" where
	+ "tsubst (Ct s T) \<rho> = Ct s (tsubstT T \<rho>)"
	+\| "tsubst (Fv v T) \<rho> = Fv v (tsubstT T \<rho>)"
	+\| "tsubst (Bv i) _ = Bv i"
	+\| "tsubst (Abs T t) \<rho> = Abs (tsubstT T \<rho>) (tsubst t \<rho>)"
	+\| "tsubst (t $ u) \<rho> = tsubst t \<rho> $ tsubst u \<rho>"
	+
	+text \<open>Typ of a term\<close>
	+
	+inductive has_typ1 :: "typ list \<Rightarrow> term \<Rightarrow> typ \<Rightarrow> bool" ("_ \<turnstile>\<^sub>\<tau> _ : _" [51, 51, 51] 51) where
	+ "has_typ1 _ (Ct _ T) T"
	+\| "i < length Ts \<Longrightarrow> has_typ1 Ts (Bv i) (nth Ts i)"
	+\| "has_typ1 _ (Fv _ T) T"
	+\| "has_typ1 (T#Ts) t T' \<Longrightarrow> has_typ1 Ts (Abs T t) (T \<rightarrow> T')"
	+\| "has_typ1 Ts u U \<Longrightarrow> has_typ1 Ts t (U \<rightarrow> T) \<Longrightarrow>
	+ has_typ1 Ts (t $ u) T"
	+definition has_typ :: "term \<Rightarrow> typ \<Rightarrow> bool" ("\<turnstile>\<^sub>\<tau> _ : _" [51, 51] 51) where "has_typ t T = has_typ1 [] t T"
	+
	+definition "typ_of t = (if \<exists>T . has_typ t T then Some (THE T . has_typ t T) else None)"
	+
	+text\<open>More operations on terms\<close>
	+
	+fun lift :: "term \<Rightarrow> nat \<Rightarrow> term" where
	+ "lift (Bv i) n = (if i \<ge> n then Bv (i+1) else Bv i)"
	+\| "lift (Abs T body) n = Abs T (lift body (n+1))"
	+\| "lift (App f t) n = App (lift f n) (lift t n)"
	+\| "lift u n = u"
	+
	+fun subst_bv2 :: "term \<Rightarrow> nat \<Rightarrow> term \<Rightarrow> term" where
	+ "subst_bv2 (Bv i) n u = (if i < n then Bv i
	+ else if i = n then u
	+ else (Bv (i - 1)))"
	+\| "subst_bv2 (Abs T body) n u = Abs T (subst_bv2 body (n + 1) (lift u 0))"
	+\| "subst_bv2 (f $ t) n u = subst_bv2 f n u $ subst_bv2 t n u"
	+\| "subst_bv2 t _ _ = t"
	+
	+definition "subst_bv u t = subst_bv2 t 0 u"
	+
	+fun bind_fv2 :: "(variable \<times> typ) \<Rightarrow> nat \<Rightarrow> term \<Rightarrow> term" where
	+ "bind_fv2 vT n (Fv v T) = (if vT = (v,T) then Bv n else Fv v T)"
	+\| "bind_fv2 vT n (Abs T t) = Abs T (bind_fv2 vT (n+1) t)"
	+\| "bind_fv2 vT n (f $ u) = bind_fv2 vT n f $ bind_fv2 vT n u"
	+\| "bind_fv2 _ _ t = t"
	+
	+definition "bind_fv vT t = bind_fv2 vT 0 t"
	+
	+abbreviation "Abs_fv v T t \<equiv> Abs T (bind_fv (v,T) t)"
	+
	+text \<open>Some typ/term constants\<close>
	+
	+abbreviation "itselfT ty \<equiv> Ty STR ''itself'' [ty]"
	+abbreviation "constT name \<equiv> Ty name []"
	+abbreviation "propT \<equiv> constT STR ''prop''"
	+
	+abbreviation "mk_eq t1 t2 \<equiv> Ct STR ''Pure.eq''
	+ (the (typ_of t1) \<rightarrow> (the (typ_of t2) \<rightarrow> propT)) $ t1 $ t2"
	+(* Because mk_eq works only with closed terms *)
	+abbreviation "mk_eq' ty t1 t2 \<equiv> Ct STR ''Pure.eq''
	+ (ty \<rightarrow> (ty \<rightarrow> propT)) $ t1 $ t2"
	+abbreviation mk_imp :: "term \<Rightarrow> term \<Rightarrow> term" (infixr "\<longmapsto>" 51) where
	+ "A \<longmapsto> B \<equiv> Ct STR ''Pure.imp'' (propT \<rightarrow> (propT \<rightarrow> propT)) $ A $ B"
	+abbreviation "mk_all x ty t \<equiv>
	+ Ct STR ''Pure.all'' ((ty \<rightarrow> propT) \<rightarrow> propT) $ Abs_fv x ty t"
	+
	+text \<open>Order sorted signature\<close>
	+
	+type_synonym osig = "(class rel \<times> (name \<rightharpoonup> (class \<rightharpoonup> sort list)))"
	+
	+fun "subclass" :: "osig \<Rightarrow> class rel" where "subclass (cl, _) = cl"
	+fun tcsigs :: "osig \<Rightarrow> (name \<rightharpoonup> (class \<rightharpoonup> sort list))" where "tcsigs (_, ars) = ars"
	+
	+text \<open>Relation in sorts\<close>
	+
	+definition "class_leq sub c1 c2 = ((c1,c2) \<in> sub)"
	+definition "class_les sub c1 c2 = (class_leq sub c1 c2 \<and> \<not> class_leq sub c2 c1)"
	+definition "sort_leq sub s1 s2 = (\<forall>c\<^sub>2 \<in> s2 . \<exists>c\<^sub>1 \<in> s1. class_leq sub c\<^sub>1 c\<^sub>2)"
	+
	+text \<open>Is a class/sort defined\<close>
	+
	+definition "class_ex rel c = (c \<in> Field rel)"
	+definition "sort_ex rel S = (S \<subseteq> Field rel)"
	+
	+text \<open>Normalizing sorts\<close>
	+
	+definition "normalize_sort sub (S::sort)
	+ = {c \<in> S. \<not> (\<exists>c' \<in> S. class_les sub c' c)}"
	+abbreviation "normalized_sort sub S \<equiv> normalize_sort sub S = S"
	+
	+definition "wf_sort sub S = (normalized_sort sub S \<and> sort_ex sub S)"
	+
	+text \<open>Wellformedness of osig\<close>
	+
	+definition [simp]: "wf_subclass rel = (trans rel \<and> antisym rel \<and> Refl rel)"
	+
	+definition "complete_tcsigs sub tcs \<equiv> (\<forall>ars \<in> ran tcs .
	+ \<forall>(c\<^sub>1, c\<^sub>2) \<in> sub . c\<^sub>1\<in>dom ars \<longrightarrow> c\<^sub>2\<in>dom ars)"
	+
	+definition "coregular_tcsigs sub tcs \<equiv> (\<forall>ars \<in> ran tcs .
	+ \<forall>c\<^sub>1 \<in> dom ars. \<forall>c\<^sub>2 \<in> dom ars.
	+ (class_leq sub c\<^sub>1 c\<^sub>2 \<longrightarrow> list_all2 (sort_leq sub) (the (ars c\<^sub>1)) (the (ars c\<^sub>2))))"
	+
	+definition "consistent_length_tcsigs tcs \<equiv> (\<forall>ars \<in> ran tcs .
	+ \<forall>ss\<^sub>1 \<in> ran ars. \<forall>ss\<^sub>2 \<in> ran ars. length ss\<^sub>1 = length ss\<^sub>2)"
	+
	+definition "all_normalized_and_ex_tcsigs sub tcs \<equiv>
	+ (\<forall>ars \<in> ran tcs . \<forall>ss \<in> ran ars . \<forall>s \<in> set ss. wf_sort sub s)"
	+
	+definition [simp]: "wf_tcsigs sub tcs \<longleftrightarrow>
	+ coregular_tcsigs sub tcs
	+ \<and> complete_tcsigs sub tcs
	+ \<and> consistent_length_tcsigs tcs
	+ \<and> all_normalized_and_ex_tcsigs sub tcs"
	+
	+fun wf_osig where "wf_osig (sub, tcs) \<longleftrightarrow> wf_subclass sub \<and> wf_tcsigs sub tcs"
	+
	+text \<open>Embedding typs into terms/Encoding of type classes\<close>
	+
	+definition "mk_type ty = Ct STR ''Pure.type'' (Core.itselfT ty)"
	+
	+abbreviation "mk_suffix (str::name) suff \<equiv> String.implode (String.explode str @ String.explode suff)"
	+
	+abbreviation "classN \<equiv> STR ''_class''"
	+abbreviation "const_of_class name \<equiv> mk_suffix name classN"
	+
	+definition "mk_of_class ty c =
	+ Ct (const_of_class c) (Core.itselfT ty \<rightarrow> propT) $ mk_type ty"
	+
	+text \<open>Checking if a typ belongs to a sort\<close>
	+
	+inductive has_sort :: "osig \<Rightarrow> typ \<Rightarrow> sort \<Rightarrow> bool" where
	+ has_sort_Tv[intro]: "sort_leq sub S S' \<Longrightarrow> has_sort (sub, tcs) (Tv a S) S'"
	+\| has_sort_Ty:
	+ "tcs \<kappa> = Some dm \<Longrightarrow> \<forall>c \<in> S. \<exists>Ss . dm c = Some Ss \<and> list_all2 (has_sort (sub, tcs)) Ts Ss
	+ \<Longrightarrow> has_sort (sub, tcs) (Ty \<kappa> Ts) S"
	+
	+text \<open>Signatures \<close>
	+
	+type_synonym signature = "(name \<rightharpoonup> typ) \<times> (name \<rightharpoonup> nat) \<times> osig"
	+
	+fun const_type :: "signature \<Rightarrow> (name \<rightharpoonup> typ)" where "const_type (ctf, _, _) = ctf"
	+fun type_arity :: "signature \<Rightarrow> (name \<rightharpoonup> nat)" where "type_arity (_, arf, _) = arf"
	+fun osig :: "signature \<Rightarrow> osig" where "osig (_, _, oss) = oss"
	+
	+(* Which typs and consts must be defined in a signature*)
	+fun is_std_sig where "is_std_sig (ctf, arf, _) \<longleftrightarrow>
	+ arf STR ''fun'' = Some 2 \<and> arf STR ''prop'' = Some 0
	+ \<and> arf STR ''itself'' = Some 1
	+ \<and> ctf STR ''Pure.eq''
	+ = Some ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> propT))
	+ \<and> ctf STR ''Pure.all'' = Some ((Tv (Var (STR '''a'', 0)) full_sort \<rightarrow> propT) \<rightarrow> propT)
	+ \<and> ctf STR ''Pure.imp'' = Some (propT \<rightarrow> (propT \<rightarrow> propT))
	+ \<and> ctf STR ''Pure.type'' = Some (itselfT (Tv (Var (STR '''a'', 0)) full_sort))"
	+
	+text \<open>Wellformedness checks\<close>
	+
	+definition [simp]: "class_ok_sig \<Sigma> c \<equiv> class_ex (subclass (osig \<Sigma>)) c"
	+
	+inductive wf_type :: "signature \<Rightarrow> typ \<Rightarrow> bool" where
	+ typ_ok_Ty: "type_arity \<Sigma> \<kappa> = Some (length Ts) \<Longrightarrow> \<forall>T\<in>set Ts . wf_type \<Sigma> T
	+ \<Longrightarrow> wf_type \<Sigma> (Ty \<kappa> Ts)"
	+\| typ_ok_Tv[intro]: "wf_sort (subclass (osig \<Sigma>)) S \<Longrightarrow> wf_type \<Sigma> (Tv a S)"
	+
	+inductive wf_term :: "signature \<Rightarrow> term \<Rightarrow> bool" where
	+ "wf_type \<Sigma> T \<Longrightarrow> wf_term \<Sigma> (Fv v T)"
	+\| "wf_term \<Sigma> (Bv n)"
	+\| "const_type \<Sigma> s = Some ty \<Longrightarrow> wf_type \<Sigma> T \<Longrightarrow> tinstT T ty \<Longrightarrow> wf_term \<Sigma> (Ct s T)"
	+\| "wf_term \<Sigma> t \<Longrightarrow> wf_term \<Sigma> u \<Longrightarrow> wf_term \<Sigma> (t $ u)"
	+\| "wf_type \<Sigma> T \<Longrightarrow> wf_term \<Sigma> t \<Longrightarrow> wf_term \<Sigma> (Abs T t)"
	+
	+definition "wt_term \<Sigma> t \<equiv> wf_term \<Sigma> t \<and> (\<exists>T. has_typ t T)"
	+
	+fun wf_sig :: "signature \<Rightarrow> bool" where
	+ "wf_sig (ctf, arf, oss) = (wf_osig oss
	+ \<and> dom (tcsigs oss) = dom arf
	+ \<and> (\<forall>type \<in> dom (tcsigs oss). (\<forall>ars \<in> ran (the (tcsigs oss type)) . the (arf type) = length ars))
	+ \<and> (\<forall>ty \<in> Map.ran ctf . wf_type (ctf, arf, oss) ty))"
	+
	+text \<open>Theories\<close>
	+
	+type_synonym "theory" = "signature \<times> term set"
	+
	+fun sig :: "theory \<Rightarrow> signature" where "sig (\<Sigma>, _) = \<Sigma>"
	+fun axioms :: "theory \<Rightarrow> term set" where "axioms (_, axs) = axs"
	+
	+text \<open>Equality axioms, stated directly\<close>
	+
	+abbreviation "tvariable a \<equiv> (Tv (Var (a, 0)) full_sort)"
	+abbreviation "variable x T \<equiv> Fv (Var (x, 0)) T"
	+
	+abbreviation "aT \<equiv> tvariable STR '''a''"
	+abbreviation "bT \<equiv> tvariable STR '''b''"
	+abbreviation "x \<equiv> variable STR ''x'' aT"
	+abbreviation "y \<equiv> variable STR ''y'' aT"
	+abbreviation "z \<equiv> variable STR ''z'' aT"
	+abbreviation "f \<equiv> variable STR ''f'' (aT \<rightarrow> bT)"
	+abbreviation "g \<equiv> variable STR ''g'' (aT \<rightarrow> bT)"
	+abbreviation "P \<equiv> variable STR ''P'' (aT \<rightarrow> propT)"
	+abbreviation "Q \<equiv> variable STR ''Q'' (aT \<rightarrow> propT)"
	+abbreviation "A \<equiv> variable STR ''A'' propT"
	+abbreviation "B \<equiv> variable STR ''B'' propT"
	+
	+definition "eq_reflexive_ax \<equiv> mk_eq x x"
	+definition "eq_symmetric_ax \<equiv> mk_eq x y \<longmapsto> mk_eq y x"
	+definition "eq_transitive_ax \<equiv> mk_eq x y \<longmapsto> mk_eq y z \<longmapsto> mk_eq x z"
	+definition "eq_intr_ax \<equiv> (A \<longmapsto> B) \<longmapsto> (B \<longmapsto> A) \<longmapsto> mk_eq A B"
	+definition "eq_elim_ax \<equiv> mk_eq A B \<longmapsto> A \<longmapsto> B"
	+definition "eq_combination_ax \<equiv> mk_eq f g \<longmapsto> mk_eq x y \<longmapsto> mk_eq (f $ x) (g $ y)"
	+definition "eq_abstract_rule_ax \<equiv>
	+ (Ct STR ''Pure.all'' ((aT \<rightarrow> propT) \<rightarrow> propT) $ Abs aT (mk_eq' bT (f $ Bv 0) (g $ Bv 0)))
	+ \<longmapsto> mk_eq (Abs aT (f $ Bv 0)) (Abs aT (g $ Bv 0))"
	+
	+hide_const (open) x y z f g P Q A B
	+
	+abbreviation "eq_axs \<equiv> {eq_reflexive_ax, eq_symmetric_ax, eq_transitive_ax, eq_intr_ax, eq_elim_ax,
	+ eq_combination_ax, eq_abstract_rule_ax}"
	+
	+text\<open>Wellformedness of theories\<close>
	+
	+fun wf_theory where "wf_theory (\<Sigma>, axs) \<longleftrightarrow>
	+ (\<forall>p \<in> axs . wt_term \<Sigma> p \<and> has_typ p propT)
	+ \<and> is_std_sig \<Sigma>
	+ \<and> wf_sig \<Sigma>
	+ \<and> eq_axs \<subseteq> axs"
	+
	+text\<open>Wellformedness of typ antiations\<close>
	+
	+definition [simp]: "wf_inst \<Theta> \<rho> \<equiv>
	+ (\<forall>v S . \<rho> v S \<noteq> Tv v S \<longrightarrow>
	+ (has_sort (osig (sig \<Theta>)) (\<rho> v S) S) \<and> wf_type (sig \<Theta>) (\<rho> v S))"
	+
	+text\<open>Inference system\<close>
	+
	+inductive proves :: "theory \<Rightarrow> term set \<Rightarrow> term \<Rightarrow> bool" ("(_,_) \<turnstile> (_)" 50) for \<Theta> where
	+ axiom: "wf_theory \<Theta> \<Longrightarrow> A\<in>axioms \<Theta> \<Longrightarrow> wf_inst \<Theta> \<rho>
	+ \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> tsubst A \<rho>"
	+\| "assume": "wf_term (sig \<Theta>) A \<Longrightarrow> has_typ A propT \<Longrightarrow> A \<in> \<Gamma> \<Longrightarrow> \<Theta>,\<Gamma> \<turnstile> A"
	+\| forall_intro: "wf_theory \<Theta> \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> B \<Longrightarrow> (x,\<tau>) \<notin> FV \<Gamma> \<Longrightarrow> wf_type (sig \<Theta>) \<tau>
	+ \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> mk_all x \<tau> B"
	+\| forall_elim: "\<Theta>, \<Gamma> \<turnstile> Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> B
	+ \<Longrightarrow> has_typ a \<tau> \<Longrightarrow> wf_term (sig \<Theta>) a
	+ \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> subst_bv a B"
	+\| implies_intro: "wf_theory \<Theta> \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> B \<Longrightarrow> wf_term (sig \<Theta>) A \<Longrightarrow> has_typ A propT
	+ \<Longrightarrow> \<Theta>, \<Gamma> - {A} \<turnstile> A \<longmapsto> B"
	+\| implies_elim: "\<Theta>, \<Gamma>\<^sub>1 \<turnstile> A \<longmapsto> B \<Longrightarrow> \<Theta>, \<Gamma>\<^sub>2 \<turnstile> A \<Longrightarrow> \<Theta>, \<Gamma>\<^sub>1\<union>\<Gamma>\<^sub>2 \<turnstile> B"
	+\| of_class: "wf_theory \<Theta>
	+ \<Longrightarrow> const_type (sig \<Theta>) (const_of_class c) = Some (Core.itselfT aT \<rightarrow> propT)
	+ \<Longrightarrow> wf_type (sig \<Theta>) T
	+ \<Longrightarrow> has_sort (osig (sig \<Theta>)) T {c}
	+ \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> mk_of_class T c"
	+(* Stuff about equality that cannot be expressed as an axiom*)
	+\| \<beta>_conversion: "wf_theory \<Theta> \<Longrightarrow> wt_term (sig \<Theta>) (Abs T t) \<Longrightarrow> wf_term (sig \<Theta>) u \<Longrightarrow> has_typ u T
	+ \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> mk_eq (Abs T t $ u) (subst_bv u t)"
	+\| eta: "wf_theory \<Theta> \<Longrightarrow> wf_term (sig \<Theta>) t \<Longrightarrow> has_typ t (\<tau> \<rightarrow> \<tau>')
	+ \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (t $ Bv 0)) t"
	+
	+text\<open>Ensure no garbage in \<open>\<Theta>,\<Gamma>\<close>\<close>
	+
	+definition proves' :: "theory \<Rightarrow> term set \<Rightarrow> term \<Rightarrow> bool" ("(_,_) \<tturnstile> (_)" 51) where
	+ "proves' \<Theta> \<Gamma> t \<equiv> wf_theory \<Theta> \<and> (\<forall>h \<in> \<Gamma> . wf_term (sig \<Theta>) h \<and> has_typ h propT) \<and> \<Theta>, \<Gamma> \<turnstile> t"
	+
	+hide_const (open) aT bT
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/EqualityProof.thy b/thys/Metalogic_ProofChecker/EqualityProof.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/EqualityProof.thy
	@@ -0,0 +1,1578 @@
	+section "Derived rules on equality and normalization"
	+
	+theory EqualityProof
	+ imports Logic
	+begin
	+
	+(* Check for automation here, steps seem very small*)
	+
	+lemma proves_eq_reflexive_pre:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> t"
	+ shows "\<Theta>, {} \<turnstile> mk_eq t t"
	+proof-
	+ have "eq_reflexive_ax \<in> axioms \<Theta>"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust) auto
	+ moreover obtain \<tau> where \<tau>: "typ_of t = Some \<tau>" using assms wt_term_def by auto
	+ moreover hence "typ_ok \<Theta> \<tau>" using assms term_ok_imp_typ_ok by blast
	+ ultimately have "\<Theta>, {} \<turnstile> subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_reflexive_ax"
	+ using axiom_subst_typ' assms by (simp del: term_ok_def)
	+ hence "\<Theta>, {} \<turnstile> subst_term [((Var (STR ''x'', 0), \<tau>), t)]
	+ (subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_reflexive_ax)"
	+ using \<tau> assms(1) assms(2) inst_var by auto
	+ moreover have "subst_term [((Var (STR ''x'', 0), \<tau>), t)]
	+ (subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_reflexive_ax)
	+ = mk_eq t t"
	+ using \<tau> by (simp add: eq_axs_def typ_of_def)
	+ ultimately show ?thesis
	+ by simp
	+qed
	+
	+lemma unsimp_context: "\<Gamma> = {} \<union> \<Gamma>"
	+ by simp
	+
	+lemma proves_eq_reflexive:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> t"
	+ assumes "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t t"
	+ by (subst unsimp_context) (use assms proves_eq_reflexive_pre weaken_proves_set in blast)
	+
	+lemma proves_eq_symmetric_pre:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> t"
	+ assumes "term_ok \<Theta> s"
	+ assumes "typ_of s = typ_of t"
	+ shows "\<Theta>, {} \<turnstile> mk_eq s t \<longmapsto> mk_eq t s"
	+proof-
	+
	+ have "eq_symmetric_ax \<in> axioms \<Theta>"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust) auto
	+ moreover obtain \<tau> where \<tau>: "typ_of t = Some \<tau>" using assms wt_term_def by auto
	+
	+ moreover hence "typ_ok \<Theta> \<tau>" using assms term_ok_imp_typ_ok by blast
	+ ultimately have "\<Theta>, {} \<turnstile> subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_symmetric_ax"
	+ using assms axiom_subst_typ' by (auto simp del: term_ok_def)
	+ hence "\<Theta>, {} \<turnstile> subst_term [((Var (STR ''x'', 0), \<tau>), s), ((Var (STR ''y'', 0), \<tau>), t)]
	+ (subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_symmetric_ax)"
	+ using \<tau> \<open>typ_ok \<Theta> \<tau>\<close> term_ok_var assms by (fastforce intro!: inst_var_multiple simp add: eq_symmetric_ax_def)
	+ thus ?thesis
	+ using \<tau> assms(4) by (simp add: eq_axs_def typ_of_def)
	+qed
	+
	+lemma proves_eq_symmetric:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> t"
	+ assumes "term_ok \<Theta> s"
	+ assumes "typ_of s = typ_of t"
	+ assumes "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq s t \<longmapsto> mk_eq t s"
	+ by (subst unsimp_context) (use assms proves_eq_symmetric_pre weaken_proves_set in blast)
	+
	+lemma proves_eq_symmetric2':
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> (mk_eq s t)"
	+ assumes "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq s t \<longmapsto> mk_eq t s"
	+proof-
	+ have "term_ok \<Theta> s" "term_ok \<Theta> t"
	+ using assms wt_term_def term_ok_mk_eqD by blast+
	+ moreover have "typ_of s = typ_of t"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust)
	+ (auto simp add: tinstT_def typ_of_def wt_term_def bind_eq_Some_conv)
	+ ultimately show ?thesis
	+ using proves_eq_symmetric assms by blast
	+qed
	+
	+lemma proves_eq_symmetric_rule:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> t"
	+ assumes "term_ok \<Theta> s"
	+ assumes "typ_of s = typ_of t"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> mk_eq s t"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t s"
	+ using proves.implies_elim[OF proves_eq_symmetric[OF assms(1-4), of \<Gamma>] assms(5), OF ctxt] by simp
	+
	+lemma proves_eq_transitive_pre:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> s"
	+ assumes "term_ok \<Theta> t"
	+ assumes "term_ok \<Theta> u"
	+ assumes "typ_of s = typ_of t" "typ_of t = typ_of u"
	+ shows "\<Theta>, {} \<turnstile> mk_eq s t \<longmapsto> mk_eq t u \<longmapsto> mk_eq s u"
	+proof-
	+ have "eq_transitive_ax \<in> axioms \<Theta>"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust) auto
	+ moreover obtain \<tau> where \<tau>: "typ_of t = Some \<tau>" using assms wt_term_def by auto
	+ moreover hence ok: "typ_ok \<Theta> \<tau>" using assms term_ok_imp_typ_ok by blast
	+ ultimately have "\<Theta>, {} \<turnstile> subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_transitive_ax"
	+ using assms axiom_subst_typ' by (auto simp del: term_ok_def)
	+ hence "\<Theta>, {} \<turnstile> subst_term [((Var (STR ''x'', 0), \<tau>), s), ((Var (STR ''y'', 0), \<tau>), t),
	+ ((Var (STR ''z'', 0), \<tau>), u)]
	+ (subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_transitive_ax)"
	+ using \<tau> assms ok term_ok_var by (fastforce intro!: inst_var_multiple simp add: eq_transitive_ax_def)
	+ moreover have "subst_term [((Var (STR ''x'', 0), \<tau>), s), ((Var (STR ''y'', 0), \<tau>), t),
	+ ((Var (STR ''z'', 0), \<tau>), u)]
	+ (subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>)] eq_transitive_ax)
	+ = mk_eq s t \<longmapsto> mk_eq t u \<longmapsto> mk_eq s u"
	+ using \<tau> assms(5-6) apply (simp add: eq_axs_def typ_of_def)
	+ by (metis option.sel the_default.simps(2))
	+ ultimately show ?thesis
	+ by simp
	+qed
	+
	+lemma proves_eq_transitive:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> s"
	+ assumes "term_ok \<Theta> t"
	+ assumes "term_ok \<Theta> u"
	+ assumes "typ_of s = typ_of t" "typ_of t = typ_of u"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq s t \<longmapsto> mk_eq t u \<longmapsto> mk_eq s u"
	+ by (subst unsimp_context) (use assms proves_eq_transitive_pre weaken_proves_set in blast)
	+
	+lemma proves_eq_transitive2:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> (mk_eq s t)"
	+ assumes "term_ok \<Theta> (mk_eq t u)"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq s t \<longmapsto> mk_eq t u \<longmapsto> mk_eq s u"
	+proof-
	+ have "term_ok \<Theta> s" "term_ok \<Theta> t" "term_ok \<Theta> u"
	+ using assms wt_term_def term_ok_mk_eqD by blast+
	+ moreover have "typ_of s = typ_of t"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust)
	+ (auto simp add: tinstT_def typ_of_def wt_term_def bind_eq_Some_conv)
	+ moreover have "typ_of t = typ_of u"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust)
	+ (auto simp add: tinstT_def typ_of_def wt_term_def bind_eq_Some_conv)
	+ ultimately show ?thesis using proves_eq_transitive assms by blast
	+qed
	+
	+lemma proves_eq_transitive_rule:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> s"
	+ assumes "term_ok \<Theta> t"
	+ assumes "term_ok \<Theta> u"
	+ assumes "typ_of s = typ_of t" "typ_of t = typ_of u"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> mk_eq s t" "\<Theta>, \<Gamma> \<turnstile> mk_eq t u"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq s u"
	+proof-
	+ note 1 = proves_eq_transitive[OF assms(1-6), of \<Gamma>]
	+ note 2 = proves.implies_elim[OF 1 assms(7)]
	+ note 3 = proves.implies_elim[OF 2 assms(8)]
	+ thus ?thesis using ctxt by simp
	+qed
	+
	+lemma proves_eq_intr_pre:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ shows "\<Theta>, {} \<turnstile> (A \<longmapsto> B) \<longmapsto> (B \<longmapsto> A) \<longmapsto> mk_eq A B"
	+proof-
	+ have closed: "is_closed A" "is_closed B"
	+ using assms(3) assms(5) typ_of_imp_closed by auto
	+ have "eq_intr_ax \<in> axioms \<Theta>"
	+ using thy by (cases \<Theta> rule: theory_full_exhaust) auto
	+
	+ hence 1: "\<Theta>, {} \<turnstile> eq_intr_ax"
	+ by (simp add: axiom' thy)
	+ hence "\<Theta>, {} \<turnstile> subst_term [((Var (STR ''A'', 0), propT), A), ((Var (STR ''B'', 0), propT), B)]
	+ eq_intr_ax"
	+ using assms term_ok_var propT_ok by (fastforce intro!: inst_var_multiple simp add: eq_intr_ax_def)
	+ thus ?thesis using assms by (simp add: eq_axs_def typ_of_def)
	+qed
	+
	+lemma proves_eq_intr:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> (A \<longmapsto> B) \<longmapsto> (B \<longmapsto> A) \<longmapsto> mk_eq A B"
	+ by (subst unsimp_context) (use assms proves_eq_intr_pre weaken_proves_set in blast)
	+
	+lemma proves_eq_intr_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> (A \<longmapsto> B)" "\<Theta>, \<Gamma> \<turnstile> (B \<longmapsto> A)"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq A B"
	+proof-
	+ note 1 = proves_eq_intr[OF assms(1-5), of \<Gamma>]
	+ note 2 = proves.implies_elim[OF 1 assms(6)]
	+ note 3 = proves.implies_elim[OF 2 assms(7)]
	+ thus ?thesis using ctxt by simp
	+qed
	+
	+lemma proves_eq_elim_pre:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ shows "\<Theta>, {} \<turnstile> mk_eq A B \<longmapsto> A \<longmapsto> B"
	+proof-
	+ have closed: "is_closed A" "is_closed B"
	+ by (simp_all add: assms(3) assms(5) typ_of_imp_closed)
	+ have "eq_elim_ax \<in> axioms \<Theta>"
	+ using thy by (cases \<Theta> rule: theory_full_exhaust) auto
	+ hence 1: "\<Theta>, {} \<turnstile> eq_elim_ax"
	+ by (simp add: axiom' thy)
	+ hence "\<Theta>, {} \<turnstile> subst_term [((Var (STR ''A'', 0), propT), A), ((Var (STR ''B'', 0), propT), B)]
	+ eq_elim_ax"
	+ using assms term_ok_var propT_ok by (fastforce intro!: inst_var_multiple simp add: eq_elim_ax_def)
	+ thus ?thesis
	+ using assms by (simp add: eq_axs_def typ_of_def)
	+qed
	+
	+lemma proves_eq_elim:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq A B \<longmapsto> A \<longmapsto> B"
	+ by (subst unsimp_context) (use assms proves_eq_elim_pre weaken_proves_set in blast)
	+
	+lemma proves_eq_elim_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> mk_eq A B"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> A \<longmapsto> B"
	+ using proves.implies_elim[OF proves_eq_elim[OF assms(1-5)] assms(6), of \<Gamma>, OF ctxt] by simp
	+
	+lemma proves_eq_elim2_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> mk_eq A B"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> B \<longmapsto> A"
	+proof-
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq B A"
	+ by (rule proves_eq_symmetric_rule) (use assms in simp_all)
	+ thus ?thesis by (intro proves_eq_elim_rule) (use assms in simp_all)
	+qed
	+
	+lemma proves_eq_combination_pre:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes f: "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes g: "term_ok \<Theta> g" "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes x: "term_ok \<Theta> x" "typ_of x = Some \<tau>"
	+ assumes y: "term_ok \<Theta> y" "typ_of y = Some \<tau>"
	+ shows "\<Theta>, {} \<turnstile> mk_eq f g \<longmapsto> mk_eq x y \<longmapsto> mk_eq (f $ x) (g $ y)"
	+proof-
	+ have ok: "typ_ok \<Theta> \<tau>" "typ_ok \<Theta> (\<tau> \<rightarrow> \<tau>')" "typ_ok \<Theta> \<tau>'"
	+ using term_ok_betapply term_ok_imp_typ_ok thy typ_of_betaply thy x f by blast+
	+
	+ have "eq_combination_ax \<in> axioms \<Theta>"
	+ using thy by (cases \<Theta> rule: theory_full_exhaust) auto
	+ moreover have "typ_ok \<Theta> \<tau>" "typ_ok \<Theta> \<tau>'"
	+ using assms term_ok_imp_typ_ok thy term_ok_betapply typ_of_betaply by meson+
	+ ultimately have 1: "\<Theta>, {} \<turnstile> subst_typ'
	+ [((Var (STR '''a'', 0), full_sort), \<tau>), ((Var (STR '''b'', 0), full_sort), \<tau>')] eq_combination_ax"
	+ using assms axiom_subst_typ' by (simp del: term_ok_def)
	+ hence "\<Theta>, {} \<turnstile> subst_term
	+ [((Var (STR ''f'', 0), \<tau> \<rightarrow> \<tau>'), f), ((Var (STR ''g'', 0), \<tau> \<rightarrow> \<tau>'), g),
	+ ((Var (STR ''x'', 0), \<tau>), x), ((Var (STR ''y'', 0), \<tau>), y)]
	+ (subst_typ' [((Var (STR '''a'', 0), full_sort), \<tau>), ((Var (STR '''b'', 0), full_sort), \<tau>')]
	+ eq_combination_ax)"
	+ using assms term_ok_var ok by (fastforce intro!: inst_var_multiple simp add: eq_combination_ax_def)
	+ thus ?thesis
	+ using assms by (simp add: eq_axs_def typ_of_def)
	+qed
	+
	+lemma proves_eq_combination:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes f: "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes g: "term_ok \<Theta> g" "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes x: "term_ok \<Theta> x" "typ_of x = Some \<tau>"
	+ assumes y: "term_ok \<Theta> y" "typ_of y = Some \<tau>"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq f g \<longmapsto> mk_eq x y \<longmapsto> mk_eq (f $ x) (g $ y)"
	+ by (subst unsimp_context) (use assms proves_eq_combination_pre weaken_proves_set in blast)
	+
	+(* Can probably drop a whole lot of assumptions as thy are deriveable from the last one*)
	+lemma proves_eq_combination_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes f: "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes g: "term_ok \<Theta> g" "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes x: "term_ok \<Theta> x" "typ_of x = Some \<tau>"
	+ assumes y: "term_ok \<Theta> y" "typ_of y = Some \<tau>"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> mk_eq f g" "\<Theta>, \<Gamma> \<turnstile> mk_eq x y"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (f $ x) (g $ y)"
	+proof-
	+ note 1 = proves_eq_combination[OF assms(1-9), of \<Gamma>]
	+ note 2 = proves.implies_elim[OF 1 assms(10)]
	+ note 3 = proves.implies_elim[OF 2 assms(11)]
	+ thus ?thesis using ctxt by simp
	+qed
	+
	+lemma proves_eq_combination_rule_better:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> mk_eq f g" "\<Theta>, \<Gamma> \<turnstile> mk_eq x y"
	+ assumes f: "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes x: "typ_of x = Some \<tau>"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (f $ x) (g $ y)"
	+proof-
	+ have ok_Apps: "term_ok \<Theta> (mk_eq f g)" "term_ok \<Theta> (mk_eq x y)"
	+ using assms(2-3) proved_terms_well_formed_pre by auto
	+ hence tyy: "typ_of y = Some \<tau>" and tyg: "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ using term_ok_mk_eq_same_typ thy x f term_okD1 by metis+
	+ moreover have "term_ok \<Theta> x" "term_ok \<Theta> y" "term_ok \<Theta> f" "term_ok \<Theta> g"
	+ using ok_Apps term_ok_mk_eqD by blast+
	+ ultimately show ?thesis using proves_eq_combination_rule assms by simp
	+qed
	+
	+lemma proves_eq_mp_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> A" "typ_of A = Some propT"
	+ assumes B: "term_ok \<Theta> B" "typ_of B = Some propT"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq A B"
	+ assumes pA: "\<Theta>, \<Gamma> \<turnstile> A"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> B"
	+proof-
	+ have "\<Theta>, \<Gamma> \<turnstile> A \<longmapsto> B" using proves_eq_elim_rule[OF assms(1-5) eq ctxt] .
	+ thus "\<Theta>, \<Gamma> \<turnstile> B" using proves.implies_elim pA by fastforce
	+qed
	+
	+lemma proves_eq_mp_rule_better:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq A B"
	+ assumes pA: "\<Theta>, \<Gamma> \<turnstile> A"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> B"
	+ by (metis ctxt eq pA proved_terms_well_formed(1) proved_terms_well_formed(2)
	+ proves_eq_mp_rule term_ok_mk_eqD term_ok_mk_eq_same_typ thy)
	+
	+lemma proves_subst_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes x: "term_ok \<Theta> x" "typ_of x = Some \<tau>"
	+ assumes y: "term_ok \<Theta> y" "typ_of y = Some \<tau>"
	+ assumes P: "term_ok \<Theta> P" "typ_of P = Some (\<tau> \<rightarrow> propT)"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma> . term_ok \<Theta> A" "\<forall>A\<in>\<Gamma> . typ_of A = Some propT"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq x y"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (P $ x) (P $ y)"
	+proof-
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq P P" using assms proves_eq_reflexive by blast
	+ thus ?thesis using proves_eq_combination_rule assms by blast
	+qed
	+
	+
	+lemma proves_beta_step_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes abs: "term_ok \<Theta> (Abs T t)" "\<Theta>, \<Gamma> \<turnstile> (Abs T t) $ x"
	+ assumes x: "term_ok \<Theta> x" "typ_of x = Some T"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> subst_bv x t"
	+proof-
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq ((Abs T t) $ x) (subst_bv x t)"
	+ using proves.\<beta>_conversion assms by (simp add: term_okD1)
	+ moreover have "term_ok \<Theta> (Abs T t $ x)" and tyAbs: "typ_of (Abs T t $ x) = Some propT"
	+ using abs(2) proved_terms_well_formed by simp_all
	+ moreover have tySub: "typ_of (subst_bv x t) = Some propT"
	+ using tyAbs unfolding subst_bv_def typ_of_def
	+ using typ_of1_subst_bv_gen' by (auto simp add: bind_eq_Some_conv split: if_splits)
	+ moreover have "term_ok \<Theta> (subst_bv x t)"
	+ proof-
	+ have "term_ok' (sig \<Theta>) t"
	+ using assms(2) term_ok'.simps(5) wt_term_def term_ok_def by blast
	+ hence "term_ok' (sig \<Theta>) (subst_bv x t)"
	+ using term_ok'_subst_bv1 x(1) by (simp add: term_okD1 subst_bv_def)
	+ thus ?thesis
	+ using x(1) wt_term_def term_ok'_subst_bv1 subst_bv_def tySub term_okD1 by simp
	+ qed
	+ ultimately show ?thesis apply -
	+ apply (rule proves_eq_mp_rule[where A="(Abs T t) $ x"])
	+ using assms by simp_all
	+qed
	+
	+(* TODO: Remember the name of this rule *)
	+lemma proves_add_param_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes ctxt: "finite \<Gamma>"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq f g" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes type: "typ_ok \<Theta> \<tau>"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $
	+ (Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0))))"
	+proof-
	+ have term_ok: "term_ok \<Theta> (mk_eq f g)"
	+ using eq(1) proved_terms_well_formed_pre by blast
	+ hence term_ok': "term_ok \<Theta> f" "term_ok \<Theta> g"
	+ apply (simp add: eq(2) wt_term_def)
	+ using \<open>term_ok \<Theta> (mk_eq f g)\<close> wt_term_def typ_of_def term_ok_app_eqD by blast
	+ hence "typ_of f = typ_of g"
	+ using thy term_ok by (cases \<Theta> rule: theory_full_exhaust)
	+ (auto simp add: tinstT_def typ_of_def wt_term_def bind_eq_Some_conv)
	+ hence type': "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ using eq(2) by simp
	+
	+ obtain x where "x \<notin> fst ` (fv (mk_eq f g) \<union> FV \<Gamma>)"
	+ using finite_fv finite_FV infinite_fv_UNIV variant_variable_fresh ctxt
	+ by (meson finite_Un finite_imageI)
	+ hence free: "(x,\<tau>) \<notin> fv (mk_eq f g) \<union> FV \<Gamma>"
	+ by force
	+ hence "\<Theta>, \<Gamma> \<turnstile> mk_eq (Fv x \<tau>) (Fv x \<tau>)"
	+ using ctxt proves_eq_reflexive term_ok_var thy type by presburger
	+ hence "\<Theta>, \<Gamma> \<turnstile> mk_eq (f $ Fv x \<tau>) (g $ Fv x \<tau>)"
	+ apply -
	+ apply (rule proves_eq_combination_rule[where \<tau>'=\<tau>'])
	+ using assms term_ok' type' by (simp_all del: term_ok_def)
	+ hence "\<Theta>, \<Gamma> \<turnstile> mk_all x \<tau> (mk_eq (f $ Fv x \<tau>) (g $ Fv x \<tau>))"
	+ apply -
	+ apply (rule proves.forall_intro)
	+ using thy eq type free by simp_all
	+ moreover have "mk_all x \<tau> (mk_eq (f $ Fv x \<tau>) (g $ Fv x \<tau>))
	+ = (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $
	+ (Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0))))"
	+ using free eq type type' bind_fv2_changed
	+ by (fastforce simp add: bind_fv_def bind_fv_unchanged typ_of_def)
	+ ultimately show ?thesis
	+ by simp
	+qed
	+
	+lemma proves_add_abs_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes ctxt: "finite \<Gamma>"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq f g" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes type: "typ_ok \<Theta> \<tau>"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) (Abs \<tau> (g $ Bv 0))"
	+proof-
	+ have ok: "term_ok \<Theta> f" "term_ok \<Theta> g"
	+ using eq(1) proved_terms_well_formed(2) term_ok_mk_eqD by blast+
	+ have g_ty: "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ by (metis eq(1) eq(2) proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy)
	+ hence closed: "is_closed f" "is_closed g"
	+ using eq(2) typ_of_imp_closed by blast+
	+
	+ have ok': "term_ok \<Theta> (Abs \<tau> (f $ Bv 0))" "term_ok \<Theta> (Abs \<tau> (g $ Bv 0))"
	+ using type term_ok_eta_expand ok thy eq(2) g_ty by blast+
	+
	+ have ok_ind: "wf_term (sig \<Theta>) f" "wf_term (sig \<Theta>) g"
	+ using ok wt_term_def by simp_all
	+
	+ note 1 = proves.eta[OF thy ok_ind(1) typ_of_imp_has_typ[OF eq(2)], of \<Gamma>]
	+ note 2 = proves.eta[OF thy ok_ind(2) typ_of_imp_has_typ[OF g_ty], of \<Gamma>]
	+
	+ have simp': "subst_bv x f = f" "subst_bv x g = g" for x
	+ using ok term_ok_subst_bv_no_change by auto
	+
	+ have s2: "\<Theta>,\<Gamma> \<turnstile> mk_eq g (Abs \<tau> (g $ Bv 0))"
	+ apply (rule proves_eq_symmetric_rule)
	+ using "2" ok'(2) ok(2) thy typ_of_eta_expand[OF g_ty] g_ty ctxt by (simp_all add: simp'(2))
	+
	+ have tr1: "\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) g"
	+ using 1 eq(1) g_ty ok'(1) ok(1) ok(2) proves_eq_transitive_rule[OF thy _ _ _ _ _ _ _ ctxt]
	+ typ_of_eta_expand[OF eq(2)] eq(2) by (fastforce simp add: simp'(1))
	+
	+ show ?thesis
	+ using tr1 s2 proves_eq_transitive_rule[OF thy ok'(1) ok(2) ok'(2)] typ_of_eta_expand eq(2) g_ty
	+ ctxt
	+ by simp
	+qed
	+
	+lemma proves_inst_bound_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma> . term_ok \<Theta> A" "\<forall>A\<in>\<Gamma> . typ_of A = Some propT"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> f) (Abs \<tau> g)" "typ_of (Abs \<tau> f) = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes x: "term_ok \<Theta> x" "typ_of x = Some \<tau>"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv x f) (subst_bv x g)"
	+proof-
	+ have "term_ok \<Theta> (mk_eq (Abs \<tau> f) (Abs \<tau> g))"
	+ using eq(1) proved_terms_well_formed(2) by blast
	+ hence "term_ok \<Theta> (Abs \<tau> f)" "term_ok \<Theta> (Abs \<tau> g)"
	+ using term_ok_mk_eqD by blast+
	+ hence "typ_of (Abs \<tau> f) = typ_of (Abs \<tau> g)"
	+ using thy \<open>term_ok \<Theta> (mk_eq (Abs \<tau> f) (Abs \<tau> g))\<close> by (cases \<Theta> rule: theory_full_exhaust)
	+ (auto simp add: tinstT_def typ_of_def wt_term_def bind_eq_Some_conv)
	+ hence "typ_of (Abs \<tau> g) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using eq(2) by simp
	+
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq x x"
	+ by (simp add: ctxt proves_eq_reflexive thy x(1) del: term_ok_def)
	+ hence 1: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> f $ x) (Abs \<tau> g $ x)"
	+ using proves_eq_combination_rule[OF thy \<open>term_ok \<Theta> (Abs \<tau> f)\<close> eq(2) \<open>term_ok \<Theta> (Abs \<tau> g)\<close>
	+ \<open>typ_of (Abs \<tau> g) = Some (\<tau> \<rightarrow> \<tau>')\<close> x x eq(1) _ ctxt]
	+ by blast
	+
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> f $ x) (subst_bv x f)"
	+ apply (rule \<beta>_conversion)
	+ using thy x \<open>term_ok \<Theta> (Abs \<tau> f)\<close> by (simp_all add: wt_term_def)
	+
	+ have "term_ok \<Theta> (Abs \<tau> f $ x)" using \<open>term_ok \<Theta> (Abs \<tau> f)\<close> x
	+ \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> f $ x) (Abs \<tau> g $ x)\<close> proved_terms_well_formed(1)
	+ wt_term_def typ_of1_split_App_obtains typ_of_def
	+ by (meson proved_terms_well_formed(2) term_ok_mk_eqD)
	+ have "term_ok \<Theta> (Abs \<tau> g $ x)" using \<open>term_ok \<Theta> (Abs \<tau> g)\<close> x
	+ \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> f $ x) (Abs \<tau> g $ x)\<close> proved_terms_well_formed(1)
	+ wt_term_def typ_of1_split_App_obtains typ_of_def
	+ by (meson proved_terms_well_formed(2) term_ok_mk_eqD)
	+
	+ have "typ_of (subst_bv x f) = Some \<tau>'"
	+ using \<open>typ_of (Abs \<tau> f) = Some (\<tau> \<rightarrow> \<tau>')\<close> x(2) typ_of_def typ_of_betapply by auto
	+ moreover have "term_ok' (sig \<Theta>) (subst_bv x f)"
	+ using \<open>term_ok \<Theta> (Abs \<tau> f)\<close> substn_subst_0' term_ok'_subst_bv2 wt_term_def x(1) by auto
	+ ultimately have "term_ok \<Theta> (subst_bv x f)"
	+ by (simp add: wt_term_def)
	+
	+ have "typ_of (Abs \<tau> f $ x) = typ_of (subst_bv x f)"
	+ using \<open>typ_of (Abs \<tau> f) = typ_of (Abs \<tau> g)\<close> typ_of_def \<open>typ_of (Abs \<tau> g) = Some (\<tau> \<rightarrow> \<tau>')\<close>
	+ \<open>typ_of (subst_bv x f) = Some \<tau>'\<close> typ_of_Abs_body_typ' x(2) by fastforce
	+
	+ have "typ_of (Abs \<tau> f $ x) = typ_of (Abs \<tau> g $ x)"
	+ using \<open>typ_of (Abs \<tau> f) = typ_of (Abs \<tau> g)\<close> typ_of_def by auto
	+
	+ have 2: "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv x f) (Abs \<tau> f $ x)"
	+ apply - apply (rule proves_eq_symmetric_rule)
	+ using thy apply blast
	+ using \<open>term_ok \<Theta> (subst_bv x f)\<close> apply blast
	+ using \<open>term_ok \<Theta> (Abs \<tau> f $ x)\<close> apply blast
	+ using \<open>typ_of (Abs \<tau> f $ x) = typ_of (subst_bv x f)\<close> apply blast
	+ using \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> f $ x) (subst_bv x f)\<close> apply blast
	+ using ctxt by blast+
	+
	+ have 3: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> g $ x) (subst_bv x g)"
	+ apply (rule \<beta>_conversion)
	+ using thy x \<open>term_ok \<Theta> (Abs \<tau> g)\<close> by (simp_all add: wt_term_def)
	+
	+ have "term_ok \<Theta> (subst_bv x g)"
	+ using \<open>term_ok \<Theta> (Abs \<tau> g $ x)\<close> \<open>term_ok \<Theta> (Abs \<tau> g)\<close> \<open>typ_of (Abs \<tau> f $ x) = typ_of (Abs \<tau> g $ x)\<close>
	+ \<open>typ_of (Abs \<tau> f $ x) = typ_of (subst_bv x f)\<close> \<open>typ_of (Abs \<tau> g) = Some (\<tau> \<rightarrow> \<tau>')\<close>
	+ \<open>typ_of (subst_bv x f) = Some \<tau>'\<close> betapply.simps(1) subst_bv_def term_ok'.simps(5)
	+ term_ok'_subst_bv1 wt_term_def typ_of_betaply x(1) x(2)
	+ by (meson "3" proved_terms_well_formed(2) term_ok_mk_eqD)
	+
	+ have "typ_of (subst_bv x f) = typ_of (Abs \<tau> g $ x)"
	+ using \<open>typ_of (Abs \<tau> f $ x) = typ_of (Abs \<tau> g $ x)\<close>
	+ \<open>typ_of (Abs \<tau> f $ x) = typ_of (subst_bv x f)\<close> by auto
	+
	+ have "typ_of (Abs \<tau> g $ x) = typ_of (subst_bv x g)"
	+ using \<open>typ_of (Abs \<tau> f) = typ_of (Abs \<tau> g)\<close> eq(2) typ_of_betapply typ_of_def x(2) by auto
	+
	+ have c1: "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv x f) (Abs \<tau> g $ x)"
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau> f $ x"];
	+ (use assms 1 2 \<open>term_ok \<Theta> (subst_bv x f)\<close> in \<open>solves simp\<close>)?)
	+ using \<open>term_ok \<Theta> (Abs \<tau> f $ x)\<close> apply blast
	+ using \<open>term_ok \<Theta> (Abs \<tau> g $ x)\<close> apply blast
	+ using \<open>typ_of (Abs \<tau> f $ x) = typ_of (subst_bv x f)\<close> apply simp
	+ using \<open>typ_of (Abs \<tau> f $ x) = typ_of (Abs \<tau> g $ x)\<close> apply blast
	+ done
	+ show ?thesis
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau> g $ x"];
	+ (use assms 1 2 \<open>term_ok \<Theta> (subst_bv x f)\<close> in \<open>solves simp\<close>)?)
	+ using \<open>term_ok \<Theta> (Abs \<tau> g $ x)\<close>
	+ \<open>term_ok \<Theta> (subst_bv x g)\<close>
	+ \<open>typ_of (subst_bv x f) = typ_of (Abs \<tau> g $ x)\<close>
	+ \<open>typ_of (Abs \<tau> g $ x) = typ_of (subst_bv x g)\<close>
	+ \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bv x f) (Abs \<tau> g $ x)\<close>
	+ \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> g $ x) (subst_bv x g)\<close> by simp_all
	+qed
	+
	+(* The is_closeds are annoying *)
	+lemma proves_descend_abs_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau>' (bind_fv (x, \<tau>') s)) (Abs \<tau>' (bind_fv (x, \<tau>') t))"
	+ "is_closed s" "is_closed t"
	+ assumes x: "(x, \<tau>') \<notin> FV \<Gamma>" "typ_ok \<Theta> \<tau>'"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq s t"
	+proof-
	+ have abs_ok: "term_ok \<Theta> (Abs_fv x \<tau>' s)" "term_ok \<Theta> (Abs_fv x \<tau>' t)"
	+ using eq proved_terms_well_formed wt_term_def typ_of1_split_App typ_of_def
	+ by (meson term_ok_mk_eqD)+
	+ obtain \<tau> where \<tau>1: "typ_of (Abs_fv x \<tau>' s) = Some (\<tau>' \<rightarrow> \<tau>)"
	+ by (smt eq proved_terms_well_formed_pre typ_of1_split_App_obtains typ_of_Abs_body_typ' typ_of_def)
	+ hence \<tau>2: "typ_of (Abs_fv x \<tau>' t) = Some (\<tau>' \<rightarrow> \<tau>)"
	+ by (metis eq(1) proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy)
	+
	+ have add_param: "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs \<tau>' (bind_fv (x, \<tau>') s) $ Fv x \<tau>')
	+ (Abs \<tau>' (bind_fv (x, \<tau>') t) $ Fv x \<tau>')"
	+ apply(rule proves_eq_combination_rule; use assms abs_ok \<tau>1 \<tau>2 in \<open>(solves simp)?\<close>)
	+ using proves_eq_reflexive term_ok_var thy x(2) wt_term_def ctxt by blast+
	+
	+ have \<beta>s: "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs \<tau>' (bind_fv (x, \<tau>') s) $ Fv x \<tau>')
	+ (subst_bv (Fv x \<tau>') (bind_fv (x, \<tau>') s))"
	+ by (rule proves.\<beta>_conversion; use assms abs_ok \<tau>1 \<tau>2 in \<open>(solves \<open>simp add: wt_term_def\<close>)?\<close>)
	+ moreover have simps: "subst_bv (Fv x \<tau>') (bind_fv (x, \<tau>') s) = s"
	+ using subst_bv_bind_fv typ_of_imp_closed eq(2) by blast
	+ ultimately have \<beta>s: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau>' (bind_fv (x, \<tau>') s) $ Fv x \<tau>') s"
	+ by simp
	+
	+ have t1: "term_ok \<Theta> s"
	+ using \<beta>s proved_terms_well_formed(2) wt_term_def typ_of_def
	+ using term_ok_app_eqD by blast
	+ have t2: "term_ok \<Theta> (Abs_fv x \<tau>' s $ term.Fv x \<tau>')"
	+ using \<beta>s \<open>term_ok \<Theta> s\<close> proved_terms_well_formed(2) term_ok'.simps(4)
	+ wt_term_def term_ok_mk_eq_same_typ thy
	+ by (meson term_ok_mk_eqD)
	+
	+ have \<beta>s_rev: "\<Theta>, \<Gamma> \<turnstile> mk_eq s (Abs \<tau>' (bind_fv (x, \<tau>') s) $ Fv x \<tau>')"
	+ apply (rule proves_eq_symmetric_rule; use assms abs_ok \<tau>1 \<tau>2 t1 t2 in \<open>(solves simp)?\<close>)
	+ using \<beta>s proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy apply blast
	+ using \<beta>s by simp
	+
	+ have \<beta>t: "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs \<tau>' (bind_fv (x, \<tau>') t) $ Fv x \<tau>')
	+ (subst_bv (Fv x \<tau>') (bind_fv (x, \<tau>') t))"
	+ by (rule proves.\<beta>_conversion; use assms abs_ok \<tau>1 \<tau>2 t1 t2 in \<open>(solves \<open>simp add: wt_term_def\<close>)?\<close>)
	+ moreover have simpt: "subst_bv (Fv x \<tau>') (bind_fv (x, \<tau>') t) = t"
	+ using subst_bv_bind_fv typ_of_imp_closed eq(3) by blast
	+ ultimately have \<beta>t: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau>' (bind_fv (x, \<tau>') t) $ Fv x \<tau>') t"
	+ by simp
	+
	+ have t3: "term_ok \<Theta> (Abs_fv x \<tau>' t $ term.Fv x \<tau>')"
	+ using \<beta>s add_param proved_terms_well_formed(2) t1 term_ok'.simps(4)
	+ wt_term_def term_ok_mk_eq_same_typ thy
	+ by (meson term_ok_mk_eqD)
	+ have t4: "typ_of s = typ_of (Abs_fv x \<tau>' t $ term.Fv x \<tau>')"
	+ by (metis \<beta>s add_param proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy)
	+ have t5: "typ_of s = typ_of (Abs_fv x \<tau>' s $ Fv x \<tau>')"
	+ using \<beta>s_rev proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy by blast
	+ have t6: "typ_of (Abs_fv x \<tau>' s $ Fv x \<tau>') = typ_of (Abs_fv x \<tau>' t $ term.Fv x \<tau>')"
	+ using t4 t5 by auto
	+ have half: "\<Theta>, \<Gamma> \<turnstile> mk_eq s (Abs \<tau>' (bind_fv (x, \<tau>') t) $ Fv x \<tau>')"
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau>' (bind_fv (x, \<tau>') s) $ Fv x \<tau>'"]
	+ ; use assms abs_ok \<tau>1 \<tau>2 t1 t2 t3 t4 t5 t6 in \<open>(solves simp)?\<close>)
	+ using \<beta>s_rev apply blast
	+ using add_param by blast
	+
	+ have t7: "term_ok \<Theta> t"
	+ using \<beta>t proved_terms_well_formed(2) t1 t4 term_ok'.simps(4) wt_term_def term_ok_mk_eq_same_typ thy
	+ by (meson term_ok_app_eqD)
	+ have t8: "typ_of (Abs_fv x \<tau>' t $ term.Fv x \<tau>') = typ_of t"
	+ using \<beta>t proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy by blast
	+
	+ show ?thesis
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau>' (bind_fv (x, \<tau>') t) $ Fv x \<tau>'"]
	+ ; use assms abs_ok \<tau>1 \<tau>2 t1 t2 t3 t4 t5 t6 t7 t8 in \<open>(solves simp)?\<close>)
	+ using half apply blast
	+ using \<beta>t by blast
	+qed
	+
	+(* MOVE? Not general enough for other place, seems like an adhoc solution*)
	+lemma obtain_fresh_variable:
	+ assumes "finite \<Gamma>"
	+ obtains x where "(x,\<tau>) \<notin> fv t \<union> FV \<Gamma>"
	+ using assms finite_fv finite_FV
	+ by (metis finite_Un finite_imageI fst_conv image_eqI variant_variable_fresh)
	+lemma obtain_fresh_variable':
	+ assumes "finite \<Gamma>"
	+ obtains x where "(x,\<tau>) \<notin> fv t \<union> fv u \<union> FV \<Gamma>"
	+ using assms finite_fv finite_FV
	+ by (metis finite_Un finite_imageI fst_conv image_eqI variant_variable_fresh)
	+
	+lemma proves_eq_abstract_rule_pre:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes B: "term_ok \<Theta> g" "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ shows "\<Theta>, {} \<turnstile> (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)))
	+ \<longmapsto> mk_eq (Abs \<tau> (f $ Bv 0)) (Abs \<tau> (g $ Bv 0))"
	+proof-
	+ have "eq_abstract_rule_ax \<in> axioms \<Theta>"
	+ using thy by (cases \<Theta> rule: theory_full_exhaust) auto
	+ moreover have ok2: "typ_ok \<Theta> (\<tau> \<rightarrow> \<tau>')"
	+ using assms(2) assms(3) term_ok_imp_typ_ok thy by blast
	+ moreover hence ok3: "typ_ok \<Theta> \<tau>'"
	+ using thy A(2) by (cases \<Theta> rule: theory_full_exhaust) auto
	+ moreover have ok1: "typ_ok \<Theta> \<tau>"
	+ using thy A(2) ok2 by (cases \<Theta> rule: theory_full_exhaust) auto
	+ ultimately have 1: "\<Theta>, {} \<turnstile> subst_typ'
	+ [((Var (STR '''a'', 0), full_sort), \<tau>), ((Var (STR '''b'', 0), full_sort), \<tau>')] eq_abstract_rule_ax"
	+ using assms axiom_subst_typ' by (simp del: term_ok_def)
	+ hence "\<Theta>, {} \<turnstile> subst_term [((Var (STR ''g'', 0), \<tau> \<rightarrow> \<tau>'), g),
	+ ((Var (STR ''f'', 0), \<tau> \<rightarrow> \<tau>'), f)] (subst_typ'
	+ [((Var (STR '''a'', 0), full_sort), \<tau>), ((Var (STR '''b'', 0), full_sort), \<tau>')] eq_abstract_rule_ax)"
	+ using ok1 ok2 ok3 assms term_ok_var by (fastforce intro!: inst_var_multiple simp add: eq_abstract_rule_ax_def)
	+ moreover have "subst_term [((Var (STR ''g'', 0), \<tau> \<rightarrow> \<tau>'), g),
	+ ((Var (STR ''f'', 0), \<tau> \<rightarrow> \<tau>'), f)] (subst_typ'
	+ [((Var (STR '''a'', 0), full_sort), \<tau>), ((Var (STR '''b'', 0), full_sort), \<tau>')] eq_abstract_rule_ax)
	+ = (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)))
	+ \<longmapsto> mk_eq (Abs \<tau> (f $ Bv 0)) (Abs \<tau> (g $ Bv 0))"
	+ using assms typ_of1_weaken_Ts by (fastforce simp add: eq_axs_def typ_of_def)
	+ ultimately show ?thesis
	+ using assms by simp
	+qed
	+
	+lemma proves_eq_abstract_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes B: "term_ok \<Theta> g" "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)))
	+ \<longmapsto> mk_eq (Abs \<tau> (f $ Bv 0)) (Abs \<tau> (g $ Bv 0))"
	+ by (subst unsimp_context) (use assms proves_eq_abstract_rule_pre weaken_proves_set in blast)
	+
	+lemma proves_eq_abstract_rule_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes A: "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes B: "term_ok \<Theta> g" "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes "\<Theta>, \<Gamma> \<turnstile> (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)))"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) (Abs \<tau> (g $ Bv 0))"
	+proof-
	+ note 1 = proves_eq_abstract_rule[where \<Gamma>=\<Gamma>, OF assms(1-5) ctxt]
	+ note 2 = proves.implies_elim[OF 1 assms(6)]
	+ thus ?thesis using ctxt by simp
	+qed
	+
	+lemma proves_eq_ext_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes f: "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes g: "term_ok \<Theta> g" "typ_of g = Some (\<tau> \<rightarrow> \<tau>')"
	+ assumes prem: "\<Theta>, \<Gamma> \<turnstile> Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0))"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq f g"
	+proof-
	+ obtain x where x: "(x,\<tau>) \<notin> FV \<Gamma>" "(x,\<tau>) \<notin> fv f" "(x,\<tau>) \<notin> fv g"
	+ by (meson Un_iff ctxt(1) obtain_fresh_variable')
	+ have closed: "is_closed f" "is_closed g"
	+ using f g has_typ_imp_closed term_ok_def wt_term_def by blast+
	+
	+ have "term_ok \<Theta> (Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)))"
	+ using prem proved_terms_well_formed(2) term_ok_app_eqD by blast
	+
	+ have "subst_bv (Fv x \<tau>) (f $ Bv 0) = f $ Fv x \<tau>"
	+ using Core.subst_bv_def f(1) term_ok_subst_bv_no_change by auto
	+ moreover have "subst_bv (Fv x \<tau>) (g $ Bv 0) = g $ Fv x \<tau>"
	+ using Core.subst_bv_def g(1) term_ok_subst_bv_no_change by auto
	+ ultimately have "subst_bv (Fv x \<tau>) (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0))
	+ = mk_eq' \<tau>' (f $ Fv x \<tau>) (g $ Fv x \<tau>)"
	+ by (simp add: Core.subst_bv_def)
	+ hence simp: "Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)) \<bullet> Fv x \<tau> = mk_eq (f $ Fv x \<tau>) (g $ Fv x \<tau>)"
	+ using f g by (auto simp add: typ_of_def)
	+ hence simp': "subst_bv (Fv x \<tau>) (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)) = mk_eq' \<tau>' (f $ Fv x \<tau>) (g $ Fv x \<tau>)"
	+ using f g by (auto simp add: typ_of_def)
	+
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq' \<tau>' (f $ Fv x \<tau>) (g $ Fv x \<tau>)"
	+ apply (subst simp'[symmetric])
	+ apply (rule forall_elim[where \<tau>=\<tau>])
	+ using prem apply blast
	+ apply simp
	+ using \<open>term_ok \<Theta> (Abs \<tau> (mk_eq' \<tau>' (f $ Bv 0) (g $ Bv 0)))\<close> term_ok'.simps(1) term_ok'.simps(5) term_okD1 by blast
	+ moreover have "typ_of (f $ Fv x \<tau>) = Some \<tau>'" "typ_of (g $ Fv x \<tau>) = Some \<tau>'"
	+ using f(2) g(2) by (simp_all add: typ_of_def)
	+ ultimately have 1: "\<Theta>, \<Gamma> \<turnstile> mk_eq (f $ Fv x \<tau>) (g $ Fv x \<tau>)"
	+ by simp
	+ have core: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) (Abs \<tau> (g $ Bv 0))"
	+ apply (rule proves_eq_abstract_rule_rule[OF thy f g _ ctxt])
	+ using prem by blast
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) f"
	+ using f proves.eta term_okD1 thy by blast
	+ have left: "\<Theta>, \<Gamma> \<turnstile> mk_eq f (Abs \<tau> (f $ Bv 0))" (* Should be: auto ... *)
	+ apply (rule proves_eq_symmetric_rule[OF thy f(1) _ _ _ ctxt])
	+ using \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) (Abs \<tau> (g $ Bv 0))\<close> proved_terms_well_formed(2) term_ok_mk_eqD apply blast
	+ apply (simp add: Logic.typ_of_eta_expand f(2))
	+ using \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) f\<close> by blast
	+
	+ have right: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (g $ Bv 0)) g"
	+ using g proves.eta term_okD1 thy by blast
	+
	+ show ?thesis
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau> (f $ Bv 0)", OF thy f(1) _ g(1) _ _ left _ ctxt])
	+ using \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) f\<close> proved_terms_well_formed(2) term_ok_mk_eqD apply blast
	+ apply (simp add: Logic.typ_of_eta_expand f(2))
	+ apply (simp add: Logic.typ_of_eta_expand f(2) g(2))
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau> (g $ Bv 0)", OF thy _ _ g(1) _ _ core right ctxt])
	+ using \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> (f $ Bv 0)) f\<close> proved_terms_well_formed(2) term_ok_mk_eqD apply blast
	+ using \<open>\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs \<tau> (g $ Bv 0)) g\<close> proved_terms_well_formed(2) term_ok_mk_eqD apply blast
	+ by (simp add: Logic.typ_of_eta_expand f(2) g(2))+
	+qed
	+
	+lemma bind_fv2_idem[simp]:
	+ "bind_fv2 (x, \<tau>) lev1 (bind_fv2 (x, \<tau>) lev2 t) = bind_fv2 (x, \<tau>) lev2 t "
	+ by (induction "(x,\<tau>)" lev2 t arbitrary: lev1 rule: bind_fv2.induct) auto
	+corollary bind_fv_idem[simp]:
	+ "bind_fv (x, \<tau>) (bind_fv (x, \<tau>) t) = bind_fv (x, \<tau>) t "
	+ using bind_fv_def bind_fv2_idem by simp
	+corollary bind_fv_Abs_fv[simp]: "bind_fv (x, \<tau>) (Abs_fv x \<tau> t) = Abs_fv x \<tau> t"
	+ by (simp add: bind_fv_def)
	+
	+lemma "bind_fv2 (x,\<tau>) lev (mk_eq' \<tau>' s t) = mk_eq' \<tau>' (bind_fv2 (x,\<tau>) lev s) (bind_fv2 (x,\<tau>) lev t)"
	+ by simp
	+lemma "bind_fv (x,\<tau>) (mk_eq' \<tau>' s t) = mk_eq' \<tau>' (bind_fv (x,\<tau>) s) (bind_fv (x,\<tau>) t)"
	+ by (simp add: bind_fv_def)
	+
	+lemma term_ok_Abs_fvI: "term_ok \<Theta> s \<Longrightarrow> typ_ok \<Theta> \<tau> \<Longrightarrow> term_ok \<Theta> (Abs_fv x \<tau> s)"
	+ by (auto simp add: wt_term_def term_ok'_bind_fv typ_of_Abs_bind_fv)
	+
	+lemma proves_eq_abstract_rule_derived_rule:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes x: "(x, \<tau>) \<notin> FV \<Gamma>" "typ_ok \<Theta> \<tau>"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq s t"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (bind_fv (x, \<tau>) s)) (Abs \<tau> (bind_fv (x, \<tau>) t))"
	+proof-
	+ obtain \<tau>' where s: "typ_of s = Some \<tau>'"
	+ by (meson eq option.exhaust_sel proved_terms_well_formed(2) term_okD2 term_ok_app_eqD)
	+ have t: "typ_of t = Some \<tau>'"
	+ by (metis eq proved_terms_well_formed(2) s term_ok_mk_eq_same_typ thy)
	+
	+ have ok: "term_ok \<Theta> s" "term_ok \<Theta> t"
	+ using eq proved_terms_well_formed(2) term_ok_mk_eqD by blast+
	+
	+ have closed: "is_closed s" "is_closed t"
	+ using eq has_typ_imp_closed proved_terms_well_formed(2) term_ok_def term_ok_mk_eqD wt_term_def by blast+
	+
	+ have "is_closed (mk_eq s t)"
	+ using eq proved_terms_closed by blast
	+ hence "Abs \<tau> (bind_fv (x, \<tau>) (mk_eq s t)) \<bullet> Fv x \<tau> = mk_eq s t"
	+ using betapply_Abs_fv by auto
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_all x \<tau> (mk_eq s t)"
	+ using eq forall_intro thy typ_ok_def x(1) x(2) by blast
	+
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (bind_fv (x, \<tau>) s) $ Fv x \<tau>) (subst_bv (Fv x \<tau>) (bind_fv (x, \<tau>) s))"
	+ using term_ok_Abs_fvI[OF ok(1) x(2)] wf_term.intros(1) typ_ok_def x(2)
	+ by (auto intro!: \<beta>_conversion[OF thy])
	+ moreover have "subst_bv (Fv x \<tau>) (bind_fv (x, \<tau>) s) = s"
	+ by (simp add: closed(1) subst_bv_bind_fv)
	+ ultimately have unfs: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (bind_fv (x, \<tau>) s) $ Fv x \<tau>) s"
	+ by simp
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (bind_fv (x, \<tau>) t) $ Fv x \<tau>) (subst_bv (Fv x \<tau>) (bind_fv (x, \<tau>) t))"
	+ using term_ok_Abs_fvI[OF ok(2) x(2)] wf_term.intros(1) typ_ok_def x(2)
	+ by (auto intro!: \<beta>_conversion[OF thy])
	+
	+ moreover have "subst_bv (Fv x \<tau>) (bind_fv (x, \<tau>) t) = t"
	+ by (simp add: closed(2) subst_bv_bind_fv)
	+ ultimately have unft: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (bind_fv (x, \<tau>) t) $ Fv x \<tau>) t"
	+ by simp
	+
	+ have prem:
	+ "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (bind_fv (x, \<tau>) s) $ Fv x \<tau>) (Abs \<tau> (bind_fv (x, \<tau>) t) $ Fv x \<tau>)"
	+ apply (rule proves_eq_transitive_rule[where t=s, OF thy _ _ _ _ _ _ _ ctxt])
	+ using ok(1) term_ok_mk_eqD unfs unft proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy
	+ apply (all blast)[4]
	+ apply (metis proved_terms_well_formed(2) s t term_ok_mk_eq_same_typ thy unft)
	+ using unfs apply blast
	+ subgoal
	+ apply (rule proves_eq_transitive_rule[where t=t, OF thy ok _ _ _ _ _ ctxt])
	+ using proved_terms_well_formed(2) term_ok_mk_eqD unft apply blast
	+ apply (simp add: s t)
	+ apply (metis proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy unft)
	+ using eq apply simp
	+ subgoal apply (rule proves_eq_symmetric_rule[OF thy ok(2) _ _ _ ctxt])
	+ using proved_terms_well_formed(2) term_ok_mk_eqD unft apply blast
	+ using proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy unft apply blast
	+ using unft apply blast
	+ done
	+ done
	+ done
	+ hence "\<Theta>, \<Gamma> \<turnstile> mk_all x \<tau>
	+ (mk_eq (Abs \<tau> (bind_fv (x, \<tau>) s) $ Fv x \<tau>) (Abs \<tau> (bind_fv (x, \<tau>) t) $ Fv x \<tau>))"
	+ using forall_intro thy typ_ok_def x(1) x(2) by blast
	+ moreover have "mk_all x \<tau>
	+ (mk_eq (Abs \<tau> (bind_fv (x, \<tau>) s) $ Fv x \<tau>) (Abs \<tau> (bind_fv (x, \<tau>) t) $ Fv x \<tau>))
	+ = mk_all x \<tau>
	+ (mk_eq' \<tau>' (Abs \<tau> (bind_fv (x, \<tau>) s) $ Fv x \<tau>) (Abs \<tau> (bind_fv (x, \<tau>) t) $ Fv x \<tau>))"
	+ using bind_fv2_preserves_type s t typ_of_def by (fastforce simp add: bind_fv_def typ_of_def)+
	+ moreover have "mk_all x \<tau>
	+ (mk_eq' \<tau>' (Abs \<tau> (bind_fv (x, \<tau>) s) $ Fv x \<tau>) (Abs \<tau> (bind_fv (x, \<tau>) t) $ Fv x \<tau>)) =
	+ Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau>
	+ (mk_eq' \<tau>' (Abs \<tau> (bind_fv (x, \<tau>) s) $ Bv 0) (Abs \<tau> (bind_fv (x, \<tau>) t) $ Bv 0))"
	+ by (simp add: bind_fv_def)
	+ ultimately have pre_ext: "\<Theta>, \<Gamma> \<turnstile> Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau>
	+ (mk_eq' \<tau>' (Abs \<tau> (bind_fv (x, \<tau>) s) $ Bv 0) (Abs \<tau> (bind_fv (x, \<tau>) t) $ Bv 0))"
	+ by simp
	+ show ?thesis
	+ apply (rule proves_eq_ext_rule[where \<tau>=\<tau> and \<tau>'=\<tau>', OF thy _ _ _ _ _ ctxt])
	+ using proved_terms_well_formed(2) term_ok_app_eqD unfs apply blast
	+ apply (simp add: s typ_of_Abs_bind_fv)
	+ using proved_terms_well_formed(2) term_ok_app_eqD unft apply blast
	+ apply (simp add: t typ_of_Abs_bind_fv)
	+ using pre_ext by blast
	+qed
	+
	+(* This should allow descending under abstractions for rewriting *)
	+lemma proves_descend_abs_rule_iff:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes ok: "is_closed s" "is_closed t"
	+ assumes x: "(x, \<tau>') \<notin> FV \<Gamma>" "typ_ok \<Theta> \<tau>'"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq s t
	+ \<longleftrightarrow> \<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau>' (bind_fv (x, \<tau>') s)) (Abs \<tau>' (bind_fv (x, \<tau>') t))"
	+proof (rule iffI)
	+ assume asm: "\<Theta>,\<Gamma> \<turnstile> mk_eq s t"
	+ hence "term_ok \<Theta> s" "term_ok \<Theta> t"
	+ using proved_terms_well_formed(2) term_ok_mk_eqD by blast+
	+ show "\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs_fv x \<tau>' s) (Abs_fv x \<tau>' t)"
	+ by (rule proves_eq_abstract_rule_derived_rule[OF thy x ctxt asm])
	+next
	+ assume asm: "\<Theta>,\<Gamma> \<turnstile> mk_eq (Abs_fv x \<tau>' s) (Abs_fv x \<tau>' t)"
	+ show "\<Theta>,\<Gamma> \<turnstile> mk_eq s t"
	+ using assms asm proves_descend_abs_rule by blast
	+qed
	+
	+(* This seems better *)
	+lemma proves_descend_abs_rule':
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau>' s) (Abs \<tau>' t)"
	+ assumes x: "(x, \<tau>') \<notin> FV \<Gamma>" "typ_ok \<Theta> \<tau>'"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv (Fv x \<tau>') s) (subst_bv (Fv x \<tau>') t)"
	+proof-
	+ have abs_ok: "term_ok \<Theta> (Abs \<tau>' s)" "term_ok \<Theta> (Abs \<tau>' t)"
	+ using eq(1) option.distinct(1) proved_terms_well_formed term_ok'.simps(4)
	+ wt_term_def typ_of1_split_App typ_of_def
	+ by (smt term_ok_mk_eqD)+
	+
	+ obtain \<tau> where \<tau>1: "typ_of (Abs \<tau>' s) = Some (\<tau>' \<rightarrow> \<tau>)"
	+ by (smt eq proved_terms_well_formed_pre typ_of1_split_App_obtains typ_of_Abs_body_typ' typ_of_def)
	+ hence \<tau>2: "typ_of (Abs \<tau>' t)= Some (\<tau>' \<rightarrow> \<tau>)"
	+ by (metis eq(1) proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy)
	+
	+ have add_param: "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs \<tau>' s $ Fv x \<tau>')
	+ (Abs \<tau>' t $ Fv x \<tau>')"
	+ apply (rule proves_eq_combination_rule; use assms abs_ok \<tau>1 \<tau>2 in \<open>(solves \<open>simp del: term_ok_def\<close>)?\<close>)
	+ using proves_eq_reflexive term_ok_var thy x(2) ctxt by blast
	+
	+ have \<beta>s: "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs \<tau>' s $ Fv x \<tau>')
	+ (subst_bv (Fv x \<tau>') s)"
	+ by (rule proves.\<beta>_conversion; use assms abs_ok \<tau>1 \<tau>2 in \<open>(solves \<open>simp add: wt_term_def\<close>)?\<close>)
	+
	+ have t1: "term_ok \<Theta> (subst_bv (Fv x \<tau>') s)"
	+ using \<beta>s proved_terms_well_formed(2) wt_term_def typ_of_def
	+ using term_ok_mk_eqD by blast
	+ have t2: "term_ok \<Theta> (Abs \<tau>' s $ term.Fv x \<tau>')"
	+ using \<beta>s proved_terms_well_formed(2) t1 term_ok'.simps(4) wt_term_def term_ok_mk_eq_same_typ thy
	+ term_ok_mk_eqD by blast
	+ have \<beta>s_rev: "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv (Fv x \<tau>') s) (Abs \<tau>' s $ Fv x \<tau>')"
	+ apply (rule proves_eq_symmetric_rule; use assms abs_ok \<tau>1 \<tau>2 t1 t2 in \<open>(solves simp)?\<close>)
	+ using \<beta>s proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy apply blast
	+ using \<beta>s by simp
	+
	+ have \<beta>t: "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs \<tau>' t $ Fv x \<tau>')
	+ (subst_bv (Fv x \<tau>') t)"
	+ by (rule proves.\<beta>_conversion; use assms abs_ok \<tau>1 \<tau>2 t1 in \<open>(solves \<open>simp add: wt_term_def\<close>)?\<close>)
	+
	+ have t3: "term_ok \<Theta> (Abs \<tau>' t $ term.Fv x \<tau>')"
	+ using \<beta>s add_param proved_terms_well_formed(2) t1 term_ok'.simps(4)
	+ wt_term_def term_ok_mk_eq_same_typ thy term_ok_mk_eqD
	+ by meson
	+ have t4: "typ_of (subst_bv (Fv x \<tau>') s) = typ_of (Abs \<tau>' t $ term.Fv x \<tau>')"
	+ by (metis \<beta>s add_param proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy)
	+ have t5: "typ_of (subst_bv (Fv x \<tau>') s) = typ_of (Abs \<tau>' s $ Fv x \<tau>')"
	+ using \<beta>s_rev proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy by blast
	+ have t6: "typ_of (Abs \<tau>' s $ Fv x \<tau>') = typ_of (Abs \<tau>' t $ term.Fv x \<tau>')"
	+ using t4 t5 by auto
	+
	+ have half: "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv (Fv x \<tau>') s) (Abs \<tau>' t $ Fv x \<tau>')"
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau>' s $ Fv x \<tau>'"]
	+ ; use assms abs_ok \<tau>1 \<tau>2 t1 t2 t3 t4 t5 t6 in \<open>(solves simp)?\<close>)
	+ using \<beta>s_rev apply blast
	+ using add_param by blast
	+
	+ have t7: "term_ok \<Theta> (subst_bv (Fv x \<tau>') t)"
	+ using \<beta>t proved_terms_well_formed(2) t1 t4 term_ok'.simps(4) wt_term_def term_ok_mk_eq_same_typ thy
	+ by (meson term_ok_app_eqD)
	+ have t8: "typ_of (Abs \<tau>' t $ term.Fv x \<tau>') = typ_of (subst_bv (Fv x \<tau>') t)"
	+ using \<beta>t proved_terms_well_formed(2) term_ok_mk_eq_same_typ thy by blast
	+
	+ show ?thesis
	+ apply (rule proves_eq_transitive_rule[where t="Abs \<tau>' t $ Fv x \<tau>'"]
	+ ; use assms abs_ok \<tau>1 \<tau>2 t1 t2 t3 t4 t5 t6 t7 t8 in \<open>(solves simp)?\<close>)
	+ using half apply blast
	+ using \<beta>t by blast
	+qed
	+
	+lemma proves_ascend_abs_rule':
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes x: "(x, \<tau>') \<notin> FV \<Gamma>" "(x,\<tau>') \<notin> fv (mk_eq (Abs \<tau>' s) (Abs \<tau>' t))" "typ_ok \<Theta> \<tau>'"
	+ assumes eq: "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv (Fv x \<tau>') s) (subst_bv (Fv x \<tau>') t)"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau>' s) (Abs \<tau>' t)"
	+proof-
	+ have ok_ind: "wf_type (sig \<Theta>) \<tau>'"
	+ using x(3) by simp
	+
	+
	+ note 1 = proves_eq_abstract_rule_derived_rule[OF thy]
	+ have "term_ok \<Theta> (subst_bv (Fv x \<tau>') s)"
	+ using eq proved_terms_well_formed(2) wt_term_def typ_of_def
	+ by (meson term_ok_app_eqD)
	+ hence "is_closed (subst_bv (Fv x \<tau>') s)"
	+ using wt_term_def typ_of_imp_closed by auto
	+ hence loose_s: "\<not> loose_bvar s 1"
	+ using is_closed_subst_bv by simp
	+ hence loose_s': "(\<And>x. 1 < x \<Longrightarrow> \<not> loose_bvar1 s x) "
	+ by (simp add: not_loose_bvar_imp_not_loose_bvar1_all_greater)
	+ moreover have " \<not> occs (case_prod Fv (x,\<tau>')) s"
	+ proof-
	+ have "(x,\<tau>') \<notin> fv s"
	+ using x(2) by auto
	+ thus ?thesis
	+ by (simp add: fv_iff_occs)
	+ qed
	+ ultimately have s: "Abs_fv x \<tau>' (subst_bv (term.Fv x \<tau>') s) = Abs \<tau>' s"
	+ unfolding subst_bv_def bind_fv_def
	+ using bind_fv2_subst_bv1_cancel
	+ by (metis (full_types) case_prod_conv less_one linorder_neqE_nat
	+ loose_bvar1_imp_loose_bvar loose_s not_less_zero)
	+
	+ have "term_ok \<Theta> (subst_bv (Fv x \<tau>') t)"
	+ using eq proved_terms_well_formed(2) wt_term_def typ_of_def
	+ by (meson term_ok_app_eqD)
	+ hence "is_closed (subst_bv (Fv x \<tau>') t)"
	+ using wt_term_def typ_of_imp_closed by auto
	+ hence loose_s: "\<not> loose_bvar t 1"
	+ using is_closed_subst_bv by simp
	+ hence loose_s': "(\<And>x. 1 < x \<Longrightarrow> \<not> loose_bvar1 t x) "
	+ by (simp add: not_loose_bvar_imp_not_loose_bvar1_all_greater)
	+ moreover have " \<not> occs (case_prod Fv (x,\<tau>')) t"
	+ proof-
	+ have "(x,\<tau>') \<notin> fv t"
	+ using x(2) by auto
	+ thus ?thesis
	+ by (simp add: fv_iff_occs)
	+ qed
	+ ultimately have t: "Abs_fv x \<tau>' (subst_bv (term.Fv x \<tau>') t) = Abs \<tau>' t"
	+ unfolding subst_bv_def bind_fv_def
	+ using bind_fv2_subst_bv1_cancel
	+ by (metis (full_types) case_prod_conv less_one linorder_neqE_nat loose_bvar1_imp_loose_bvar
	+ loose_s not_less_zero)
	+
	+ from 1 s t show ?thesis
	+ using ctxt eq x(1) x(3) by fastforce
	+qed
	+
	+lemma proves_descend_abs_rule_iff':
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes x: "(x, \<tau>') \<notin> FV \<Gamma>" "(x, \<tau>') \<notin> fv (mk_eq (Abs \<tau>' s) (Abs \<tau>' t))" "typ_ok \<Theta> \<tau>'"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq (subst_bv (Fv x \<tau>') s) (subst_bv (Fv x \<tau>') t)
	+ \<longleftrightarrow> \<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau>' s) (Abs \<tau>' t)"
	+ apply (rule iffI)
	+ using assms proves_ascend_abs_rule' apply simp
	+ using assms proves_descend_abs_rule' by simp
	+
	+lemma proves_beta_step_pre:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes free: "\<forall>(x,\<tau>) \<in> set vs . (x,\<tau>) \<notin> fv t \<union> FV \<Gamma>"
	+ assumes term_ok': "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) t)"
	+ assumes beta: "t \<rightarrow>\<^sub>\<beta> u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (subst_bvs (map (case_prod Fv) vs) t)
	+ (subst_bvs (map (case_prod Fv) vs) u)"
	+using beta term_ok' free proof(induction t u arbitrary: vs rule: beta.induct)
	+ case (beta T s t)
	+ have ok: "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) (Abs T s))"
	+ "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) t)"
	+ using beta.prems(1) apply simp_all
	+ using term_ok_app_eqD term_ok_def by blast+
	+
	+ have "\<forall>x \<in> set (map (case_prod Fv) vs) . is_closed x"
	+ using beta.prems(2) by auto
	+ hence simp: "subst_bvs (map (case_prod Fv) vs) (Abs T s)
	+ = Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs))"
	+ by auto
	+ hence ok': "term_ok \<Theta> (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))"
	+ using ok by simp
	+ have T: "typ_of (subst_bvs (map (case_prod Fv) vs) t) = Some T"
	+ using ok(2) wt_term_def typ_of_beta_redex_arg simp
	+ using beta.prems(1) subst_bvs_App
	+ by (metis term_okD2)
	+
	+ have ok_unf: "wt_term (sig \<Theta>) (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))"
	+ "wf_term (sig \<Theta>) (subst_bvs (map (case_prod Fv) vs) t)"
	+ using ok(2) ok' wt_term_def by simp_all
	+
	+ have "subst_bvs (map (\<lambda>a. case a of (a, b) \<Rightarrow> term.Fv a b) vs)
	+ (Abs T s $ t) =
	+ Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)) $ subst_bvs (map (case_prod Fv) vs) t"
	+ by (simp add: simp)
	+ moreover have "subst_bvs (map (case_prod Fv) vs) (subst_bv2 s 0 t)
	+ = (subst_bv (subst_bvs (map (case_prod Fv) vs) t)
	+ (subst_bvs1' s 1 (map (case_prod Fv) vs)))"
	+ using subst_bvs1'_subst_bv2[symmetric] subst_bvs_subst_bvs1'
	+ by simp (metis One_nat_def Suc_eq_plus1 map_map simp subst_bvs1.simps(2) subst_bvs1_subst_bvs1'
	+ subst_bvs_def substn_subst_0' term.inject(4))
	+ ultimately show ?case
	+ using \<beta>_conversion[OF thy ok_unf, of \<Gamma>] T by simp
	+next
	+ case (appL s t u)
	+ hence ok: "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) s)"
	+ "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) u)"
	+ by (metis subst_bvs_App term_ok_app_eqD)+
	+ moreover have "\<forall>a \<in> set vs. case a of (x, \<tau>) \<Rightarrow> (x, \<tau>) \<notin> fv s \<union> FV \<Gamma>"
	+ using appL by simp
	+ ultimately have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) s)
	+ (subst_bvs (map (case_prod Fv) vs) t)"
	+ using appL.IH by blast
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) u)
	+ (subst_bvs (map (case_prod Fv) vs) u)"
	+ using proves_eq_reflexive[OF thy ok(2), of \<Gamma>, OF finite ctxt] by blast
	+ moreover obtain \<tau> where \<tau>: "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) u) = Some \<tau>"
	+ using ok wt_term_def by auto
	+ moreover obtain \<tau>' where "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) s) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using \<tau> appL.prems(1) not_None_eq subst_bvs_App wt_term_def typ_of1_arg_typ typ_of_def
	+ by (metis term_okD2)
	+ ultimately show ?case
	+ using proves_eq_combination_rule_better thy finite ctxt by simp
	+next
	+ case (appR s t u)
	+ hence ok: "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) s)"
	+ "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) u)"
	+ by (metis subst_bvs_App term_ok_app_eqD)+
	+ moreover have "\<forall>a \<in> set vs. case a of (x, \<tau>) \<Rightarrow> (x, \<tau>) \<notin> fv s \<union> FV \<Gamma>"
	+ using appR by simp
	+ ultimately have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) s)
	+ (subst_bvs (map (case_prod Fv) vs) t)"
	+ using appR.IH by blast
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) u)
	+ (subst_bvs (map (case_prod Fv) vs) u)"
	+ using proves_eq_reflexive[OF thy ok(2), of \<Gamma>, OF finite ctxt] by blast
	+ moreover obtain \<tau> where \<tau>: "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) s) = Some \<tau>"
	+ using ok wt_term_def by auto
	+ moreover obtain \<tau>' where "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) u) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using \<tau> appR.prems(1) not_None_eq subst_bvs_App wt_term_def typ_of1_arg_typ typ_of_def
	+ by (metis term_okD2)
	+ ultimately show ?case
	+ using proves_eq_combination_rule_better thy finite ctxt by simp
	+next
	+ case (abs s t T)
	+ have "\<forall>a \<in> set vs. case a of (x, \<tau>) \<Rightarrow> (x, \<tau>) \<notin> fv s \<union> FV \<Gamma>"
	+ using abs.prems(2) by auto
	+
	+ have "\<forall>v\<in>set (map (case_prod Fv) vs) . is_closed v"
	+ by auto
	+
	+ hence simp: "mk_eq (subst_bvs (map (case_prod Fv) vs) (Abs T s))
	+ (subst_bvs (map (case_prod Fv) vs) (Abs T t))
	+ = mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))"
	+ by simp
	+
	+ have T_ok: "typ_ok \<Theta> T"
	+ using abs.prems term_ok_Types_typ_ok simp thy by auto
	+
	+ have 1: "finite (fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))) \<union> FV \<Gamma> \<union> fv s)"
	+ using finite finite_fv finite_FV by simp
	+ hence "\<exists>x . (x,T) \<notin> (fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))) \<union> FV \<Gamma> \<union> fv s)"
	+ proof -
	+ have "\<And>v t P. (v, t) \<notin> P \<or> v \<in> fst ` P"
	+ by (metis (no_types) fst_conv image_eqI)
	+ then show ?thesis
	+ using 1 variant_variable_fresh finite_Un finite_imageI fst_conv image_eqI by smt
	+ qed
	+ from this
	+ obtain x where x: "(x,T) \<notin> (fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))) \<union> FV \<Gamma> \<union> fv s)"
	+ by fastforce
	+ hence x: "(x, T) \<notin> fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs))))"
	+ "(x,T) \<notin> FV \<Gamma>" "(x, T) \<notin> fv s"
	+ by auto
	+
	+ have ok: "term_ok \<Theta> (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))"
	+ using abs.prems(1) simp by auto
	+
	+
	+ thm subst_bvs_extend_lower_level
	+ have combine: "(subst_bv (term.Fv x T)
	+ (subst_bvs1' s 1 (map (\<lambda>(x, y). term.Fv x y) vs))) =
	+ (subst_bvs (map (case_prod Fv) ((x,T)#vs)) s)"
	+ using subst_bvs_extend_lower_level
	+ using \<open>\<forall>v\<in>set (map (\<lambda>(x, y). term.Fv x y) vs). is_closed v\<close> by auto
	+ have 1: "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) ((x,T)#vs)) s)
	+ (subst_bvs (map (case_prod Fv) ((x,T)#vs)) t)"
	+ apply(rule abs.IH)
	+ using ok apply (metis combine term_ok_subst_bv)
	+ using x abs.prems(2) by auto
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))"
	+ apply (rule proves_ascend_abs_rule'[where x=x])
	+ using thy apply simp
	+ using x apply simp
	+ using x apply simp
	+ using T_ok apply simp
	+ using 1 \<open>\<forall>v\<in>set (map (\<lambda>(x, y). term.Fv x y) vs). is_closed v\<close> subst_bvs_extend_lower_level
	+ finite ctxt by auto
	+ then show ?case
	+ using simp by auto
	+qed
	+
	+lemma subst_bvs_empty[simp]: "subst_bvs [] t = t"
	+ by (simp add: subst_bvs_subst_bvs1')
	+
	+lemma proves_beta_step:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "term_ok \<Theta> t"
	+ assumes beta: "t \<rightarrow>\<^sub>\<beta> u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t u"
	+proof-
	+ have unsimpt: "t = subst_bvs (map (case_prod Fv) []) t"
	+ by simp
	+ moreover have unsimpu: "u = subst_bvs (map (case_prod Fv) []) u"
	+ by simp
	+ ultimately have unsimp: "mk_eq t u = mk_eq
	+ (subst_bvs (map (case_prod Fv) []) t)
	+ (subst_bvs (map (case_prod Fv) []) u)"
	+ by simp
	+ show ?thesis
	+ apply (subst unsimp)
	+ apply (rule proves_beta_step_pre)
	+ using assms by simp_all
	+qed
	+
	+lemma proves_beta_steps:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "term_ok \<Theta> t"
	+ assumes beta: "t \<rightarrow>\<^sub>\<beta>\<^sup>* u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t u"
	+using beta term_ok proof (induction rule: rtranclp.induct)
	+ case (rtrancl_refl a)
	+ then show ?case using finite ctxt by (simp add: proves_eq_reflexive thy)
	+next
	+ case (rtrancl_into_rtrancl a b c)
	+ hence "\<Theta>,\<Gamma> \<turnstile> mk_eq a b" by simp
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> mk_eq b c"
	+ using proves_beta_step rtrancl_into_rtrancl.hyps(2)
	+ using beta_star_preserves_term_ok local.finite rtrancl_into_rtrancl.hyps(1)
	+ rtrancl_into_rtrancl.prems thy finite ctxt by blast
	+ ultimately show ?case
	+ by (meson finite ctxt proved_terms_well_formed(2) proves_eq_transitive_rule[OF thy _ _ _ _ _ _ _ finite ctxt]
	+ term_ok_mk_eqD term_ok_mk_eq_same_typ thy)
	+qed
	+
	+lemma proves_beta_norm:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "term_ok \<Theta> t"
	+ assumes beta: "beta_norm t = Some u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t u"
	+ using finite ctxt
	+ by (simp add: beta_norm_imp_beta_reds local.beta local.finite proves_beta_steps term_ok thy
	+ del: term_ok_def)
	+
	+lemma beta_norm_preserves_proves:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "\<Theta>, \<Gamma> \<turnstile> t"
	+ assumes beta: "beta_norm t = Some u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> u"
	+ using assms proves_eq_mp_rule_better[OF thy _ _ finite ctxt] proves_beta_norm[OF thy finite _ _ ctxt]
	+ proved_terms_well_formed(2)
	+ by blast
	+
	+lemma proves_eta_step_pre:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes free: "\<forall>(x,\<tau>) \<in> set vs . (x,\<tau>) \<notin> fv t \<union> FV \<Gamma>"
	+ assumes term_ok': "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) t)"
	+ assumes eta: "t \<rightarrow>\<^sub>\<eta> u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (subst_bvs (map (case_prod Fv) vs) t)
	+ (subst_bvs (map (case_prod Fv) vs) u)"
	+using eta term_ok' free proof(induction t u arbitrary: vs rule: eta.induct)
	+ case (eta s T)
	+
	+ have closeds: "\<forall>x \<in> set (map (case_prod Fv) vs) . is_closed x"
	+ using eta.prems(2) by auto
	+ hence simp: "subst_bvs (map (case_prod Fv) vs) (Abs T (s $ Bv 0))
	+ = Abs T (subst_bvs1' (s $ Bv 0) 1 (map (case_prod Fv) vs))"
	+ by auto
	+ hence simp': "subst_bvs (map (case_prod Fv) vs) (Abs T (s $ Bv 0))
	+ = Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs) $ Bv 0)"
	+ by auto
	+
	+ have closed: "is_closed (subst_bvs (map (case_prod Fv) vs) (Abs T (s $ Bv 0)))"
	+ using eta(2) wt_term_def typ_of_imp_closed by auto
	+ hence no_loose1: "\<not> loose_bvar (subst_bvs1' s 1 (map (case_prod Fv) vs)) 1"
	+ unfolding is_open_def
	+ by (metis One_nat_def Suc_eq_plus1 loose_bvar.simps(2) loose_bvar.simps(3) simp subst_bvs1'.simps(3))
	+ have not_dependent: "\<not> is_dependent (subst_bvs1' s 1 (map (case_prod Fv) vs))"
	+ using is_closed_subst_bvs1'_closeds
	+ by (simp add: closeds eta.hyps)
	+
	+ have decr_simp: "subst_bv x (subst_bvs1' s 1 (map (case_prod Fv) vs))
	+ = subst_bvs (map (case_prod Fv) vs) (decr 0 s)" for x
	+ apply (simp add: closeds eta.hyps subst_bvs_decr)
	+ using is_dependent_def no_loose_bvar1_subst_bv2_decr not_dependent substn_subst_0' by auto
	+ have ok: "term_ok \<Theta> (subst_bvs1' s 1 (map (case_prod Fv) vs))"
	+ by (metis One_nat_def Suc_leI eta.prems(1) is_dependent_def le_eq_less_or_eq
	+ loose_bvar_decr_unchanged loose_bvar_iff_exist_loose_bvar1 no_loose1 not_dependent simp'
	+ term_ok_eta_red_step)
	+ hence ok_ind: "wf_term (sig \<Theta>) (subst_bvs1' s 1 (map (case_prod Fv) vs))"
	+ using wt_term_def by simp
	+
	+ obtain \<tau> where "typ_of (Abs T (subst_bvs1' (s $ Bv 0) 1 (map (case_prod Fv) vs))) = Some (T \<rightarrow> \<tau>)"
	+ using eta.prems(1) simp wt_term_def typ_of_Abs_body_typ'
	+ by (smt has_typ_iff_typ_of typ_of_def term_ok_def)
	+ hence ty: "typ_of (subst_bvs1' s 1 (map (case_prod Fv) vs)) = Some (T \<rightarrow> \<tau>)"
	+ using eta.eta eta_preserves_typ_of is_closed_decr_unchanged not_dependent
	+ ok simp simp' wt_term_def typ_of_imp_closed
	+ by (metis (no_types, lifting) has_typ_imp_closed term_ok_def)
	+
	+ then show ?case
	+ using proves.eta[OF thy ok_ind, of _ _ \<Gamma>] ty decr_simp simp'
	+ by (simp add: closeds eta.hyps subst_bvs_decr typ_of_imp_closed)
	+next
	+ case (appL s t u)
	+ hence ok: "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) s)"
	+ "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) u)"
	+ by (metis subst_bvs_App term_ok_app_eqD)+
	+ moreover have "\<forall>a \<in> set vs. case a of (x, \<tau>) \<Rightarrow> (x, \<tau>) \<notin> fv s \<union> FV \<Gamma>"
	+ using appL by simp
	+ ultimately have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) s)
	+ (subst_bvs (map (case_prod Fv) vs) t)"
	+ using appL.IH by blast
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) u)
	+ (subst_bvs (map (case_prod Fv) vs) u)"
	+ using proves_eq_reflexive[OF thy ok(2), of \<Gamma>, OF finite ctxt] by blast
	+ moreover obtain \<tau> where \<tau>: "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) u) = Some \<tau>"
	+ using ok wt_term_def by auto
	+ moreover obtain \<tau>' where "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) s) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using \<tau> appL.prems(1) not_None_eq subst_bvs_App wt_term_def typ_of1_arg_typ typ_of_def
	+ by (smt has_typ_iff_typ_of typ_of_def term_ok_def)
	+ ultimately show ?case
	+ using proves_eq_combination_rule_better thy finite ctxt by simp
	+next
	+ case (appR s t u)
	+ hence ok: "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) s)"
	+ "term_ok \<Theta> (subst_bvs (map (case_prod Fv) vs) u)"
	+ by (metis subst_bvs_App term_ok_app_eqD)+
	+ moreover have "\<forall>a \<in> set vs. case a of (x, \<tau>) \<Rightarrow> (x, \<tau>) \<notin> fv s \<union> FV \<Gamma>"
	+ using appR by simp
	+ ultimately have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) s)
	+ (subst_bvs (map (case_prod Fv) vs) t)"
	+ using appR.IH by blast
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) vs) u)
	+ (subst_bvs (map (case_prod Fv) vs) u)"
	+ using proves_eq_reflexive[OF thy ok(2), of \<Gamma>, OF finite ctxt] by blast
	+ moreover obtain \<tau> where \<tau>: "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) s) = Some \<tau>"
	+ using ok wt_term_def by auto
	+ moreover obtain \<tau>' where "typ_of
	+ (subst_bvs (map (case_prod Fv) vs) u) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using \<tau> appR.prems(1) not_None_eq subst_bvs_App wt_term_def typ_of1_arg_typ typ_of_def
	+ by (metis term_okD2)
	+ ultimately show ?case
	+ using proves_eq_combination_rule_better thy finite ctxt by simp
	+next
	+ case (abs s t T)
	+ have "\<forall>a \<in> set vs. case a of (x, \<tau>) \<Rightarrow> (x, \<tau>) \<notin> fv s \<union> FV \<Gamma>"
	+ using abs.prems(2) by auto
	+
	+ have "\<forall>v\<in>set (map (case_prod Fv) vs) . is_closed v"
	+ by auto
	+
	+ hence simp: "mk_eq (subst_bvs (map (case_prod Fv) vs) (Abs T s))
	+ (subst_bvs (map (case_prod Fv) vs) (Abs T t))
	+ = mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))"
	+ by simp
	+
	+ have T_ok: "typ_ok \<Theta> T"
	+ using abs.prems term_ok_Types_typ_ok simp thy by auto
	+
	+ have 1: "finite (fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))) \<union> FV \<Gamma> \<union> fv s)"
	+ using finite finite_fv finite_FV by simp
	+ hence "\<exists>x . (x,T) \<notin> (fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))) \<union> FV \<Gamma> \<union> fv s)"
	+ proof -
	+ have "\<And>v t P. (v::variable, t::typ) \<notin> P \<or> v \<in> fst ` P"
	+ by (metis (no_types) fst_conv image_eqI)
	+ then show ?thesis
	+ using 1 variant_variable_fresh finite_Un finite_imageI fst_conv image_eqI
	+ by smt
	+ qed
	+ from this
	+ obtain x where x: "(x,T) \<notin> (fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))) \<union> FV \<Gamma> \<union> fv s)"
	+ by fastforce
	+ hence x: "(x, T) \<notin> fv (mk_eq (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs))))"
	+ "(x,T) \<notin> FV \<Gamma>" "(x, T) \<notin> fv s"
	+ by auto
	+
	+ have ok: "term_ok \<Theta> (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))"
	+ using abs.prems(1) simp by auto
	+
	+ have combine: "(subst_bv (Fv x T)
	+ (subst_bvs1' s 1 (map (case_prod Fv) vs))) =
	+ (subst_bvs (map (case_prod Fv) ((x,T)#vs)) s)"
	+ using subst_bvs_extend_lower_level
	+ using \<open>\<forall>v\<in>set (map (\<lambda>(x, y). term.Fv x y) vs). is_closed v\<close> by auto
	+ have 1: "\<Theta>,\<Gamma> \<turnstile> mk_eq (subst_bvs (map (case_prod Fv) ((x,T)#vs)) s)
	+ (subst_bvs (map (case_prod Fv) ((x,T)#vs)) t)"
	+ apply(rule abs.IH)
	+ using ok combine apply (metis term_ok_subst_bv)
	+ using x abs.prems(2) by auto
	+ have "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Abs T (subst_bvs1' s 1 (map (case_prod Fv) vs)))
	+ (Abs T (subst_bvs1' t 1 (map (case_prod Fv) vs)))"
	+ apply (rule proves_ascend_abs_rule'[where x=x])
	+ using thy apply simp
	+ using x apply simp
	+ using x apply simp
	+ using T_ok apply simp
	+ using 1 \<open>\<forall>v\<in>set (map (\<lambda>(x, y). term.Fv x y) vs). is_closed v\<close> subst_bvs_extend_lower_level
	+ finite ctxt by auto
	+ then show ?case
	+ using simp by auto
	+qed
	+
	+lemma proves_eta_step:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "term_ok \<Theta> t"
	+ assumes eta: "t \<rightarrow>\<^sub>\<eta> u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t u"
	+proof-
	+ have unsimpt: "t = subst_bvs (map (case_prod Fv) []) t"
	+ by simp
	+ moreover have unsimpu: "u = subst_bvs (map (case_prod Fv) []) u"
	+ by simp
	+ ultimately have unsimp: "mk_eq t u = mk_eq
	+ (subst_bvs (map (case_prod Fv) []) t)
	+ (subst_bvs (map (case_prod Fv) []) u)"
	+ by simp
	+ show ?thesis
	+ apply (subst unsimp)
	+ apply (rule proves_eta_step_pre)
	+ using assms by simp_all
	+qed
	+
	+lemma proves_eta_steps:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "term_ok \<Theta> t"
	+ assumes eta: "t \<rightarrow>\<^sub>\<eta>\<^sup>* u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t u"
	+using eta term_ok proof (induction rule: rtranclp.induct)
	+ case (rtrancl_refl a)
	+ then show ?case using finite ctxt by (simp add: proves_eq_reflexive thy)
	+next
	+ case (rtrancl_into_rtrancl a b c)
	+ hence "\<Theta>,\<Gamma> \<turnstile> mk_eq a b" by simp
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> mk_eq b c"
	+ using proves_eta_step rtrancl_into_rtrancl.hyps(2) eta_star_preserves_term_ok local.finite
	+ rtrancl_into_rtrancl.hyps(1) rtrancl_into_rtrancl.prems thy finite ctxt
	+ by blast
	+ ultimately show ?case
	+ by (meson proved_terms_well_formed(2) proves_eq_transitive_rule[OF thy _ _ _ _ _ _ _ finite ctxt]
	+ term_ok_mk_eqD term_ok_mk_eq_same_typ thy)
	+qed
	+
	+lemma proves_eta_norm:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "term_ok \<Theta> t"
	+ assumes eta: "eta_norm t = u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> mk_eq t u"
	+ using finite ctxt
	+ by (simp add: eta_norm_imp_eta_reds local.eta local.finite proves_eta_steps term_ok thy del: term_ok_def)
	+
	+lemma eta_norm_preserves_proves:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "\<Theta>, \<Gamma> \<turnstile> t"
	+ assumes eta: "eta_norm t = u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> u"
	+ using assms proves_eq_mp_rule_better[OF thy _ _ finite ctxt]
	+ proves_eta_norm[OF thy finite _ _ ctxt] proved_terms_well_formed(2) by blast
	+
	+lemma beta_eta_norm_preserves_proves:
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes finite: "finite \<Gamma>"
	+ assumes term_ok: "\<Theta>, \<Gamma> \<turnstile> t"
	+ assumes beta_eta: "beta_eta_norm t = Some u"
	+ assumes ctxt: "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> u"
	+ using beta_eta beta_norm_preserves_proves[OF thy finite _ _ ctxt]
	+ eta_norm_preserves_proves[OF thy finite _ _ ctxt] finite term_ok thy by blast
	+
	+lemma forall_elim':
	+ assumes thy: "wf_theory \<Theta>"
	+ assumes all: "\<Theta>, \<Gamma> \<turnstile> Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ B"
	+ assumes a: "has_typ a \<tau>" "wf_term (sig \<Theta>) a"
	+ assumes ctxt: "finite \<Gamma>" "\<forall>A\<in>\<Gamma>. term_ok \<Theta> A" "\<forall>A\<in>\<Gamma>. typ_of A = Some propT"
	+ shows "\<Theta>, \<Gamma> \<turnstile> B \<bullet> a"
	+proof(cases "is_Abs B")
	+ case True
	+ from this obtain t T where Abs: "B = Abs T t"
	+ using is_Abs_def by auto
	+ have "T = \<tau>"
	+ by (smt Abs all list.inject proved_terms_well_formed(1) typ.inject(1) typ_of1.simps(1)
	+ typ_of_Abs_body_typ' typ_of_def typ_of_fun)
	+ then show ?thesis
	+ using True Abs all a by (auto intro: forall_elim[where \<tau>=\<tau>])
	+next
	+ case False
	+
	+ have wf_B: "wf_term (sig \<Theta>) B"
	+ using all proved_terms_well_formed(2) term_okD1 term_ok_app_eqD by blast
	+ have B_typ: "\<turnstile>\<^sub>\<tau> B : \<tau> \<rightarrow> propT"
	+ by (metis (no_types, lifting) all proved_terms_well_formed(1) typ_of1.simps(1) typ_of_def
	+ typ_of_fun typ_of_imp_has_typ)
	+
	+ have "B \<bullet> a = B $ a"
	+ using False by (metis betapply.elims term.discI(4))
	+ moreover have "Abs \<tau> (B $ Bv 0) \<bullet> a = B $ a"
	+ using B_typ closed_subst_bv_no_change subst_bv_def typ_of_imp_closed
	+ by (auto simp add: subst_bv_def incr_boundvars_def)
	+ ultimately have simp: "B \<bullet> a = subst_bv a (B $ Bv 0)"
	+ by auto
	+
	+ have 1: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Abs \<tau> (B $ Bv 0)) B"
	+ by (rule proves.eta[OF thy wf_B B_typ])
	+ have 2: "\<Theta>, \<Gamma> \<turnstile> mk_eq B (Abs \<tau> (B $ Bv 0))"
	+ apply (rule proves_eq_symmetric_rule[OF thy _ _ _ 1 ctxt])
	+ using wf_B B_typ term_ok_def wt_term_def apply blast
	+ using 1 proved_terms_well_formed(2) term_ok_mk_eqD apply blast
	+ using B_typ Logic.typ_of_eta_expand by auto
	+ have 3: "\<Theta>, \<Gamma> \<turnstile> mk_eq (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT)) (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT))"
	+ apply (rule proves_eq_reflexive[OF thy _ ctxt])
	+ using all proved_terms_well_formed(2) term_ok_app_eqD by blast
	+
	+ have 4: "\<Theta>, \<Gamma> \<turnstile> mk_eq
	+ (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ B)
	+ (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ (Abs \<tau> (B $ Bv 0)))"
	+ apply (rule proves_eq_combination_rule_better[OF thy 3 2 _ _ ctxt, where \<tau>="(\<tau> \<rightarrow> propT)" and \<tau>'= propT])
	+ using typ_of_def apply auto[1]
	+ using B_typ by blast
	+
	+ have 5: "\<Theta>, \<Gamma> \<turnstile> (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ (Abs \<tau> (B $ Bv 0)))"
	+ by (rule proves_eq_mp_rule_better[OF thy 4 all ctxt])
	+
	+ show ?thesis
	+ apply (subst simp)
	+ apply (rule proves.forall_elim[OF 5])
	+ using assms(3) apply blast
	+ using assms(4) by blast
	+ qed
	+end
	diff --git a/thys/Metalogic_ProofChecker/EtaNorm.thy b/thys/Metalogic_ProofChecker/EtaNorm.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/EtaNorm.thy
	@@ -0,0 +1,248 @@
	+section "Eta Normalization"
	+
	+theory EtaNorm
	+ imports Term BetaNorm
	+begin
	+(* Again from Lambda calculus from @{dir "~~/src/HOL/Proofs/Lambda"} and modified*)
	+
	+inductive
	+ eta :: "term \<Rightarrow> term \<Rightarrow> bool" (infixl "\<rightarrow>\<^sub>\<eta>" 50)
	+where
	+ eta [simp, intro]: "\<not> is_dependent s \<Longrightarrow> Abs T (s $ Bv 0) \<rightarrow>\<^sub>\<eta> decr 0 s"
	+ \| appL [simp, intro]: "s \<rightarrow>\<^sub>\<eta> t \<Longrightarrow> s $ u \<rightarrow>\<^sub>\<eta> t $ u"
	+ \| appR [simp, intro]: "s \<rightarrow>\<^sub>\<eta> t \<Longrightarrow> u $ s \<rightarrow>\<^sub>\<eta> u $ t"
	+ \| abs [simp, intro]: "s \<rightarrow>\<^sub>\<eta> t \<Longrightarrow> Abs T s \<rightarrow>\<^sub>\<eta> Abs T t"
	+
	+abbreviation
	+ eta_reds :: "term \<Rightarrow> term \<Rightarrow> bool" (infixl "\<rightarrow>\<^sub>\<eta>\<^sup>*" 50) where
	+ "s \<rightarrow>\<^sub>\<eta>\<^sup>* t \<equiv> eta\<^sup>\<^sup> s t"
	+
	+abbreviation
	+ eta_red0 :: "term \<Rightarrow> term \<Rightarrow> bool" (infixl "\<rightarrow>\<^sub>\<eta>\<^sup>=" 50) where
	+ "s \<rightarrow>\<^sub>\<eta>\<^sup>= t \<equiv> eta\<^sup>=\<^sup>= s t"
	+
	+inductive_cases eta_cases [elim!]:
	+ "Abs T s \<rightarrow>\<^sub>\<eta> z"
	+ "s $ t \<rightarrow>\<^sub>\<eta> u"
	+ "Bv i \<rightarrow>\<^sub>\<eta> t"
	+
	+lemma subst_bv2_not_free [simp]: "\<not> loose_bvar1 s i \<Longrightarrow> subst_bv2 s i t = subst_bv2 s i u"
	+ by (induction s arbitrary: i t u) (simp_all add:)
	+
	+lemma free_lift [simp]:
	+ "loose_bvar1 (lift t k) i = (i < k \<and> loose_bvar1 t i \<or> k < i \<and> loose_bvar1 t (i - 1))"
	+ by (induct t arbitrary: i k) (auto cong: conj_cong)
	+
	+lemma free_subst_bv2 [simp]:
	+ "loose_bvar1 (subst_bv2 s k t) i =
	+ (loose_bvar1 s k \<and> loose_bvar1 t i \<or> loose_bvar1 s (if i < k then i else i + 1))"
	+ apply (induct s arbitrary: i k t)
	+ using free_lift apply (simp_all add: diff_Suc split: nat.split)
	+ by blast
	+
	+lemma free_eta: "s \<rightarrow>\<^sub>\<eta> t \<Longrightarrow> loose_bvar1 t i = loose_bvar1 s i"
	+ apply (induct arbitrary: i set: eta)
	+ apply (simp_all cong: conj_cong)
	+ using is_dependent_def loose_bvar1_decr''' loose_bvar1_decr'''' by blast
	+
	+lemma not_free_eta:
	+ "s \<rightarrow>\<^sub>\<eta> t \<Longrightarrow> \<not> loose_bvar1 s i \<Longrightarrow> \<not> loose_bvar1 t i"
	+ by (simp add: free_eta)
	+
	+lemma no_loose_bvar1_subst_bv2_decr: "\<not> loose_bvar1 t i \<Longrightarrow> subst_bv2 t i x = decr i t"
	+ by (induction t i x rule: subst_bv2.induct) auto
	+
	+lemma eta_subst_bv2 [simp]:
	+ "s \<rightarrow>\<^sub>\<eta> t \<Longrightarrow> subst_bv2 s i u \<rightarrow>\<^sub>\<eta> subst_bv2 t i u"
	+proof (induction s t arbitrary: u i rule: eta.induct)
	+ case (eta s T)
	+ hence 1: "\<not> loose_bvar1 s 0"
	+ using is_dependent_def by simp
	+ have "decr 0 s = subst_bv2 s 0 dummy" for dummy
	+ using no_loose_bvar1_subst_bv2_decr[symmetric, OF 1, of dummy] .
	+ from this obtain dummy where dummy: "decr 0 s = subst_bv2 s 0 dummy"
	+ by simp
	+
	+ show ?case
	+ using 1 apply (simp add: dummy subst_bv2_subst_bv2 [symmetric])
	+ using free_lift is_dependent_def no_loose_bvar1_subst_bv2_decr by auto
	+qed auto
	+
	+theorem lift_subst_bv2_dummy: "\<not> loose_bvar s i \<Longrightarrow> lift (decr i s) i = s"
	+ by (induct s arbitrary: i) simp_all
	+
	+lemma decr_is_closed[simp]: "is_closed t \<Longrightarrow> decr lev t = t"
	+ by (metis is_open_def lift_subst_bv2_dummy lift_def loose_bvar_Suc loose_bvar_incr_bvar no_loose_bvar_no_incr zero_induct)
	+
	+lemma eta_reducible_imp_eta_step: "eta_reducible t \<Longrightarrow> \<exists>t'. t \<rightarrow>\<^sub>\<eta> t'"
	+ by (induction t rule: eta_reducible.induct) auto
	+
	+lemma eta_step_imp_eta_reducible: "t \<rightarrow>\<^sub>\<eta> t' \<Longrightarrow> eta_reducible t"
	+proof (induction t t' rule: eta.induct)
	+ case (abs s t T)
	+ show ?case
	+ proof(cases s)
	+ case (App u v)
	+ then show ?thesis by (cases v; use abs eta_reducible_Abs in metis)
	+ qed (use abs in auto)
	+qed auto
	+
	+lemma eta_reds_appR: "s \<rightarrow>\<^sub>\<eta>\<^sup>* t \<Longrightarrow> u $ s \<rightarrow>\<^sub>\<eta>\<^sup>* u $ t"
	+ by (induction s t rule: rtranclp.induct) (auto simp add: rtranclp.rtrancl_into_rtrancl)
	+lemma eta_reds_appL: "s \<rightarrow>\<^sub>\<eta>\<^sup>* t \<Longrightarrow> s $ u \<rightarrow>\<^sub>\<eta>\<^sup>* t $ u"
	+ by (induction s t rule: rtranclp.induct) (auto simp add: rtranclp.rtrancl_into_rtrancl)
	+lemma eta_reds_abs: "s \<rightarrow>\<^sub>\<eta>\<^sup>* t \<Longrightarrow> Abs T s \<rightarrow>\<^sub>\<eta>\<^sup>* Abs T t"
	+ by (induction s t rule: rtranclp.induct) (auto simp add: rtranclp.rtrancl_into_rtrancl)
	+
	+lemma eta_norm_imp_eta_reds: assumes "eta_norm t = t'" shows "t \<rightarrow>\<^sub>\<eta>\<^sup>* t'"
	+using assms proof (induction t arbitrary: t' rule: eta_norm.induct)
	+ case (1 T body)
	+ then show ?case
	+ proof (cases "eta_norm body")
	+ case (App f u)
	+ then show ?thesis
	+ using 1 apply (clarsimp simp add: is_dependent_def eta_reds_abs split: term.splits nat.splits if_splits)
	+ by (metis eta.eta eta_reds_abs eta_reducible.simps(11) is_dependent_def
	+ not_eta_reducible_eta_norm not_eta_reducible_imp_eta_norm_no_change rtranclp.simps)
	+ qed (auto simp add: is_dependent_def eta_reds_abs split: term.splits nat.splits if_splits)
	+next
	+ case (2 f u)
	+ hence "f \<rightarrow>\<^sub>\<eta>\<^sup>* eta_norm f" "u \<rightarrow>\<^sub>\<eta>\<^sup>* eta_norm u"
	+ by simp_all
	+ then show ?case using 2
	+ by (metis eta_norm.simps(2) eta_reds_appL eta_reds_appR rtranclp_trans)
	+qed auto
	+
	+lemma rtrancl_eta_App:
	+ "s \<rightarrow>\<^sub>\<eta>\<^sup>* s' \<Longrightarrow> t \<rightarrow>\<^sub>\<eta>\<^sup>* t' \<Longrightarrow> s $ t \<rightarrow>\<^sub>\<eta>\<^sup>* s' $ t'"
	+ by (blast intro!: eta_reds_appR eta_reds_appL intro: rtranclp_trans)
	+
	+lemma eta_preserves_typ_of1: "t \<rightarrow>\<^sub>\<eta> t' \<Longrightarrow> typ_of1 Ts t = Some \<tau> \<Longrightarrow> typ_of1 Ts t' = Some \<tau>"
	+proof (induction Ts t arbitrary: \<tau> t' rule: typ_of1.induct)
	+ case (1 uu uv T)
	+ then show ?case
	+ using eta_step_imp_eta_reducible by fastforce
	+next
	+ case (2 Ts i)
	+ then show ?case
	+ using eta_step_imp_eta_reducible by fastforce
	+next
	+ case (3 uw ux T)
	+ then show ?case
	+ using eta_step_imp_eta_reducible by fastforce
	+next
	+ case (4 Ts T body)
	+ then show ?case
	+ proof(cases body)
	+ case (Abs B b)
	+ then show ?thesis using 4
	+ by (metis eta_cases(1) term.distinct(19) typ_of1.simps(4) typ_of_Abs_body_typ')
	+ next
	+ case (App u v)
	+ note oApp = App
	+ then show ?thesis
	+ proof(cases "is_dependent u")
	+ case True
	+ then show ?thesis
	+ by (metis "4.IH" "4.prems"(1) "4.prems"(2) App eta_cases(1) term.inject(5)
	+ typ_of1.simps(4) typ_of_Abs_body_typ')
	+ next
	+ case False
	+ then show ?thesis
	+ proof(cases v)
	+ case (Ct n T)
	+ then show ?thesis
	+ using 4 oApp False typ_of_Abs_body_typ'
	+ by (metis eta_cases(1) term.distinct(3) term.inject(5) typ_of1.simps(4))
	+ next
	+ case (Fv n T)
	+ then show ?thesis
	+ using 4 oApp False typ_of_Abs_body_typ'
	+ by (metis eta_cases(1) term.distinct(9) term.inject(5) typ_of1.simps(4))
	+ next
	+ case (Bv n)
	+ then show ?thesis
	+ proof(cases n)
	+ case 0 thm 4
	+ show ?thesis
	+ proof(cases rule: eta_cases(1)[OF "4.prems"(1)])
	+ case (1 s)
	+ thm "4"(3)
	+ obtain rty where "typ_of1 (T#Ts) (s $ Bv 0) = Some (rty)"
	+ using typ_of_Abs_body_typ'[OF "4"(3)] "1"(3) "1"(1) by blast
	+ moreover have "\<tau> = T \<rightarrow> rty"
	+ by (metis "1"(1) "4.prems"(2) calculation option.inject typ_of_Abs_body_typ')
	+ ultimately have "typ_of1 (T#Ts) s = Some \<tau>"
	+ using typ_of1_arg_typ
	+ by (metis length_Cons nth_Cons_0 typ_of1.simps(2) zero_less_Suc)
	+ hence "typ_of1 Ts (decr 0 s) = Some \<tau>"
	+ by (metis "1"(3) append_Cons append_Nil is_dependent_def list.size(3) typ_of1_decr)
	+ then show ?thesis
	+ using 1 oApp False typ_of_Abs_body_typ' Bv 0 by auto
	+ next
	+ case (2 t)
	+ then show ?thesis
	+ using oApp False typ_of_Abs_body_typ' Bv 0
	+ by (metis "4.IH" "4.prems"(2) typ_of1.simps(4))
	+ qed
	+ next
	+ case (Suc nat)
	+ then show ?thesis
	+ using 4 oApp False typ_of_Abs_body_typ' Bv
	+ apply -
	+ apply (rule eta_cases(1)[of T body t'])
	+ apply blast
	+ apply blast
	+ apply (metis "4.IH" "4.prems"(2) typ_of1.simps(4))
	+ done
	+ qed
	+ next
	+ case (Abs T t)
	+ then show ?thesis
	+ using 4 oApp False typ_of_Abs_body_typ'
	+ (* Help metis a bit *)
	+ apply -
	+ apply (erule eta.cases(1))
	+ by (metis term.distinct(15) term.distinct(19) term.inject(4) term.inject(5)
	+ typ_of1.simps(4))+
	+ next
	+ case (App f u)
	+ then show ?thesis
	+ using 4 oApp False typ_of_Abs_body_typ'
	+ by (metis eta_cases(1) term.distinct(17) term.inject(5) typ_of1.simps(4))
	+ qed
	+ qed
	+ qed (use 4 in auto)
	+next
	+ case (5 Ts f u)
	+ then show ?case
	+ by (smt bind.bind_lunit eta_cases(2) typ_of1.simps(5) typ_of1_split_App_obtains)
	+qed
	+
	+lemma eta_preserves_typ_of: "t \<rightarrow>\<^sub>\<eta> t' \<Longrightarrow> typ_of t = Some \<tau> \<Longrightarrow> typ_of t' = Some \<tau>"
	+ using eta_preserves_typ_of1 typ_of_def by simp
	+
	+
	+lemma eta_star_preserves_typ_of1: "r \<rightarrow>\<^sub>\<eta>\<^sup>* s \<Longrightarrow> typ_of1 Ts r = Some T \<Longrightarrow> typ_of1 Ts s = Some T"
	+proof (induction rule: rtranclp.induct)
	+ case (rtrancl_refl a)
	+ then show ?case
	+ by simp
	+next
	+ case (rtrancl_into_rtrancl a b c)
	+ then show ?case
	+ using eta_preserves_typ_of1 by blast
	+qed
	+
	+lemma eta_star_preserves_typ_of: "r \<rightarrow>\<^sub>\<eta>\<^sup>* s \<Longrightarrow> typ_of r = Some T \<Longrightarrow> typ_of s = Some T"
	+ using eta_star_preserves_typ_of1 typ_of_def by simp
	+
	+lemma subst_bvs1'_decr: "\<forall>x\<in>set us. is_closed x \<Longrightarrow> \<not> loose_bvar1 t k
	+ \<Longrightarrow> subst_bvs1' (decr k t) k us = decr k (subst_bvs1' t (Suc k) us)"
	+ by (induction k t arbitrary: us rule: decr.induct) (auto simp add: is_open_def)
	+
	+lemma subst_bvs_decr: "\<forall>x\<in>set us. is_closed x \<Longrightarrow> \<not> is_dependent t
	+ \<Longrightarrow> subst_bvs us (decr 0 t) = decr 0 (subst_bvs1' t 1 us)"
	+ by (simp add: is_dependent_def subst_bvs1'_decr subst_bvs_subst_bvs1')
	+
	+end
	diff --git a/thys/Metalogic_ProofChecker/EtaNormProof.thy b/thys/Metalogic_ProofChecker/EtaNormProof.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/EtaNormProof.thy
	@@ -0,0 +1,63 @@
	+
	+text\<open>Facts about eta normalization involving theories\<close>
	+
	+theory EtaNormProof
	+ imports EtaNorm Theory
	+ (* This means I need to restructure *)
	+ BetaNormProof
	+begin
	+
	+lemma term_ok'_decr: "term_ok' \<Sigma> t \<Longrightarrow> term_ok' \<Sigma> (decr i t)"
	+ by (induction i t rule: decr.induct) auto
	+
	+lemma eta_preserves_term_ok': "term_ok' \<Sigma> r \<Longrightarrow> r \<rightarrow>\<^sub>\<eta> s \<Longrightarrow> term_ok' \<Sigma> s"
	+proof (induction r arbitrary: s)
	+ case (Ct n T)
	+ then show ?case
	+ apply (simp add: tinstT_def split: option.splits)
	+ (* Seems like I miss a simp rule for Ct*)
	+ using eta_reducible.simps(12) eta_step_imp_eta_reducible by blast
	+next
	+ case (Fv n T)
	+ then show ?case
	+ using eta.cases
	+ by blast
	+next
	+ case (Bv n)
	+ then show ?case
	+ by auto
	+next
	+ case (Abs R r)
	+ then show ?case
	+ using eta.cases
	+ by (fastforce simp add: term_ok'_decr)
	+next
	+ case (App f u)
	+ then show ?case
	+ apply -
	+ apply (erule eta_cases(2))
	+ using term_ok'.simps(4) by blast+
	+qed
	+
	+lemma eta_preserves_term_ok: "term_ok \<Theta> r \<Longrightarrow> r \<rightarrow>\<^sub>\<eta> s \<Longrightarrow> term_ok \<Theta> s"
	+proof -
	+ assume a1: "term_ok \<Theta> r"
	+ assume a2: "r \<rightarrow>\<^sub>\<eta> s"
	+ then have "None \<noteq> typ_of1 [] s"
	+ using a1 eta_preserves_typ_of1 option.collapse wt_term_def typ_of_def
	+ by auto
	+ then show ?thesis
	+ using a2 a1 eta_preserves_term_ok' wt_term_def typ_of_def wf_term_iff_term_ok' term_ok_def
	+ by (meson eta_preserves_typ_of has_typ_iff_typ_of)
	+qed
	+
	+lemma eta_star_preserves_term_ok': "r \<rightarrow>\<^sub>\<eta>\<^sup>* s \<Longrightarrow> term_ok' \<Sigma> r \<Longrightarrow> term_ok' \<Sigma> s"
	+ by (induction rule: rtranclp.induct) (auto simp add: eta_preserves_term_ok')
	+
	+corollary eta_star_preserves_term_ok: "r \<rightarrow>\<^sub>\<eta>\<^sup>* s \<Longrightarrow> term_ok thy r \<Longrightarrow> term_ok thy s"
	+ using eta_star_preserves_term_ok' eta_star_preserves_typ_of1 wt_term_def typ_of_def by auto
	+
	+corollary term_ok_eta_norm: "term_ok thy t \<Longrightarrow> eta_norm t = t'\<Longrightarrow> term_ok thy t'"
	+ using eta_norm_imp_eta_reds eta_star_preserves_term_ok by blast
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Instances.thy b/thys/Metalogic_ProofChecker/Instances.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Instances.thy
	@@ -0,0 +1,992 @@
	+section "Executable Instance Relations"
	+
	+theory Instances
	+ imports Term
	+begin
	+
	+(*
	+ Executable versions for the following definitions
	+
	+ Do by computing such a \<rho>
	+
	+ First using partial functions, then with alists
	+
	+ definition "tinstT T1 T2 \<equiv> \<exists>\<rho>. tsubstT T2 \<rho> = T1"
	+ definition "tinst t1 t2 \<equiv> \<exists>\<rho>. tsubst t2 \<rho> = t1"
	+ definition "inst t1 t2 \<equiv> \<exists>\<rho>. subst t2 \<rho> = t1"
	+*)
	+
	+(* Straight forward code translation from ML code in distribution *)
	+fun raw_match :: "typ \<Rightarrow> typ \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option"
	+ and raw_matches :: "typ list \<Rightarrow> typ list \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option"
	+ where
	+ "raw_match (Tv v S) T subs =
	+ (case subs (v,S) of
	+ None \<Rightarrow> Some (subs((v,S) := Some T))
	+ \| Some U \<Rightarrow> (if U = T then Some subs else None))"
	+\| "raw_match (Ty a Ts) (Ty b Us) subs =
	+ (if a=b then raw_matches Ts Us subs else None)"
	+\| "raw_match _ _ _ = None"
	+\| "raw_matches (T#Ts) (U#Us) subs = Option.bind (raw_match T U subs) (raw_matches Ts Us)"
	+\| "raw_matches [] [] subs = Some subs"
	+\| "raw_matches _ _ subs = None"
	+
	+(* Probably easier to use *)
	+function (sequential) raw_match'
	+ :: "typ \<Rightarrow> typ \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option" where
	+ "raw_match' (Tv v S) T subs =
	+ (case subs (v,S) of
	+ None \<Rightarrow> Some (subs((v,S) := Some T))
	+ \| Some U \<Rightarrow> (if U = T then Some subs else None))"
	+\| "raw_match' (Ty a Ts) (Ty b Us) subs =
	+ (if a=b \<and> length Ts = length Us
	+ then fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip Ts Us) (Some subs)
	+ else None)"
	+\| "raw_match' T U subs = (if T = U then Some subs else None)"
	+ by pat_completeness auto
	+termination proof (relation "measure (\<lambda>(T, U, subs) . size T + size U)", goal_cases)
	+ case 1
	+ then show ?case
	+ by auto
	+next
	+ case (2 a Ts b Us subs x xa y xb aa)
	+ hence "length Ts = length Us" "a=b"
	+ by auto
	+ from this 2(2-) show ?case
	+ by (induction Ts Us rule: list_induct2) auto
	+qed
	+
	+lemma length_neq_imp_not_raw_matches: "length Ts \<noteq> length Us \<Longrightarrow> raw_matches Ts Us subs = None"
	+ by (induction Ts Us subs rule: raw_match_raw_matches.induct(2) [where P = "\<lambda>T U subs . True"])
	+ (auto cong: Option.bind_cong)
	+
	+(* Making sure I did not mess up my version of the definition *)
	+lemma "raw_match T U subs = raw_match' T U subs"
	+proof (induction T U subs rule: raw_match_raw_matches.induct(1)
	+ [where Q = "\<lambda>Ts Us subs . raw_matches Ts Us subs
	+ = (if length Ts = length Us
	+ then fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip Ts Us) (Some subs)
	+ else None)"])
	+ case (4 T Ts U Us subs)
	+ then show ?case
	+ proof (cases "raw_match T U subs")
	+ case None
	+ then show ?thesis
	+ proof (cases "length Ts = length Us")
	+ case True
	+ then show ?thesis using 4 None by (induction Ts Us rule: list_induct2) auto
	+ next
	+ case False
	+ then show ?thesis using 4 None length_neq_imp_not_raw_matches by auto
	+ qed
	+ next
	+ case (Some a)
	+ then show ?thesis using 4 by auto
	+ qed
	+qed simp_all
	+
	+lemma raw_match'_map_le: "raw_match' T U subs = Some subs' \<Longrightarrow> map_le subs subs'"
	+proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
	+ case (2 a Ts b Us subs)
	+ have "length Ts = length Us"
	+ using "2.prems" by (auto split: if_splits)
	+ moreover have I: "(a,b) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' a b subs = Some subs' \<Longrightarrow> subs \<subseteq>\<^sub>m subs'"
	+ for a b subs subs'
	+ using "2.prems" by (auto split: if_splits intro: "2.IH")
	+ ultimately show ?case using "2.prems"
	+ proof (induction Ts Us arbitrary: subs subs' rule: rev_induct2)
	+ case Nil
	+ then show ?case
	+ by (auto split: if_splits)
	+ next
	+ case (snoc x xs y ys)
	+ then show ?case
	+ using map_le_trans by (fastforce split: if_splits prod.splits simp add: bind_eq_Some_conv)
	+ qed
	+qed (auto simp add: map_le_def split: if_splits option.splits)
	+
	+(* Specializing for raw_match' *)
	+lemma fold_matches_first_step_not_None:
	+ assumes
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (x#xs) (y#ys)) (Some subs) = Some subs'"
	+ obtains point where
	+ "raw_match' x y subs = Some point"
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (xs) (ys)) (Some point) = Some subs'"
	+ using fold_matches_first_step_not_None assms .
	+lemma fold_matches_last_step_not_None:
	+ assumes
	+ "length xs = length ys"
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (xs@[x]) (ys@[y])) (Some subs) = Some subs'"
	+ obtains point where
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (xs) (ys)) (Some subs) = Some point"
	+ "raw_match' x y point = Some subs'"
	+ using fold_matches_last_step_not_None assms .
	+
	+corollary raw_match'_Type_conds:
	+ assumes "raw_match' (Ty a Ts) (Ty b Us) subs = Some subs'"
	+ shows "a=b" "length Ts = length Us"
	+ using assms by (auto split: if_splits)
	+
	+corollary fold_matches_first_step_not_None':
	+ assumes "length xs = length ys"
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (raw_match' T U)) (zip (x#xs) (y#ys)) (Some subs) = Some subs'"
	+ shows "raw_match' x y subs ~= None"
	+ using assms fold_matches_first_step_not_None
	+ by (metis option.discI)
	+
	+corollary raw_match'_hd_raw_match':
	+ assumes "raw_match' (Ty a (T#Ts)) (Ty b (U#Us)) subs = Some subs'"
	+ shows "raw_match' T U subs ~= None"
	+ using assms fold_matches_first_step_not_None' raw_match'_Type_conds
	+ by (metis (no_types, lifting) length_Cons nat.simps(1) raw_match'.simps(2))
	+
	+corollary raw_match'_eq_Some_at_point_not_None':
	+ assumes "length Ts = length Us"
	+ assumes "raw_match' (Ty a (Ts@Ts')) (Ty b (Us@Us')) subs = Some subs'"
	+ shows "raw_match' (Ty a (Ts)) (Ty b (Us)) subs ~= None"
	+ using assms fold_Option_bind_eq_Some_at_point_not_None' by (fastforce split: if_splits)
	+
	+(* I should have defined a custom induction rule here, instead I copied the structure of the proof
	+ each time... Clean up when time
	+*)
	+
	+lemma raw_match'_tvsT_subset_dom_res: "raw_match' T U subs = Some subs' \<Longrightarrow> tvsT T \<subseteq> dom subs'"
	+proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
	+ case (2 a Ts b Us subs)
	+ have l: "length Ts = length Us" "a = b" using 2
	+ by (metis option.discI raw_match'.simps(2))+
	+
	+ from this 2 have better_IH:
	+ "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs' \<Longrightarrow> tvsT x \<subseteq> dom subs'"
	+ for x y subs subs' by simp
	+ from l "2.prems" better_IH show ?case
	+ proof (induction Ts Us arbitrary: a b subs subs' rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+ obtain point where point: "raw_match' x y subs = Some point"
	+ and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
	+ by (metis (no_types, lifting) Cons.hyps Cons.prems(1) Cons.prems(2) fold_matches_first_step_not_None
	+ raw_match'.simps(2) raw_match'_Type_conds(2))
	+
	+ have "tvsT (Ty a xs) \<subseteq> dom subs'"
	+ apply (rule Cons.IH[of _ b point])
	+ using Cons.prems rest apply blast+
	+ by (metis Cons.prems(3) list.set_intros(2) zip_Cons_Cons)
	+ moreover have "tvsT x \<subseteq> dom point"
	+ by (metis Cons.prems(3) list.set_intros(1) point zip_Cons_Cons)
	+ moreover have "dom point \<subseteq> dom subs'"
	+ using map_le_implies_dom_le raw_match'_map_le rest by blast
	+ ultimately show ?case
	+ by auto
	+ qed
	+qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)
	+
	+lemma raw_match'_dom_res_subset_tvsT:
	+ "raw_match' T U subs = Some subs' \<Longrightarrow> dom subs' \<subseteq> tvsT T \<union> dom subs"
	+proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
	+ case (2 a Ts b Us subs)
	+ have l: "length Ts = length Us" "a = b" using 2
	+ by (metis option.discI raw_match'.simps(2))+
	+
	+ from this 2 have better_IH:
	+ "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs'
	+ \<Longrightarrow> dom subs' \<subseteq> tvsT x \<union> dom subs"
	+ for x y subs subs' by blast
	+ from l "2.prems" better_IH show ?case
	+ proof (induction Ts Us arbitrary: a b subs subs' rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+ obtain point where first: "raw_match' x y subs = Some point"
	+ and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
	+ by (metis (no_types, lifting) Cons.hyps Cons.prems(1) Cons.prems(2) fold_matches_first_step_not_None raw_match'.simps(2) raw_match'_Type_conds(2))
	+
	+ from first have "dom point \<subseteq> tvsT x \<union> dom subs"
	+ using Cons.prems(3) by fastforce
	+ moreover have "dom subs' \<subseteq> tvsT (Ty a xs) \<union> dom point"
	+ apply (rule Cons.IH)
	+ using Cons.prems(1) apply simp
	+ using Cons.prems(2) rest apply simp
	+ by (metis Cons.prems(3) list.set_intros(2) zip_Cons_Cons)
	+
	+ ultimately show ?case using Cons.prems in_mono
	+ apply (clarsimp split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv domIff)
	+ by (smt UN_iff Un_iff domIff in_mono option.distinct(1))
	+ (by fastforce, but too slow, check later )
	+ qed
	+qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)
	+
	+corollary raw_match'_dom_res_eq_tvsT:
	+ "raw_match' T U subs = Some subs' \<Longrightarrow> dom subs' = tvsT T \<union> dom subs"
	+ by (simp add: map_le_implies_dom_le raw_match'_tvsT_subset_dom_res
	+ raw_match'_dom_res_subset_tvsT raw_match'_map_le subset_antisym)
	+
	+corollary raw_match'_dom_res_eq_tvsT_empty:
	+ "raw_match' T U (\<lambda>x. None) = Some subs' \<Longrightarrow> dom subs' = tvsT T"
	+ using raw_match'_dom_res_eq_tvsT by simp
	+
	+lemma raw_match'_map_defined: "raw_match' T U subs = Some subs' \<Longrightarrow> p\<in>tvsT T \<Longrightarrow> subs' p ~= None"
	+ using raw_match'_dom_res_eq_tvsT by blast
	+
	+lemma raw_match'_extend_map_preserve:
	+ "raw_match' T U subs = Some subs' \<Longrightarrow> map_le subs' subs'' \<Longrightarrow> p\<in>tvsT T \<Longrightarrow> subs'' p = subs' p"
	+ using raw_match'_dom_res_eq_tvsT domIff map_le_implies_dom_le
	+ by (simp add: map_le_def)
	+
	+abbreviation "convert_subs subs \<equiv> (\<lambda>v S . the_default (Tv v S) (subs (v, S)))"
	+
	+lemma map_eq_on_tvsT_imp_map_eq_on_typ:
	+ "(\<And>p . p\<in>tvsT T \<Longrightarrow> subs p = subs' p)
	+ \<Longrightarrow> tsubstT T (convert_subs subs)
	+ = tsubstT T (convert_subs subs')"
	+ by (induction T) auto
	+
	+lemma raw_match'_extend_map_preserve':
	+ assumes "raw_match' T U subs = Some subs'" "map_le subs' subs''"
	+ shows "tsubstT T (convert_subs subs')
	+ = tsubstT T (convert_subs subs'')"
	+ apply (rule map_eq_on_tvsT_imp_map_eq_on_typ)
	+ using raw_match'_extend_map_preserve assms by metis
	+
	+lemma raw_match'_produces_matcher:
	+ "raw_match' T U subs = Some subs'
	+ \<Longrightarrow> tsubstT T (convert_subs subs') = U"
	+proof (induction T U subs arbitrary: subs' rule: raw_match'.induct)
	+ case (2 a Ts b Us subs)
	+ hence l: "length Ts = length Us" "a=b" by (simp_all split: if_splits)
	+ from this 2 have better_IH:
	+ "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs'
	+ \<Longrightarrow> tsubstT x (convert_subs subs') = y"
	+ for x y subs subs' by simp
	+ from l better_IH show ?case using 2
	+ proof(induction Ts Us arbitrary: subs subs' rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+ obtain point where first: "raw_match' x y subs = Some point"
	+ and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
	+ by (metis (no_types, lifting) Cons.hyps Cons.prems(4) fold_matches_first_step_not_None l(2) length_Cons raw_match'.simps(2))
	+
	+ have "tsubstT x (convert_subs point) = y"
	+ using Cons.prems(2) first by auto
	+ moreover have "map_le point subs'"
	+ using raw_match'_map_le rest by blast
	+ ultimately have subs'_hd: "tsubstT x (convert_subs subs') = y"
	+ using raw_match'_extend_map_preserve' first by simp
	+
	+ show ?case using Cons by (auto simp add: bind_eq_Some_conv subs'_hd first)
	+ qed
	+qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)
	+
	+lemma tsubstT_matcher_imp_raw_match'_unchanged:
	+ "tsubstT T \<rho> = U \<Longrightarrow> raw_match' T U (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
	+proof (induction T arbitrary: U \<rho>)
	+ case (Ty a Ts)
	+ then show ?case
	+ proof (induction Ts arbitrary: U)
	+ case Nil
	+ then show ?case by auto
	+ next
	+ case (Cons T Ts)
	+ then show ?case
	+ by auto
	+ qed
	+qed auto
	+
	+lemma raw_match'_imp_raw_match'_on_map_le:
	+ assumes "raw_match' T U subs = Some subs'"
	+ assumes "map_le lesubs subs"
	+ shows "\<exists>lesubs'. raw_match' T U lesubs = Some lesubs' \<and> map_le lesubs' subs'"
	+ using assms proof (induction T U subs arbitrary: lesubs subs' rule: raw_match'.induct)
	+ case (1 v S T subs lesubs subs')
	+ then show ?case
	+ by (force split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv map_le_def
	+ intro!: domI)
	+next
	+ case (2 a Ts b Us subs)
	+ hence l: "length Ts = length Us" "a=b" by (simp_all split: if_splits)
	+ from this 2 have better_IH:
	+ "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs'
	+ \<Longrightarrow> lesubs \<subseteq>\<^sub>m subs \<Longrightarrow> \<exists>lesubs'. raw_match' x y lesubs = Some lesubs' \<and> lesubs' \<subseteq>\<^sub>m subs'"
	+ for x y subs lesubs subs' by simp
	+ from l better_IH show ?case using 2
	+ proof(induction Ts Us arbitrary: subs lesubs subs' rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+ obtain point where first: "raw_match' x y subs = Some point"
	+ and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
	+ by (metis (no_types, lifting) Cons.hyps Cons.prems(4) fold_matches_first_step_not_None l(2) length_Cons raw_match'.simps(2))
	+
	+ have "\<exists>lepoint. raw_match' x y lesubs = Some lepoint \<and> lepoint \<subseteq>\<^sub>m point"
	+ using Cons first by auto
	+ from this obtain lepoint where
	+ comp_lepoint: "raw_match' x y lesubs = Some lepoint" and le_lepoint: "lepoint \<subseteq>\<^sub>m point"
	+ by auto
	+
	+ have "\<exists>lesubs'. raw_match' (Ty a xs) (Ty b ys) lepoint = Some lesubs' \<and> lesubs' \<subseteq>\<^sub>m subs'"
	+ using Cons rest le_lepoint by auto
	+ from this obtain lesubs' where
	+ comp_lesubs': "raw_match' (Ty a xs) (Ty b ys) lepoint = Some lesubs'"
	+ and le_lesubs': "lesubs' \<subseteq>\<^sub>m subs'"
	+ by auto
	+
	+ show ?case using Cons.prems Cons.hyps comp_lepoint comp_lesubs' le_lesubs' by auto
	+ qed
	+qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)
	+
	+lemma map_le_same_dom_imp_same_map: "dom f = dom g \<Longrightarrow> map_le f g \<Longrightarrow> f = g"
	+ by (simp add: map_le_antisym map_le_def)
	+
	+corollary map_le_produces_same_raw_match':
	+ assumes "raw_match' T U subs = Some subs'"
	+ assumes "dom subs \<subseteq> tvsT T"
	+ assumes "map_le lesubs subs"
	+ shows "raw_match' T U lesubs = Some subs'"
	+proof-
	+ have "dom subs' = tvsT T"
	+ using assms(1) assms(2) raw_match'_dom_res_eq_tvsT by auto
	+ moreover obtain lesubs' where "raw_match' T U lesubs = Some lesubs'" "map_le lesubs' subs'"
	+ using raw_match'_imp_raw_match'_on_map_le assms(1) assms(3) by blast
	+ moreover hence "dom lesubs' = tvsT T"
	+ using \<open>dom subs' = tvsT T\<close> map_le_implies_dom_le raw_match'_tvsT_subset_dom_res by fastforce
	+
	+ ultimately show ?thesis using map_le_same_dom_imp_same_map by metis
	+qed
	+
	+corollary "raw_match' T U subs = Some subs' \<Longrightarrow> dom subs \<subseteq> tvsT T \<Longrightarrow>
	+ raw_match' T U (\<lambda>p . None) = Some subs'"
	+ using map_le_empty map_le_produces_same_raw_match' by blast
	+
	+lemma raw_match'_restriction:
	+ assumes "raw_match' T U subs = Some subs'"
	+ assumes " tvsT T \<subseteq> restriction "
	+ shows "raw_match' T U (subs\|`restriction) = Some (subs'\|`restriction)"
	+using assms proof (induction T U subs arbitrary: restriction subs' rule: raw_match'.induct)
	+ case (1 v S T subs)
	+ then show ?case
	+ apply simp
	+ by (smt fun_upd_restrict_conv option.case_eq_if option.discI option.sel restrict_fun_upd)
	+next
	+ case (2 a Ts b Us subs)
	+ hence l: "length Ts = length Us" "a=b" by (simp_all split: if_splits)
	+ from this 2 have better_IH:
	+ "(x, y) \<in> set (zip Ts Us) \<Longrightarrow> raw_match' x y subs = Some subs' \<Longrightarrow> tvsT x \<subseteq> restriction
	+ \<Longrightarrow> raw_match' x y (subs \|` restriction) = Some (subs' \|` restriction)"
	+ for x y subs restriction subs' by simp
	+ from l better_IH show ?case using 2
	+ proof(induction Ts Us arbitrary: subs subs' rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+ obtain point where first: "raw_match' x y subs = Some point"
	+ and rest: "raw_match' (Ty a xs) (Ty b ys) point = Some subs'"
	+ by (metis (no_types, lifting) Cons.hyps Cons.prems(4) fold_matches_first_step_not_None l(2)
	+ length_Cons raw_match'.simps(2))
	+
	+ have "raw_match' x y (subs \|` restriction)
	+ = Some (point \|` restriction)"
	+ using Cons first by simp
	+
	+ moreover have "raw_match' (Ty a xs) (Ty b ys) (point \|` restriction)
	+ = Some (subs' \|` restriction)"
	+ using Cons rest by simp
	+
	+ ultimately show ?case by (simp split: if_splits)
	+ qed
	+qed (auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)
	+
	+
	+corollary raw_match'_restriction_on_tvsT:
	+ assumes "raw_match' T U subs = Some subs'"
	+ shows "raw_match' T U (subs\|`tvsT T) = Some (subs'\|`tvsT T)"
	+ using raw_match'_restriction assms by simp
	+
	+lemma tinstT_imp_ex_raw_match':
	+ assumes "tinstT T1 T2"
	+ shows "\<exists>subs. raw_match' T2 T1 (\<lambda>p . None) = Some subs"
	+proof-
	+ obtain \<rho> where "tsubstT T2 \<rho> = T1" using assms tinstT_def by auto
	+ hence "raw_match' T2 T1 (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
	+ using tsubstT_matcher_imp_raw_match'_unchanged by auto
	+
	+ hence "raw_match' T2 T1 ((\<lambda>(idx, S). Some (\<rho> idx S))\|`tvsT T2)
	+ = Some ((\<lambda>(idx, S). Some (\<rho> idx S))\|`tvsT T2)"
	+ using raw_match'_restriction_on_tvsT by simp
	+ moreover have "dom ((\<lambda>(idx, S). Some (\<rho> idx S))\|`tvsT T2) = tvsT T2" by auto
	+ ultimately show ?thesis using map_le_produces_same_raw_match'
	+ using map_le_empty by blast
	+qed
	+
	+lemma ex_raw_match'_imp_tinstT:
	+ assumes "\<exists>subs. raw_match' T2 T1 (\<lambda>p . None) = Some subs"
	+ shows "tinstT T1 T2"
	+proof-
	+ obtain subs where "raw_match' T2 T1 (\<lambda>p . None) = Some subs"
	+ using assms by auto
	+ hence "tsubstT T2 (convert_subs subs) = T1"
	+ using raw_match'_produces_matcher by blast
	+ thus ?thesis unfolding tinstT_def by fast
	+qed
	+
	+corollary tinstT_iff_ex_raw_match':
	+ "tinstT T1 T2 \<longleftrightarrow> (\<exists>subs. raw_match' T2 T1 (\<lambda>p . None) = Some subs)"
	+ using ex_raw_match'_imp_tinstT tinstT_imp_ex_raw_match' by blast
	+
	+function (sequential) raw_match_term
	+ :: "term \<Rightarrow> term \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) \<Rightarrow> ((variable \<times> sort) \<rightharpoonup> typ) option"
	+ where
	+ "raw_match_term (Ct a T) (Ct b U) subs = (if a = b then raw_match' T U subs else None)"
	+\| "raw_match_term (Fv a T) (Fv b U) subs = (if a = b then raw_match' T U subs else None)"
	+\| "raw_match_term (Bv i) (Bv j) subs = (if i = j then Some subs else None)"
	+\| "raw_match_term (Abs T t) (Abs U u) subs =
	+ Option.bind (raw_match' T U subs) (raw_match_term t u)"
	+\| "raw_match_term (f $ u) (f' $ u') subs = Option.bind (raw_match_term f f' subs) (raw_match_term u u')"
	+\| "raw_match_term _ _ _ = None"
	+ by pat_completeness auto
	+termination by size_change
	+
	+lemma raw_match_term_map_le: "raw_match_term t u subs = Some subs' \<Longrightarrow> map_le subs subs'"
	+ by (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
	+ (auto split: if_splits prod.splits intro: map_le_trans raw_match'_map_le simp add: bind_eq_Some_conv)
	+
	+lemma raw_match_term_tvs_subset_dom_res:
	+ "raw_match_term t u subs = Some subs' \<Longrightarrow> tvs t \<subseteq> dom subs'"
	+proof (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
	+ case (4 T t U u subs)
	+ from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
	+ by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+ moreover hence body: "raw_match_term t u bsubs = Some subs'"
	+ using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+
	+ ultimately have 1: "tvs t \<subseteq> dom subs'"
	+ using 4 by fastforce
	+
	+ from bsubs have "tvsT T \<subseteq> dom bsubs"
	+ using raw_match'_tvsT_subset_dom_res by auto
	+
	+ moreover have "bsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le body by blast
	+
	+ ultimately have 2: "tvsT T \<subseteq> dom subs'"
	+ using map_le_implies_dom_le by blast
	+ then show ?case
	+ using "4.prems" 1 2 by (simp split: if_splits)
	+next
	+ case (5 f u f' u' subs)
	+ from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
	+ by (auto simp add: bind_eq_Some_conv)
	+ hence u: "raw_match_term u u' fsubs = Some subs'"
	+ using "5.prems" by auto
	+
	+ have 1: "tvs u \<subseteq> dom subs'"
	+ using f u "5.IH" by auto
	+
	+ have "tvs f \<subseteq> dom fsubs"
	+ using 5 f by simp
	+ moreover have "fsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le u by blast
	+ ultimately have 2: "tvs f \<subseteq> dom subs'"
	+ using map_le_implies_dom_le by blast
	+
	+ then show ?case using 1 by simp
	+qed (use raw_match'_tvsT_subset_dom_res in \<open>auto split: option.splits if_splits prod.splits\<close>)
	+
	+
	+lemma raw_match_term_dom_res_subset_tvs:
	+ "raw_match_term t u subs = Some subs' \<Longrightarrow> dom subs' \<subseteq> tvs t \<union> dom subs"
	+proof (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
	+ case (4 T t U u subs)
	+ from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
	+ by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+ moreover hence body: "raw_match_term t u bsubs = Some subs'"
	+ using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+
	+ ultimately have 1: "dom subs' \<subseteq> tvs t \<union> dom bsubs"
	+ using 4 by fastforce
	+
	+ from bsubs have "dom bsubs \<subseteq> tvsT T \<union> dom bsubs"
	+ using raw_match'_dom_res_subset_tvsT by auto
	+
	+ moreover have "subs \<subseteq>\<^sub>m bsubs" using bsubs raw_match'_map_le by blast
	+
	+ ultimately have 2: "dom bsubs \<subseteq> tvsT T \<union> dom subs"
	+ using bsubs raw_match'_dom_res_subset_tvsT by auto
	+ then show ?case
	+ using "4.prems" 1 2 by (auto split: if_splits)
	+next
	+ case (5 f u f' u' subs)
	+ from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
	+ by (auto simp add: bind_eq_Some_conv)
	+ hence u: "raw_match_term u u' fsubs = Some subs'"
	+ using "5.prems" by auto
	+
	+ have 1: "dom fsubs \<subseteq> tvs f \<union> dom subs"
	+ using 5 f u by simp
	+
	+ have "dom subs' \<subseteq> tvs u \<union> dom fsubs"
	+ using 5 f by simp
	+ moreover have "fsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le u by blast
	+ ultimately have 2: "dom subs' \<subseteq> tvs f \<union> tvs u \<union> dom subs"
	+ by (smt "1" Un_commute inf_sup_aci(6) subset_Un_eq)
	+ then show ?case using 1 by simp
	+qed (use raw_match'_dom_res_subset_tvsT in \<open>auto split: option.splits if_splits prod.splits\<close>)
	+
	+corollary raw_match_term_dom_res_eq_tvs:
	+ "raw_match_term t u subs = Some subs' \<Longrightarrow> dom subs' = tvs t \<union> dom subs"
	+ by (simp add: map_le_implies_dom_le raw_match_term_tvs_subset_dom_res
	+ raw_match_term_dom_res_subset_tvs raw_match_term_map_le subset_antisym)
	+
	+lemma raw_match_term_extend_map_preserve:
	+ "raw_match_term t u subs = Some subs' \<Longrightarrow> map_le subs' subs'' \<Longrightarrow> p\<in>tvs t \<Longrightarrow> subs'' p = subs' p"
	+ using raw_match_term_dom_res_eq_tvs domIff map_le_implies_dom_le
	+ by (simp add: map_le_def)
	+
	+lemma map_eq_on_tvs_imp_map_eq_on_term:
	+ "(\<And>p . p\<in>tvs t \<Longrightarrow> subs p = subs' p)
	+ \<Longrightarrow> tsubst t (convert_subs subs)
	+ = tsubst t (convert_subs subs')"
	+ by (induction t) (use map_eq_on_tvsT_imp_map_eq_on_typ in \<open>fastforce+\<close>)
	+
	+lemma raw_match_extend_map_preserve':
	+ assumes "raw_match_term t u subs = Some subs'" "map_le subs' subs''"
	+ shows "tsubst t (convert_subs subs')
	+ = tsubst t (convert_subs subs'')"
	+ apply (rule map_eq_on_tvs_imp_map_eq_on_term)
	+ using raw_match_term_extend_map_preserve assms by fastforce
	+
	+lemma raw_match_term_produces_matcher:
	+ "raw_match_term t u subs = Some subs'
	+ \<Longrightarrow> tsubst t (convert_subs subs') = u"
	+proof (induction t u subs arbitrary: subs' rule: raw_match_term.induct)
	+ case (4 T t U u subs)
	+ from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
	+ by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+ moreover hence body: "raw_match_term t u bsubs = Some subs'"
	+ using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+
	+ ultimately have 1: "tsubst t (convert_subs subs') = u"
	+ using 4 by fastforce
	+
	+ from bsubs have "tsubstT T (convert_subs bsubs) = U"
	+ using raw_match'_produces_matcher by blast
	+
	+ moreover have "bsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le body by blast
	+
	+ ultimately have 2: "tsubstT T (convert_subs subs') = U"
	+ using raw_match'_extend_map_preserve'[OF bsubs, of subs'] by simp
	+
	+ then show ?case
	+ using "4.prems" 1 2 by (simp split: if_splits)
	+next
	+ case (5 f u f' u' subs)
	+ from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
	+ by (auto simp add: bind_eq_Some_conv)
	+ hence u: "raw_match_term u u' fsubs = Some subs'"
	+ using "5.prems" by auto
	+
	+ have 1: "tsubst u (convert_subs subs') = u'"
	+ using f u "5.IH" by auto
	+
	+ have "tsubst f (convert_subs fsubs) = f'"
	+ using 5 f by simp
	+ moreover have "fsubs \<subseteq>\<^sub>m subs'" using raw_match_term_map_le u by blast
	+ ultimately have 2: "tsubst f (convert_subs subs') = f'"
	+ using raw_match_extend_map_preserve'[OF f, of subs'] by simp
	+
	+ then show ?case using raw_match'_extend_map_preserve' 1 by auto
	+qed (auto split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+
	+lemma ex_raw_match_term_imp_tinst:
	+ assumes "\<exists>subs. raw_match_term t2 t1 (\<lambda>p . None) = Some subs"
	+ shows "tinst t1 t2"
	+proof-
	+ obtain subs where "raw_match_term t2 t1 (\<lambda>p . None) = Some subs"
	+ using assms by auto
	+ hence "tsubst t2 (convert_subs subs) = t1"
	+ using raw_match_term_produces_matcher by blast
	+ thus ?thesis unfolding tinst_def by fast
	+qed
	+
	+lemma tsubst_matcher_imp_raw_match_term_unchanged:
	+ "tsubst t \<rho> = u \<Longrightarrow> raw_match_term t u (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
	+ by (induction t arbitrary: u \<rho>) (auto simp add: tsubstT_matcher_imp_raw_match'_unchanged)
	+
	+lemma raw_match_term_restriction:
	+ assumes "raw_match_term t u subs = Some subs'"
	+ assumes "tvs t \<subseteq> restriction "
	+ shows "raw_match_term t u (subs\|`restriction) = Some (subs'\|`restriction)"
	+ using assms by (induction t u subs arbitrary: restriction subs' rule: raw_match_term.induct)
	+ (use raw_match'_restriction in
	+ \<open>auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv\<close>)
	+
	+corollary raw_match_term_restriction_on_tvs:
	+ assumes "raw_match_term t u subs = Some subs'"
	+ shows "raw_match_term t u (subs\|`tvs t) = Some (subs'\|`tvs t)"
	+ using raw_match_term_restriction assms by simp
	+
	+lemma raw_match_term_imp_raw_match_term_on_map_le:
	+ assumes "raw_match_term t u subs = Some subs'"
	+ assumes "map_le lesubs subs"
	+ shows "\<exists>lesubs'. raw_match_term t u lesubs = Some lesubs' \<and> map_le lesubs' subs'"
	+using assms proof (induction t u subs arbitrary: lesubs subs' rule: raw_match_term.induct)
	+ case (4 T t U u subs)
	+ from this obtain bsubs where bsubs: "raw_match' T U subs = Some bsubs"
	+ by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+ hence body: "raw_match_term t u bsubs = Some subs'"
	+ using "4.prems" by (auto simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+
	+ from bsubs 4 obtain lebsubs where
	+ lebsubs: "raw_match' T U subs = Some lebsubs" "map_le lebsubs bsubs"
	+ using raw_match'_map_le map_le_trans
	+ by (fastforce split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+ from this obtain lesubs' where
	+ lesubs':"raw_match_term t u lebsubs = Some lesubs'" "map_le lesubs' subs'"
	+ using "4.prems"
	+ by (auto split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+
	+ show ?case
	+ using lebsubs lesubs' 4 apply ( auto split: if_splits simp add: bind_eq_Some_conv)
	+ by (meson raw_match'_imp_raw_match'_on_map_le)
	+next
	+ case (5 f u f' u' subs)
	+ from this obtain fsubs where f: "raw_match_term f f' subs = Some fsubs"
	+ by (auto simp add: bind_eq_Some_conv)
	+ hence u: "raw_match_term u u' fsubs = Some subs'"
	+ using "5.prems" by auto
	+
	+ from 5 obtain lefsubs where
	+ lefsubs: "raw_match_term f f' subs = Some lefsubs" "map_le lefsubs fsubs"
	+ using raw_match_term_map_le map_le_trans f by auto
	+ from this obtain lesubs' where
	+ lesubs':"raw_match_term u u' lefsubs = Some lesubs'" "map_le lesubs' subs'"
	+ using "5.prems"
	+ by (auto split: if_splits simp add: bind_eq_Some_conv raw_match'_produces_matcher)
	+
	+ from lefsubs lesubs' show ?case using 5 by (fastforce split: if_splits simp add: bind_eq_Some_conv)
	+qed (use raw_match'_imp_raw_match'_on_map_le in
	+ \<open>auto split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv\<close>)
	+
	+corollary map_le_produces_same_raw_match_term:
	+ assumes "raw_match_term t u subs = Some subs'"
	+ assumes "dom subs \<subseteq> tvs t"
	+ assumes "map_le lesubs subs"
	+ shows "raw_match_term t u lesubs = Some subs'"
	+proof-
	+ have "dom subs' = tvs t"
	+ using assms(1) assms(2) raw_match_term_dom_res_eq_tvs by auto
	+ moreover obtain lesubs' where "raw_match_term t u lesubs = Some lesubs'" "map_le lesubs' subs'"
	+ using raw_match_term_imp_raw_match_term_on_map_le assms(1) assms(3) by blast
	+ moreover hence "dom lesubs' = tvs t"
	+ using \<open>dom subs' = tvs t\<close> map_le_implies_dom_le raw_match_term_tvs_subset_dom_res by fastforce
	+
	+ ultimately show ?thesis using map_le_same_dom_imp_same_map by metis
	+qed
	+
	+lemma tinst_imp_ex_raw_match_term:
	+ assumes "tinst t1 t2"
	+ shows "\<exists>subs. raw_match_term t2 t1 (\<lambda>p . None) = Some subs"
	+proof-
	+ obtain \<rho> where "tsubst t2 \<rho> = t1" using assms tinst_def by auto
	+ hence "raw_match_term t2 t1 (\<lambda>(idx, S). Some (\<rho> idx S)) = Some (\<lambda>(idx, S). Some (\<rho> idx S))"
	+ using tsubst_matcher_imp_raw_match_term_unchanged by auto
	+
	+ hence "raw_match_term t2 t1 ((\<lambda>(idx, S). Some (\<rho> idx S))\|`tvs t2)
	+ = Some ((\<lambda>(idx, S). Some (\<rho> idx S))\|`tvs t2)"
	+ using raw_match_term_restriction_on_tvs by simp
	+ moreover have "dom ((\<lambda>(idx, S). Some (\<rho> idx S))\|`tvs t2) = tvs t2" by auto
	+ ultimately show ?thesis using map_le_produces_same_raw_match_term
	+ using map_le_empty by blast
	+qed
	+
	+corollary tinst_iff_ex_raw_match_term:
	+ "tinst t1 t2 \<longleftrightarrow> (\<exists>subs. raw_match_term t2 t1 (\<lambda>p . None) = Some subs)"
	+ using ex_raw_match_term_imp_tinst tinst_imp_ex_raw_match_term by blast
	+
	+(* Now transfer to assoc lists for executability *)
	+
	+function (sequential) assoc_match
	+ :: "typ \<Rightarrow> typ \<Rightarrow> ((variable \<times> sort) \<times> typ) list \<Rightarrow> ((variable \<times> sort) \<times> typ) list option" where
	+ "assoc_match (Tv v S) T subs =
	+ (case lookup (\<lambda>x. x=(v,S)) subs of
	+ None \<Rightarrow> Some (((v,S), T) # subs)
	+ \| Some U \<Rightarrow> (if U = T then Some subs else None))"
	+\| "assoc_match (Ty a Ts) (Ty b Us) subs =
	+ (if a=b \<and> length Ts = length Us
	+ then fold (\<lambda>(T, U) subs . Option.bind subs (assoc_match T U)) (zip Ts Us) (Some subs)
	+ else None)"
	+\| "assoc_match T U subs = (if T = U then Some subs else None)"
	+ by (pat_completeness) auto
	+termination proof (relation "measure (\<lambda>(T, U, subs) . size T + size U)", goal_cases)
	+ case 1
	+ then show ?case
	+ by auto
	+next
	+ case (2 a Ts b Us subs x xa y xb aa)
	+ hence "length Ts = length Us" "a=b"
	+ by auto
	+ from this 2(2-) show ?case
	+ by (induction Ts Us rule: list_induct2) auto
	+qed
	+
	+corollary assoc_match_Type_conds:
	+ assumes "assoc_match (Ty a Ts) (Ty b Us) subs = Some subs'"
	+ shows "a=b" "length Ts = length Us"
	+ using assms by (auto split: if_splits)
	+
	+lemma fold_assoc_matches_first_step_not_None:
	+ assumes
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (assoc_match T U)) (zip (x#xs) (y#ys)) (Some subs) = Some subs'"
	+ obtains point where
	+ "assoc_match x y subs = Some point"
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (assoc_match T U)) (zip (xs) (ys)) (Some point) = Some subs'"
	+ using assms apply (simp split: option.splits)
	+ by (metis fold_Option_bind_eq_Some_start_not_None' not_None_eq)
	+
	+lemma assoc_match_subset: "assoc_match T U subs = Some subs' \<Longrightarrow> set subs \<subseteq> set subs'"
	+proof (induction T U subs arbitrary: subs' rule: assoc_match.induct)
	+ case (2 a Ts b Us subs)
	+ hence l: "length Ts = length Us" "a = b" by (simp_all split: if_splits)
	+ have better_IH: "(x, y) \<in> set (zip Ts Us) \<Longrightarrow>
	+ assoc_match x y subs = Some subs' \<Longrightarrow> set subs \<subseteq> set subs'"
	+ for x y subs subs' using 2 by (simp split: if_splits)
	+ from l better_IH "2.prems" show ?case
	+ proof (induction Ts Us arbitrary: subs rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+
	+ obtain point where first: "assoc_match x y subs = Some point"
	+ and rest: "assoc_match (Ty a xs) (Ty b ys) point = Some subs'"
	+ using fold_assoc_matches_first_step_not_None
	+ by (metis (no_types, lifting) Cons.hyps Cons.prems assoc_match.simps(2) assoc_match_Type_conds(2))
	+
	+ then show ?case
	+ using Cons.IH Cons.prems(2) by (fastforce split: option.splits prod.splits if_splits
	+ simp add: lookup_present_eq_key bind_eq_Some_conv)
	+ qed
	+qed (auto split: option.splits prod.splits if_splits simp add: lookup_present_eq_key)
	+
	+lemma assoc_match_distinct: "assoc_match T U subs = Some subs' \<Longrightarrow> distinct (map fst subs)
	+ \<Longrightarrow> distinct (map fst subs')"
	+proof (induction T U subs arbitrary: subs' rule: assoc_match.induct)
	+ case (2 a Ts b Us subs)
	+ hence l: "length Ts = length Us" "a = b" by (simp_all split: if_splits)
	+ have better_IH: "(x, y) \<in> set (zip Ts Us) \<Longrightarrow>
	+ assoc_match x y subs = Some subs' \<Longrightarrow> distinct (map fst subs) \<Longrightarrow> distinct (map fst subs')"
	+ for x y subs subs' using 2 by (simp split: if_splits)
	+ from l better_IH "2.prems" show ?case
	+ proof (induction Ts Us arbitrary: subs subs' rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+
	+ obtain point where first: "assoc_match x y subs = Some point"
	+ and rest: "assoc_match (Ty a xs) (Ty b ys) point = Some subs'"
	+ using fold_assoc_matches_first_step_not_None
	+ by (metis (no_types, lifting) Cons.hyps Cons.prems assoc_match.simps(2) assoc_match_Type_conds(2))
	+
	+ have dst_point: "distinct (map fst point)"
	+ apply (rule Cons.prems)
	+ using first Cons.prems by simp_all
	+
	+ have "distinct (map fst subs')"
	+ apply (rule Cons.IH)
	+ using Cons.prems rest apply simp
	+ using Cons.prems apply auto[1]
	+ using rest apply simp
	+ using dst_point apply simp
	+ done
	+
	+ then show ?case
	+ using Cons.IH Cons.prems(2) by simp
	+ qed
	+qed (auto split: option.splits prod.splits if_splits simp add: lookup_present_eq_key)
	+
	+
	+(* Seems that distinct is not even necessary, as both take the first one in case of duplicates*)
	+lemma lookup_eq_map_of_ap:
	+ shows "lookup (\<lambda>x. x=k) subs = map_of subs k"
	+ by (induction subs arbitrary: k) auto
	+
	+(* Ugly proof, but should mean that I can replace raw_match' with the executable assoc_match *)
	+lemma raw_match'_assoc_match:
	+ shows "raw_match' T U (map_of subs) = map_option map_of (assoc_match T U subs)"
	+ proof (induction T U "map_of subs" arbitrary: subs rule: raw_match'.induct)
	+case (1 v S T)
	+ then show ?case
	+ by (auto split: option.splits prod.splits simp add: lookup_present_eq_key lookup_eq_map_of_ap)
	+next
	+ case (2 a Ts b Us subs)
	+ then show ?case
	+ proof(cases "(raw_match' (Ty a Ts) (Ty b Us) (map_of subs))")
	+ case None
	+ then show ?thesis
	+ proof (cases "a = b \<and> length Ts = length Us")
	+ case True
	+ hence "length Ts = length Us" "a = b" by auto
	+ then show ?thesis using 2 None
	+ proof (induction Ts Us arbitrary: subs rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+
	+ hence eq_hd: "raw_match' x y (map_of subs) = map_option map_of (assoc_match x y subs)"
	+ by auto
	+
	+ then show ?case
	+ proof(cases "assoc_match x y subs")
	+ case None
	+ hence "raw_match' x y (map_of subs) = None" using eq_hd by simp
	+ then show ?thesis
	+ using fold_Option_bind_at_some_point_None_eq_None fold_assoc_matches_first_step_not_None
	+ Cons.prems
	+ by (auto split: option.splits prod.splits if_splits
	+ simp add: fold_Option_bind_eq_None_start_None)
	+ next
	+ case (Some res)
	+ hence "raw_match' x y (map_of subs) = Some (map_of res)" using eq_hd by simp
	+ then show ?thesis
	+ using fold_assoc_matches_first_step_not_None fold_Option_bind_eq_Some_at_each_point_Some
	+ Cons.prems Cons.IH
	+ by (auto split: option.splits prod.splits if_splits
	+ simp add: fold_Option_bind_eq_None_start_None)
	+ qed
	+ qed
	+ next
	+ case False
	+ then show ?thesis using None 2 by auto
	+ qed
	+ next
	+ case (Some res)
	+ hence l: "length Ts = length Us" "a = b" by (simp_all split: if_splits)
	+ have better_IH: "(x, y) \<in> set (zip Ts Us) \<Longrightarrow>
	+ raw_match' x y (map_of subs) = map_option map_of (assoc_match x y subs)"
	+ for x y subs using 2 Some by (simp split: if_splits)
	+ from l better_IH Some "2.prems" show ?thesis
	+ proof (induction Ts Us arbitrary: subs res rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (Cons x xs y ys)
	+
	+ obtain point where first: "raw_match' x y (map_of subs) = Some (map_of point)"
	+ and rest: "raw_match' (Ty a xs) (Ty b ys) (map_of point) = Some res"
	+ using fold_matches_first_step_not_None Cons.prems
	+ by (simp split: option.splits prod.splits if_splits) (smt map_option_eq_Some)
	+
	+ have 1: "raw_match' x y (map_of subs) = map_option map_of (assoc_match x y subs)"
	+ using Cons.prems by simp
	+
	+ have 2: "raw_match' (Ty a xs) (Ty b ys) (map_of point)
	+ = map_option map_of (assoc_match (Ty a xs) (Ty b ys) point)"
	+ using Cons rest by auto
	+
	+ show ?case
	+ using 1 2 first rest
	+ apply (simp split: if_splits option.splits prod.splits)
	+ by (smt Cons.IH Cons.prems(2) assoc_match.simps(2) list.set_intros(2) map_option_eq_Some
	+ rest zip_Cons_Cons)
	+ qed
	+ qed
	+qed (auto split: option.splits prod.splits simp add: lookup_present_eq_key)
	+
	+lemma dom_eq_and_eq_on_dom_imp_eq: "dom m = dom m' \<Longrightarrow> \<forall>x\<in>dom m . m x = m' x \<Longrightarrow> m = m'"
	+ by (simp add: map_le_def map_le_same_dom_imp_same_map)
	+
	+lemma list_of_map:
	+ assumes "finite (dom subs)"
	+ shows "\<exists>l. map_of l = subs"
	+proof-
	+ have "finite {(k, the (subs k)) \| k . k\<in>dom subs}" using assms by simp
	+ from this obtain l where l: "set l = {(k, the (subs k)) \| k . k\<in>dom subs}"
	+ using finite_list by fastforce
	+
	+ hence "dom (map_of l) = fst ` {(k, the (subs k)) \| k . k\<in>dom subs}"
	+ by (simp add: dom_map_of_conv_image_fst)
	+ also have "\<dots> = dom subs"
	+ by (simp add: Setcompr_eq_image domI image_image)
	+ finally have "dom (map_of l) = dom subs" .
	+ moreover have "map_of l x = subs x" if "x\<in>dom subs" for x
	+ using that
	+ by (smt l domIff fst_conv map_of_SomeD mem_Collect_eq option.collapse prod.sel(2) weak_map_of_SomeI)
	+ ultimately have "map_of l = subs"
	+ by (simp add: dom_eq_and_eq_on_dom_imp_eq)
	+ thus ?thesis ..
	+qed
	+
	+corollary tinstT_iff_assoc_match[code]: "tinstT T1 T2 \<longleftrightarrow> assoc_match T2 T1 [] ~= None"
	+ using tinstT_iff_ex_raw_match' list_of_map raw_match'_assoc_match
	+ by (smt map_of_eq_empty_iff map_option_is_None option.collapse option.distinct(1))
	+
	+function (sequential) assoc_match_term
	+ :: "term \<Rightarrow> term \<Rightarrow> ((variable \<times> sort) \<times> typ) list \<Rightarrow> ((variable \<times> sort) \<times> typ) list option"
	+ where
	+ "assoc_match_term (Ct a T) (Ct b U) subs = (if a = b then assoc_match T U subs else None)"
	+\| "assoc_match_term (Fv a T) (Fv b U) subs = (if a = b then assoc_match T U subs else None)"
	+\| "assoc_match_term (Bv i) (Bv j) subs = (if i = j then Some subs else None)"
	+\| "assoc_match_term (Abs T t) (Abs U u) subs =
	+ Option.bind (assoc_match T U subs) (assoc_match_term t u)"
	+\| "assoc_match_term (f $ u) (f' $ u') subs = Option.bind (assoc_match_term f f' subs) (assoc_match_term u u')"
	+\| "assoc_match_term _ _ _ = None"
	+ by pat_completeness auto
	+termination by size_change
	+
	+lemma raw_match_term_assoc_match_term:
	+ "raw_match_term t u (map_of subs) = map_option map_of (assoc_match_term t u subs)"
	+proof (induction t u "map_of subs" arbitrary: subs rule: raw_match_term.induct)
	+ case (4 T t U u)
	+
	+ then show ?case
	+ proof (cases "assoc_match T U subs")
	+ case None
	+ then show ?thesis using raw_match'_assoc_match by simp
	+ next
	+ case (Some bsubs)
	+ hence 1: "raw_match' T U (map_of subs) = Some (map_of bsubs)"
	+ using raw_match'_assoc_match by simp
	+ hence "raw_match_term t u (map_of bsubs) = map_option map_of (assoc_match_term t u bsubs)"
	+ using 4 by blast
	+ then show ?thesis by (simp add: Some 1)
	+ qed
	+next
	+ case (5 f u f' u')
	+ (* Do a real proof here when time *)
	+ from "5.hyps"(1) "5.hyps"(2) have "Option.bind (map_option map_of (assoc_match_term f f' subs))
	+ (raw_match_term u u') =
	+ map_option map_of (Option.bind (assoc_match_term f f' subs) (assoc_match_term u u'))"
	+ by (smt None_eq_map_option_iff bind.bind_lunit bind_eq_None_conv option.collapse option.map_sel)
	+ with 5 show ?case
	+ using raw_match'_assoc_match 5
	+ by (auto split: option.splits prod.splits simp add: lookup_present_eq_key bind_eq_Some_conv bind_eq_None_conv)
	+qed (use raw_match'_assoc_match in \<open>auto split: option.splits prod.splits\<close>)
	+
	+(* Automation surprisingly broke on translation :( *)
	+corollary tinst_iff_assoc_match_term[code]: "tinst t1 t2 \<longleftrightarrow> assoc_match_term t2 t1 [] \<noteq> None"
	+proof
	+ assume "tinst t1 t2"
	+ from this obtain asubs where "raw_match_term t2 t1 Map.empty = Some asubs"
	+ using tinst_imp_ex_raw_match_term by blast
	+ from this obtain csubs where "assoc_match_term t2 t1 [] = Some csubs"
	+ by (metis empty_eq_map_of_iff map_option_eq_Some raw_match_term_assoc_match_term)
	+ thus "assoc_match_term t2 t1 [] \<noteq> None" by simp
	+next
	+ assume "assoc_match_term t2 t1 [] \<noteq> None"
	+ from this obtain csubs where "assoc_match_term t2 t1 [] = Some csubs"
	+ by blast
	+ from this obtain asubs where "raw_match_term t2 t1 Map.empty = Some asubs"
	+ by (metis empty_eq_map_of_iff option.simps(9) raw_match_term_assoc_match_term)
	+ thus "tinst t1 t2"
	+ using tinst_iff_ex_raw_match_term by blast
	+qed
	+
	+hide_fact fold_matches_first_step_not_None fold_matches_last_step_not_None
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Logic.thy b/thys/Metalogic_ProofChecker/Logic.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Logic.thy
	@@ -0,0 +1,1647 @@
	+section "Logic"
	+
	+theory Logic
	+ imports Theory Term_Subst SortConstants Name BetaNormProof EtaNormProof
	+begin
	+
	+term proves
	+
	+abbreviation "inst_ok \<Theta> insts \<equiv>
	+ distinct (map fst insts) \<comment>\<open>No duplicates, makes stuff easier\<close>
	+ \<and> list_all (typ_ok \<Theta>) (map snd insts) \<comment>\<open>Stuff I substitute in is well typed\<close>
	+ \<and> list_all (\<lambda>((idn, S), T) . has_sort (osig (sig \<Theta>)) T S) insts" \<comment>\<open>Types "fit" in the Fviables\<close>
	+
	+lemma inst_ok_imp_wf_inst:
	+ "inst_ok \<Theta> insts \<Longrightarrow> wf_inst \<Theta> (\<lambda>idn S .the_default (Tv idn S) (lookup (\<lambda>x. x=(idn, S)) insts))"
	+ by (induction insts) (auto split: if_splits prod.splits)
	+
	+lemma term_ok'_eta_norm: "term_ok' \<Sigma> t \<Longrightarrow> term_ok' \<Sigma> (eta_norm t)"
	+ by (induction t rule: eta_norm.induct)
	+ (auto split: term.splits nat.splits simp add: term_ok'_decr is_dependent_def)
	+corollary term_ok_eta_norm: "term_ok thy t \<Longrightarrow> term_ok thy (eta_norm t)"
	+ using wt_term_def typ_of_eta_norm term_ok'_eta_norm by auto
	+
	+abbreviation "beta_eta_norm t \<equiv> map_option eta_norm (beta_norm t)"
	+
	+lemma "beta_eta_norm t = Some t' \<Longrightarrow> \<not> eta_reducible t'"
	+ using not_eta_reducible_eta_norm by auto
	+lemma term_ok_beta_eta_norm: "term_ok thy t \<Longrightarrow> beta_eta_norm t = Some t' \<Longrightarrow> term_ok thy t'"
	+ using term_ok_eta_norm term_ok_beta_norm by blast
	+lemma typ_of_beta_eta_norm:
	+ "typ_of t = Some T \<Longrightarrow> beta_eta_norm t = Some t' \<Longrightarrow> typ_of t' = Some T"
	+ using beta_norm_imp_beta_reds beta_star_preserves_typ_of1 typ_of1_eta_norm typ_of_def by fastforce
	+
	+lemma inst_ok_nil[simp]: "inst_ok \<Theta> []" by simp
	+
	+lemma axiom_subst_typ':
	+ assumes "wf_theory \<Theta>" "A\<in>axioms \<Theta>" "inst_ok \<Theta> insts"
	+ shows "\<Theta>, \<Gamma> \<turnstile> subst_typ' insts A"
	+proof-
	+ have "wf_inst \<Theta> (\<lambda>idn S . the_default (Tv idn S) (lookup (\<lambda>x. x=(idn, S)) insts))"
	+ using inst_ok_imp_wf_inst assms(3) by blast
	+ moreover have "subst_typ' insts A
	+ = tsubst A (\<lambda>idn S . the_default (Tv idn S) (lookup (\<lambda>x. x=(idn, S)) insts))"
	+ by (simp add: tsubst_simulates_subst_typ')
	+ ultimately show ?thesis
	+ using assms axiom by simp
	+qed
	+
	+corollary axiom': "wf_theory \<Theta> \<Longrightarrow> A \<in> axioms \<Theta> \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> A"
	+ apply (subst subst_typ'_nil[symmetric])
	+ using axiom_subst_typ' inst_ok_nil by metis
	+
	+lemma has_sort_Tv_refl: "wf_osig oss \<Longrightarrow> sort_ex (subclass oss) S \<Longrightarrow> has_sort oss (Tv v S) S"
	+ by (cases oss) (simp add: osig_subclass_loc wf_subclass_loc.intro has_sort_Tv wf_subclass_loc.sort_leq_refl)
	+
	+lemma has_sort_Tv_refl':
	+ "wf_theory \<Theta> \<Longrightarrow> typ_ok \<Theta> (Tv v S) \<Longrightarrow> has_sort (osig (sig \<Theta>)) (Tv v S) S"
	+ using has_sort_Tv_refl
	+ by (metis wf_sig.simps osig.elims wf_theory_imp_wf_sig typ_ok_def
	+ wf_type_imp_typ_ok_sig typ_ok_sig.simps(2) wf_sort_def)
	+
	+lemma wf_inst_imp_inst_ok:
	+ "wf_theory \<Theta> \<Longrightarrow> distinct l \<Longrightarrow> \<forall>(v, S) \<in> set l . typ_ok \<Theta> (Tv v S) \<Longrightarrow> wf_inst \<Theta> \<rho>
	+ \<Longrightarrow> inst_ok \<Theta> (map (\<lambda>(v, S) . ((v, S), \<rho> v S)) l)"
	+proof (induction l)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons a l)
	+ have I: "inst_ok \<Theta> (map (\<lambda>(v,S) . ((v, S), \<rho> v S)) l)"
	+ using Cons by fastforce
	+
	+ have "a \<notin> set l"
	+ using Cons.prems(2) by auto
	+ hence "(a, case_prod \<rho> a) \<notin> set (map (\<lambda>(v,S) . ((v, S), \<rho> v S)) l)"
	+ by (simp add: image_iff prod.case_eq_if)
	+ moreover have "distinct (map (\<lambda>(v,S) . ((v, S), \<rho> v S)) l)"
	+ using I distinct_kv_list distinct_map by fast
	+ ultimately have "distinct (map (\<lambda>(v,S) . ((v, S), \<rho> v S)) (a#l))"
	+ by (auto split: prod.splits)
	+
	+ moreover have "wf_type (sig \<Theta>) (case_prod \<rho> a)"
	+ using Cons.prems(3-4) by auto (metis typ_ok_Tv wf_type_imp_typ_ok_sig)
	+ moreover hence "typ_ok \<Theta> (case_prod \<rho> a)"
	+ by simp
	+ moreover hence "has_sort (osig (sig \<Theta>)) (case_prod \<rho> a) (snd a)"
	+ using Cons.prems by (metis (full_types) has_sort_Tv_refl' prod.case_eq_if wf_inst_def)
	+
	+ ultimately show ?case
	+ using I by (auto simp del: typ_ok_def split: prod.splits)
	+qed
	+
	+(* MOVE to term, also use for transfering proofs *)
	+lemma typs_of_fv_subset_Types: "snd ` fv t \<subseteq> Types t"
	+ by (induction t) auto
	+lemma osig_tvsT_subset_SortsT: "snd ` tvsT T \<subseteq> SortsT T"
	+ by (induction T) auto
	+lemma osig_tvs_subset_Sorts: "snd ` tvs t \<subseteq> Sorts t"
	+ by (induction t) (use osig_tvsT_subset_SortsT in \<open>auto simp add: image_subset_iff\<close>)
	+
	+lemma term_ok_Types_imp_typ_ok_pre:
	+ "is_std_sig \<Sigma> \<Longrightarrow> term_ok' \<Sigma> t \<Longrightarrow> \<tau> \<in> Types t \<Longrightarrow> typ_ok_sig \<Sigma> \<tau>"
	+ by (induction t arbitrary: \<tau>) (auto split: option.splits)
	+
	+lemma term_ok_Types_typ_ok: "wf_theory \<Theta> \<Longrightarrow> term_ok \<Theta> t \<Longrightarrow> \<tau> \<in> Types t \<Longrightarrow> typ_ok \<Theta> \<tau>"
	+ by (cases \<Theta> rule: theory_full_exhaust) (fastforce simp add: wt_term_def
	+ intro: term_ok_Types_imp_typ_ok_pre)
	+
	+lemma term_ok_fv_imp_typ_ok_pre:
	+ "is_std_sig \<Sigma> \<Longrightarrow> term_ok' \<Sigma> t \<Longrightarrow> (x,\<tau>) \<in> fv t \<Longrightarrow> typ_ok_sig \<Sigma> \<tau>"
	+ using typs_of_fv_subset_Types term_ok_Types_imp_typ_ok_pre
	+ by (metis image_subset_iff snd_conv)
	+
	+lemma term_ok_vars_typ_ok: "wf_theory \<Theta> \<Longrightarrow> term_ok \<Theta> t \<Longrightarrow> (x, \<tau>) \<in> fv t \<Longrightarrow> typ_ok \<Theta> \<tau>"
	+ using term_ok_Types_typ_ok typs_of_fv_subset_Types by (metis image_subset_iff snd_conv)
	+
	+lemma typ_ok_TFreesT_imp_sort_ok_pre:
	+ "is_std_sig \<Sigma> \<Longrightarrow> typ_ok_sig \<Sigma> T \<Longrightarrow> (x, S) \<in> tvsT T \<Longrightarrow> wf_sort (subclass (osig \<Sigma>)) S"
	+proof (induction T)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts) (fastforce dest: split_list split: option.split_asm)+
	+qed (auto simp add: wf_sort_def)
	+
	+lemma term_ok_TFrees_imp_sort_ok_pre:
	+ "is_std_sig \<Sigma> \<Longrightarrow> term_ok' \<Sigma> t \<Longrightarrow> (x, S) \<in> tvs t \<Longrightarrow> wf_sort (subclass (osig \<Sigma>)) S"
	+proof (induction t arbitrary: S)
	+ case (Ct n T)
	+ then show ?case
	+ apply (clarsimp split: option.splits)
	+ by (use typ_ok_TFreesT_imp_sort_ok_pre wf_sort_def in auto)
	+next
	+ case (Fv n T)
	+ then show ?case
	+ apply (clarsimp split: option.splits)
	+ by (use typ_ok_TFreesT_imp_sort_ok_pre wf_sort_def in auto)
	+next
	+ case (Bv n)
	+ then show ?case
	+ by (clarsimp split: option.splits)
	+next
	+ case (Abs T t)
	+ then show ?case
	+ apply simp
	+ using typ_ok_TFreesT_imp_sort_ok_pre wf_sort_def
	+ by meson
	+next
	+ case (App t1 t2)
	+ then show ?case
	+ by auto
	+qed
	+
	+lemma typ_ok_tvsT_imp_sort_ok_pre:
	+ "is_std_sig \<Sigma> \<Longrightarrow> typ_ok_sig \<Sigma> T \<Longrightarrow> (x,S) \<in> tvsT T \<Longrightarrow> wf_sort (subclass (osig \<Sigma>)) S"
	+proof (induction T)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts) (fastforce dest: split_list split: option.split_asm)+
	+qed (auto simp add: wf_sort_def)
	+
	+lemma term_ok_tvars_sort_ok:
	+ assumes "wf_theory \<Theta>" "term_ok \<Theta> t" "(x, S) \<in> tvs t"
	+ shows "wf_sort (subclass (osig (sig \<Theta>))) S"
	+proof-
	+ have "term_ok' (sig \<Theta>) t"
	+ using assms(2) by (simp add: wt_term_def)
	+ moreover have "is_std_sig (sig \<Theta>)"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust) simp
	+ ultimately show ?thesis
	+ using assms(3) term_ok_TFrees_imp_sort_ok_pre by simp
	+qed
	+
	+lemma term_ok'_bind_fv2:
	+ assumes "term_ok' \<Sigma> t"
	+ shows "term_ok' \<Sigma> (bind_fv2 (v,T) lev t)"
	+ using assms by (induction "(v,T)" lev t rule: bind_fv2.induct) auto
	+
	+lemma term_ok'_bind_fv:
	+ assumes "term_ok' \<Sigma> t"
	+ shows "term_ok' \<Sigma> (bind_fv (v,\<tau>) t)"
	+ using term_ok'_bind_fv2 bind_fv_def assms by metis
	+
	+lemma term_ok'_Abs_fv:
	+ assumes "term_ok' \<Sigma> t" "typ_ok_sig \<Sigma> \<tau>"
	+ shows "term_ok' \<Sigma> (Abs \<tau> (bind_fv (v,\<tau>) t))"
	+ using term_ok'_bind_fv assms by simp
	+
	+lemma term_ok'_mk_all:
	+ assumes "wf_theory \<Theta>" and "term_ok' (sig \<Theta>) B" and "typ_of B = Some propT"
	+ and "typ_ok \<Theta> \<tau>"
	+ shows "term_ok' (sig \<Theta>) (mk_all x \<tau> B)"
	+ using assms term_ok'_bind_fv
	+ by (cases \<Theta> rule: wf_theory.cases) (auto simp add: typ_of_def tinstT_def)
	+
	+lemma term_ok_mk_all:
	+ assumes "wf_theory \<Theta>" and "term_ok' (sig \<Theta>) B" and "typ_of B = Some propT" and "typ_ok \<Theta> \<tau>"
	+ shows "term_ok \<Theta> (mk_all x \<tau> B)"
	+ using typ_of_mk_all term_ok'_mk_all assms by (auto simp add: wt_term_def)
	+
	+lemma term_ok'_incr_boundvars:
	+ "term_ok' (sig \<Theta>) t \<Longrightarrow> term_ok' (sig \<Theta>) (incr_boundvars lev t)"
	+ using term_ok'_incr_bv incr_boundvars_def by simp
	+
	+lemma term_ok'_subst_bv1:
	+ assumes "term_ok' (sig \<Theta>) f" and "term_ok' (sig \<Theta>) u"
	+ shows "term_ok' (sig \<Theta>) (subst_bv1 f lev u)"
	+ using assms by (induction f lev u rule: subst_bv1.induct) (use term_ok'_incr_boundvars in auto)
	+
	+lemma term_ok'_subst_bv:
	+ assumes "term_ok' (sig \<Theta>) f" and "term_ok' (sig \<Theta>) u"
	+ shows "term_ok' (sig \<Theta>) (subst_bv f u)"
	+ using assms term_ok'_subst_bv1 subst_bv_def by simp
	+
	+lemma term_ok'_betapply:
	+ assumes "term_ok' (sig \<Theta>) f" "term_ok' (sig \<Theta>) u"
	+ shows "term_ok' (sig \<Theta>) (f \<bullet> u)"
	+proof(cases "f")
	+ case (Abs T t)
	+ then show ?thesis
	+ using assms term_ok'_subst_bv1 by (simp add: subst_bv_def)
	+qed (use assms in auto)
	+
	+lemma term_ok_betapply:
	+ assumes "term_ok \<Theta> f" "term_ok \<Theta> u"
	+ assumes "typ_of f = Some (uty \<rightarrow> tty)" "typ_of u = Some uty"
	+ shows "term_ok \<Theta> (f \<bullet> u)"
	+ using assms term_ok'_betapply wt_term_def typ_of_betaply assms by auto
	+
	+lemma typ_ok_sig_subst_typ:
	+ assumes "is_std_sig \<Sigma>" and "typ_ok_sig \<Sigma> ty" and "distinct (map fst insts)"
	+ and "list_all (typ_ok_sig \<Sigma>) (map snd insts)"
	+ shows "typ_ok_sig \<Sigma> (subst_typ insts ty)"
	+using assms proof (induction insts ty rule: subst_typ.induct)
	+ case (1 inst a Ts)
	+ have "typ_ok_sig \<Sigma> (subst_typ inst ty)" if "ty \<in> set Ts" for ty
	+ using that 1 by (auto simp add: list_all_iff split: option.splits)
	+
	+ hence "\<forall>ty \<in> set (map (subst_typ inst) Ts) . typ_ok_sig \<Sigma> ty"
	+ by simp
	+ hence "list_all (typ_ok_sig \<Sigma>) (map (subst_typ inst) Ts)"
	+ using list_all_iff by blast
	+ moreover have "length (map (subst_typ inst) Ts) = length Ts" by simp
	+ ultimately show ?case using "1.prems" by (auto split: option.splits)
	+next
	+ case (2 inst idn S)
	+ then show ?case
	+ proof(cases "lookup (\<lambda>x. x = (idn, S)) inst \<noteq> None")
	+ case True
	+ from this 2 obtain res where res: "lookup (\<lambda>x. x = (idn, S)) inst = Some res" by auto
	+ have "res \<in> set (map snd inst)" using 2 res by (induction inst) (auto split: if_splits)
	+ hence "typ_ok_sig \<Sigma> res" using 2(4) res
	+ by (induction inst) (auto split: if_splits simp add: rev_image_eqI)
	+ then show ?thesis using res by simp
	+ next
	+ case False
	+ hence rewr: "subst_typ inst (Tv idn S) = Tv idn S" by auto
	+ then show ?thesis using "2.prems"(2) by simp
	+ qed
	+qed
	+
	+(* MOVE *)
	+corollary subst_typ_tinstT: "tinstT (subst_typ insts ty) ty"
	+ unfolding tinstT_def using tsubstT_simulates_subst_typ by fastforce
	+
	+lemma tsubstT_trans: "tsubstT ty \<rho>1 = ty1 \<Longrightarrow> tsubstT ty1 \<rho>2 = ty2
	+ \<Longrightarrow> tsubstT ty (\<lambda>idx s . case \<rho>1 idx s of Tv idx' s' \<Rightarrow> \<rho>2 idx' s'
	+ \| Ty s Ts \<Rightarrow> Ty s (map (\<lambda>T. tsubstT T \<rho>2) Ts)) = ty2"
	+unfolding tinstT_def proof (induction ty arbitrary: ty1 ty2)
	+ case (Tv idx s)
	+ then show ?case by (cases "\<rho>1 idx s") auto
	+qed auto
	+
	+corollary tinstT_trans: "tinstT ty1 ty \<Longrightarrow> tinstT ty2 ty1 \<Longrightarrow> tinstT ty2 ty"
	+ unfolding tinstT_def using tsubstT_trans by blast
	+
	+lemma term_ok'_subst_typ':
	+ assumes "is_std_sig \<Sigma>" and "term_ok' \<Sigma> t" and "distinct (map fst insts)"
	+ and "list_all (typ_ok_sig \<Sigma>) (map snd insts)"
	+ shows "term_ok' \<Sigma> (subst_typ' insts t)"
	+ using assms by (induction t)
	+ (use typ_ok_sig_subst_typ subst_typ_tinstT tinstT_trans in \<open>auto split: option.splits\<close>)
	+
	+(* This is a bit suspect, as I am disregarding abstractions... *)
	+lemma
	+ term_ok'_occs:
	+ "is_std_sig \<Sigma> \<Longrightarrow> term_ok' \<Sigma> t \<Longrightarrow> occs u t \<Longrightarrow> term_ok' \<Sigma> u"
	+ by (induction t) auto
	+
	+lemma typ_of1_tsubst:
	+ "typ_of1 Ts t = Some ty \<Longrightarrow> typ_of1 (map (\<lambda>T . tsubstT T \<rho>) Ts) (tsubst t \<rho>) = Some (tsubstT ty \<rho>)"
	+proof (induction Ts t arbitrary: ty rule: typ_of1.induct)
	+ case (2 Ts i)
	+ then show ?case by (auto split: if_splits)
	+next
	+ case (4 Ts T body)
	+ then show ?case by (auto simp add: bind_eq_Some_conv)
	+next
	+ case (5 Ts f u)
	+ from "5.prems" obtain u_ty where u_ty: "typ_of1 Ts u = Some u_ty" by (auto simp add: bind_eq_Some_conv)
	+ from this "5.prems" have f_ty: "typ_of1 Ts f = Some (u_ty \<rightarrow> ty)"
	+ by (auto simp add: bind_eq_Some_conv typ_of1_arg_typ[OF "5.prems"(1)]
	+ split: if_splits typ.splits option.splits)
	+
	+ from u_ty "5.IH"(1) have "typ_of1 (map (\<lambda>T. tsubstT T \<rho>) Ts) (tsubst u \<rho>) = Some (tsubstT u_ty \<rho>)"
	+ by simp
	+ moreover from u_ty f_ty "5.IH"(2) have "typ_of1 (map (\<lambda>T. tsubstT T \<rho>) Ts) (tsubst f \<rho>)
	+ = Some (tsubstT (u_ty \<rightarrow> ty) \<rho>)"
	+ by simp
	+ ultimately show ?case by simp
	+qed auto
	+
	+corollary typ_of1_tsubst_weak:
	+ assumes "typ_of1 Ts t = Some ty"
	+ assumes "typ_of1 (map (\<lambda>T . tsubstT T \<rho>) Ts) (tsubst t \<rho>) = Some ty'"
	+ shows "tsubstT ty \<rho> = ty'"
	+ using assms typ_of1_tsubst by auto
	+
	+lemma tsubstT_no_change[simp]: "tsubstT T Tv = T"
	+ by (induction T) (auto simp add: map_idI)
	+
	+lemma term_ok_mk_eq_same_typ:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> (mk_eq s t)"
	+ shows "typ_of s = typ_of t"
	+ using assms by (cases \<Theta> rule: theory_full_exhaust)
	+ (fastforce simp add: wt_term_def typ_of_def bind_eq_Some_conv tinstT_def)
	+
	+lemma typ_of_eta_expand: "typ_of f = Some (\<tau> \<rightarrow> \<tau>') \<Longrightarrow> typ_of (Abs \<tau> (f $ Bv 0)) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using typ_of1_weaken by (fastforce simp add: bind_eq_Some_conv typ_of_def)
	+
	+lemma term_okI: "term_ok' (sig \<Theta>) t \<Longrightarrow> typ_of t \<noteq> None \<Longrightarrow> term_ok \<Theta> t"
	+ by (simp add: wt_term_def)
	+lemma term_okD1: "term_ok \<Theta> t \<Longrightarrow> term_ok' (sig \<Theta>) t"
	+ by (simp add: wt_term_def)
	+lemma term_okD2: "term_ok \<Theta> t \<Longrightarrow> typ_of t \<noteq> None"
	+ by (simp add: wt_term_def)
	+
	+lemma term_ok_imp_typ_ok': assumes "wf_theory \<Theta>" "term_ok \<Theta> t" shows "typ_ok \<Theta> (the (typ_of t))"
	+proof-
	+ obtain ty where ty: "typ_of t = Some ty"
	+ by (meson assms option.exhaust term_okD2)
	+ hence "typ_ok \<Theta> ty"
	+ using term_ok_imp_typ_ok assms by blast
	+ thus ?thesis using ty by simp
	+qed
	+
	+lemma term_ok_mk_eqI:
	+ assumes "wf_theory \<Theta>" "term_ok \<Theta> s" "term_ok \<Theta> t" "typ_of s = typ_of t"
	+ shows"term_ok \<Theta> (mk_eq s t)"
	+proof (rule term_okI)
	+ have "typ_ok \<Theta> (the (typ_of t))"
	+ using assms(1) assms(3) term_ok_imp_typ_ok' by blast
	+ hence "typ_ok_sig (sig \<Theta>) (the (typ_of t))"
	+ by simp
	+ then show "term_ok' (sig \<Theta>) (mk_eq s t)"
	+ using assms apply -
	+ apply (drule term_okD1)+
	+ apply (cases \<Theta> rule: theory_full_exhaust)
	+ by (auto split: option.splits simp add: tinstT_def)
	+next
	+ show "typ_of (mk_eq s t) \<noteq> None"
	+ using assms typ_of_def by (auto dest: term_okD2 simp add: wt_term_def)
	+qed
	+
	+lemma typ_of1_decr': "\<not> loose_bvar1 t 0 \<Longrightarrow> typ_of1 (T#Ts) t = Some \<tau> \<Longrightarrow> typ_of1 Ts (decr 0 t) = Some \<tau>"
	+proof (induction Ts t arbitrary: T \<tau> rule: typ_of1.induct)
	+ case (4 Ts B body)
	+ then show ?case
	+ using typ_of1_decr_gen
	+ apply (simp add: bind_eq_Some_conv split: if_splits option.splits)
	+ by (metis append_Cons append_Nil length_Cons list.size(3) typ_of1_decr_gen)
	+next
	+ case (5 Ts f u)
	+ then show ?case apply (simp add: bind_eq_Some_conv split: if_splits option.splits)
	+ by (smt no_loose_bvar1_subst_bv2_decr subst_bv_def substn_subst_0' typ_of1.simps(3) typ_of1_subst_bv_gen')
	+qed (auto simp add: bind_eq_Some_conv split: if_splits option.splits)
	+
	+lemma typ_of1_eta_red_step_pre: "\<not> loose_bvar1 t 0 \<Longrightarrow>
	+ typ_of1 Ts (Abs \<tau> (t $ Bv 0)) = Some (\<tau> \<rightarrow> \<tau>') \<Longrightarrow> typ_of1 Ts (decr 0 t) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using typ_of1_decr'
	+ by (smt length_Cons nth_Cons_0 typ_of1.simps(2) typ_of1_arg_typ typ_of_Abs_body_typ' zero_less_Suc)
	+
	+lemma typ_of1_eta_red_step: "\<not> is_dependent t \<Longrightarrow>
	+ typ_of (Abs \<tau> (t $ Bv 0)) = Some (\<tau> \<rightarrow> \<tau>') \<Longrightarrow> typ_of (decr 0 t) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using typ_of_def is_dependent_def typ_of1_eta_red_step_pre by simp
	+
	+(* MOVE *)
	+lemma distinct_add_vars': "distinct acc \<Longrightarrow> distinct (add_vars' t acc)"
	+ unfolding add_vars'_def
	+ by (induction t arbitrary: acc) auto
	+
	+lemma distinct_add_tvarsT': "distinct acc \<Longrightarrow> distinct (add_tvarsT' T acc)"
	+proof (induction T arbitrary: acc)
	+ case (Ty n Ts)
	+ then show ?case
	+ by (induction Ts rule: rev_induct) (auto simp add: add_tvarsT'_def)
	+qed (simp add: add_tvarsT'_def)
	+
	+lemma distinct_add_tvars': "distinct acc \<Longrightarrow> distinct (add_tvars' t acc)"
	+ by (induction t arbitrary: acc) (simp_all add: add_tvars'_def fold_types_def distinct_add_tvarsT')
	+
	+(* Figure out better syntax for goal *)
	+lemma proved_terms_well_formed_pre: "\<Theta>, \<Gamma> \<turnstile> p \<Longrightarrow> typ_of p = Some propT \<and> term_ok \<Theta> p"
	+proof (induction \<Gamma> p rule: proves.induct)
	+ case (axiom A \<rho>)
	+
	+ from axiom have ty: "typ_of1 [] A = Some propT"
	+ by (cases \<Theta> rule: theory_full_exhaust) (simp add: wt_term_def typ_of_def)
	+ let ?l = "add_tvars' A []"
	+ let ?l' = "map (\<lambda>(v, S) . ((v, S), \<rho> v S)) ?l"
	+ have dist: "distinct ?l"
	+ using distinct_add_tvars' by simp
	+ moreover have "\<forall>(v, S) \<in> set ?l . typ_ok \<Theta> (Tv v S)"
	+ proof-
	+ have "typ_ok \<Theta> (Tv v T)" if "(v, T) \<in> tvs A" for v T
	+ using axiom.hyps(1) axiom.hyps(2) axioms_terms_ok
	+ term_ok_tvars_sort_ok that typ_ok_def typ_ok_Tv
	+ by (meson wf_sort_def)
	+ moreover have "set ?l = tvs A"
	+ by auto
	+ ultimately show ?thesis
	+ by auto
	+ qed
	+ moreover hence "\<forall>(v, S) \<in> set ?l . has_sort (osig (sig \<Theta>)) (Tv v S) S"
	+ using axiom.hyps(1) has_sort_Tv_refl' by blast
	+
	+ ultimately have "inst_ok \<Theta> ?l'"
	+ apply - apply (rule wf_inst_imp_inst_ok)
	+ using axiom.hyps(1) axiom.hyps(3) by blast+
	+
	+ have simp: "tsubst A \<rho> = subst_typ' ?l' A"
	+ using dist subst_typ'_simulates_tsubst_gen' by auto
	+
	+ have "typ_of1 [] (tsubst A \<rho>) = Some propT"
	+ using tsubst_simulates_subst_typ' axioms_typ_of_propT typ_of1_tsubst ty by fastforce
	+ hence 1: "typ_of1 [] (subst_typ' ?l' A) = Some propT"
	+ using simp by simp
	+
	+ from axiom have "term_ok' (sig \<Theta>) A"
	+ by (cases \<Theta> rule: theory_full_exhaust) (simp add: wt_term_def)
	+ hence 2: "term_ok' (sig \<Theta>) (subst_typ' ?l' A)"
	+ using axiom term_ok'_subst_typ' apply (cases \<Theta> rule: theory_full_exhaust)
	+ apply (simp add: list_all_iff wt_term_def typ_of_def)
	+ by (metis (no_types, lifting) \<open>inst_ok \<Theta> (map (\<lambda>(v, S). ((v, S), \<rho> v S)) (add_tvars' A []))\<close>
	+ axiom.hyps(1) list.pred_mono_strong sig.simps term_ok'_subst_typ' wf_theory.simps
	+ typ_ok_def wf_type_imp_typ_ok_sig)
	+ from 1 2 show ?case using simp by (simp add: wt_term_def typ_of_def)
	+next
	+ case ("assume" A)
	+ then show ?case by (simp add: wt_term_def)
	+next
	+ (Same as case above)
	+ case (forall_intro \<Gamma> B x \<tau>)
	+ hence "term_ok' (sig \<Theta>) B" and "typ_of B = Some propT"
	+ by (simp_all add: wt_term_def)
	+ show ?case using typ_of_mk_all forall_intro
	+ term_ok_mk_all[OF \<open>wf_theory \<Theta>\<close> \<open>term_ok' (sig \<Theta>) B\<close>
	+ \<open>typ_of B = Some propT\<close> _, of _ x] \<open>wf_type (sig \<Theta>) \<tau>\<close>
	+ by auto
	+next
	+ case (forall_elim \<Gamma> \<tau> B a)
	+ thus ?case using term_ok'_subst_bv1
	+ by (auto simp add: typ_of_def term_ok'_subst_bv tinstT_def
	+ wt_term_def bind_eq_Some_conv subst_bv_def typ_of1_subst_bv_gen'
	+ split: if_splits option.splits)
	+next
	+ case (implies_intro \<Gamma> B A)
	+ then show ?case
	+ by (cases \<Theta> rule: wf_theory.cases) (auto simp add: typ_of_def wt_term_def tinstT_def)
	+next
	+ case (implies_elim \<Gamma>\<^sub>1 A B \<Gamma>\<^sub>2)
	+
	+ then show ?case
	+ by (auto simp add: bind_eq_Some_conv typ_of_def wt_term_def tinstT_def
	+ split: option.splits if_splits)
	+next
	+ case (of_class c iT T)
	+
	+ then show ?case
	+ by (cases \<Theta> rule: theory_full_exhaust)
	+ (auto simp add: bind_eq_Some_conv typ_of_def wt_term_def
	+ tinstT_def mk_of_class_def mk_type_def)
	+next
	+ case (\<beta>_conversion T t x)
	+ hence 1: "typ_of (mk_eq (Abs T t $ x) (subst_bv x t)) = Some propT"
	+ by (auto simp add: typ_of_def wt_term_def subst_bv_def bind_eq_Some_conv
	+ typ_of1_subst_bv_gen')
	+ moreover have "term_ok \<Theta> (mk_eq (Abs T t $ x) (subst_bv x t))"
	+ proof-
	+ have "typ_of (mk_eq (Abs T t $ x) (subst_bv x t)) \<noteq> None"
	+ using 1 by simp
	+ (* This needs to be moved out *)
	+ moreover have "term_ok' (sig \<Theta>) (mk_eq (Abs T t $ x) (subst_bv x t))"
	+ proof-
	+ have "term_ok' (sig \<Theta>) (Abs T t $ x)"
	+ using \<beta>_conversion.hyps(2) \<beta>_conversion.hyps(3) term_ok'.simps(4) wt_term_def term_ok_def by blast
	+ moreover hence "term_ok' (sig \<Theta>) (subst_bv x t)"
	+ using subst_bv_def term_ok'_subst_bv1 by auto
	+ moreover have "const_type (sig \<Theta>) STR ''Pure.eq''
	+ = Some ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> propT))"
	+ using \<beta>_conversion.hyps(1) by (cases \<Theta>) fastforce
	+ moreover obtain t' where "typ_of (Abs T t $ x) = Some t'"
	+ by (smt "1" typ_of1_split_App typ_of_def)
	+ moreover hence "typ_of (subst_bv x t) = Some t'"
	+ by (smt list.simps(1) subst_bv_def typ.simps(1) typ_of1_split_App typ_of1_subst_bv_gen' typ_of_Abs_body_typ' typ_of_def)
	+ moreover have "typ_ok_sig (sig \<Theta>) t'"
	+ using \<beta>_conversion.hyps(1) calculation(2) calculation(5) wt_term_def term_ok_imp_typ_ok typ_ok_def by auto
	+ moreover hence "typ_ok_sig (sig \<Theta>) (t' \<rightarrow> propT) "
	+ using \<open>wf_theory \<Theta>\<close> by (cases \<Theta> rule: theory_full_exhaust) auto
	+ moreover have "tinstT (T \<rightarrow> (T \<rightarrow> propT)) ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> propT))"
	+ unfolding tinstT_def by auto
	+ moreover have "tinstT (t' \<rightarrow> (t' \<rightarrow> propT)) ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> propT))"
	+ unfolding tinstT_def by auto
	+ ultimately show ?thesis using \<open>wf_theory \<Theta>\<close> by (cases \<Theta> rule: theory_full_exhaust) auto
	+ qed
	+ ultimately show ?thesis using wt_term_def by simp
	+ qed
	+ ultimately show ?case by simp
	+next
	+ case (eta t \<tau> \<tau>')
	+ hence tyeta: "typ_of (Abs \<tau> (t $ Bv 0)) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using typ_of_eta_expand by auto
	+ moreover have "\<not> is_dependent t"
	+ proof-
	+ have "is_closed t"
	+ using eta.hyps(3) typ_of_imp_closed by blast
	+ thus ?thesis
	+ using is_dependent_def is_open_def loose_bvar1_imp_loose_bvar by blast
	+ qed
	+ ultimately have ty_decr: "typ_of (decr 0 t) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using typ_of1_eta_red_step by blast
	+
	+ hence 1: "typ_of (mk_eq (Abs \<tau> (t $ Bv 0)) (decr 0 t)) = Some propT"
	+ using eta tyeta by (auto simp add: typ_of_def)
	+
	+ have "typ_ok \<Theta> (\<tau> \<rightarrow> \<tau>')"
	+ using eta term_ok_imp_typ_ok by (simp add: wt_term_def del: typ_ok_def)
	+ hence tyok: "typ_ok \<Theta> \<tau>" "typ_ok \<Theta> \<tau>'"
	+ unfolding typ_ok_def by (auto split: option.splits)
	+ hence "term_ok \<Theta> (Abs \<tau> (t $ Bv 0))"
	+ using eta(2) tyeta by (simp add: wt_term_def)
	+ moreover have "term_ok \<Theta> (decr 0 t)"
	+ using eta term_ok'_decr tyeta ty_decr wt_term_def typ_ok_def tyok
	+ by (cases \<Theta> rule: theory_full_exhaust) (auto split: option.splits simp add: tinstT_def)
	+ ultimately have "term_ok \<Theta> (mk_eq (Abs \<tau> (t $ Bv 0)) (decr 0 t))"
	+ using eta.hyps ty_decr tyeta tyok 1 term_ok_mk_eqI
	+ by metis
	+ then show ?case using 1
	+ using eta.hyps(2) eta.hyps(3) has_typ_imp_closed term_ok_subst_bv_no_change
	+ closed_subst_bv_no_change by auto
	+qed
	+
	+corollary proved_terms_well_formed:
	+ assumes "\<Theta>, \<Gamma> \<turnstile> p"
	+ shows "typ_of p = Some propT" "term_ok \<Theta> p"
	+ using assms proved_terms_well_formed_pre by auto
	+
	+lemma forall_intros:
	+ "wf_theory \<Theta> \<Longrightarrow> \<Theta>,\<Gamma> \<turnstile> B \<Longrightarrow> \<forall>(x, \<tau>)\<in>set frees . (x,\<tau>) \<notin> FV \<Gamma> \<and> typ_ok \<Theta> \<tau>
	+ \<Longrightarrow> \<Theta>,\<Gamma> \<turnstile> mk_all_list frees B"
	+by (induction frees arbitrary: B)
	+ (auto intro: proves.forall_intro simp add: mk_all_list_def simp del: FV_def split: prod.splits)
	+
	+(* MOVE *)
	+lemma term_ok_var[simp]: "term_ok \<Theta> (Fv idn \<tau>) = typ_ok \<Theta> \<tau>"
	+ by (simp add: wt_term_def typ_of_def)
	+lemma typ_of_var[simp]: "typ_of (Fv idn \<tau>) = Some \<tau>"
	+ by (simp add: typ_of_def)
	+
	+(* Is this a simp rule? *)
	+lemma is_closed_Fv[simp]: "is_closed (Fv idn \<tau>)" by (simp add: is_open_def)
	+
	+corollary proved_terms_closed: "\<Theta>, \<Gamma> \<turnstile> B \<Longrightarrow> is_closed B"
	+ by (simp add: proved_terms_well_formed(1) typ_of_imp_closed)
	+
	+lemma not_loose_bvar_bind_fv2:
	+ "\<not> loose_bvar t lev \<Longrightarrow> \<not> loose_bvar (bind_fv2 v lev t) (Suc lev)"
	+ by (induction t arbitrary: lev) auto
	+lemma not_loose_bvar_bind_fv2_:
	+ "\<not> loose_bvar (bind_fv2 v lev t) lev \<Longrightarrow> \<not> loose_bvar t lev"
	+ by (induction t arbitrary: lev) (auto split: if_splits)
	+
	+lemma fold_add_vars'_FV_pre: "set (fold add_vars' Hs acc) = set acc \<union> FV (set Hs)"
	+ by (induction Hs arbitrary: acc) (auto simp add: add_vars'_fv_pre)
	+corollary fold_add_vars'_FV[simp]: "set (fold (add_vars') Hs []) = FV (set Hs)"
	+ using fold_add_vars'_FV_pre by simp
	+
	+lemma forall_intro_vars:
	+ assumes "wf_theory \<Theta>" "\<Theta>, set Hs \<turnstile> B"
	+ shows "\<Theta>, set Hs \<turnstile> forall_intro_vars B Hs"
	+ apply (rule forall_intros)
	+ using assms apply simp_all apply clarsimp
	+ using add_vars'_fv proved_terms_well_formed_pre term_ok_vars_typ_ok
	+ by (metis term_ok_vars_typ_ok typ_ok_def wf_type_imp_typ_ok_sig)
	+
	+(* MOVE *)
	+lemma mk_all_list'_preserves_term_ok_typ_of:
	+ assumes "wf_theory \<Theta>" "term_ok \<Theta> B" "typ_of B = Some propT" "\<forall>(idn,ty)\<in>set vs . typ_ok \<Theta> ty"
	+ shows "term_ok \<Theta> (mk_all_list vs B) \<and> typ_of (mk_all_list vs B) = Some propT"
	+using assms proof (induction vs rule: rev_induct)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (snoc v vs)
	+ hence I: "term_ok \<Theta> (mk_all_list vs B)" "typ_of (mk_all_list vs B) = Some propT" by simp_all
	+ obtain idn ty where v: "v=(idn,ty)" by fastforce
	+ hence s: "(mk_all_list (vs @ [v]) B) = mk_all idn ty (mk_all_list (vs) B)"
	+ by (simp add: mk_all_list_def)
	+ have "typ_ok \<Theta> ty" using v snoc.prems by simp
	+ then show ?case using I s term_ok_mk_all snoc.prems(1) wt_term_def typ_of_mk_all by auto
	+qed
	+
	+corollary forall_intro_vars_preserves_term_ok_typ_of:
	+ assumes "wf_theory \<Theta>" "term_ok \<Theta> B" "typ_of B = Some propT"
	+ shows "term_ok \<Theta> (forall_intro_vars B Hs) \<and> typ_of (forall_intro_vars B Hs) = Some propT"
	+proof-
	+ have 1: "\<forall>(idn,ty)\<in>set (add_vars' B []) . typ_ok \<Theta> ty"
	+ using add_vars'_fv assms(1) assms(2) term_ok_vars_typ_ok by blast
	+ thus ?thesis using assms mk_all_list'_preserves_term_ok_typ_of by simp
	+qed
	+
	+(* MOVE and rename *)
	+lemma bind_fv_remove_var_from_fv: "fv (bind_fv (idn, \<tau>) t) = fv t - {(idn, \<tau>)}"
	+ using bind_fv2_Fv_fv bind_fv_def by simp
	+
	+lemma forall_intro_vars_remove_fv[simp]: "fv (forall_intro_vars t []) = {}"
	+ using mk_all_list_fv_unchanged add_vars'_fv by simp
	+
	+lemma term_ok_mk_all_list:
	+ assumes "wf_theory \<Theta>"
	+ assumes "term_ok \<Theta> B"
	+ assumes "typ_of B = Some propT"
	+ assumes "\<forall>(idn, \<tau>) \<in> set l . typ_ok \<Theta> \<tau>"
	+ shows "term_ok \<Theta> (mk_all_list l B) \<and> typ_of (mk_all_list l B) = Some propT"
	+using assms proof(induction l rule: rev_induct)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (snoc v vs)
	+ obtain idn \<tau> where v: "v = (idn, \<tau>)" by fastforce
	+ hence simp: "mk_all_list (vs@[v]) B = mk_all idn \<tau> (mk_all_list vs B)"
	+ by (auto simp add: mk_all_list_def)
	+ have I: "term_ok \<Theta> (mk_all_list vs B)" "typ_of (mk_all_list vs B) = Some propT"
	+ using snoc by auto
	+ have "term_ok \<Theta> (mk_all idn \<tau> (mk_all_list vs B))"
	+ using term_ok_mk_all snoc.prems I v by (auto simp add: wt_term_def)
	+ moreover have "typ_of (mk_all idn \<tau> (mk_all_list vs B)) = Some propT"
	+ using I(2) v typ_of_mk_all by simp
	+ ultimately show ?case by (simp add: simp)
	+qed
	+
	+(* Move, also see if these are not subsumed *)
	+lemma tvs_bind_fv2: "tvs (bind_fv2 (v, T) lev t) \<union> tvsT T = tvs t \<union> tvsT T"
	+ by (induction "(v, T)" lev t rule: bind_fv2.induct) auto
	+lemma tvs_bind_fv: "tvs (bind_fv (v,T) t) \<union> tvsT T = tvs t \<union> tvsT T"
	+ using tvs_bind_fv2 bind_fv_def by simp
	+
	+lemma tvs_mk_all': "tvs (mk_all idn ty B) = tvs B \<union> tvsT ty"
	+ using tvs_bind_fv typ_of_def is_variable.simps(2) by fastforce
	+
	+lemma tvs_mk_all_list:
	+ "tvs (mk_all_list vs B) = tvs B \<union> tvsT_Set (snd ` set vs)"
	+proof(induction vs rule: rev_induct)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (snoc v vs)
	+ obtain idn \<tau> where v: "v = (idn, \<tau>)" by fastforce
	+ show ?case using snoc v tvs_mk_all' by (auto simp add: mk_all_list_def)
	+qed
	+
	+lemma tvs_occs: "occs v t \<Longrightarrow> tvs v \<subseteq> tvs t"
	+ by (induction t) auto
	+
	+lemma tvs_forall_intro_vars: "tvs (forall_intro_vars B Hs) = tvs B"
	+proof-
	+ have "\<forall>(idn, ty)\<in>fv B . occs (Fv idn ty) B"
	+ using fv_occs by blast
	+ hence "\<forall>(idn, ty)\<in>fv B . tvs (Fv idn ty) \<subseteq> tvs B"
	+ using tvs_occs by blast
	+ hence "\<forall>(idn, ty)\<in>fv B . tvsT ty \<subseteq> tvs B"
	+ by simp
	+ hence "tvsT_Set (snd ` fv B) \<subseteq> tvs B"
	+ by fastforce
	+ hence "tvsT_Set (snd ` set (add_vars' B [])) \<subseteq> tvs B"
	+ by (simp add: add_vars'_fv)
	+ thus ?thesis using tvs_mk_all_list by auto
	+qed
	+
	+lemma "strip_all_single_var B = Some \<tau> \<Longrightarrow> strip_all_single_body B \<noteq> B"
	+ using strip_all_vars_step by fastforce
	+
	+lemma strip_all_body_unchanged_iff_strip_all_single_body_unchanged:
	+ "strip_all_body B = B \<longleftrightarrow> strip_all_single_body B = B"
	+ by (metis not_Cons_self2 not_None_eq not_is_all_imp_strip_all_body_unchanged
	+ strip_all_body_single_simp' strip_all_single_var_is_all strip_all_vars_step)
	+
	+lemma strip_all_body_unchanged_imp_strip_all_vars_no:
	+ assumes "strip_all_body B = B"
	+ shows "strip_all_vars B = []"
	+ by (smt assms not_Cons_self2 strip_all_body_single_simp' strip_all_single_body.simps(1) strip_all_vars.elims)
	+
	+lemma strip_all_body_unchanged_imp_strip_all_single_body_unchanged:
	+ "strip_all_body B = B \<Longrightarrow> strip_all_single_body B = B"
	+ by (smt (z3) not_Cons_self2 strip_all_body_single_simp' strip_all_single_body.simps(1) strip_all_vars.simps(1))
	+
	+lemma strip_all_single_body_unchanged_imp_strip_all_body_unchanged:
	+ "strip_all_single_body B = B \<Longrightarrow> strip_all_body B = B"
	+ by (auto elim!: strip_all_single_body.elims)
	+
	+lemma strip_all_single_var_np_imp_strip_all_body_single_unchanged:
	+ "strip_all_single_var B = None \<Longrightarrow> strip_all_single_body B = B"
	+ by (auto elim!: strip_all_single_var.elims)
	+
	+lemma strip_all_single_form: "strip_all_single_var B = Some \<tau>
	+ \<Longrightarrow> Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (strip_all_single_body B) = B"
	+ by (auto elim!: strip_all_single_var.elims split: if_splits)
	+
	+lemma proves_strip_all_single:
	+ assumes "\<Theta>, \<Gamma> \<turnstile> B" "strip_all_single_var B = Some \<tau>"
	+ "typ_of t = Some \<tau>" "term_ok \<Theta> t"
	+ shows "\<Theta>, \<Gamma> \<turnstile> subst_bv t (strip_all_single_body B)"
	+proof-
	+ have 1: "Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (strip_all_single_body B) = B"
	+ using assms(2) strip_all_single_form by blast
	+ hence "\<Theta>, \<Gamma> \<turnstile> Abs \<tau> (strip_all_single_body B) \<bullet> t"
	+ using assms forall_elim
	+ proof -
	+ have "has_typ t \<tau>"
	+ by (meson \<open>typ_of t = Some \<tau>\<close> has_typ_iff_typ_of)
	+ then show ?thesis
	+ by (metis "1" assms(1) assms(4) betapply.simps(1) forall_elim term_ok_def wt_term_def)
	+ qed
	+ thus ?thesis by simp
	+qed
	+
	+corollary proves_strip_all_single_Fv:
	+ assumes "\<Theta>, \<Gamma> \<turnstile> B" "strip_all_single_var B = Some \<tau>"
	+ shows "\<Theta>, \<Gamma> \<turnstile> subst_bv (Fv x \<tau>) (strip_all_single_body B)"
	+proof -
	+ have ok: "term_ok \<Theta> B"
	+ using assms(1) proved_terms_well_formed(2) by auto
	+ thm strip_all_single_form
	+ wt_term_def term_ok_var typ_of_var typ_ok_def proves_strip_all_single
	+ strip_all_single_form
	+ have s: "B = Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (strip_all_single_body B)"
	+ using assms(2) strip_all_single_form[symmetric] by simp
	+ have "\<tau> \<in> Types B"
	+ by (subst s, simp)
	+ hence "typ_ok \<Theta> \<tau>"
	+ by (metis ok s term_ok'.simps(4) term_ok'.simps(5) term_okD1 typ_ok_def typ_ok_sig_imp_wf_type)
	+ hence "term_ok \<Theta> (Fv x \<tau>)"
	+ using term_ok_var by blast
	+ then show ?thesis
	+ using assms proves_strip_all_single[where \<tau>=\<tau>] by auto
	+qed
	+
	+lemma strip_all_vars_no_strip_all_body_unchanged[simp]:
	+ "strip_all_vars B = [] \<Longrightarrow> strip_all_body B = B"
	+ by (auto elim!: strip_all_vars.elims)
	+
	+lemma "strip_all_vars B = (\<tau>s@[\<tau>]) \<Longrightarrow> strip_all_body B
	+ = strip_all_single_body (Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> (strip_all_body B))"
	+ by simp
	+
	+lemma strip_all_vars_incr_bv: "strip_all_vars (incr_bv inc lev t) = strip_all_vars t"
	+ by (induction t arbitrary: lev rule: strip_all_vars.induct) auto
	+lemma strip_all_vars_incr_boundvars: "strip_all_vars (incr_boundvars inc t) = strip_all_vars t"
	+ using incr_boundvars_def strip_all_vars_incr_bv by simp
	+
	+lemma strip_all_vars_subst_bv1_Fv:
	+ "strip_all_vars (subst_bv1 B lev (Fv x \<tau>)) = strip_all_vars B"
	+ by (induction B arbitrary: lev rule: strip_all_vars.induct) (auto simp add: incr_boundvars_def)
	+lemma strip_all_vars_subst_bv_Fv:
	+ "strip_all_vars (subst_bv (Fv x \<tau>) B) = strip_all_vars B"
	+ by (simp add: strip_all_vars_subst_bv1_Fv subst_bv_def)
	+
	+lemma "strip_all_single_var B = Some \<tau>
	+ \<Longrightarrow> strip_all_vars (subst_bv (Fv x \<tau>) (strip_all_single_body B)) = tl (strip_all_vars B)"
	+ by (metis list.sel(3) strip_all_vars_step strip_all_vars_subst_bv_Fv)
	+
	+(* Allowing general terms instead of just vars here is more difficult as one could create new leading
	+ \<And>s *)
	+corollary proves_strip_all_vars_Fv:
	+ assumes "length xs = length (strip_all_vars B)" "\<Theta>, \<Gamma> \<turnstile> B"
	+ shows "\<Theta>, \<Gamma> \<turnstile> fold (\<lambda>(x,\<tau>). subst_bv (Fv x \<tau>) o strip_all_single_body)
	+ (zip xs (strip_all_vars B)) B"
	+using assms proof (induction xs "strip_all_vars B" arbitrary: B rule: list_induct2)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons x xs \<tau> \<tau>s)
	+ have st: "strip_all_single_var B = Some \<tau>"
	+ by (metis Cons.hyps(3) is_all_iff_strip_all_vars_not_empty list.distinct(1) list.inject
	+ option.exhaust strip_all_single_var_is_all strip_all_vars_step)
	+ moreover have "term_ok \<Theta> (Fv x \<tau>)"
	+ proof-
	+ obtain B' where "Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $ Abs \<tau> B' = B"
	+ using st strip_all_single_form by blast
	+ moreover have "term_ok \<Theta> B"
	+ using Cons.prems proved_terms_well_formed(2) by auto
	+ ultimately have "typ_ok \<Theta> \<tau>"
	+ using term_ok'.simps(5) term_ok'.simps(4) term_ok_def wt_term_def typ_ok_def by blast
	+ thus ?thesis unfolding term_ok_def wt_term_def typ_ok_def by simp
	+ qed
	+ ultimately have 1: "\<Theta>,\<Gamma> \<turnstile> subst_bv (Fv x \<tau>) (strip_all_single_body B)"
	+ using proves_strip_all_single
	+ by (simp add: Cons.prems proves_strip_all_single_Fv)
	+ have "\<Theta>,\<Gamma> \<turnstile> fold (\<lambda>(x, \<tau>). subst_bv (Fv x \<tau>) \<circ> strip_all_single_body)
	+ (zip xs (strip_all_vars (subst_bv (Fv x \<tau>) (strip_all_single_body B))))
	+ (subst_bv (Fv x \<tau>) (strip_all_single_body B))"
	+ apply (rule Cons.hyps)
	+ apply (metis Cons.hyps(3) list.inject st strip_all_vars_step strip_all_vars_subst_bv_Fv)
	+ using 1 by simp
	+ moreover have "strip_all_vars B = \<tau> # \<tau>s"
	+ using Cons.hyps(3) by auto
	+ ultimately show ?case
	+ using st strip_all_vars_step strip_all_vars_subst_bv_Fv by fastforce
	+qed
	+
	+
	+lemma trivial_pre_depr: "term_ok \<Theta> c \<Longrightarrow> typ_of c = Some propT \<Longrightarrow> \<Theta>, {c} \<turnstile> c"
	+ by (rule "assume") (simp_all add: wt_term_def)
	+
	+lemma trivial_pre:
	+ assumes "wf_theory \<Theta>" "term_ok \<Theta> c" "typ_of c = Some propT"
	+ shows "\<Theta>, {} \<turnstile> c \<longmapsto> c"
	+proof-
	+ have s: "{} = {c} - {c}" by simp
	+ show ?thesis
	+ apply (subst s)
	+ apply (rule "implies_intro")
	+ using assms by (auto simp add: wt_term_def intro: "assume")
	+qed
	+
	+lemma inst_var:
	+ assumes wf_theory: "wf_theory \<Theta>"
	+ assumes B: "\<Theta>, \<Gamma> \<turnstile> B"
	+ assumes a_ok: "term_ok \<Theta> a"
	+ assumes typ_a: "typ_of a = Some \<tau>"
	+ assumes free: "(x,\<tau>) \<notin> FV \<Gamma>"
	+ shows "\<Theta>, \<Gamma> \<turnstile> subst_term [((x, \<tau>), a)] B"
	+proof-
	+ have s1: "mk_all x \<tau> B = Ct STR ''Pure.all'' ((\<tau> \<rightarrow> propT) \<rightarrow> propT) $
	+ Abs \<tau> (bind_fv (x, \<tau>) B)"
	+ by (simp add: typ_of_def)
	+ have closed_B: "is_closed B" using B proved_terms_well_formed_pre
	+ using typ_of_imp_closed by blast
	+ have "typ_ok \<Theta> \<tau>" using wt_term_def typ_ok_def term_ok_imp_typ_ok
	+ using a_ok wf_theory typ_a by blast
	+ hence p1: "\<Theta>, \<Gamma> \<turnstile> mk_all x \<tau> B"
	+ using forall_intro[OF wf_theory B] B typ_a wt_term_def wf_theory
	+ term_ok_imp_typ_ok free by simp
	+ have "\<Theta>, \<Gamma> \<turnstile> subst_bv a (bind_fv (x, \<tau>) B)"
	+ using forall_elim[of _ _ \<tau>] p1 typ_a a_ok proves_strip_all_single
	+ by (meson has_typ_iff_typ_of term_ok_def wt_term_def)
	+ have "\<Theta>, \<Gamma> \<turnstile> subst_bv a ((bind_fv (x, \<tau>) B))"
	+ using forall_elim[of _ _ \<tau>] p1 typ_a a_ok proves_strip_all_single
	+ by (meson has_typ_iff_typ_of term_ok_def wt_term_def)
	+ thus "\<Theta>, \<Gamma> \<turnstile> subst_term [((x, \<tau>), a)] B"
	+ using instantiate_var_same_type'' assms closed_B by simp
	+qed
	+
	+(* MOVE *)
	+lemma subst_term_single_no_change[simp]:
	+ assumes nvar: "(x,\<tau>)\<notin>fv B"
	+ shows "subst_term [((x,\<tau>), t)] B = B"
	+ using assms by (induction B) auto
	+
	+lemma fv_subst_term_single:
	+ assumes var: "(x,\<tau>)\<in>fv B"
	+ assumes "\<And>p . p \<in> fv t \<Longrightarrow> p ~= (x,\<tau>)"
	+ shows "fv (subst_term [((x,\<tau>), t)] B) = fv B - {(x,\<tau>)} \<union> fv t"
	+using assms proof (induction B)
	+ case (App B1 B2)
	+ then show ?case
	+ by (cases "(x,\<tau>)\<in>fv B1"; cases "(x,\<tau>)\<in>fv B2") auto
	+qed simp_all
	+
	+(* TODO: Get rid of distinctness and non_overlap by performing standard single to parallel substitution
	+ construction: Rename variables, then substitute the now non problematic terms
	+
	+ TODO: Check assms for useless ones, improve syntax
	+*)
	+lemma inst_vars_pre:
	+ assumes wf_theory: "wf_theory \<Theta>"
	+ assumes B: "\<Theta>, \<Gamma> \<turnstile> B"
	+ (assumes vars: "set (map fst insts) \<subseteq> fv B")
	+ assumes vars_ok: "list_all (term_ok \<Theta>) (map snd insts)"
	+ assumes typs_ok: "list_all (\<lambda>((idx, ty), t) . typ_of t = Some ty) insts"
	+ assumes free: "list_all (\<lambda>((idx, ty), t) . (idx, ty) \<notin> FV \<Gamma>) insts"
	+ assumes typ_a: "typ_of a = Some \<tau>"
	+ assumes distinct: "distinct (map fst insts)"
	+ assumes no_overlap: "\<And>x . x \<in> (\<Union>t \<in> snd ` (set insts) . fv t) \<Longrightarrow> x \<notin> fst ` (set insts)"
	+ shows "\<Theta>, \<Gamma> \<turnstile> fold (\<lambda>single. subst_term [single]) insts B"
	+using assms proof(induction insts arbitrary: B)
	+ case Nil
	+ then show ?case using B by simp
	+next
	+ case (Cons x xs)
	+
	+ from this obtain idn ty t where x: "x = ((idn, ty), t)" by (metis prod.collapse)
	+
	+ have "\<Theta>, \<Gamma> \<turnstile> fold (\<lambda>single. subst_term [single]) (x # xs) B
	+ \<longleftrightarrow> \<Theta>, \<Gamma> \<turnstile> fold (\<lambda>single. subst_term [single]) xs (subst_term [x] B)"
	+ by simp
	+ moreover have "\<Theta>, \<Gamma> \<turnstile> fold (\<lambda>single. subst_term [single]) xs (subst_term [x] B)"
	+ proof-
	+ have single: "\<Theta>, \<Gamma> \<turnstile> (subst_term [x] B)" using inst_var Cons by (simp add: x)
	+ show ?thesis using Cons single by simp
	+ qed
	+ ultimately show ?case by simp
	+qed
	+
	+(* MOVE *)
	+lemma subterm_term_ok':
	+ "is_std_sig \<Sigma> \<Longrightarrow> term_ok' \<Sigma> t \<Longrightarrow> is_closed st \<Longrightarrow> occs st t \<Longrightarrow> term_ok' \<Sigma> st"
	+proof (induction t arbitrary: st)
	+ case (Abs T t)
	+ then show ?case by (auto simp add: is_open_def)
	+next
	+ case (App t1 t2)
	+ then show ?case using term_ok'_occs by blast
	+qed auto
	+
	+(* MOVE *)
	+lemma infinite_fv_UNIV: "infinite (UNIV :: (indexname \<times> typ) set)"
	+ by (simp add: finite_prod)
	+
	+
	+lemma implies_intro'_pre:
	+ assumes "wf_theory \<Theta>" "\<Theta>, \<Gamma> \<turnstile> B" "term_ok \<Theta> A" "typ_of A = Some propT" "A \<notin> \<Gamma>"
	+ shows "\<Theta>, \<Gamma> \<turnstile> A \<longmapsto> B"
	+ using assms proves.implies_intro apply (simp add: wt_term_def)
	+ by (metis Diff_empty Diff_insert0)
	+
	+lemma implies_intro'_pre2:
	+ assumes "wf_theory \<Theta>" "\<Theta>, \<Gamma> \<turnstile> B" "term_ok \<Theta> A" "typ_of A = Some propT" "A \<in> \<Gamma>"
	+ shows "\<Theta>, \<Gamma> \<turnstile> A \<longmapsto> B"
	+proof-
	+ have 1: "\<Theta>, \<Gamma> - {A} \<turnstile> A \<longmapsto> B"
	+ using assms proves.implies_intro by (simp add: wt_term_def)
	+ have "\<Theta>, \<Gamma> - {A} - {A} \<turnstile> A \<longmapsto> (A \<longmapsto> B)"
	+ using assms proves.implies_intro
	+ by (simp add: 1 implies_intro'_pre)
	+ moreover have "\<Theta>, {A} \<turnstile> A"
	+ using proves.assume assms
	+ by (simp add: trivial_pre_depr)
	+ moreover have "\<Gamma> = (\<Gamma> - {A} - {A}) \<union> {A}"
	+ using assms by auto
	+ ultimately show ?thesis using proves.implies_elim by metis
	+qed
	+
	+(* Names are suspect, change *)
	+lemma subst_term_preserves_typ_of1[simp]:
	+ "typ_of1 Ts (subst_term [((x, \<tau>), Fv y \<tau>)] t) = typ_of1 Ts t"
	+ by (induction Ts t rule: typ_of1.induct) (fastforce)+
	+
	+lemma subst_term_preserves_typ_of[simp]:
	+ "typ_of (subst_term [((x, \<tau>), Fv y \<tau>)] t) = typ_of t"
	+ using typ_of_def by simp
	+
	+lemma subst_term_preserves_term_ok'[simp]:
	+ "term_ok' \<Sigma> (subst_term [((x, \<tau>), Fv y \<tau>)] t) \<longleftrightarrow> term_ok' \<Sigma> t"
	+ by (induction t) auto
	+
	+lemma subst_term_preserves_term_ok[simp]:
	+ "term_ok \<Theta> (subst_term [((x, \<tau>), Fv y \<tau>)] A) \<longleftrightarrow> term_ok \<Theta> A"
	+ by (simp add: wt_term_def)
	+
	+lemma not_in_FV_in_fv_not_in: "(x,\<tau>) \<notin> FV \<Gamma> \<Longrightarrow> (x,\<tau>) \<in> fv t \<Longrightarrow> t \<notin> \<Gamma>"
	+ by auto
	+
	+lemma subst_term_fv: "fv (subst_term [((x, \<tau>), Fv y \<tau>)] t)
	+ = (if (x,\<tau>) \<in> fv t then insert (y,\<tau>) else id) (fv t - {(x,\<tau>)})"
	+ by (induction t) auto
	+
	+lemma rename_free:
	+ assumes wf_theory: "wf_theory \<Theta>"
	+ assumes B: "\<Theta>, \<Gamma> \<turnstile> B"
	+ assumes free: "(x,\<tau>)\<notin> FV \<Gamma>"
	+ shows "\<Theta>, \<Gamma> \<turnstile> subst_term [((x, \<tau>), Fv y \<tau>)] B"
	+ by (metis B free inst_var proved_terms_well_formed(2) subst_term_single_no_change
	+ term_ok_vars_typ_ok term_ok_var wf_theory typ_of_var)
	+
	+lemma tvs_subst_term_single[simp]: "tvs (subst_term [((x, \<tau>), Fv y \<tau>)] A) = tvs A"
	+ by (induction A) auto
	+
	+(* Conditions are a bit random, clear up *)
	+lemma weaken_proves': "\<Theta>, \<Gamma> \<turnstile> B \<Longrightarrow> term_ok \<Theta> A \<Longrightarrow> typ_of A = Some propT \<Longrightarrow> A \<notin> \<Gamma>
	+ \<Longrightarrow> finite \<Gamma>
	+ \<Longrightarrow> \<Theta>, insert A \<Gamma> \<turnstile> B"
	+proof (induction \<Gamma> B arbitrary: A rule: proves.induct)
	+ case (axiom A insts \<Gamma> A')
	+ then show ?case using proves.axiom axiom by metis
	+next
	+ case ("assume" A \<Gamma> A')
	+ then show ?case using proves.intros by blast
	+next
	+ case (forall_intro \<Gamma> B x \<tau>)
	+
	+ have "\<exists>y . y\<notin>fst ` (fv A \<union> fv B \<union> FV \<Gamma>)"
	+ proof-
	+ have "finite (FV \<Gamma>)"
	+ using finite_fv forall_intro.prems by auto
	+ hence "finite (fv A \<union> fv B \<union> FV \<Gamma>)" by simp
	+ hence "finite (fst ` (fv A \<union> fv B \<union> FV \<Gamma>))" by simp
	+
	+ thus ?thesis using variant_variable_fresh by blast
	+ qed
	+ from this obtain y where "y\<notin>fst ` (fv A \<union> fv B \<union> FV \<Gamma>)" by auto
	+
	+ have not_in_ren: "subst_term [((x, \<tau>), Fv y \<tau>)] A \<notin> \<Gamma>"
	+ proof(cases "(x, \<tau>) \<in> fv A")
	+ case True
	+ show ?thesis
	+ apply (rule not_in_FV_in_fv_not_in[of y \<tau>])
	+ apply (metis (full_types) Un_iff \<open>y \<notin> fst ` (fv A \<union> fv B \<union> FV \<Gamma>)\<close> fst_conv image_eqI)
	+ using True subst_term_fv by auto
	+ next
	+ case False
	+ hence "subst_term [((x, \<tau>), Fv y \<tau>)] A = A"
	+ by simp
	+ then show ?thesis
	+ by (simp add: forall_intro.prems(3))
	+ qed
	+ have term_ok_ren: "term_ok \<Theta> (subst_term [((x, \<tau>), Fv y \<tau>)] A)"
	+ using forall_intro.prems(1) subst_term_preserves_term_ok by blast
	+ have typ_of_ren: "typ_of (subst_term [((x, \<tau>), Fv y \<tau>)] A) = Some propT"
	+ using forall_intro.prems by auto
	+
	+ hence "\<Theta>, insert (subst_term [((x, \<tau>), Fv y \<tau>)] A) \<Gamma> \<turnstile> B"
	+ using forall_intro.IH forall_intro.prems(3) forall_intro.prems(4)
	+ not_in_ren term_ok_ren typ_of_ren by blast
	+ have "\<Theta>, insert (subst_term [((x, \<tau>), Fv y \<tau>)] A) \<Gamma> \<turnstile> mk_all x \<tau> B"
	+ apply (rule proves.forall_intro)
	+ apply (simp add: forall_intro.hyps(1))
	+ using \<open>\<Theta>, insert (subst_term [((x, \<tau>), Fv y \<tau>)] A) \<Gamma> \<turnstile> B\<close> apply blast
	+ subgoal using subst_term_fv \<open>(x, \<tau>) \<notin> FV \<Gamma>\<close> apply simp
	+ by (metis Un_iff \<open>y \<notin> fst ` (fv A \<union> fv B \<union> FV \<Gamma>)\<close> fst_conv image_eqI)
	+ using forall_intro.hyps(4) by blast
	+ hence "\<Theta>, \<Gamma> \<turnstile> subst_term [((x, \<tau>), Fv y \<tau>)] A \<longmapsto> mk_all x \<tau> B"
	+ using forall_intro.hyps(1) forall_intro.hyps(2) forall_intro.hyps(4)
	+ forall_intro.prems(1) forall_intro.prems(3)
	+ implies_intro'_pre local.forall_intro not_in_ren proves.forall_intro
	+ subst_term_preserves_typ_of term_ok_ren by auto
	+ hence "\<Theta>, \<Gamma> \<turnstile> subst_term [((y, \<tau>), Fv x \<tau>)]
	+ (subst_term [((x, \<tau>), Fv y \<tau>)] A \<longmapsto> mk_all x \<tau> B)"
	+ by (smt Un_iff \<open>y \<notin> fst ` (fv A \<union> fv B \<union> FV \<Gamma>)\<close> forall_intro.hyps(1)
	+ fst_conv image_eqI rename_free)
	+ hence "\<Theta>, \<Gamma> \<turnstile> A \<longmapsto> mk_all x \<tau> B"
	+ using forall_intro proves.forall_intro implies_intro'_pre by auto
	+ moreover have "\<Theta>, {A} \<turnstile> A"
	+ using forall_intro.prems(1) local.forall_intro(7) trivial_pre_depr by blast
	+ ultimately show ?case
	+ using implies_elim by fastforce
	+next
	+ case (forall_elim \<Gamma> \<tau> B a)
	+ then show ?case using proves.forall_elim by blast
	+next
	+ case (implies_intro \<Gamma> B N)
	+ then show ?case
	+ proof (cases "A=N")
	+ case True
	+ (* Do this less automatic probably, for speed reasons*)
	+ hence "\<Theta>,\<Gamma> - {N} \<turnstile> N \<longmapsto> B"
	+
	+ using implies_intro.hyps(1) implies_intro.hyps(2) implies_intro.hyps(3)
	+ implies_intro.hyps(4) proves.implies_intro by blast
	+ hence "\<Theta>,\<Gamma> - {N} \<turnstile> A \<longmapsto> N \<longmapsto> B"
	+ using True implies_intro'_pre implies_intro.hyps(1) implies_intro.hyps(3)
	+ implies_intro.hyps(4) implies_intro.prems(1) by blast
	+ hence "\<Theta>,insert N \<Gamma> \<turnstile> B"
	+ using True implies_elim implies_intro insert_absorb by fastforce
	+ then show ?thesis
	+ using True implies_elim implies_intro.hyps(3) implies_intro.hyps(4) implies_intro.prems(1)
	+ trivial_pre_depr by (simp add: implies_intro'_pre2 implies_intro.hyps(1))
	+ next
	+ case False
	+ hence s: "insert A (\<Gamma> - {N}) = insert A \<Gamma> - {N}" by auto
	+
	+ have I: "\<Theta>,insert A \<Gamma> \<turnstile> B"
	+ using implies_intro.prems False by (auto intro!: implies_intro.IH)
	+
	+ show ?thesis
	+ apply (subst s)
	+ apply (rule proves.implies_intro)
	+ using implies_intro.hyps I by auto
	+ qed
	+next
	+ case (implies_elim \<Gamma>\<^sub>1 A' B \<Gamma>\<^sub>2)
	+ show ?case
	+ using proves.implies_elim implies_elim by (metis UnCI Un_insert_left finite_Un)
	+next
	+ case (\<beta>_conversion \<Gamma> s T t x)
	+ then show ?case using proves.\<beta>_conversion by blast
	+next
	+ case (eta t \<tau> \<tau>')
	+ then show ?case using proves.eta by simp
	+next
	+ case (of_class c T' T \<Gamma>)
	+ then show ?case
	+ by (simp add: proves.of_class)
	+qed
	+corollary weaken_proves: "\<Theta>, \<Gamma> \<turnstile> B \<Longrightarrow> term_ok \<Theta> A \<Longrightarrow> typ_of A = Some propT
	+ \<Longrightarrow> finite \<Gamma>
	+ \<Longrightarrow> \<Theta>, insert A \<Gamma> \<turnstile> B"
	+ using weaken_proves' by (metis insert_absorb)
	+
	+lemma weaken_proves_set: "finite \<Gamma>2 \<Longrightarrow> \<Theta>, \<Gamma> \<turnstile> B \<Longrightarrow> \<forall>A\<in>\<Gamma>2 . term_ok \<Theta> A \<Longrightarrow> \<forall>A\<in>\<Gamma>2 . typ_of A = Some propT
	+ \<Longrightarrow> finite \<Gamma>
	+ \<Longrightarrow> \<Theta>, \<Gamma> \<union> \<Gamma>2 \<turnstile> B"
	+ by (induction \<Gamma>2 arbitrary: \<Gamma> rule: finite_induct) (use weaken_proves in auto)
	+
	+(* Maybe do directly instead *)
	+lemma no_tvsT_imp_subst_typ_unchanged: "tvsT T = empty \<Longrightarrow> subst_typ insts T = T"
	+ by (simp add: no_tvsT_imp_tsubsT_unchanged tsubstT_simulates_subst_typ)
	+
	+lemma subst_typ_fv:
	+ shows "apsnd (subst_typ insts) ` fv B = fv (subst_typ' insts B)"
	+ by (induction B) auto
	+
	+lemma subst_typ_fv_point:
	+ assumes "(x, \<tau>) \<in> fv B"
	+ shows "(x, subst_typ insts \<tau>) \<in> fv (subst_typ' insts B)"
	+ using subst_typ_fv by (metis apsnd_conv assms image_eqI)
	+
	+lemma subst_typ_typ_ok:
	+ assumes "typ_ok_sig \<Sigma> \<tau>"
	+ assumes "list_all (typ_ok_sig \<Sigma>) (map snd insts)"
	+ shows "typ_ok_sig \<Sigma> (subst_typ insts \<tau>)"
	+using assms proof (induction \<tau>)
	+ case (Tv idn \<tau>)
	+ then show ?case
	+ by (cases "lookup (\<lambda>x. x = (idn, \<tau>)) insts")
	+ (fastforce simp add: list_all_iff dest: lookup_present_eq_key' split: prod.splits)+
	+qed (auto simp add: list_all_iff lookup_present_eq_key' split: option.splits)
	+
	+lemma subst_typ_comp_single_left: "subst_typ [single] (subst_typ insts T)
	+ = subst_typ (map (apsnd (subst_typ [single])) insts@[single]) T"
	+proof (induction T)
	+ case (Tv idn ty)
	+ then show ?case by (induction insts) auto
	+qed auto
	+
	+lemma subst_typ_comp_single_left_stronger: "subst_typ [single] (subst_typ insts T)
	+ = subst_typ (map (apsnd (subst_typ [single])) insts
	+ @ (if fst single \<in> set (map fst insts) then [] else [single])) T"
	+proof (induction T)
	+ case (Tv idn S)
	+ then show ?case
	+ proof (cases "lookup (\<lambda>x. x = (idn,S)) insts")
	+ case None
	+ hence "lookup (\<lambda>x. x = (idn, S)) (map (apsnd (subst_typ [single])) insts) = None"
	+ by (induction insts) (auto split: if_splits)
	+ then show ?thesis
	+ using None apply simp
	+ by (metis eq_fst_iff list.set_map lookup.simps(2) lookup_None_iff subst_typ.simps(2)
	+ subst_typ_comp subst_typ_nil the_default.simps(1))
	+ next
	+ case (Some a)
	+ hence "lookup (\<lambda>x. x = (idn, S)) (map (apsnd (subst_typ [single])) insts) = Some (subst_typ [single] a)"
	+ by (induction insts) (auto split: if_splits)
	+ then show ?thesis
	+ using Some apply simp
	+ by (metis subst_typ.simps(2) subst_typ_comp_single_left the_default.simps(2))
	+ qed
	+qed auto
	+
	+lemma subst_typ'_comp_single_left: "subst_typ' [single] (subst_typ' insts t)
	+ = subst_typ' (map (apsnd (subst_typ [single])) insts@[single]) t"
	+ by (induction t) (use subst_typ_comp_single_left in auto)
	+
	+lemma subst_typ'_comp_single_left_stronger: "subst_typ' [single] (subst_typ' insts t)
	+ = subst_typ' (map (apsnd (subst_typ [single])) insts
	+ @ (if fst single \<in> set (map fst insts) then [] else [single])) t"
	+ by (induction t) (use subst_typ_comp_single_left_stronger in auto)
	+
	+lemma subst_typ_preserves_typ_ok:
	+ assumes "wf_theory \<Theta>"
	+ assumes "typ_ok \<Theta> T"
	+ assumes "list_all (typ_ok \<Theta>) (map snd insts)"
	+ shows "typ_ok \<Theta> (subst_typ insts T)"
	+using assms proof (induction T)
	+ case (Ty n Ts)
	+ have I: "\<forall>x \<in> set Ts . typ_ok \<Theta> (subst_typ insts x)"
	+ using Ty by (auto simp add: typ_ok_def list_all_iff split: option.splits)
	+ moreover have "(\<forall>x \<in> set Ts . typ_ok \<Theta> (subst_typ insts x)) =
	+ (\<forall>x \<in> set (map (subst_typ insts) Ts) . typ_ok \<Theta> x)" by (induction Ts) auto
	+ ultimately have "list_all (wf_type (sig \<Theta>)) (map (subst_typ insts) Ts)"
	+ using list_allI typ_ok_def Ball_set typ_ok_def by fastforce
	+ then show ?case using Ty list.pred_mono_strong by (force split: option.splits)
	+next
	+ case (Tv idn \<tau>)
	+ then show ?case by (induction insts) auto
	+qed
	+
	+lemma typ_ok_Ty[simp]: "typ_ok \<Theta> (Ty n Ts) \<Longrightarrow> list_all (typ_ok \<Theta>) Ts"
	+ by (auto simp add: typ_ok_def list.pred_mono_strong split: option.splits)
	+lemma typ_ok_sig_Ty[simp]: "typ_ok_sig \<Sigma> (Ty n Ts) \<Longrightarrow> list_all (typ_ok_sig \<Sigma>) Ts"
	+ by (auto simp add: list.pred_mono_strong split: option.splits)
	+
	+lemma wf_theory_imp_wf_osig: "wf_theory \<Theta> \<Longrightarrow> wf_osig (osig (sig \<Theta>))"
	+ by (cases \<Theta> rule: theory_full_exhaust) simp
	+
	+lemma the_lift2_option_Somes[simp]: "the (lift2_option f (Some a) (Some b)) = f a b" by simp
	+
	+lemma class_les_mgd:
	+ assumes "wf_osig oss"
	+ assumes "tcsigs oss type = Some mgd"
	+ assumes "mgd C' = Some Ss'"
	+ assumes "class_les (subclass oss) C' C"
	+ shows "mgd C \<noteq> None"
	+proof-
	+ have "complete_tcsigs (subclass oss) (tcsigs oss)"
	+ using assms(1) by (cases oss) simp
	+ thus ?thesis
	+ using assms(2-4) by (auto simp add: class_les_def class_leq_def complete_tcsigs_def intro!: domI ranI)
	+qed
	+
	+lemma has_sort_sort_leq_osig:
	+ assumes "wf_osig (sub, tcs)" "has_sort (sub,tcs) T S" "sort_leq sub S S'"
	+ shows "has_sort (sub,tcs) T S'"
	+using assms(2,3,1) proof (induction "(sub,tcs)" T S arbitrary: S' rule: has_sort.induct)
	+ case (has_sort_Tv S S' tcs a)
	+ then show ?case
	+ using wf_osig.simps wf_subclass_loc.intro wf_subclass_loc.sort_leq_trans by blast
	+next
	+ case (has_sort_Ty \<kappa> K S Ts)
	+ show ?case
	+ proof (rule has_sort.has_sort_Ty[where dm=K])
	+ show "tcs \<kappa> = Some K"
	+ using has_sort_Ty.hyps(1) .
	+ next
	+ show "\<forall>C\<in>S'. \<exists>Ss. K C = Some Ss \<and> list_all2 (has_sort (sub, tcs)) Ts Ss"
	+ proof (rule ballI)
	+ fix C assume C: "C \<in> S'"
	+ show "\<exists>Ss. K C = Some Ss \<and> list_all2 (has_sort (sub, tcs)) Ts Ss"
	+ proof (cases "C \<in> S")
	+ case True
	+ then show ?thesis
	+ using list_all2_mono has_sort_Ty.hyps(2) by fastforce
	+ next
	+ case False
	+ from this obtain C' where C':
	+ "C' \<in> S" "class_les sub C' C"
	+ by (metis C class_les_def has_sort_Ty.prems(1) has_sort_Ty.prems(2) sort_leq_def
	+ subclass.simps wf_osig_imp_wf_subclass_loc wf_subclass_loc.class_leq_antisym)
	+ from this obtain Ss' where Ss':
	+ "K C' = Some Ss'" "list_all2 (has_sort (sub,tcs)) Ts Ss'"
	+ using list_all2_mono has_sort_Ty.hyps(2) by fastforce
	+ from this obtain Ss where Ss: "K C = Some Ss"
	+ using has_sort_Ty.prems class_les_mgd C'(2) has_sort_Ty.hyps(1) wf_theory_imp_wf_osig
	+ by force
	+ have lengthSs': "length Ts = length Ss'"
	+ using Ss'(2) list_all2_lengthD by auto
	+ have coregular:
	+ "coregular_tcsigs sub tcs"
	+ using has_sort_Ty.prems(2) wf_theory_imp_wf_osig wf_tcsigs_def
	+ by (metis wf_osig.simps)
	+
	+ hence leq: "list_all2 (sort_leq sub) Ss' Ss"
	+ using C'(2) Ss'(1) Ss has_sort_Ty.hyps(1) ranI
	+ by (metis class_les_def coregular_tcsigs_def domI option.sel)
	+
	+ have "list_all2 (has_sort (sub,tcs)) Ts Ss"
	+ proof(rule list_all2_all_nthI)
	+ show "length Ts = length Ss"
	+ using Ss Ss'(1) lengthSs' wf_theory_imp_wf_osig leq list_all2_lengthD by auto
	+ next
	+ fix n assume n: "n < length Ts"
	+ hence "sort_leq sub (Ss' ! n) (Ss ! n)"
	+ using leq by (simp add: lengthSs' list_all2_nthD)
	+ thus "has_sort (sub,tcs) (Ts ! n) (Ss ! n)"
	+ using has_sort_Ty.hyps(2) has_sort_Ty.prems(2) C'(1) Ss'(1) n list_all2_nthD
	+ by fastforce
	+ qed
	+
	+ thus "\<exists>Ss. K C = Some Ss \<and> list_all2 (has_sort (sub, tcs)) Ts Ss"
	+ using Ss by (simp)
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma has_sort_sort_leq: "wf_theory \<Theta> \<Longrightarrow> has_sort (osig (sig \<Theta>)) T S
	+ \<Longrightarrow> sort_leq (subclass (osig (sig \<Theta>))) S S'
	+ \<Longrightarrow> has_sort (osig (sig \<Theta>)) T S'"
	+by (metis has_sort_sort_leq_osig subclass.elims wf_theory_imp_wf_osig)
	+
	+lemma subst_typ_preserves_has_sort:
	+ assumes "wf_theory \<Theta>"
	+ assumes "has_sort (osig (sig \<Theta>)) T S"
	+ assumes "list_all (\<lambda>((idn, S), T). has_sort (osig (sig \<Theta>)) T S) insts"
	+ shows "has_sort (osig (sig \<Theta>)) (subst_typ insts T) S"
	+using assms proof(induction T arbitrary: S)
	+ case (Ty \<kappa> Ts)
	+ obtain cl tcs where cltcs: "osig (sig \<Theta>) = (cl, tcs)"
	+ by fastforce
	+ moreover obtain K where "tcsigs (osig (sig \<Theta>)) \<kappa> = Some K"
	+ using Ty.prems(2) has_sort.simps by auto
	+ ultimately have mgd: "tcs \<kappa> = Some K"
	+ by simp
	+ have "has_sort (osig (sig \<Theta>)) (subst_typ insts (Ty \<kappa> Ts)) S
	+ = has_sort (osig (sig \<Theta>)) (Ty \<kappa> (map (subst_typ insts) Ts)) S"
	+ by simp
	+ moreover have "has_sort (osig (sig \<Theta>)) (Ty \<kappa> (map (subst_typ insts) Ts)) S"
	+ proof (subst cltcs, rule has_sort_Ty[of tcs, OF mgd], rule ballI)
	+ fix C assume C: "C \<in> S"
	+ obtain Ss where Ss: "K C = Some Ss"
	+ using C Ty.prems(2) mgd has_sort.simps cltcs by auto
	+ have "list_all2 (has_sort (osig (sig \<Theta>))) (map (subst_typ insts) Ts) Ss"
	+ proof (rule list_all2_all_nthI)
	+ show "length (map (subst_typ insts) Ts) = length Ss"
	+ using C Ss Ty.prems(2) list_all2_lengthD mgd has_sort.simps cltcs by fastforce
	+ next
	+ fix n assume n: "n < length (map (subst_typ insts) Ts)"
	+
	+ have "list_all2 (has_sort (cl, tcs)) Ts Ss"
	+ using C Ss Ty.prems(2) cltcs has_sort.simps mgd by auto
	+ hence 1: "has_sort (osig (sig \<Theta>)) (Ts ! n) (Ss ! n)"
	+ using cltcs list_all2_conv_all_nth n by auto
	+ have "has_sort (osig (sig \<Theta>)) (subst_typ insts (Ts ! n)) (Ss ! n)"
	+ using 1 n Ty.prems cltcs C Ss mgd Ty.IH by auto
	+
	+ then show "has_sort (osig (sig \<Theta>)) (map (subst_typ insts) Ts ! n) (Ss ! n)"
	+ using n by auto
	+ qed
	+ thus "\<exists>Ss. K C = Some Ss \<and> list_all2 (has_sort (cl, tcs)) (map (subst_typ insts) Ts) Ss"
	+ using Ss cltcs by simp
	+ qed
	+ ultimately show ?case
	+ by simp
	+next
	+ case (Tv idn S')
	+ show ?case
	+ proof(cases "(lookup (\<lambda>x. x = (idn, S')) insts)")
	+ case None
	+ then show ?thesis using Tv by simp
	+ next
	+ case (Some res)
	+ hence "((idn, S'), res) \<in> set insts" using lookup_present_eq_key' by fast
	+ hence "has_sort (osig (sig \<Theta>)) res S'" using Tv
	+ using split_list by fastforce
	+ moreover have 1: "sort_leq (subclass (osig (sig \<Theta>))) S' S"
	+ using Tv.prems(2) has_sort_Tv_imp_sort_leq by blast
	+ ultimately show ?thesis
	+ using Some Tv(2) has_sort_Tv_imp_sort_leq apply simp
	+ using assms(1) 1 has_sort_sort_leq by blast
	+ qed
	+qed
	+
	+
	+lemma subst_typ_preserves_Some_typ_of1:
	+ assumes "typ_of1 Ts t = Some T"
	+ shows "typ_of1 (map (subst_typ insts) Ts) (subst_typ' insts t)
	+ = Some (subst_typ insts T)"
	+using assms proof (induction t arbitrary: T Ts)
	+next
	+ case (App t1 t2)
	+ from this obtain RT where "typ_of1 Ts t1 = Some (RT \<rightarrow> T)"
	+ using typ_of1_split_App_obtains by blast
	+ hence "typ_of1 (map (subst_typ insts) Ts) (subst_typ' insts t1) =
	+ Some (subst_typ insts (RT \<rightarrow> T))" using App.IH(1) by blast
	+ moreover have "typ_of1 (map (subst_typ insts) Ts) (subst_typ' insts t2) = Some (subst_typ insts RT)"
	+ using App \<open>typ_of1 Ts t1 = Some (RT \<rightarrow> T)\<close> typ_of1_fun_typ by blast
	+ ultimately show ?case by simp
	+qed (fastforce split: if_splits simp add: bind_eq_Some_conv)+
	+
	+corollary subst_typ_preserves_Some_typ_of:
	+ assumes "typ_of t = Some T"
	+ shows "typ_of (subst_typ' insts t)
	+ = Some (subst_typ insts T)"
	+ using assms subst_typ_preserves_Some_typ_of1 typ_of_def by fastforce
	+
	+lemma subst_typ'_incr_bv:
	+ "subst_typ' insts (incr_bv inc lev t) = incr_bv inc lev (subst_typ' insts t)"
	+ by (induction inc lev t rule: incr_bv.induct) auto
	+
	+lemma subst_typ'_incr_boundvars:
	+ "subst_typ' insts (incr_boundvars lev t) = incr_boundvars lev (subst_typ' insts t)"
	+ using subst_typ'_incr_bv incr_boundvars_def by simp
	+
	+lemma subst_typ'_subst_bv1: "subst_typ' insts (subst_bv1 t n u)
	+ = subst_bv1 (subst_typ' insts t) n (subst_typ' insts u)"
	+ by (induction t n u rule: subst_bv1.induct) (auto simp add: subst_typ'_incr_boundvars)
	+
	+lemma subst_typ'_subst_bv: "subst_typ' insts (subst_bv t u)
	+ = subst_bv (subst_typ' insts t) (subst_typ' insts u)"
	+ using subst_typ'_subst_bv1 subst_bv_def by simp
	+
	+lemma subst_typ_no_tvsT_unchanged:
	+ "\<forall>(f, s) \<in> set insts . f \<notin> tvsT T \<Longrightarrow> subst_typ insts T = T"
	+proof (induction T)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts) (fastforce split: prod.splits)+
	+next
	+ case (Tv idn S)
	+ then show ?case
	+ by simp (smt case_prodD case_prodE find_None_iff lookup_None_iff_find_None the_default.simps(1))
	+qed
	+
	+lemma subst_typ'_no_tvs_unchanged:
	+ "\<forall>(f, s) \<in> set insts . f \<notin> tvs t \<Longrightarrow> subst_typ' insts t = t"
	+ by (induction t) (use subst_typ_no_tvsT_unchanged in \<open>fastforce+\<close>)
	+
	+(* This is weaker than the previously proved version, but probably easier to use... *)
	+lemma subst_typ'_preserves_term_ok':
	+ assumes "wf_theory \<Theta>"
	+ assumes "inst_ok \<Theta> insts"
	+ assumes "term_ok' (sig \<Theta>) t"
	+ shows "term_ok' (sig \<Theta>) (subst_typ' insts t)"
	+ using assms term_ok'_subst_typ' typ_ok_def
	+ by (metis list.pred_mono_strong wf_theory_imp_is_std_sig wf_type_imp_typ_ok_sig)
	+
	+lemma subst_typ'_preserves_term_ok:
	+ assumes "wf_theory \<Theta>"
	+ assumes "inst_ok \<Theta> insts"
	+ assumes "term_ok \<Theta> t"
	+ shows "term_ok \<Theta> (subst_typ' insts t)"
	+using assms subst_typ_preserves_Some_typ_of wt_term_def subst_typ'_preserves_term_ok' by auto
	+
	+lemma subst_typ_rename_vars_cancel:
	+ assumes "y \<notin> fst ` tvsT T"
	+ shows "subst_typ [((y,S), Tv x S)] (subst_typ [((x,S), Tv y S)] T) = T"
	+using assms proof (induction T)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts) auto
	+qed auto
	+
	+lemma subst_typ'_rename_tvars_cancel:
	+ assumes "y \<notin> fst ` tvs t" assumes "y \<notin> fst ` tvsT \<tau>"
	+ shows "subst_typ' [((y,S), Tv x S)] ((bind_fv2 (x, subst_typ [((x,S), Tv y S)] \<tau>))
	+ lev (subst_typ' [((x,S), Tv y S)] t))
	+ = bind_fv2 (x, \<tau>) lev t"
	+using assms proof (induction t arbitrary: lev)
	+ case (Ct n T)
	+ then show ?case
	+ by (simp add: subst_typ_rename_vars_cancel)
	+next
	+ case (Fv idn T)
	+ then show ?case
	+ by (clarsimp simp add: subst_typ_rename_vars_cancel) (metis subst_typ_rename_vars_cancel)
	+next
	+ case (Abs T t)
	+ thus ?case
	+ by (simp add: image_Un subst_typ_rename_vars_cancel)
	+next
	+ case (App t1 t2)
	+ then show ?case
	+ by (simp add: image_Un)
	+qed auto
	+
	+lemma bind_fv2_renamed_var:
	+ assumes "y \<notin> fst ` fv t"
	+ shows "bind_fv2 (y, \<tau>) i (subst_term [((x, \<tau>), Fv y \<tau>)] t)
	+ = bind_fv2 (x, \<tau>) i t"
	+using assms proof (induction t arbitrary: i)
	+qed auto
	+
	+lemma bind_fv_renamed_var:
	+ assumes "y \<notin> fst ` fv t"
	+ shows "bind_fv (y, \<tau>) (subst_term [((x, \<tau>), Fv y \<tau>)] t)
	+ = bind_fv (x, \<tau>) t"
	+ using bind_fv2_renamed_var bind_fv_def assms by auto
	+
	+lemma subst_typ'_rename_tvar_bind_fv2:
	+ assumes "y \<notin> fst ` fv t"
	+ assumes "(b, S) \<notin> tvs t"
	+ assumes "(b, S) \<notin> tvsT \<tau>"
	+ shows "bind_fv2 (y, subst_typ [((a, S), Tv b S)] \<tau>) i
	+ (subst_typ' [((a,S), Tv b S)] (subst_term [((x, \<tau>), Fv y \<tau>)] t))
	+ = subst_typ' [((a,S), Tv b S)] (bind_fv2 (x, \<tau>) i t)"
	+using assms proof (induction t arbitrary: i)
	+qed auto
	+
	+lemma subst_typ'_rename_tvar_bind_fv:
	+ assumes "y \<notin> fst ` fv t"
	+ assumes "(b, S) \<notin> tvs t"
	+ assumes "(b, S) \<notin> tvsT \<tau>"
	+ shows "bind_fv (y, subst_typ [((a,S), Tv b S)] \<tau>)
	+ (subst_typ' [((a,S), Tv b S)] (subst_term [((x, \<tau>), Fv y \<tau>)] t))
	+ = subst_typ' [((a,S), Tv b S)] (bind_fv (x, \<tau>) t)"
	+ using bind_fv_def assms subst_typ'_rename_tvar_bind_fv2 by auto
	+
	+lemma tvar_in_fv_in_tvs: "(a, \<tau>) \<in> fv B \<Longrightarrow> (x, S) \<in> tvsT \<tau> \<Longrightarrow> (x, S) \<in> tvs B"
	+ by (induction B) auto
	+
	+lemma tvs_bind_fv2_subset: "tvs (bind_fv2 (a, \<tau>) i B) \<subseteq> tvs B"
	+ by (induction B arbitrary: i) auto
	+
	+lemma tvs_bind_fv_subset: "tvs (bind_fv (a, \<tau>) B) \<subseteq> tvs B"
	+ using tvs_bind_fv2_subset bind_fv_def by simp
	+
	+lemma subst_typ_rename_tvar_preserves_eq:
	+ "(y, S) \<notin> tvsT T \<Longrightarrow> (y, S) \<notin> tvsT \<tau> \<Longrightarrow>
	+ subst_typ [((x, S), Tv y S)] T = subst_typ [((x, S), Tv y S)] \<tau> \<Longrightarrow> T=\<tau>"
	+proof (induction T arbitrary: \<tau>)
	+ case (Ty n Ts)
	+ then show ?case
	+ proof (induction \<tau>)
	+ case (Ty n Ts)
	+ then show ?case
	+ by simp (smt list.inj_map_strong)
	+ next
	+ case (Tv n S)
	+ then show ?case
	+ by (auto split: if_splits)
	+ qed
	+next
	+ case (Tv n S)
	+ then show ?case by (induction \<tau>) (auto split: if_splits)
	+qed
	+
	+lemma subst_typ'_subst_term_rename_var_swap:
	+ assumes "b \<notin> fst ` fv B"
	+ assumes "(y, S) \<notin> tvs B"
	+ assumes "(y, S) \<notin> tvsT \<tau>"
	+ shows "subst_typ' [((x, S), Tv y S)] (subst_term [((a, \<tau>), Fv b \<tau>)] B)
	+ = subst_term [((a, (subst_typ [((x, S), Tv y S)] \<tau>)), Fv b (subst_typ [((x, S), Tv y S)] \<tau>))]
	+ (subst_typ' [((x, S), Tv y S)] B)"
	+using assms proof (induction B)
	+ case (Fv idn T)
	+ then show ?case using subst_typ_rename_tvar_preserves_eq by auto
	+qed auto
	+
	+(* My naming needs work, also those lemmas might be subsumed *)
	+lemma tvar_not_in_term_imp_free_not_in_term:
	+ "(y, S) \<in> tvsT \<tau> \<Longrightarrow> (y,S) \<notin> tvs t \<Longrightarrow> (a, \<tau>) \<notin> fv t"
	+ by (induction t) auto
	+
	+lemma tvar_not_in_term_imp_free_not_in_term_set:
	+ "finite \<Gamma> \<Longrightarrow> (y, S) \<in> tvsT \<tau> \<Longrightarrow> (y,S) \<notin> tvs_Set \<Gamma> \<Longrightarrow> (a, \<tau>) \<notin> FV \<Gamma>"
	+ using tvar_not_in_term_imp_free_not_in_term by simp
	+
	+(* I can probably weaken vars a bit, should only need wf criteria on insts, nothing more *)
	+lemma inst_var_multiple:
	+ assumes wf_theory: "wf_theory \<Theta>"
	+ assumes B: "\<Theta>, \<Gamma> \<turnstile> B"
	+ assumes vars: "\<forall>(x,\<tau>)\<in>fst ` set insts . term_ok \<Theta> (Fv x \<tau>)"
	+ assumes a_ok: "\<forall>a\<in>snd ` set insts . term_ok \<Theta> a"
	+ assumes typ_a: "\<forall>((_,\<tau>), a)\<in>set insts . typ_of a = Some \<tau>"
	+ assumes free: "\<forall>(v, _)\<in>set insts . v \<notin> FV \<Gamma>"
	+ assumes distinct: "distinct (map fst insts)"
	+ assumes finite: "finite \<Gamma>"
	+ shows "\<Theta>, \<Gamma> \<turnstile> subst_term insts B"
	+proof-
	+ obtain fresh_idns where fresh_idns:
	+ "length fresh_idns = length insts"
	+ "\<forall>idn \<in> set fresh_idns .
	+ idn \<notin> fst ` (fv B \<union> (\<Union>t\<in>snd ` set insts . (fv t)) \<union> (fst ` set insts)) \<union> fst ` (FV \<Gamma>)"
	+ "distinct fresh_idns"
	+ using distinct_fresh_rename_idns fresh_fresh_rename_idns length_fresh_rename_idns finite_FV finite
	+ by (metis finite_imageI)
	+ have 0: "subst_term insts B
	+ = fold (\<lambda>single acc . subst_term [single] acc) (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (fold (\<lambda>single acc . subst_term [single] acc) (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) B)"
	+ using fresh_idns distinct subst_term_combine' by simp
	+
	+ from fresh_idns vars a_ok typ_a free distinct have 1:
	+ "\<Theta>, \<Gamma> \<turnstile> (fold (\<lambda>single acc . subst_term [single] acc)
	+ (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) B)"
	+ proof (induction fresh_idns insts rule: rev_induct2)
	+ case Nil
	+ then show ?case using B by simp
	+ next
	+ case (snoc x xs y ys)
	+ from snoc have term_oky: "term_ok \<Theta> (Fv (fst (fst y)) (snd (fst y)))"
	+ by (auto simp add: wt_term_def split: prod.splits)
	+
	+ have 1: "\<Theta>, \<Gamma> \<turnstile> fold (\<lambda>single. subst_term [single])
	+ (zip (map fst ys) (map2 Fv xs (map snd (map fst ys)))) B"
	+ apply (rule snoc.IH)
	+ subgoal using snoc.prems(1) by (clarsimp split: prod.splits) (smt UN_I Un_iff fst_conv image_iff)
	+ using snoc.prems(2-7) by auto
	+
	+ moreover obtain yn n where ynn: "fst y = (yn, n)" by fastforce
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> subst_term [(fst y, Fv x n)]
	+ (fold (\<lambda>single. subst_term [single]) (zip (map fst (ys))
	+ (map2 Fv (xs) (map snd (map fst (ys))))) B)"
	+ apply (simp only: ynn)
	+ apply (rule inst_var[of "\<Theta>" \<Gamma> "(fold (\<lambda>single. subst_term [single]) (zip (map fst (ys))
	+ (map2 Fv (xs) (map snd (map fst (ys))))) B)" "(Fv x n)" "n" "yn"])
	+ using snoc.prems \<open>wf_theory \<Theta>\<close> 1 apply (solves simp)+
	+ using term_oky ynn apply (simp add: wt_term_def typ_of_def)
	+ using term_oky ynn apply (simp add: wt_term_def typ_of_def)
	+ using snoc.prems(6) ynn by auto
	+
	+ moreover have "fold (\<lambda>single. subst_term [single]) (zip (map fst (ys @ [y]))
	+ (map2 Fv (xs @ [x]) (map snd (map fst (ys @ [y]))))) B
	+ = subst_term [(fst y, Fv x (snd (fst y)))]
	+ (fold (\<lambda>single. subst_term [single]) (zip (map fst (ys))
	+ (map2 Fv (xs) (map snd (map fst (ys))))) B)"
	+ using snoc.hyps by (induction xs ys rule: list_induct2) simp_all
	+
	+ ultimately show ?case by simp
	+ qed
	+ define point where "point \<equiv> (fold (\<lambda>single acc . subst_term [single] acc)
	+ (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) B)"
	+
	+ from fresh_idns vars a_ok typ_a free distinct have 2:
	+ "\<Theta>, \<Gamma> \<turnstile> fold (\<lambda>single acc . subst_term [single] acc)
	+ (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ point"
	+ proof (induction fresh_idns insts rule: rev_induct2)
	+ case Nil
	+ then show ?case using B
	+ using 1 point_def by auto
	+ next
	+ case (snoc x xs y ys)
	+
	+ from snoc have typ_ofy: "typ_of (snd y) = Some (snd (fst y))" by auto
	+
	+ have 1: " \<Theta>,\<Gamma> \<turnstile> fold (\<lambda>single. subst_term [single])
	+ (zip (zip xs (map snd (map fst ys))) (map snd ys))
	+ point"
	+ apply (rule snoc.IH)
	+ subgoal using snoc.prems(1) by (clarsimp split: prod.splits) (smt UN_I Un_iff fst_conv image_iff)
	+ using snoc.prems(2-7) by auto
	+ moreover obtain yn n where ynn: "fst y = (yn, n)" by fastforce
	+ moreover have "\<Theta>,\<Gamma> \<turnstile> subst_term [((x, snd (fst y)), snd y)] (fold (\<lambda>single. subst_term [single])
	+ (zip (zip (xs) (map snd (map fst (ys))))
	+ (map snd (ys)))
	+ point)"
	+ apply (simp only: ynn) apply (rule inst_var)
	+ using snoc.prems \<open>wf_theory \<Theta>\<close> 1 apply (solves simp)+
	+ using typ_ofy ynn apply (simp add: wt_term_def typ_of_def)
	+ using snoc.prems apply simp
	+ by (metis (full_types, hide_lams) UN_I fst_conv image_eqI)
	+ moreover have "fold (\<lambda>single. subst_term [single])
	+ (zip (zip (xs @ [x]) (map snd (map fst (ys @ [y]))))
	+ (map snd (ys @ [y])))
	+ point = subst_term [((x, snd (fst y)), snd y)] (fold (\<lambda>single. subst_term [single])
	+ (zip (zip (xs) (map snd (map fst (ys))))
	+ (map snd (ys)))
	+ point)"
	+ using snoc.hyps by (induction xs ys rule: list_induct2) simp_all
	+
	+ ultimately show ?case by simp
	+ qed
	+
	+ from 0 1 2 show ?thesis using point_def by simp
	+qed
	+
	+lemma term_ok_eta_red_step:
	+ "\<not> is_dependent t \<Longrightarrow> term_ok \<Theta> (Abs T (t $ Bv 0)) \<Longrightarrow> term_ok \<Theta> (decr 0 t)"
	+ unfolding term_ok_def wt_term_def using term_ok'_decr eta_preserves_typ_of by simp blast
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Name.thy b/thys/Metalogic_ProofChecker/Name.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Name.thy
	@@ -0,0 +1,176 @@
	+(*
	+ Generation of fresh names
	+*)
	+
	+section "Names"
	+
	+theory Name
	+ imports Preliminaries Term
	+ "HOL-Library.Char_ord"
	+begin
	+
	+(* Horrible generator for now(make a string of "a"s that is longer than all strings in the set),
	+ make something better later
	+ Needs list nature of strings, so not directly on literals
	+*)
	+fun fresh_name :: "string set \<Rightarrow> string" where
	+ "fresh_name S = (if S=empty then ''a'' else replicate (Max (length ` S) + 1) (CHR ''a''))"
	+
	+lemma fresh_name_fresh:
	+ assumes "finite S"
	+ shows "fresh_name S \<notin> S"
	+proof(cases "S=empty")
	+ case True
	+ then show ?thesis by simp
	+next
	+ case False
	+ hence "length (fresh_name S) > (Max (image length S))" by auto
	+ hence "\<forall>s\<in>S. length (fresh_name S) > length s" using assms by (simp add: le_imp_less_Suc)
	+ thus "fresh_name S \<notin> S" by blast
	+qed
	+
	+(* Lift this generator to literals *)
	+context
	+ includes "String.literal.lifting"
	+begin
	+lift_definition fresh_name' :: "String.literal set \<Rightarrow> String.literal" is "fresh_name"
	+ by (auto split: if_splits)
	+
	+
	+lemma [code]: "fresh_name' S = String.implode (fresh_name (String.explode ` S))"
	+ by (metis String.implode_explode_eq fresh_name'.rep_eq)
	+
	+lemma fresh_name'_fresh:
	+ assumes "finite S"
	+ shows "fresh_name' S \<notin> S"
	+ by (metis assms finite_imageI fresh_name'.rep_eq fresh_name_fresh rev_image_eqI)
	+end
	+
	+fun variant_name :: "name \<Rightarrow> name set \<Rightarrow> (name \<times> name set)" where
	+ "variant_name s S = (let s' = (fresh_name' S) in (s', insert s' S))"
	+
	+lemma variant_name_fresh:
	+ assumes "finite S"
	+ shows "fst (variant_name s S) \<notin> S"
	+ using assms fresh_name'_fresh
	+ by (metis fst_conv variant_name.simps)
	+
	+lemma variant_name_adds:
	+ shows "snd (variant_name s S) = insert (fst (variant_name s S)) S"
	+ by (metis fst_conv snd_conv variant_name.simps)
	+
	+(* This is a hack to transfer result to variables, better to write generator directly *)
	+fun name :: "variable \<Rightarrow> name" where
	+ "name (variable.Free n) = n"
	+\| "name (Var (n,_)) = n"
	+
	+(* And for variables *)
	+fun variant_variable :: "variable \<Rightarrow> variable set \<Rightarrow> (variable \<times> variable set)" where
	+ "variant_variable (variable.Free n) S = (let s' = fresh_name' (name ` S) in
	+ (Free s', insert (variable.Free s') S))"
	+\| "variant_variable (Var (n,_)) S = (let s' = fresh_name' (name ` S) in
	+ (Var (s',0), insert (Var (s',0)) S))"
	+
	+
	+lemma variant_variable_fresh:
	+ assumes "finite S"
	+ shows "fst (variant_variable s S) \<notin> S"
	+ apply (cases s)
	+ using assms fresh_name'_fresh
	+ apply (metis finite_imageI fstI name.simps(1) rev_image_eqI variant_variable.simps(1))
	+ using assms fresh_name'_fresh
	+ by (metis (no_types, hide_lams) finite_imageI fst_conv image_iff name.simps(2) surj_pair variant_variable.simps(2))
	+
	+lemma variant_variable_adds:
	+ shows "snd (variant_variable s S) = insert (fst (variant_variable s S)) S"
	+ by (metis (no_types, lifting) fst_conv snd_conv variant_variable.elims)
	+
	+(* Even worse generator for fresh variable names to allow transforming parallel to sequential substitutions
	+ Applied hack for variables here too
	+*)
	+
	+fun variant_variables :: "nat \<Rightarrow> variable \<Rightarrow> variable set \<Rightarrow> (variable list \<times> variable set)" where
	+ "variant_variables 0 _ S = ([], S)"
	+\| "variant_variables (Suc n) s S =
	+ (let (s', S') = variant_variable s S in
	+ (let (ss, S'') = variant_variables n s' S' in
	+ (s'#ss, S'')))"
	+
	+lemma variant_names_fresh:
	+ assumes "finite S"
	+ shows "\<forall>s \<in> set (fst (variant_variables n s S)) . s \<notin> S"
	+ using assms proof (induction n arbitrary: s S)
	+ case 0
	+ then show ?case by simp
	+next
	+ case (Suc n)
	+ obtain s' S' where s'S': "variant_variable s S = (s', S')"
	+ by fastforce
	+ hence "s' \<notin> S"
	+ by (metis Suc.prems fst_conv variant_variable_fresh)
	+ moreover have I: "\<forall>s\<in>set (fst (variant_variables n s' S')). s \<notin> S'"
	+ by (metis Suc.IH Suc.prems s'S' finite.insertI snd_conv variant_variable_adds)
	+ moreover have "S \<subseteq> S'"
	+ by (metis insert_iff s'S' snd_conv subsetI variant_variable_adds)
	+ ultimately show ?case
	+ by (auto simp add: Let_def s'S' split: prod.splits)
	+qed
	+
	+lemma variant_names_distinct:
	+ assumes "finite S"
	+ shows "distinct (fst (variant_variables n s S))"
	+ using assms proof (induction n arbitrary: s S)
	+ case 0
	+ then show ?case by simp
	+next
	+ case (Suc n)
	+ obtain s' S' where s'S': "variant_variable s S = (s', S')"
	+ by fastforce
	+ hence "s' \<notin> S"
	+ by (metis Suc.prems fst_conv variant_variable_fresh)
	+ moreover have I: "distinct (fst (variant_variables n s' S'))"
	+ by (metis Suc.IH Suc.prems s'S' finite.insertI snd_conv variant_variable_adds)
	+ moreover have "S \<subseteq> S'"
	+ by (metis insert_iff s'S' snd_conv subsetI variant_variable_adds)
	+ ultimately show ?case
	+ apply (simp add: Let_def s'S' split: prod.splits)
	+ by (metis Suc.prems finite.insertI fst_conv insertI1 s'S' snd_conv variant_names_fresh variant_variable_adds)
	+qed
	+
	+corollary variant_names_amount:
	+ assumes "finite S"
	+ shows "length (fst (variant_variables n s S)) = n"
	+ using assms by (induction n arbitrary: s S) (simp_all add: case_prod_beta variant_variable_adds)
	+
	+(*
	+ After translation I also need to make sure fresh vars are not in the context
	+*)
	+abbreviation "fresh_rename_ns n B insts G \<equiv> fst (variant_variables n (Free STR ''lol'')
	+ (fst ` (fv B \<union> (\<Union>t\<in>snd ` set insts . fv t) \<union> (fst ` set insts)) \<union> G))"
	+abbreviation "fresh_rename_idns n B insts \<equiv> fresh_rename_ns n B insts"
	+
	+lemma map_Pair_zip_replicate_conv: "map (\<lambda>x. Pair x c) l = zip l (replicate (length l) c)"
	+ by (induction l) auto
	+
	+lemma distinct_fresh_rename_ns: "finite G \<Longrightarrow> distinct (fresh_rename_ns n B insts G)"
	+ by (metis (no_types, lifting) List.finite_set add_vars'_fv finite_UN finite_Un finite_imageI variant_names_distinct)
	+
	+lemma fresh_fresh_rename_ns: "finite G \<Longrightarrow> \<forall>nm \<in> set (fresh_rename_ns n B insts G) .
	+ nm \<notin> (fst ` (fv B \<union> (\<Union>t \<in> snd ` set insts . (fv t)) \<union> (fst ` set insts)) \<union> G)"
	+ by (metis (no_types, lifting) List.finite_set add_vars'_fv finite_UN finite_Un finite_imageI variant_names_fresh)
	+
	+lemma length_fresh_rename_ns: "finite G \<Longrightarrow> length (fresh_rename_ns n B insts G) = n"
	+ by (metis (no_types, lifting) List.finite_set add_vars'_fv finite_UN finite_Un finite_imageI variant_names_amount)
	+
	+lemma distinct_fresh_rename_idns: "finite G \<Longrightarrow> distinct (fresh_rename_idns n B insts G)"
	+ using distinct_fresh_rename_ns by (metis)
	+
	+lemma fresh_fresh_rename_idns: "finite G \<Longrightarrow> \<forall>nm \<in> set (fresh_rename_idns n B insts G) .
	+ nm \<notin> (fst ` (fv B \<union> (\<Union>t \<in> snd ` set insts . (fv t)) \<union> (fst ` set insts)) \<union> G)"
	+ using distinct_fresh_rename_ns map_Pair_zip_replicate_conv map_Pair_zip_replicate_conv
	+ by (smt fresh_fresh_rename_ns fst_conv imageE image_eqI list.set_map)
	+
	+lemma length_fresh_rename_idns: "finite G \<Longrightarrow> length (fresh_rename_idns n B insts G) = n"
	+ by (metis length_fresh_rename_ns)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Preliminaries.thy b/thys/Metalogic_ProofChecker/Preliminaries.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Preliminaries.thy
	@@ -0,0 +1,384 @@
	+
	+section "Preliminaries"
	+
	+theory Preliminaries
	+ imports Complex_Main
	+ "List-Index.List_Index"
	+ "HOL-Library.AList"
	+ "HOL-Library.Sublist"
	+ "HOL-Eisbach.Eisbach"
	+ "HOL-Library.Simps_Case_Conv"
	+begin
	+
	+text \<open>Stuff about options\<close>
	+
	+fun the_default :: "'a \<Rightarrow> 'a option \<Rightarrow> 'a" where
	+ "the_default a None = a"
	+\| "the_default _ (Some b) = b"
	+
	+abbreviation Or :: "'a option \<Rightarrow> 'a option \<Rightarrow> 'a option" (infixl "OR" 60) where
	+ "e1 OR e2 \<equiv> case e1 of None \<Rightarrow> e2 \| p \<Rightarrow> p"
	+
	+lemma Or_Some: "(e1 OR e2) = Some x \<longleftrightarrow> e1 = Some x \<or> (e1 = None \<and> e2 = Some x)"
	+ by(auto split: option.split)
	+
	+lemma Or_None: "(e1 OR e2) = None \<longleftrightarrow> e1 = None \<and> e2 = None"
	+ by(auto split: option.split)
	+
	+fun lift2_option :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a option \<Rightarrow> 'b option \<Rightarrow> 'c option" where
	+ "lift2_option _ None _ = None" \|
	+ "lift2_option _ _ None = None" \|
	+ "lift2_option f (Some x) (Some y) = Some (f x y)"
	+
	+lemma lift2_option_not_None: "lift2_option f x y \<noteq> None \<longleftrightarrow> (x \<noteq> None \<and> y \<noteq> None)"
	+ using lift2_option.elims by blast
	+lemma lift2_option_None: "lift2_option f x y = None \<longleftrightarrow> (x = None \<or> y = None)"
	+ using lift2_option.elims by blast
	+
	+text \<open>Lookup functions for assoc lists\<close>
	+
	+fun find :: "('a \<Rightarrow> 'b option) \<Rightarrow> 'a list \<Rightarrow> 'b option" where
	+"find f [] = None" \|
	+"find f (x#xs) = f x OR find f xs"
	+
	+lemma findD:
	+ "find f xs = Some p \<Longrightarrow> \<exists>x \<in> set xs. f x = Some p"
	+ by(induction xs arbitrary: p) (auto split: option.splits)
	+
	+lemma find_None:
	+ "find f xs = None \<longleftrightarrow> (\<forall>x \<in> set xs. f x = None)"
	+ by(induction xs) (auto split: option.splits)
	+
	+lemma find_ListFind: "find f l = Option.bind (List.find (\<lambda>x. case f x of None \<Rightarrow> False \| _ \<Rightarrow> True) l) f"
	+ by (induction l) (auto split: option.split)
	+
	+lemma "List.find P l = Some p \<Longrightarrow> \<exists>p \<in> set l . P p"
	+ by (induction l) (auto split: if_splits)
	+
	+lemma find_the_pair:
	+ assumes "distinct (map fst pairs)"
	+ and "\<And>x y. x\<in>set (map fst pairs) \<Longrightarrow> y\<in>set (map fst pairs) \<Longrightarrow> P x \<Longrightarrow> P y \<Longrightarrow> x = y"
	+ and "(x,y) \<in> set pairs" and "P x"
	+ shows "List.find (\<lambda>(x,_) . P x) pairs = Some (x,y)"
	+ using assms(1-3)
	+proof (induction pairs)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons pair pairs)
	+ thm Cons.prems
	+
	+ show ?case
	+ proof(cases "fst pair = x")
	+ case True
	+ then show ?thesis
	+ using eq_key_imp_eq_value[OF Cons.prems(1,3)] assms(4) by force
	+ next
	+ case False
	+ hence "(x,y) \<in> set pairs"
	+ using Cons.prems(3) by fastforce
	+ moreover have "\<And>x y. x \<in> set (map fst pairs) \<Longrightarrow> y \<in> set (map fst pairs) \<Longrightarrow> P x \<Longrightarrow> P y \<Longrightarrow> x = y"
	+ using Cons.prems(2) by (metis list.set_intros(2) list.simps(9))
	+ ultimately have I: "List.find (\<lambda>(x,_) . P x) pairs = Some (x,y)"
	+ using Cons.prems(1,3) by (auto intro!: Cons.IH)
	+ moreover have "\<And>y. y \<in> set (map fst (pair # pairs)) \<Longrightarrow> P y \<Longrightarrow> x = y"
	+ using Cons.prems(2,3) assms(4) by (metis set_zip_leftD zip_map_fst_snd)
	+ ultimately show ?thesis
	+ using False by fastforce
	+ qed
	+qed
	+
	+fun remdups_on :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where
	+ "remdups_on _ [] = []"
	+\| "remdups_on cmp (x # xs) =
	+ (if \<exists>x' \<in> set xs . cmp x x' then remdups_on cmp xs else x # remdups_on cmp xs)"
	+
	+fun distinct_on :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where
	+ "distinct_on _ [] \<longleftrightarrow> True"
	+\| "distinct_on cmp (x # xs) \<longleftrightarrow> \<not>(\<exists>x' \<in> set xs . cmp x x') \<and> distinct_on cmp xs"
	+
	+lemma "remdups_on (=) xs = remdups xs"
	+ by (induction xs) auto
	+
	+lemma remdups_on_antimono:
	+ "(\<And>x y . f x y \<Longrightarrow> g x y) \<Longrightarrow> set (remdups_on g xs) \<subseteq> set (remdups_on f xs)"
	+ by (induction xs) auto
	+
	+lemma remdups_on_subset_input: "set (remdups_on f xs) \<subseteq> set xs"
	+ by (induction xs) auto
	+
	+lemma distinct_on_remdups_on: "distinct_on f (remdups_on f xs)"
	+proof (induction xs)
	+ case Nil
	+ then show ?case
	+ by simp
	+next
	+ case (Cons x xs)
	+ then show ?case
	+ using remdups_on_subset_input by fastforce
	+qed
	+
	+
	+lemma distinct_on_no_compare: "(\<And>x y . f x y \<Longrightarrow> f y x)\<Longrightarrow>
	+ distinct_on f xs \<Longrightarrow> x\<in>set xs \<Longrightarrow> y\<in>set xs \<Longrightarrow> x\<noteq>y \<Longrightarrow> \<not> f x y"
	+ by (induction xs) auto
	+
	+fun lookup :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> 'b option" where
	+ "lookup _ [] = None"
	+\| "lookup f ((x,y)#xs) = (if f x then Some y else lookup f xs)"
	+
	+lemma lookup_present_eq_key: "distinct (map fst al) \<Longrightarrow> (k, v) \<in> set al \<longleftrightarrow> lookup (\<lambda>x. x=k) al = Some v"
	+ by (induction al) (auto simp add: rev_image_eqI split: if_splits)
	+
	+lemma lookup_None_iff: "lookup P xs = None \<longleftrightarrow> \<not> (\<exists>x. x \<in> set (map fst xs) \<and> P x)"
	+ by (induction xs) (auto split: if_splits)
	+
	+lemma find_Some: "List.find P l = Some p \<Longrightarrow> p\<in>set l \<and> P p"
	+ by (induction l) (auto split: if_splits)
	+
	+(* This means lookup seems somewhat superflouus *)
	+lemma find_Some_imp_lookup_Some:
	+ "List.find (\<lambda>(k,_). P k) xs = Some (k,v) \<Longrightarrow> lookup P xs = Some v"
	+ by (induction xs) auto
	+
	+lemma lookup_Some_imp_find_Some:
	+ "lookup P xs = Some v \<Longrightarrow> \<exists>x. List.find (\<lambda>(k,_). P k) xs = Some (x,v)"
	+ by (induction xs) auto
	+
	+lemma lookup_None_iff_find_None: "lookup P xs = None \<longleftrightarrow> List.find (\<lambda>(k,_). P k) xs = None"
	+ by (induction xs) auto
	+
	+lemma lookup_eq_order_irrelevant:
	+ assumes "distinct (map fst pairs)" and "distinct (map fst pairs')" and "set pairs = set pairs'"
	+ shows "lookup (\<lambda>x. x=k) pairs = lookup (\<lambda>x. x=k) pairs'"
	+proof (cases "lookup (\<lambda>x. x=k) pairs")
	+ case None
	+ then show ?thesis using lookup_None_iff
	+ by (metis assms(3) set_map)
	+next
	+ case (Some v)
	+ hence "(k,v)\<in>set pairs"
	+ using assms(1) by (simp add: lookup_present_eq_key)
	+ hence el: "(k,v)\<in>set pairs'" using assms(3) by blast
	+ show ?thesis using lookup_present_eq_key[OF assms(2)] el Some by simp
	+qed
	+
	+lemma lookup_Some_append_back:
	+ "lookup (\<lambda>x. x=k) insts = Some v \<Longrightarrow> lookup (\<lambda>x. x=k) (insts@[(k,v')]) = Some v"
	+ by (induction insts arbitrary: ) auto
	+
	+lemma lookup_eq_key_not_present: "key \<notin> set (map fst inst) \<Longrightarrow> lookup (\<lambda>x. x = key) inst = None"
	+ by (induction inst) auto
	+
	+lemma lookup_in_empty[simp]: "lookup f [] = None" by simp
	+lemma lookup_in_single[simp]: "lookup f [(k, v)] = (if f k then Some v else None)" by simp
	+
	+lemma lookup_present_eq_key': "lookup (\<lambda>x. x=k) al = Some v \<Longrightarrow> (k, v) \<in> set al "
	+ by (induction al) (auto simp add: rev_image_eqI split: if_splits)
	+
	+lemma lookup_present_eq_key'': "distinct (map fst al) \<Longrightarrow> lookup (\<lambda>x. x=k) al = Some v \<longleftrightarrow> (k, v) \<in> set al "
	+ by (induction al) (auto simp add: rev_image_eqI split: if_splits)
	+
	+lemma key_present_imp_eq_lookup_finds_value: "k \<in> fst ` set al \<Longrightarrow> \<exists>v . lookup (\<lambda>x. x=k) al = Some v"
	+ by (induction al) (auto simp add: rev_image_eqI)
	+
	+lemma list_allI: "(\<And>x. x\<in>set l \<Longrightarrow> P x) \<Longrightarrow> list_all P l"
	+ by (induction l) auto
	+
	+lemma map2_sym: "(\<And>x y . f x y = f y x) \<Longrightarrow> map2 f xs ys = map2 f ys xs"
	+proof (induction xs arbitrary: ys)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons a xs)
	+ then show ?case by (induction ys) auto
	+qed
	+
	+lemma idem_map2: assumes "(\<And>x. f x x = x)" shows "map2 f l l = l"
	+proof-
	+ have "length l = length l" by simp
	+ then show "map2 f l l = l" by (induction l l rule: list_induct2) (use assms in auto)
	+qed
	+
	+lemma rev_induct2[consumes 1, case_names Nil snoc]:
	+ assumes "length xs = length ys"
	+ assumes "P [] []"
	+ assumes "(\<And>x xs y ys. length xs = length ys \<Longrightarrow> P xs ys \<Longrightarrow> P (xs @ [x]) (ys @ [y]))"
	+ shows "P xs ys"
	+proof-
	+ have "length (rev xs) = length (rev ys)" using assms(1) by simp
	+ hence "P (rev (rev xs)) (rev (rev ys))"
	+ using assms(2-3) by (induction rule: list_induct2[of "rev xs" "rev ys"]) simp_all
	+ thus ?thesis by simp
	+qed
	+
	+lemma alist_map_corr: "distinct (map fst al) \<Longrightarrow> (k,v) \<in> set al \<longleftrightarrow> map_of al k = Some v"
	+ by simp
	+
	+lemma distinct_fst_imp_distinct: "distinct (map fst l) \<Longrightarrow> distinct l"
	+ by (induction l) auto
	+
	+lemma length_alist:
	+ assumes "distinct (map fst al)" and "distinct (map fst al')" and "set al = set al'"
	+ shows "length al = length al'"
	+ using assms by (metis distinct_card length_map set_map)
	+
	+lemma same_map_of_imp_same_length:
	+ "distinct (map fst ars1) \<Longrightarrow> distinct (map fst ars2) \<Longrightarrow> map_of ars1 = map_of ars2
	+ \<Longrightarrow> length ars1 = length ars2"
	+ (* Name is a bit to specific*)
	+ using length_alist map_of_inject_set by blast
	+
	+lemma in_range_if_ex_key: "v \<in> ran m \<longleftrightarrow> (\<exists>k. m k = Some v)"
	+ by (auto simp add: ranI ran_def)
	+
	+lemma set_AList_delete_bound: "set (AList.delete a l) \<subseteq> set l"
	+ by (induction l) auto
	+
	+lemma list_all_clearjunk_cons:
	+ "list_all P (x#(AList.clearjunk l)) \<Longrightarrow> list_all P (AList.clearjunk (x#l))"
	+ by (induction l rule: AList.clearjunk.induct) (auto simp add: delete_twist)
	+
	+lemma lookup_AList_delete: "k'\<noteq>k \<Longrightarrow> lookup (\<lambda>x. x = k) al = lookup (\<lambda>x. x = k) (AList.delete k' al)"
	+ by (induction al) auto
	+
	+lemma lookup_AList_clearjunk: "lookup (\<lambda>x. x = k) al = lookup (\<lambda>x. x = k) (AList.clearjunk al)"
	+proof (induction al)
	+ case Nil
	+ then show ?case
	+ by simp
	+next
	+ case (Cons a al)
	+ then show ?case
	+ proof(cases "fst a=k")
	+ case True
	+ then show ?thesis
	+ by (metis (full_types) clearjunk.simps(2) lookup.simps(2) prod.collapse)
	+ next
	+ case False
	+ have "lookup (\<lambda>x. x = k) (AList.clearjunk (a # al))
	+ = lookup (\<lambda>x. x = k) (a # AList.clearjunk (AList.delete (fst a) al))"
	+ by simp
	+ also have "\<dots> = lookup (\<lambda>x. x = k) (AList.clearjunk (AList.delete (fst a) al))"
	+ by (metis (full_types) False lookup.simps(2) surjective_pairing)
	+ also have "\<dots> = lookup (\<lambda>x. x = k) (AList.clearjunk al)"
	+ by (metis False clearjunk_delete lookup_AList_delete)
	+ also have "\<dots> = lookup (\<lambda>x. x = k) al"
	+ using Cons.IH by auto
	+ also have "\<dots> = lookup (\<lambda>x. x = k) (a # al)"
	+ by (metis (full_types) False lookup.simps(2) surjective_pairing)
	+ finally show ?thesis
	+ by simp
	+ qed
	+qed
	+
	+definition "diff_list xs ys \<equiv> fold removeAll ys xs"
	+
	+lemma diff_list_set[simp]: "set (diff_list xs ys) = set xs - set ys"
	+ unfolding diff_list_def by (induction ys arbitrary: xs) auto
	+
	+lemma diff_list_set_from_Nil[simp]: "diff_list [] ys = []"
	+ using last_in_set by fastforce
	+
	+lemma diff_list_set_remove_Nil[simp]: "diff_list xs [] = xs"
	+ unfolding diff_list_def by (induction xs) auto
	+
	+lemma diff_list_rec: "diff_list (x # xs) ys = (if x\<in>set ys then diff_list xs ys else x#diff_list xs ys)"
	+ unfolding diff_list_def by (induction ys arbitrary: x xs) auto
	+lemma diff_list_order_irr: "set ys = set ys' \<Longrightarrow> diff_list xs ys = diff_list xs ys'"
	+proof (induction ys arbitrary: ys' xs)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons y ys)
	+ then show ?case
	+ by (induction xs arbitrary: y ys ys') (simp_all add: diff_list_rec)
	+qed
	+
	+(* Folding lists with option return typs. probably no longer relevant, was for implementing sorts by lists *)
	+lemma fold_Option_bind_eq_Some_start_not_None:
	+ "fold (\<lambda>new option . Option.bind option (f new)) list start = Some res
	+ \<Longrightarrow> start \<noteq> None"
	+ by (induction list arbitrary: start res)
	+ (fastforce split: option.splits if_splits simp add: bind_eq_Some_conv)+
	+
	+lemma fold_Option_bind_eq_Some_at_point_not_None:
	+ "fold (\<lambda>new option . Option.bind option (f new)) (l1@l2) start = Some res
	+ \<Longrightarrow> fold (\<lambda>new option . Option.bind option (f new)) (l1) start \<noteq> None"
	+ by (induction l1 arbitrary: start res l2) (use fold_Option_bind_eq_Some_start_not_None in
	+ \<open>fastforce split: option.splits if_splits simp add: bind_eq_Some_conv\<close>)+
	+
	+lemma fold_Option_bind_eq_Some_start_not_None':
	+ "fold (\<lambda>(x,y) option . Option.bind option (f x y)) list start = Some res
	+ \<Longrightarrow> start \<noteq> None"
	+proof (induction list arbitrary: start res)
	+ case Nil
	+ then show ?case
	+ by simp
	+next
	+ case (Cons a list)
	+ then show ?case
	+ by (fastforce split: option.splits if_splits prod.splits simp add: bind_eq_Some_conv)
	+qed
	+
	+lemma fold_Option_bind_eq_None_start_None:
	+ "fold (\<lambda>(x,y) option . Option.bind option (f x y)) list None = None"
	+ by (induction list) (auto split: option.splits if_splits prod.splits)
	+
	+lemma fold_Option_bind_at_some_point_None_eq_None:
	+ "fold (\<lambda>(x,y) option . Option.bind option (f x y)) l1 start = None \<Longrightarrow>
	+ fold (\<lambda>(x,y) option . Option.bind option (f x y)) (l1@l2) start = None"
	+proof (induction l1 arbitrary: start l2)
	+ case Nil
	+ then show ?case using fold_Option_bind_eq_Some_start_not_None' by fastforce
	+next
	+ case (Cons a l1)
	+ then show ?case by simp
	+qed
	+
	+lemma fold_Option_bind_eq_Some_at_each_point_Some:
	+ "fold (\<lambda>(x,y) option . Option.bind option (f x y)) (l1@l2) start = Some res
	+ \<Longrightarrow> (\<exists>point . fold (\<lambda>(x,y) option . Option.bind option (f x y)) l1 start = Some point
	+ \<and> fold (\<lambda>(x,y) option . Option.bind option (f x y)) l2 (Some point) = Some res)"
	+proof (induction l1 arbitrary: start res l2)
	+ case Nil
	+ then show ?case
	+ using fold_Option_bind_eq_Some_start_not_None' by fastforce
	+next
	+ case (Cons a l1)
	+ then show ?case by simp
	+qed
	+
	+lemma fold_Option_bind_eq_Some_at_each_point_Some':
	+ assumes "fold (\<lambda>(x,y) option . Option.bind option (f x y)) (xs@ys) start = Some res"
	+ obtains point where
	+ "fold (\<lambda>(x,y) option . Option.bind option (f x y)) xs start = Some point" and
	+ "fold (\<lambda>(x,y) option . Option.bind option (f x y)) ys (Some point) = Some res"
	+ using assms fold_Option_bind_eq_Some_at_each_point_Some by fast
	+
	+(* Legacy *)
	+corollary fold_Option_bind_eq_Some_at_point_not_None':
	+ "fold (\<lambda>(x,y) option . Option.bind option (f x y)) (l1@l2) start = Some res
	+ \<Longrightarrow> fold (\<lambda>(x,y) option . Option.bind option (f x y)) (l1) start \<noteq> None"
	+ using fold_Option_bind_eq_Some_at_each_point_Some by fast
	+
	+(* Interestingly no longer need helper... *)
	+lemma fold_matches_first_step_not_None:
	+ assumes
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (f T U)) (zip (x#xs) (y#ys)) (Some subs) = Some subs'"
	+ obtains point where
	+ "f x y subs = Some point"
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (f T U)) (zip (xs) (ys)) (Some point) = Some subs'"
	+ using assms fold_Option_bind_eq_Some_start_not_None' not_None_eq by fastforce
	+
	+lemma fold_matches_last_step_not_None:
	+ assumes
	+ "length xs = length ys"
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (f T U)) (zip (xs@[x]) (ys@[y])) (Some subs) = Some subs'"
	+ obtains point where
	+ "fold (\<lambda>(T, U) subs . Option.bind subs (f T U)) (zip (xs) (ys)) (Some subs) = Some point"
	+ "f x y point = Some subs'"
	+ using assms fold_Option_bind_eq_Some_at_each_point_Some'[where xs="zip xs ys" and ys="[(x,y)]"
	+ and start="Some subs" and res="subs'" and f="f"] by auto
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/ProofTerm.thy b/thys/Metalogic_ProofChecker/ProofTerm.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/ProofTerm.thy
	@@ -0,0 +1,530 @@
	+
	+section "Proof Terms and proof checker"
	+
	+theory ProofTerm
	+ imports Term Logic Term_Subst SortConstants EqualityProof
	+begin
	+
	+(* Move *)
	+type_synonym tyinst = "(variable \<times> sort) \<times> typ"
	+type_synonym tinst = "(variable \<times> typ) \<times> term"
	+
	+datatype proofterm = PAxm "term" "tyinst list"
	+ \| PBound nat
	+ \| Abst "typ" proofterm
	+ \| AbsP "term" proofterm
	+ \| Appt proofterm "term"
	+ \| AppP proofterm proofterm
	+ \| OfClass "typ" "class"
	+ \| Hyp "term"
	+
	+(* For debbuging, move to code gen or seperate theory? *)
	+fun depth :: "proofterm \<Rightarrow> nat" where
	+ "depth (Abst _ P) = Suc (depth P)"
	+\| "depth (AbsP _ P) = Suc (depth P)"
	+\| "depth (Appt P _) = Suc (depth P)"
	+\| "depth (AppP P1 P2) = Suc (max (depth P1) (depth P2))"
	+\| "depth _ = 1"
	+fun size :: "proofterm \<Rightarrow> nat" where
	+ "size (Abst _ P) = Suc (size P)"
	+\| "size (AbsP _ P) = Suc (size P)"
	+\| "size (Appt P _) = Suc (size P)"
	+\| "size (AppP P1 P2) = Suc (size P1 + size P2)"
	+\| "size _ = 1"
	+
	+lemma "depth P > 0"
	+ by (induction P) auto
	+lemma "size P > 0"
	+ by (induction P) auto
	+lemma "size P \<ge> depth P"
	+ by (induction P) auto
	+
	+fun partial_nth :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option" where
	+ "partial_nth [] _ = None"
	+\| "partial_nth (x#xs) 0 = Some x"
	+\| "partial_nth (x#xs) (Suc n) = partial_nth xs n"
	+
	+definition [simp]: "partial_nth' xs n \<equiv> if n < length xs then Some (nth xs n) else None"
	+
	+lemma "partial_nth xs n \<equiv> partial_nth' xs n"
	+ by (induction rule: partial_nth.induct) auto
	+
	+lemma partial_nth_Some_imp_elem: "partial_nth l n = Some x \<Longrightarrow> x\<in>set l"
	+ by (induction rule: partial_nth.induct) auto
	+
	+text\<open>The core of the proof checker\<close>
	+
	+fun replay' :: "theory \<Rightarrow> (variable \<times> typ) list \<Rightarrow> variable set
	+ \<Rightarrow> term list \<Rightarrow> proofterm \<Rightarrow> term option" where
	+ "replay' thy _ _ Hs (PAxm t Tis) = (if inst_ok thy Tis \<and> term_ok thy t
	+ then if t \<in> axioms thy
	+ then Some (forall_intro_vars (subst_typ' Tis t) [])
	+ else None else None)"
	+\| "replay' thy _ _ Hs (PBound n) = partial_nth Hs n"
	+\| "replay' thy vs ns Hs (Abst T p) = (if typ_ok thy T
	+ then (let (s',ns') = variant_variable (Free STR ''default'') ns in
	+ map_option (mk_all s' T) (replay' thy ((s', T) # vs) ns' Hs p))
	+ else None)"
	+\| "replay' thy vs ns Hs (Appt p t) =
	+ (let rep = replay' thy vs ns Hs p in
	+ let t' = subst_bvs (map (\<lambda>(x,y) . Fv x y) vs) t in
	+ case (rep, typ_of t') of
	+ (Some (Ct s (Ty fun1 [Ty fun2 [\<tau>, Ty propT1 Nil], Ty propT2 Nil]) $ b), Some \<tau>') \<Rightarrow>
	+ if s = STR ''Pure.all'' \<and> fun1 = STR ''fun'' \<and> fun2 = STR ''fun''
	+ \<and> propT1 = STR ''prop'' \<and> propT2 = STR ''prop''
	+ \<and> \<tau>=\<tau>' \<and> term_ok thy t'
	+ then Some (b \<bullet> t') else None
	+ \| _ \<Rightarrow> None)"
	+\| "replay' thy vs ns Hs (AbsP t p) =
	+ (let t' = subst_bvs (map (\<lambda>(x,y) . Fv x y) vs) t in
	+ let rep = replay' thy vs ns (t'#Hs) p in
	+ (if typ_of t' = Some propT \<and> term_ok thy t' then map_option (mk_imp t') rep else None))"
	+\| "replay' thy vs ns Hs (AppP p1 p2) =
	+ (let rep1 = Option.bind (replay' thy vs ns Hs p1) beta_eta_norm in
	+ let rep2 = Option.bind (replay' thy vs ns Hs p2) beta_eta_norm in
	+ (case (rep1, rep2) of (
	+ Some (Ct imp (Ty fn1 [Ty prp1 [], Ty fn2 [Ty prp2 [], Ty prp3 []]]) $ A $ B),
	+ Some A') \<Rightarrow>
	+ if imp = STR ''Pure.imp'' \<and> fn1 = STR ''fun'' \<and> fn2 = STR ''fun''
	+ \<and> prp1 = STR ''prop'' \<and> prp2 = STR ''prop'' \<and> prp3 = STR ''prop'' \<and> A=A'
	+ then Some B else None
	+ \| _ \<Rightarrow> None))"
	+\| "replay' thy vs ns Hs (OfClass ty c) = (if has_sort (osig (sig thy)) ty {c}
	+ \<and> typ_ok thy ty
	+ then (case const_type (sig thy) (const_of_class c) of
	+ Some (Ty fun [Ty it [ity], Ty prop []]) \<Rightarrow>
	+ if ity = tvariable STR '''a'' \<and> fun = STR ''fun'' \<and> prop = STR ''prop'' \<and> it = STR ''itself''
	+ then Some (mk_of_class ty c) else None \| _ \<Rightarrow> None) else None)"
	+\| "replay' thy vs ns Hs (Hyp t) = (if t\<in>set Hs then Some t else None)"
	+
	+lemma fv_subst_bv1:
	+ "fv (subst_bv1 t lev u) = fv t \<union> (if loose_bvar1 t lev then fv u else {})"
	+ by (induction t lev u rule: subst_bv1.induct) (auto simp add: incr_boundvars_def)
	+
	+(* Needs precondition, doable but diverges from previous checker*)
	+corollary fv_subst_bvs_upper_bound:
	+ assumes "is_closed t"
	+ shows "fv (subst_bvs us t) \<subseteq> fv t \<union> (\<Union>x\<in>set us . (fv x))"
	+ unfolding subst_bvs_def
	+ using assms by (simp add: is_open_def no_loose_bvar_imp_no_subst_bvs1)
	+
	+lemma fv_subst_bvs1_upper_bound:
	+ "fv (subst_bvs1 t lev us) \<subseteq> fv t \<union> (\<Union>x\<in>set us . (fv x))"
	+proof (induction t lev us rule: subst_bvs1.induct)
	+ case (1 n lev args)
	+ then show ?case
	+ proof (induction args arbitrary: n lev)
	+ case Nil
	+ then show ?case
	+ by simp
	+ next
	+ case (Cons a args)
	+ then show ?case
	+ by simp (metis SUP_upper le_supI1 le_supI2 length_Suc_conv nth_mem set_ConsD set_eq_subset)
	+ qed
	+qed (auto simp add: incr_boundvars_def)
	+
	+lemma typ_of_axiom: "wf_theory thy \<Longrightarrow> t \<in> axioms thy \<Longrightarrow> typ_of t = Some propT"
	+ by (cases thy rule: theory_full_exhaust) simp
	+
	+fun fv_Proof :: "proofterm \<Rightarrow> (variable \<times> typ) set" where
	+ "fv_Proof (PAxm t _) = fv t"
	+\| "fv_Proof (PBound _) = empty"
	+\| "fv_Proof (Abst _ p) = fv_Proof p"
	+\| "fv_Proof (AbsP t p) = fv t \<union> fv_Proof p"
	+\| "fv_Proof (Appt p t) = fv_Proof p \<union> fv t"
	+\| "fv_Proof (AppP p1 p2) = fv_Proof p1 \<union> fv_Proof p2"
	+\| "fv_Proof (OfClass _ _) = empty"
	+\| "fv_Proof (Hyp t) = fv t"
	+
	+lemma typ_ok_Tv[simp]: "typ_ok thy (Tv idn S) = wf_sort (subclass (osig (sig thy))) S"
	+ by simp
	+
	+lemma typ_ok_contained_tvars_typ_ok: "typ_ok thy ty \<Longrightarrow> (idn, S) \<in> tvsT ty \<Longrightarrow> typ_ok thy (Tv idn S)"
	+ by (induction ty) (use split_list typ_ok_Ty in \<open>all \<open>fastforce split: option.splits\<close>\<close>)
	+
	+lemma typ_ok_sig_contained_tvars_typ_ok_sig:
	+ "typ_ok_sig \<Sigma> ty \<Longrightarrow> (idn, S) \<in> tvsT ty \<Longrightarrow> typ_ok_sig \<Sigma> (Tv idn S)"
	+ by (induction ty) (use split_list typ_ok_sig_Ty in \<open>all \<open>fastforce split: option.splits\<close>\<close>)
	+
	+lemma term_ok'_contained_tvars_typ_ok_sig:
	+ "term_ok' \<Sigma> t \<Longrightarrow> (idn, S) \<in> tvs t \<Longrightarrow> typ_ok_sig \<Sigma> (Tv idn S)"
	+
	+proof (induction t)
	+ case (Ct n T)
	+ hence "typ_ok_sig \<Sigma> T"
	+ by (auto split: option.splits)
	+ then show ?case
	+ using typ_ok_sig_contained_tvars_typ_ok_sig Ct by auto
	+next
	+ case (Fv idn T)
	+ hence "typ_ok_sig \<Sigma> T"
	+ by (auto split: option.splits)
	+ then show ?case
	+ using typ_ok_sig_contained_tvars_typ_ok_sig Fv by auto
	+next
	+ case (Bv n)
	+ then show ?case by auto
	+next
	+ case (Abs T t)
	+ hence "typ_ok_sig \<Sigma> T"
	+ by (auto split: option.splits)
	+ then show ?case
	+ using typ_ok_sig_contained_tvars_typ_ok_sig Abs by fastforce
	+next
	+ case (App t1 t2)
	+ then show ?case
	+ by auto
	+qed
	+
	+lemma term_ok_contained_tvars_typ_ok:
	+ "term_ok thy t \<Longrightarrow> (idn, S) \<in> tvs t \<Longrightarrow> typ_ok thy (Tv idn S)"
	+ using wt_term_def typ_ok_def term_ok'_contained_tvars_typ_ok_sig term_ok_def by blast
	+
	+lemma typ_ok_subst_typ:
	+ "typ_ok thy T \<Longrightarrow> \<forall>(_, ty) \<in> set insts . typ_ok thy ty \<Longrightarrow> typ_ok thy (subst_typ insts T)"
	+proof (induction insts T rule: subst_typ.induct)
	+ case (1 insts n Ts)
	+ have "typ_ok thy x" if "x\<in>set Ts" for x
	+ by (metis (full_types) "1.prems"(1) in_set_conv_decomp_first list_all_append list_all_simps(1)
	+ that typ_ok_Ty)
	+ hence "typ_ok thy (subst_typ insts x)" if "x\<in>set Ts" for x
	+ using that 1 by simp
	+ then show ?case
	+ using "1.prems"(1) by (auto simp add: list_all_iff split: option.splits)
	+next
	+ case (2 insts idn S)
	+ then show ?case
	+ proof(cases "(idn, S) \<in> set (map fst insts)")
	+ case True
	+ obtain ty where ty: "lookup (\<lambda>k. k=(idn,S)) insts = Some ty"
	+ by (metis (full_types) True lookup_None_iff not_Some_eq)
	+ hence "subst_typ insts (Tv idn S) = ty"
	+ by simp
	+ then show ?thesis
	+ using "2.prems"(2) ty case_prodD lookup_present_eq_key' by fastforce
	+ next
	+ case False
	+ hence "subst_typ insts (Tv idn S) = Tv idn S"
	+ by (metis (mono_tags, lifting) lookup_None_iff subst_typ.simps(2) the_default.simps(1))
	+ then show ?thesis
	+ using "2.prems"(1) by simp
	+ qed
	+qed
	+
	+lemma typ_ok_sig_subst_typ:
	+ "typ_ok_sig \<Sigma> T \<Longrightarrow> \<forall>(_, ty) \<in> set insts . typ_ok_sig \<Sigma> ty \<Longrightarrow> typ_ok_sig \<Sigma> (subst_typ insts T)"
	+proof (induction insts T rule: subst_typ.induct)
	+ case (1 insts n Ts)
	+ have "typ_ok_sig \<Sigma> x" if "x\<in>set Ts" for x
	+ using "1.prems"(1) split_list that typ_ok_sig_Ty by fastforce
	+ hence "typ_ok_sig \<Sigma> (subst_typ insts x)" if "x\<in>set Ts" for x
	+ using that 1 by simp
	+ then show ?case
	+ using "1.prems"(1) by (auto simp add: list_all_iff split: option.splits)
	+next
	+ case (2 insts idn S)
	+ then show ?case
	+ proof(cases "(idn, S) \<in> set (map fst insts)")
	+ case True
	+ obtain ty where ty: "lookup (\<lambda>k. k=(idn,S)) insts = Some ty"
	+ by (metis (full_types) True lookup_None_iff not_Some_eq)
	+ hence "subst_typ insts (Tv idn S) = ty"
	+ by simp
	+ then show ?thesis
	+ using "2.prems"(2) ty case_prodD lookup_present_eq_key' by fastforce
	+ next
	+ case False
	+ hence "subst_typ insts (Tv idn S) = Tv idn S"
	+ by (metis (mono_tags, lifting) lookup_None_iff subst_typ.simps(2) the_default.simps(1))
	+ then show ?thesis
	+ using "2.prems"(1) by simp
	+ qed
	+qed
	+
	+
	+lemma typ_ok_sig_imp_sortsT_ok_sig: "typ_ok_sig \<Sigma> T \<Longrightarrow> S \<in> SortsT T \<Longrightarrow> wf_sort (subclass (osig \<Sigma>)) S"
	+ by (induction T) (use split_list in \<open>all \<open>fastforce simp add: wf_sort_def split: option.splits\<close>\<close>)
	+
	+lemma term_ok'_imp_Sorts_ok_sig: "term_ok' \<Sigma> t \<Longrightarrow> S \<in> Sorts t \<Longrightarrow> wf_sort (subclass (osig \<Sigma>)) S"
	+ by (induction t) (use typ_ok_sig_imp_sortsT_ok_sig in \<open>(fastforce split: option.splits)+\<close>)
	+
	+lemma replay'_sound_pre:
	+ assumes thy: "wf_theory thy"
	+ (* Assumptions *)
	+ assumes HS_invs:
	+ "\<And>x. x\<in>set Hs \<Longrightarrow> term_ok thy x"
	+ "\<And>x. x\<in>set Hs \<Longrightarrow> typ_of x = Some propT"
	+ (* Names used *)
	+ assumes ns_invs:
	+ "finite ns"
	+ "fst ` FV (set Hs) \<subseteq> ns"
	+ "fst ` fv_Proof P \<subseteq> ns"
	+ (* Fviables used *)
	+ assumes vs_invs:
	+ "fst ` set vs \<subseteq> ns"
	+ (* Checked proof can be replay'ed using proves*)
	+ assumes "replay' thy vs ns Hs P = Some res"
	+ shows "thy, (set Hs) \<turnstile> res"
	+using assms proof(induction thy vs ns Hs P arbitrary: res rule: replay'.induct)
	+ case (1 thy uu uv Hs t Tis)
	+ hence
	+ ax: "t\<in>axioms thy"
	+ and insts: "inst_ok thy Tis" and t: "term_ok thy t"
	+ and res: "forall_intro_vars (subst_typ' Tis t) [] = res"
	+ by (auto split: if_splits)
	+ hence 1: "thy, {} \<turnstile> res"
	+ using res "1.prems"(1) proved_terms_well_formed_pre
	+ using axiom forall_intro_vars inst_ok_imp_wf_inst tsubst_simulates_subst_typ'
	+ by (metis (no_types, lifting) empty_set)
	+ show ?case
	+ using weaken_proves_set[of "set Hs", OF _ 1]
	+ using "1.prems"(2) "1.prems"(3) by auto
	+next
	+ case (2 thy ux uy Hs n)
	+ hence "res \<in> set Hs" using partial_nth_Some_imp_elem by simp
	+ then show ?case using proves.assume 2 by (simp add: wt_term_def)
	+next
	+ case (3 thy vs ns Hs T p)
	+
	+ obtain s' ns' where names: "(s',ns') = variant_variable (Free STR ''default'') ns"
	+ by simp
	+ from this 3 obtain bres where bres: "replay' thy ((s', T) # vs) ns' Hs p = Some bres"
	+ by (auto split: if_splits prod.splits)
	+ have "ns' = insert s' ns" using variant_variable_adds names
	+ by (metis fst_conv snd_conv)
	+ have "s' \<notin> ns" using "3.prems" variant_variable_fresh names
	+ by (metis fst_conv)
	+ hence "s' \<notin> fst ` FV (set Hs)" using "3.prems" by blast
	+ hence free: "(s', T) \<notin> FV (set Hs)" by force
	+
	+ have typ_ok: "wf_type (sig thy) T"
	+ using names "3.prems" by (auto split: if_splits)
	+ have I:"thy, set Hs \<turnstile> bres"
	+ apply (rule "3.IH"[OF _ names])
	+ using names "3.prems" apply (solves \<open>simp split: if_splits\<close>)+
	+ using names "3.prems" \<open>ns' = insert s' ns\<close> apply fastforce
	+ using "3.prems"(7) \<open>ns' = insert s' ns\<close> apply auto[1]
	+ using "3.prems"(8) \<open>ns' = insert s' ns\<close> apply auto[1]
	+ using "3.prems"(6) apply fastforce
	+ using "3.prems"(7) \<open>ns' = insert s' ns\<close> apply auto[1]
	+ using "3.prems"(8) \<open>ns' = insert s' ns\<close> apply auto[1]
	+ using bres by fastforce
	+ have res: "res = mk_all s' T bres" using names bres 3 by (auto split: if_splits prod.splits)
	+ show ?case using proves.forall_intro[OF \<open>wf_theory thy\<close> I free typ_ok] res by simp
	+next
	+ case (4 thy vs ns Hs p t)
	+ from \<open>replay' thy vs ns Hs (Appt p t) = Some res\<close> obtain rep t' b s fun1 fun2 propT1 propT2 \<tau> \<tau>' where
	+ conds: "replay' thy vs ns Hs p = Some rep"
	+ "t' = subst_bvs (map (\<lambda>(x,y) . Fv x y) vs) t"
	+ "typ_of t' = Some \<tau>'"
	+ "\<tau> = \<tau>'"
	+ "term_ok thy t'"
	+ "s= STR ''Pure.all'' \<and> fun1 = STR ''fun'' \<and> fun2 = STR ''fun'' \<and> propT1 = STR ''prop'' \<and> propT2 = STR ''prop''"
	+ "rep = Ct s (Ty fun1 [Ty fun2 [\<tau>, Ty propT1 Nil], Ty propT2 Nil]) $ b"
	+ and res: "res = (b \<bullet> t')"
	+ (* Takes forever, split up *)
	+ by (auto split: term.splits typ.splits list.splits if_splits option.splits simp add: Let_def)
	+
	+
	+ have ctxt: "finite (set Hs)" "\<forall>A \<in> set Hs . term_ok thy A" "\<forall>A \<in> set Hs . typ_of A = Some propT"
	+ using 4 by auto
	+
	+ show ?case
	+ using conds "4.prems" ctxt
	+ by (auto simp add: res wt_term_def simp del: FV_def
	+ intro!: forall_elim'[OF "4.prems"(1) _ _ _ ctxt] "4.IH")
	+next
	+ case (5 thy vs ns Hs t p)
	+ from this obtain t' rep where
	+ conds: "subst_bvs (map (\<lambda>(x,y) . Fv x y) vs) t = t'"
	+ "replay' thy vs ns (t'#Hs) p = Some rep"
	+ "typ_of t' = Some propT" "term_ok thy t'"
	+ and res: "res = mk_imp t' rep"
	+ by (auto split: term.splits typ.splits list.splits if_splits option.splits simp add: Let_def)
	+
	+ show ?case
	+ proof (cases "t'\<in> set Hs")
	+ case True
	+ hence s: "set Hs = set (t' # Hs)" by auto
	+ hence s': "set Hs = insert t' (set Hs -{t'})" by auto
	+
	+ have "thy,set (t' # Hs) \<turnstile> rep"
	+ apply (rule "5.IH")
	+ using conds(4) "5.prems" True by (auto simp add: conds(1) conds(2)[symmetric] conds(3))
	+ hence "thy,set Hs - {t'} \<turnstile> t' \<longmapsto> rep"
	+ using implies_intro "5.prems"(1) "5.prems"(4) conds(3) conds(4) s
	+ using has_typ_iff_typ_of term_ok'_imp_wf_term term_okD1 by presburger
	+ then show ?thesis
	+ apply (subst res)
	+ apply (subst s')
	+ apply (rule weaken_proves)
	+ using conds(3-4) by blast+
	+ next
	+ case False
	+ hence s: "set Hs = insert t' (set Hs) - {t'}" by auto
	+
	+ have "FV (set (map (\<lambda>(x,y) . Fv x y) vs)) = set vs" by (induction vs) auto
	+ hence frees_bound: "fv t' \<subseteq> fv t \<union> set vs"
	+ using fv_subst_bvs1_upper_bound subst_bvs_def by (fastforce simp add: conds(1)[symmetric])
	+
	+ have pre: "thy,set (t' # Hs) \<turnstile> rep"
	+ apply (rule "5.IH")
	+ using "5.prems"(5-8) conds(3-4) frees_bound
	+ by (auto simp add: "5.prems"(1-4) conds(1) conds(2) image_subset_iff simp del: term_ok_def)
	+
	+ show ?thesis
	+ apply (subst res) apply (subst s)
	+ apply (rule proves.implies_intro; use 5 conds in \<open>(solves \<open>simp add: wt_term_def\<close>)?\<close>)
	+ using pre by simp
	+ qed
	+next
	+ case (6 thy vs ns Hs p1 p2)
	+ from \<open>replay' thy vs ns Hs (AppP p1 p2) = Some res\<close> obtain fn1 fn2 prp1 prp2 prp3 A B A' imp
	+ where
	+ conds: "Option.bind (replay' thy vs ns Hs p1) beta_eta_norm
	+ = Some (Ct imp (Ty fn1 [Ty prp1 [], Ty fn2 [Ty prp2 [], Ty prp3 []]]) $ A $ B)"
	+ "Option.bind (replay' thy vs ns Hs p2) beta_eta_norm = Some A'"
	+ "imp = STR ''Pure.imp'' \<and> fn1 = STR ''fun'' \<and> fn2 = STR ''fun''
	+ \<and> prp1 = STR ''prop'' \<and> prp2 = STR ''prop'' \<and> prp3 = STR ''prop'' \<and> A=A'"
	+ and res: "res = B"
	+ by (auto split: term.splits typ.splits list.splits if_splits option.splits simp add: Let_def)
	+
	+ obtain C where C: "Option.bind (replay' thy vs ns Hs p1) beta_eta_norm = Some (C \<longmapsto> res)"
	+ using conds res by blast
	+ from this obtain pre pre_C where pre: "replay' thy vs ns Hs p1 = Some pre"
	+ and pre_C: "replay' thy vs ns Hs p2 = Some pre_C"
	+ by (meson bind_eq_Some_conv conds(2))
	+
	+ from pre C have norm_pre: "beta_eta_norm pre = Some (C \<longmapsto> res)" by simp
	+ from pre_C pre C conds have norm_pre_C: "beta_eta_norm pre_C = Some C" by auto
	+
	+ have "thy, set Hs \<turnstile> pre_C"
	+ by (rule "6.IH"(2)) (use "6.prems" conds in \<open>auto simp add: pre pre_C\<close>)
	+ hence I1: "thy, set Hs \<turnstile> C"
	+ using beta_eta_norm_preserves_proves norm_pre_C \<open>wf_theory thy\<close>
	+ using "6.prems"(2) "6.prems"(3) by blast
	+
	+ have "thy, set Hs \<turnstile> pre"
	+ by (rule "6.IH"(1)) (use "6.prems" conds in \<open>auto simp add: pre pre_C\<close>)
	+ hence I2: "thy, set Hs \<turnstile> C \<longmapsto> res"
	+ using beta_eta_norm_preserves_proves norm_pre \<open>wf_theory thy\<close>
	+ using "6.prems"(2) "6.prems"(3) by blast
	+
	+ from I1 I2 have "thy, set Hs \<union> set Hs \<turnstile> res" using proves.implies_elim by blast
	+ thus ?case by simp
	+next
	+ case (7 thy vs ns Hs ty c)
	+ from this obtain "fun" it ity "prop" where conds: "has_sort (osig (sig thy)) ty {c}"
	+ "typ_ok thy ty" "const_type (sig thy) (const_of_class c)
	+ = Some (Ty fun [Ty it [ity], Ty prop []])" "ity = tvariable STR '''a''"
	+ "fun = STR ''fun''" "prop = STR ''prop''" "it = STR ''itself''"
	+ and res: "res = (mk_of_class ty c)"
	+ by (auto split: term.splits typ.splits list.splits if_splits option.splits)
	+
	+ from res have "res = mk_of_class ty c" by auto
	+ moreover have "thy,set Hs \<turnstile> mk_of_class ty c"
	+ by (rule proves.of_class[where T=ty, OF "7.prems"(1)]) (use conds in auto)
	+
	+ ultimately show ?case by simp
	+next
	+ case (8 thy ux uy Hs n)
	+ hence "res \<in> set Hs"
	+ by (metis not_None_eq option.inject replay'.simps(8))
	+ then show ?case using proves.assume 8 by (simp add: wt_term_def)
	+qed
	+
	+lemma finite_fv_Proof: "finite (fv_Proof P)"
	+ by (induction P) auto
	+
	+abbreviation "replay'' thy vs ns Hs P \<equiv> Option.bind (replay' thy vs ns Hs P) beta_eta_norm"
	+
	+lemma replay''_sound:
	+ assumes "wf_theory thy"
	+ (* Assumptions *)
	+ assumes HS_invs:
	+ "\<And>x. x\<in>set Hs \<Longrightarrow> term_ok thy x"
	+ "\<And>x. x\<in>set Hs \<Longrightarrow> typ_of x = Some propT"
	+ (* Names used *)
	+ assumes ns_invs:
	+ "finite ns"
	+ "fst ` FV (set Hs) \<subseteq> ns"
	+ "fst ` fv_Proof P \<subseteq> ns"
	+ (* Fviables used *)
	+ assumes vs_invs:
	+ "fst ` set vs \<subseteq> ns"
	+ (* Checked proof can be replayed using proves*)
	+ assumes "replay'' thy vs ns Hs P = Some res"
	+ shows "thy, (set Hs) \<turnstile> res"
	+proof-
	+ obtain res' where res': "replay' thy vs ns Hs P = Some res'"
	+ using replay'_sound_pre assms bind_eq_Some_conv by metis
	+ moreover have "beta_eta_norm res' = Some res"
	+ using res' assms(8) by auto
	+ moreover have "thy, set Hs \<turnstile> res'"
	+ using res' assms replay'_sound_pre by simp
	+ ultimately show ?thesis
	+ using beta_eta_norm_preserves_proves assms(1-3) by blast
	+qed
	+
	+lemma
	+ assumes "wf_theory thy"
	+ assumes "replay'' thy [] (fst ` fv_Proof P) [] P = Some res"
	+ shows "thy, set [] \<turnstile> res"
	+ using assms finite_fv_Proof replay'_sound_pre replay''_sound[where vs="[]"
	+ and ns="fst ` fv_Proof P" and P=P and Hs="[]"]
	+ by simp
	+
	+(* With open hyps, run *)
	+
	+fun hyps :: "proofterm \<Rightarrow> term list" where
	+ "hyps (Abst _ p) = hyps p"
	+\| "hyps (AbsP _ p) = hyps p"
	+\| "hyps (Appt p _) = hyps p"
	+\| "hyps (AppP p1 p2) = List.union (hyps p1) (hyps p2)"
	+\| "hyps (Hyp t) = [t]"
	+\| "hyps _ = []"
	+
	+lemma replay''_sound_pre_hyps:
	+ assumes "wf_theory thy"
	+ (* This can be checked independently before running replay'. Could also check during replay' in Hyp step... *)
	+ assumes "\<And>x. x \<in> set (hyps P) \<Longrightarrow> term_ok thy x"
	+ assumes "\<And>x. x \<in> set (hyps P) \<Longrightarrow> typ_of x = Some propT"
	+ assumes "replay'' thy [] (fst ` (fv_Proof P \<union> FV (set (hyps P)))) (hyps P) P = Some res"
	+ shows "thy, set (hyps P) \<turnstile> res"
	+ apply (rule replay''_sound[where vs="[]" and ns="(fst ` (fv_Proof P \<union> FV (set (hyps P))))" and P=P and Hs="hyps P"]
	+ ; (use assms finite_fv_Proof replay'_sound_pre in \<open>solves simp\<close>)?)
	+ by blast+
	+
	+definition [simp]: "replay thy P \<equiv>
	+ (if \<forall>x\<in>set (hyps P) . term_ok thy x \<and> typ_of x = Some propT then
	+ replay'' thy [] (fst ` (fv_Proof P \<union> FV (set (hyps P)))) (hyps P) P else None)"
	+
	+lemma replay_sound_pre_hyps:
	+ assumes "wf_theory thy"
	+ assumes "replay thy P = Some res"
	+ shows "thy, set (hyps P) \<turnstile> res"
	+ using replay''_sound_pre_hyps assms by (simp split: if_splits)
	+
	+definition "check_proof thy P res \<equiv> wf_theory thy \<and> replay thy P = Some res"
	+
	+lemma check_proof_sound:
	+ shows "check_proof thy P res \<Longrightarrow> thy, set (hyps P) \<turnstile> res"
	+ using check_proof_def replay_sound_pre_hyps by blast
	+
	+lemma check_proof_really_sound:
	+ assumes "check_proof thy P res"
	+ shows "thy, set (hyps P) \<tturnstile> res"
	+proof-
	+ have "wf_theory thy"
	+ using assms check_proof_def by blast
	+ moreover have "Some res = replay thy P"
	+ by (metis assms check_proof_def)
	+ moreover hence "\<forall>x\<in>set (hyps P) . term_ok thy x \<and> typ_of x = Some propT"
	+ by (metis not_None_eq replay_def)
	+ ultimately show ?thesis
	+ by (meson assms check_proof_sound has_typ_iff_typ_of proved_terms_well_formed(1) proves'_def
	+ term_ok_def wt_term_def)
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/ROOT b/thys/Metalogic_ProofChecker/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/ROOT
	@@ -0,0 +1,13 @@
	+chapter AFP
	+
	+session Metalogic_ProofChecker (AFP) = HOL +
	+ options [timeout = 600]
	+ sessions
	+ "HOL-Eisbach"
	+ "HOL-Library"
	+ "List-Index"
	+ theories
	+ "CodeGen"
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/Metalogic_ProofChecker/SortConstants.thy b/thys/Metalogic_ProofChecker/SortConstants.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/SortConstants.thy
	@@ -0,0 +1,34 @@
	+
	+text\<open>Constants for encoding class/sort constraints in term language\<close>
	+
	+(* Mostly from ML code again *)
	+
	+theory SortConstants
	+ imports Sorts
	+begin
	+
	+(* pattern matching on strings not posigible *)
	+fun dest_type :: "term \<Rightarrow> typ option" where
	+ "dest_type (Ct nc (Ty nt [ty])) =
	+ (if nc = STR ''Pure.type'' \<and> nt = STR ''Pure.type'' then Some ty else None)"
	+\| "dest_type t = None"
	+
	+definition "type_map f t = map_option (\<lambda>ty. mk_type (f ty)) (dest_type t)"
	+
	+( type classes )
	+
	+(* i have implementations for those somewhere, find them, currently not used *)
	+consts unsuffix :: "name \<Rightarrow> name \<Rightarrow> name option"
	+
	+abbreviation "class_of_const c \<equiv> (unsuffix classN c)"
	+
	+(* class/sort membership *)
	+
	+fun dest_of_class :: "term \<Rightarrow> (typ * class) option" where
	+ "dest_of_class (Ct c_class _ $ ty) = lift2_option Pair (dest_type ty) (class_of_const c_class)"
	+\| "dest_of_class _ = None"
	+
	+definition "mk_of_sort ty S == map (\<lambda>c . mk_of_class ty c) S"
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Sorts.thy b/thys/Metalogic_ProofChecker/Sorts.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Sorts.thy
	@@ -0,0 +1,329 @@
	+section "Sorts"
	+
	+(*
	+ Some stuff on sorts. Mostly from Sort.ML I think.
	+*)
	+
	+theory Sorts
	+imports Term
	+begin
	+
	+definition [simp]: "empty_osig = ({}, Map.empty)"
	+
	+definition "sort_les cs s1 s2 = (sort_leq cs s1 s2 \<and> \<not> sort_leq cs s2 s1)"
	+definition "sort_eqv cs s1 s2 = (sort_leq cs s1 s2 \<and> sort_leq cs s2 s1)"
	+
	+lemmas class_defs = class_leq_def class_les_def class_ex_def
	+lemmas sort_defs = sort_leq_def sort_les_def sort_eqv_def sort_ex_def
	+
	+lemma sort_ex_class_ex: "sort_ex cs S \<equiv> \<forall>c \<in> S. class_ex cs c"
	+ by (auto simp add: sort_ex_def class_ex_def subset_eq)
	+
	+(* Did not want to write the wf_subclass cs assumption each time + allowed type class instances inside
	+ Now probably more trouble than help
	+*)
	+locale wf_subclass_loc =
	+ fixes cs :: "class rel"
	+ assumes wf[simp]: "wf_subclass cs"
	+begin
	+
	+lemma class_les_irrefl: "\<not> class_les cs c c"
	+ using wf by (simp add: class_les_def)
	+lemma class_les_trans: "class_les cs x y \<Longrightarrow> class_les cs y z \<Longrightarrow> class_les cs x z"
	+ using wf by (auto simp add: class_les_def class_leq_def trans_def)
	+
	+lemma class_leq_refl[iff]: "class_ex cs c \<Longrightarrow> class_leq cs c c"
	+ using wf by (simp add: class_leq_def class_ex_def refl_on_def)
	+lemma class_leq_trans: "class_leq cs x y \<Longrightarrow> class_leq cs y z \<Longrightarrow> class_leq cs x z"
	+ using wf by (auto simp add: class_leq_def elim: transE)
	+lemma class_leq_antisym: "class_leq cs c1 c2 \<Longrightarrow> class_leq cs c2 c1 \<Longrightarrow> c1=c2"
	+ using wf by (auto intro: antisymD simp: trans_def class_leq_def)
	+
	+(* classes form a ~ partial order with class_les/class_leq a for a well-formed a*)
	+lemma sort_leq_refl[iff]: "sort_ex cs s \<Longrightarrow> sort_leq cs s s"
	+ using class_leq_refl by (auto simp add: sort_ex_class_ex sort_leq_def)
	+lemma sort_leq_trans: "sort_leq cs x y \<Longrightarrow> sort_leq cs y z \<Longrightarrow> sort_leq cs x z"
	+ by (meson class_leq_trans sort_leq_def)
	+lemma sort_leq_ex: "sort_leq cs s1 s2 \<Longrightarrow> sort_ex cs s2"
	+ by (auto simp add: sort_ex_def class_leq_def sort_leq_def intro: FieldI2)
	+(* ... *)
	+
	+lemma sort_leq_minimize:
	+ "sort_leq cs s1 s2 \<Longrightarrow> \<exists>s1'. (\<forall>c1 \<in> s1' . \<exists>c2 \<in> s2. class_leq cs c1 c2) \<and> sort_leq cs s1' s2"
	+ by (meson class_leq_refl sort_ex_class_ex sort_leq_ex sort_leq_refl)
	+
	+lemma "sort_ex cs s2 \<Longrightarrow> s1 \<subseteq> s2 \<Longrightarrow> sort_ex cs s1"
	+ by (meson sort_ex_def subset_trans)
	+
	+lemma superset_imp_sort_leq: "sort_ex cs s2 \<Longrightarrow> s1 \<supseteq> s2 \<Longrightarrow> sort_leq cs s1 s2"
	+ by (auto simp add: sort_ex_class_ex sort_leq_def sort_ex_def)
	+lemma full_sort_top: "sort_ex cs s \<Longrightarrow> sort_leq cs s full_sort"
	+ by (simp add: sort_leq_def)
	+
	+(* Is this even useful? *)
	+lemma sort_les_trans: "sort_les cs x y \<Longrightarrow> sort_les cs y z \<Longrightarrow> sort_les cs x z"
	+ using sort_les_def sort_leq_trans by blast
	+
	+lemma sort_eqvI: "sort_leq cs s1 s2 \<Longrightarrow> sort_leq cs s2 s1 \<Longrightarrow> sort_eqv cs s1 s2"
	+ by (simp add: sort_eqv_def)
	+lemma sort_eqv_refl: "sort_ex cs s \<Longrightarrow> sort_eqv cs s s"
	+ using sort_leq_refl by (auto simp add: sort_eqv_def)
	+lemma sort_eqv_trans: "sort_eqv cs x y \<Longrightarrow> sort_eqv cs y z \<Longrightarrow> sort_eqv cs x z"
	+ using sort_eqv_def sort_leq_trans by blast
	+lemma sort_eqv_sym: "sort_eqv cs x y \<Longrightarrow> sort_eqv cs y x"
	+ by (auto simp add: sort_eqv_def)
	+(* sort_eqv a is ~ equivalence relation.. *)
	+
	+lemma normalize_sort_empty[simp]: "normalize_sort cs full_sort = full_sort"
	+ by (simp add: normalize_sort_def)
	+lemma normalize_sort_normalize_sort[simp]:
	+ "normalize_sort cs (normalize_sort cs s) = normalize_sort cs s"
	+ by (auto simp add: normalize_sort_def)
	+
	+lemma sort_ex_norm_sort: "sort_ex cs s \<Longrightarrow> sort_ex cs (normalize_sort cs s)"
	+ by (simp add: normalize_sort_def sort_ex_class_ex)
	+
	+lemma normalized_sort_subset: "normalize_sort cs s \<subseteq> s"
	+ by (auto simp add: normalize_sort_def)
	+
	+lemma normalize_sort_removed_elem_irrelevant':
	+ assumes "sort_ex cs (insert c s)"
	+ assumes "c \<notin> (normalize_sort cs (insert c s))"
	+ shows "normalize_sort cs (insert c s) = normalize_sort cs s"
	+proof-
	+ have "class_ex cs c" using assms(1) by (auto simp add: sort_ex_class_ex)
	+ from this assms(2) obtain c' where "class_les cs c' c" "c' \<in> s"
	+ using class_les_irrefl by (auto simp add: normalize_sort_def)
	+ thus ?thesis
	+ using \<open>class_ex cs c\<close> class_les_irrefl class_les_trans by (simp add: normalize_sort_def) blast
	+qed
	+
	+corollary normalize_sort_removed_elem_irrelevant:
	+ assumes "sort_ex cs (insert c s)"
	+ assumes "c \<notin> (normalize_sort cs (insert c s))"
	+ shows "normalize_sort cs (insert c s) = normalize_sort cs s"
	+ using assms normalize_sort_removed_elem_irrelevant'
	+ by (simp add: normalize_sort_def)
	+
	+lemma normalize_sort_nempt_is_nempty:
	+ assumes finite: "finite s"
	+ assumes nempty: "s \<noteq> full_sort"
	+ assumes "sort_ex cs s"
	+ shows "normalize_sort cs s \<noteq> full_sort"
	+using assms proof (induction s rule: finite_induct)
	+ case empty
	+ then show ?case by simp
	+next
	+ case (insert c s)
	+ note ICons = this
	+ then show ?case
	+ proof(cases s)
	+ case emptyI
	+ hence "normalize_sort cs (insert c s) = {c}"
	+ using insert class_les_irrefl by (auto simp add: normalize_sort_def sort_ex_class_ex)
	+ then show ?thesis by simp
	+ next
	+ case (insertI c' s')
	+ hence "normalize_sort cs s \<noteq> full_sort"
	+ using ICons by (auto simp add: normalize_sort_def sort_ex_class_ex)
	+ then show ?thesis
	+ proof (cases "c \<in> (normalize_sort cs s)")
	+ case True
	+ hence "insert c s = s"
	+ using normalized_sort_subset by fastforce
	+ then show ?thesis
	+ using ICons by (auto simp add: normalize_sort_def sort_ex_class_ex class_les_def)
	+ next
	+ case False
	+ then show ?thesis
	+ using normalize_sort_removed_elem_irrelevant
	+ using insert.prems(2) ICons(3) \<open>normalize_sort cs s \<noteq> full_sort\<close> by auto
	+ qed
	+ qed
	+qed
	+
	+lemma choose_smaller_in_sort:
	+ assumes elem: "c \<in> s" and nelem: "c \<notin> (normalize_sort cs s)" and "sort_ex cs s"
	+ obtains c' where "c' \<in> s" and "class_les cs c' c"
	+ using assms by (auto simp add: normalize_sort_def sort_ex_class_ex)
	+
	+lemma normalize_ex_bound':
	+ assumes finite: "finite s" and elem: "c \<in> s" and nelem: "c \<notin> (normalize_sort cs s)"
	+ and "sort_ex cs s"
	+ shows "\<exists>c' \<in> (normalize_sort cs s) . class_les cs c' c"
	+using assms proof (induction s arbitrary: c)
	+ case empty
	+ then show ?case by simp
	+next
	+ case (insert ic s)
	+ then show ?case
	+ proof(cases "ic=c")
	+ case True
	+ then show ?thesis
	+ by (smt choose_smaller_in_sort class_les_irrefl class_les_trans insert.IH insert.prems(2)
	+ insert.prems(3) insert_iff insert_subset normalize_sort_removed_elem_irrelevant' sort_ex_def)
	+ next
	+ case False
	+ hence "c \<in> s" using insert.prems by simp
	+ then show ?thesis
	+ proof(cases "ic \<in> (normalize_sort cs (insert ic s))")
	+ case True
	+ then show ?thesis
	+ proof(cases "class_les cs ic c")
	+ case True
	+ then show ?thesis
	+ using insert \<open>c \<in> s\<close> normalize_sort_removed_elem_irrelevant' sort_ex_def
	+ by (metis insert_subset)
	+ next
	+ case False
	+
	+ obtain c'' where c'': "c'' \<in> (normalize_sort cs s)" "class_les cs c'' c"
	+ using insert \<open>c \<in> s\<close> normalize_sort_removed_elem_irrelevant' sort_ex_def
	+ by (metis False choose_smaller_in_sort class_les_trans insert_iff insert_subset)
	+ moreover have "(c'', c) \<in> cs" "(c, c'') \<notin> cs"
	+ using c'' by (simp_all add: class_leq_def class_les_def)
	+ moreover hence "\<not> class_les cs ic c''"
	+ by (meson False class_leq_def class_les_def class_les_trans)
	+
	+ ultimately show ?thesis
	+ by (auto simp add: normalize_sort_def sort_ex_class_ex class_ex_def class_leq_def class_les_def)
	+ qed
	+ next
	+ case False
	+ then show ?thesis
	+ by (metis (full_types) insert.IH insert.prems(2) insert.prems(3) \<open>c \<in> s\<close>
	+ normalize_sort_removed_elem_irrelevant sort_ex_def insert_subset)
	+ qed
	+ qed
	+qed
	+
	+corollary normalize_ex_bound:
	+ assumes finite: "finite s" and elem: "c \<in> s" and nelem: "c \<notin> (normalize_sort cs s)"
	+ and "sort_ex cs s"
	+ obtains c' where "c' \<in> (normalize_sort cs s)" and "class_les cs c' c"
	+ using assms normalize_ex_bound' by auto
	+
	+lemma "sort_ex cs s \<Longrightarrow> sort_leq cs s (normalize_sort cs s)"
	+ by (auto simp add: normalize_sort_def sort_leq_def sort_ex_class_ex)
	+lemma sort_eqv_normalize_sort:
	+ assumes "finite s"
	+ assumes "sort_ex cs s"
	+ shows "sort_eqv cs s (normalize_sort cs s)"
	+proof (intro sort_eqvI)
	+ show "sort_leq cs s (normalize_sort cs s)"
	+ using assms(2) by (auto simp add: normalize_sort_def sort_leq_def sort_ex_class_ex)
	+next
	+ show "sort_leq cs (normalize_sort cs s) s"
	+ proof (unfold sort_leq_def; intro ballI)
	+ fix c2 assume "c2 \<in> s"
	+ show "\<exists>c1 \<in> normalize_sort cs s. class_leq cs c1 c2"
	+ proof (cases "c2 \<in> normalize_sort cs s")
	+ case True
	+ then show ?thesis using \<open>c2 \<in> s\<close> assms sort_ex_class_ex by fast
	+ next
	+ case False
	+ from this obtain c' where "c' \<in> normalize_sort cs s" and "class_les cs c' c2"
	+ using \<open>c2 \<in> s\<close> normalize_ex_bound assms by metis
	+ then show ?thesis using class_les_def by metis
	+ qed
	+ qed
	+qed
	+
	+lemma normalize_sort_eq_imp_sort_eqv: "sort_ex cs s1 \<Longrightarrow> sort_ex cs s2 \<Longrightarrow> finite s1 \<Longrightarrow> finite s2
	+ \<Longrightarrow> normalize_sort cs s1 = normalize_sort cs s2
	+ \<Longrightarrow> sort_eqv cs s1 s2"
	+ by (metis sort_eqv_sym sort_eqv_trans wf_subclass_loc.sort_eqv_normalize_sort wf_subclass_loc_axioms)
	+
	+lemma "class_leq cs c1 c2 \<longleftrightarrow> class_les cs c1 c2 \<or> (c1=c2 \<and> class_ex cs c1)"
	+ by (meson FieldI1 class_ex_def class_leq_antisym class_leq_def class_leq_refl class_les_def)
	+
	+lemma sort_eqv_imp_normalize_sort_eq:
	+ assumes "sort_ex cs s1" "sort_ex cs s2" "sort_eqv cs s1 s2"
	+ shows "normalize_sort cs s1 = normalize_sort cs s2"
	+proof (rule ccontr)
	+ have "sort_leq cs s1 s2" "sort_leq cs s2 s1"
	+ using assms(3) by (auto simp add: sort_eqv_def)
	+
	+ assume "normalize_sort cs s1 \<noteq> normalize_sort cs s2"
	+ hence "\<not> normalize_sort cs s1 \<subseteq> normalize_sort cs s2 \<or>
	+ \<not> normalize_sort cs s2 \<subseteq> normalize_sort cs s1"
	+ by simp
	+ from this consider "\<not> normalize_sort cs s1 \<subseteq> normalize_sort cs s2"
	+ \| "normalize_sort cs s1 \<subseteq> normalize_sort cs s2"
	+ "\<not> normalize_sort cs s2 \<subseteq> normalize_sort cs s1"
	+ by blast
	+ thus False
	+ proof cases
	+ case 1
	+ from this obtain c where c: "c \<in> normalize_sort cs s1" "c \<notin> normalize_sort cs s2"
	+ by blast
	+ from this obtain c' where c': "c' \<in> normalize_sort cs s2" "class_les cs c' c"
	+ by (smt \<open>sort_leq cs s1 s2\<close> \<open>sort_leq cs s2 s1\<close> class_les_def mem_Collect_eq normalize_sort_def
	+ sort_leq_def wf_subclass_loc.class_leq_antisym wf_subclass_loc.class_leq_trans wf_subclass_loc_axioms)
	+ then show ?thesis
	+ proof(cases "c' \<in> normalize_sort cs s1")
	+ case True
	+ hence "c \<notin> normalize_sort cs s1"
	+ using c c' by (auto simp add: normalize_sort_def)
	+ then show ?thesis using c(1) by simp
	+ next
	+ case False
	+ from False c' obtain c'' where c'': "c'' \<in> normalize_sort cs s1" "class_les cs c'' c'"
	+ by (smt \<open>sort_leq cs s1 s2\<close> \<open>sort_leq cs s2 s1\<close> class_les_def mem_Collect_eq normalize_sort_def
	+ sort_leq_def wf_subclass_loc.class_leq_antisym wf_subclass_loc.class_leq_trans wf_subclass_loc_axioms)
	+ hence "class_les cs c'' c"
	+ using c'(2) class_les_trans by blast
	+ hence "c \<notin> normalize_sort cs s1"
	+ using c c'' by (auto simp add: normalize_sort_def)
	+ then show ?thesis using c(1) by simp
	+ qed
	+ next
	+ (* Should work analogous, let's see *)
	+ case 2
	+ from this obtain c where c: "c \<in> normalize_sort cs s2" "c \<notin> normalize_sort cs s1"
	+ by blast
	+ from this obtain c' where c': "c' \<in> normalize_sort cs s1" "class_les cs c' c"
	+ by (smt \<open>sort_leq cs s1 s2\<close> \<open>sort_leq cs s2 s1\<close> class_les_def mem_Collect_eq normalize_sort_def
	+ sort_leq_def wf_subclass_loc.class_leq_antisym wf_subclass_loc.class_leq_trans wf_subclass_loc_axioms)
	+ then show ?thesis
	+ proof(cases "c' \<in> normalize_sort cs s2")
	+ case True
	+ hence "c \<notin> normalize_sort cs s2"
	+ using c c' by (auto simp add: normalize_sort_def)
	+ then show ?thesis using c(1) by simp
	+ next
	+ case False
	+ from False c' obtain c'' where c'':"c''\<in> normalize_sort cs s2" "class_les cs c'' c'"
	+ by (smt \<open>sort_leq cs s1 s2\<close> \<open>sort_leq cs s2 s1\<close> class_les_def mem_Collect_eq normalize_sort_def
	+ sort_leq_def wf_subclass_loc.class_leq_antisym wf_subclass_loc.class_leq_trans wf_subclass_loc_axioms)
	+ hence "class_les cs c'' c"
	+ using c'(2) class_les_trans by blast
	+ hence "c \<notin> normalize_sort cs s2"
	+ using c c'' by (auto simp add: normalize_sort_def)
	+ then show ?thesis using c(1) by simp
	+ qed
	+ qed
	+qed
	+
	+corollary sort_eqv_iff_normalize_sort_eq:
	+ assumes "finite s1" "finite s2"
	+ assumes "sort_ex cs s1" "sort_ex cs s2"
	+ shows "sort_eqv cs s1 s2 \<longleftrightarrow> normalize_sort cs s1 = normalize_sort cs s2"
	+using assms normalize_sort_eq_imp_sort_eqv sort_eqv_imp_normalize_sort_eq by blast
	+
	+end
	+
	+lemma tcsigs_sorts_defined: "wf_osig oss \<Longrightarrow>
	+ (\<forall>ars \<in> ran (tcsigs oss) . \<forall>ss \<in> ran ars . \<forall>s \<in> set ss. sort_ex (subclass oss) s)"
	+ by (cases oss) (simp add: wf_sort_def all_normalized_and_ex_tcsigs_def)
	+
	+lemma osig_subclass_loc: "wf_osig oss \<Longrightarrow> wf_subclass_loc (subclass oss)"
	+ using wf_subclass_loc.intro by (cases oss) simp
	+
	+lemma wf_osig_imp_wf_subclass_loc: "wf_osig oss \<Longrightarrow> wf_subclass_loc (subclass oss)"
	+ by (cases oss) (simp add: wf_subclass_loc_def)
	+
	+lemma has_sort_Tv_imp_sort_leq: "has_sort oss (Tv idn S) S' \<Longrightarrow> sort_leq (subclass oss) S S'"
	+ by (auto simp add: has_sort.simps)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/SortsExe.thy b/thys/Metalogic_ProofChecker/SortsExe.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/SortsExe.thy
	@@ -0,0 +1,383 @@
	+
	+section "Executable Sorts"
	+
	+theory SortsExe
	+ imports Sorts
	+begin
	+
	+type_synonym exeosig = "(class \<times> class) list \<times> (name \<times> (class \<times> sort list) list) list"
	+
	+abbreviation (input) "execlasses \<equiv> fst"
	+abbreviation (input) "exetcsigs \<equiv> snd"
	+
	+(* Eliminate fully? *)
	+abbreviation alist_conds :: "('k::linorder \<times> 'v) list \<Rightarrow> bool" where
	+ "alist_conds al \<equiv> distinct (map fst al)"
	+
	+(* This is not executable *)
	+definition exe_ars_conds :: "(name \<times> (class \<times> sort list) list) list \<Rightarrow> bool" where
	+ "exe_ars_conds arss \<longleftrightarrow> alist_conds arss \<and> (\<forall>ars \<in> snd ` set arss . alist_conds ars)"
	+
	+fun exe_ars_conds' :: "(('k1::linorder) \<times> (('k2::linorder) \<times> 's list) list) list \<Rightarrow> bool" where
	+ "exe_ars_conds' arss \<longleftrightarrow> alist_conds arss \<and> (\<forall>ars \<in> snd ` set arss . alist_conds ars)"
	+
	+lemma [code]: "exe_ars_conds arss \<longleftrightarrow> exe_ars_conds' arss"
	+ by (simp add: exe_ars_conds_def)
	+
	+definition exe_class_conds :: "(class \<times> class) list \<Rightarrow> bool" where
	+ "exe_class_conds cs \<equiv> distinct cs"
	+
	+definition exe_osig_conds :: "exeosig \<Rightarrow> bool" where
	+ "exe_osig_conds a \<equiv> exe_class_conds (execlasses a) \<and> exe_ars_conds (exetcsigs a)"
	+
	+fun translate_ars :: "(name \<times> (class \<times> sort list) list) list \<Rightarrow> name \<rightharpoonup> (class \<rightharpoonup> sort list)" where
	+ "translate_ars ars = map_of (map (apsnd map_of) ars)"
	+
	+abbreviation "illformed_osig \<equiv> ({}, Map.empty(STR ''A'' \<mapsto> Map.empty(STR ''A'' \<mapsto> [{STR ''A''}])))"
	+
	+lemma illformed_osig_not_wf_osig: "\<not> wf_osig illformed_osig"
	+ by (auto simp add: coregular_tcsigs_def complete_tcsigs_def consistent_length_tcsigs_def
	+ all_normalized_and_ex_tcsigs_def sort_ex_def wf_sort_def)
	+
	+(* I should probably do this with an option return type instead... *)
	+fun translate_osig :: "exeosig \<Rightarrow> osig" where
	+ "translate_osig (cs, arss) = (if exe_osig_conds (cs, arss)
	+ then (set cs, translate_ars arss)
	+ else illformed_osig)"
	+
	+definition "exe_consistent_length_tcsigs arss \<equiv> (\<forall>ars \<in> snd ` set arss .
	+ \<forall>ss\<^sub>1 \<in> snd ` set ars. \<forall>ss\<^sub>2 \<in> snd ` set ars. length ss\<^sub>1 = length ss\<^sub>2)"
	+
	+lemma in_alist_imp_in_map_of: "distinct (map fst arss)
	+ \<Longrightarrow> (name, ars) \<in> set arss \<Longrightarrow> translate_ars arss name = Some (map_of ars)"
	+ by (induction arss) (auto simp add: rev_image_eqI)
	+
	+lemma "exe_ars_conds arss \<Longrightarrow> \<exists>name . map_of (map (apsnd map_of) arss) name = Some ars
	+ \<Longrightarrow> \<exists>name arsl . (name, arsl) \<in> set arss \<and> map_of arsl = ars"
	+ by (force simp add: exe_ars_conds_def)
	+
	+lemma "exe_ars_conds arss
	+ \<Longrightarrow> (name, arsl) \<in> set arss \<and> map_of arsl = ars
	+ \<Longrightarrow> map_of (map (apsnd map_of) arss) name = Some ars"
	+ by (force simp add: exe_ars_conds_def)
	+
	+lemma consistent_length_tcsigs_imp_exe_consistent_length_tcsigs:
	+ "exe_ars_conds arss \<Longrightarrow> consistent_length_tcsigs (translate_ars arss)
	+ \<Longrightarrow> exe_consistent_length_tcsigs arss"
	+ unfolding consistent_length_tcsigs_def exe_consistent_length_tcsigs_def
	+ apply (clarsimp simp add: exe_ars_conds_def)
	+ by (metis in_alist_imp_in_map_of map_of_is_SomeI ranI snd_conv translate_ars.simps)
	+
	+lemma exe_consistent_length_tcsigs_imp_consistent_length_tcsigs:
	+ assumes "exe_ars_conds arss" "exe_consistent_length_tcsigs arss"
	+ shows "consistent_length_tcsigs (translate_ars arss)"
	+proof-
	+ {
	+ fix ars ss\<^sub>1 ss\<^sub>2
	+ assume p: "ars \<in> ran (map_of (map (apsnd map_of) arss))" "ss\<^sub>1 \<in> ran ars" "ss\<^sub>2 \<in> ran ars"
	+ from p(1) obtain name where "map_of (map (apsnd map_of) arss) name = Some ars"
	+ by (meson in_range_if_ex_key)
	+ from this obtain arsl where "(name, arsl) \<in> set arss" "map_of arsl = ars"
	+ using assms(1) by (auto simp add: exe_ars_conds_def)
	+ from this obtain c1 c2 where "ars c1 = Some ss\<^sub>1" "ars c2 = Some ss\<^sub>2"
	+ by (metis in_range_if_ex_key p(2) p(3))
	+ hence "(c1, ss\<^sub>1) \<in> set arsl" "(c2, ss\<^sub>2) \<in> set arsl"
	+ by (simp_all add: \<open>map_of arsl = ars\<close> map_of_SomeD)
	+ hence "length ss\<^sub>1 = length ss\<^sub>2"
	+ using assms(2) \<open>(name, arsl) \<in> set arss\<close>
	+ by (fastforce simp add: exe_consistent_length_tcsigs_def)
	+ }
	+ note 1 = this
	+ show ?thesis
	+ by (simp add: consistent_length_tcsigs_def exe_consistent_length_tcsigs_def) (use 1 in blast)
	+qed
	+
	+lemma consistent_length_tcsigs_iff_exe_consistent_length_tcsigs:
	+ "exe_ars_conds arss \<Longrightarrow>
	+ consistent_length_tcsigs (translate_ars arss) \<longleftrightarrow> exe_consistent_length_tcsigs arss"
	+ using consistent_length_tcsigs_imp_exe_consistent_length_tcsigs
	+ exe_consistent_length_tcsigs_imp_consistent_length_tcsigs by blast
	+
	+(* Do I even have to translate the relation? *)
	+definition "exe_complete_tcsigs cs arss
	+ \<equiv> (\<forall>ars \<in> snd ` set arss .
	+ \<forall>(c\<^sub>1, c\<^sub>2) \<in> set cs . c\<^sub>1\<in>fst ` set ars \<longrightarrow> c\<^sub>2\<in>fst ` set ars)"
	+
	+lemma exe_complete_tcsigs_imp_complete_tcsigs:
	+ assumes "exe_ars_conds arss" "exe_complete_tcsigs cs arss"
	+ shows "complete_tcsigs (set cs) (translate_ars arss)"
	+proof-
	+ {
	+ fix ars a b y
	+ assume p: "ars \<in> ran (map_of (map (apsnd map_of) arss))"
	+ "(a, b) \<in> set cs" "ars a = Some y"
	+
	+ from p(1) obtain name where "map_of (map (apsnd map_of) arss) name = Some ars"
	+ by (meson in_range_if_ex_key)
	+ from this obtain arsl where "(name, arsl) \<in> set arss" "map_of arsl = ars"
	+ using assms(1) by (auto simp add: exe_ars_conds_def)
	+ hence "(a, y) \<in> set arsl"
	+ by (simp add: map_of_SomeD p(3))
	+ hence"\<exists>y. ars b = Some y"
	+ using assms(2) \<open>(name, arsl) \<in> set arss\<close>
	+ apply (clarsimp simp add: exe_complete_tcsigs_def)
	+ by (metis (no_types, lifting) \<open>map_of arsl = ars\<close> case_prodD domD domI dom_map_of_conv_image_fst
	+ p(2) p(3) snd_conv)
	+ }
	+ note 1 = this
	+ show ?thesis
	+ by (simp add: complete_tcsigs_def exe_complete_tcsigs_def) (use 1 in blast)
	+qed
	+
	+lemma complete_tcsigs_imp_exe_complete_tcsigs: "exe_ars_conds arss \<Longrightarrow>
	+ complete_tcsigs (set cs) (translate_ars arss) \<Longrightarrow> exe_complete_tcsigs cs arss"
	+ unfolding complete_tcsigs_def exe_complete_tcsigs_def exe_ars_conds_def
	+ by (metis (mono_tags, lifting) case_prod_unfold dom_map_of_conv_image_fst in_alist_imp_in_map_of
	+ in_range_if_ex_key map_of_SomeD ran_distinct)
	+
	+lemma exe_complete_tcsigs_iff_complete_tcsigs:
	+ "exe_ars_conds arss \<Longrightarrow>
	+ complete_tcsigs (set cs) (translate_ars arss) \<longleftrightarrow> exe_complete_tcsigs cs arss"
	+ using exe_complete_tcsigs_imp_complete_tcsigs complete_tcsigs_imp_exe_complete_tcsigs
	+ by blast
	+
	+definition "exe_coregular_tcsigs (cs :: (class \<times> class) list) arss
	+ \<equiv> (\<forall>ars \<in> snd ` set arss .
	+ \<forall>c\<^sub>1 \<in> fst ` set ars. \<forall>c\<^sub>2 \<in> fst ` set ars.
	+ (class_leq (set cs) c\<^sub>1 c\<^sub>2 \<longrightarrow>
	+ list_all2 (sort_leq (set cs)) (the (lookup (\<lambda>x. x=c\<^sub>1) ars)) (the (lookup (\<lambda>x. x=c\<^sub>2) ars))))"
	+
	+
	+lemma exe_coregular_tcsigs_imp_coregular_tcsigs:
	+ assumes "exe_ars_conds arss" "exe_coregular_tcsigs cs arss"
	+ shows "coregular_tcsigs (set cs) (translate_ars arss)"
	+proof-
	+ {
	+ fix ars c\<^sub>1 c\<^sub>2 ss1 ss2
	+ assume p: "ars \<in> ran (map_of (map (apsnd map_of) arss))" "ars c\<^sub>1 = Some ss1" "ars c\<^sub>2 = Some ss2"
	+ "class_leq (set cs) c\<^sub>1 c\<^sub>2"
	+ from p(1) obtain name where "map_of (map (apsnd map_of) arss) name = Some ars"
	+ by (meson in_range_if_ex_key)
	+ from this obtain arsl where "(name, arsl) \<in> set arss" "map_of arsl = ars"
	+ using assms(1) by (auto simp add: exe_ars_conds_def)
	+ from this obtain c1 c2 where "ars c1 = Some ss1" "ars c2 = Some ss2" "class_leq (set cs) c1 c2"
	+ using p(2) p(3) p(4) by blast
	+ hence "(c1, ss1) \<in> set arsl" "(c2, ss2) \<in> set arsl"
	+ by (simp_all add: \<open>map_of arsl = ars\<close> map_of_SomeD)
	+ hence "lookup (\<lambda>x. x=c1) arsl = Some ss1" "lookup (\<lambda>x. x=c2) arsl = Some ss2"
	+ by (metis \<open>(name, arsl) \<in> set arss\<close> assms(1) exe_ars_conds_def
	+ image_eqI lookup_present_eq_key snd_conv)+
	+ hence "list_all2 (sort_leq (set cs)) ss1 ss2"
	+ using assms(2) \<open>(name, arsl) \<in> set arss\<close> \<open>(c1, ss1) \<in> set arsl\<close> \<open>(c2, ss2) \<in> set arsl\<close>
	+ \<open>class_leq (set cs) c1 c2\<close>
	+ by (fastforce simp add: exe_coregular_tcsigs_def)
	+ }
	+ note 1 = this
	+ show ?thesis
	+ by (auto simp add: coregular_tcsigs_def exe_coregular_tcsigs_def) (use 1 in blast)
	+
	+qed
	+
	+lemma coregular_tcsigs_imp_exe_coregular_tcsigs:
	+ assumes "exe_ars_conds arss" "coregular_tcsigs (set cs) (translate_ars arss)"
	+ shows "exe_coregular_tcsigs cs arss"
	+proof-
	+ {
	+ fix name ars c1 ss1 c2 ss2
	+ assume p: "(name, ars) \<in> set arss" "(c1, ss1) \<in> set ars" "(c2, ss2) \<in> set ars"
	+ "class_leq (set cs) c1 c2"
	+
	+ have s1: "(lookup (\<lambda>x. x = c1) ars) = Some ss1"
	+ using assms(1) lookup_present_eq_key p(1) p(2) by (force simp add: exe_ars_conds_def)
	+ have s2: "(lookup (\<lambda>x. x = c2) ars) = Some ss2"
	+ using assms(1) lookup_present_eq_key p(1) p(3) by (force simp add: exe_ars_conds_def)
	+ have "list_all2 (sort_leq (set cs)) (the (lookup (\<lambda>x. x = c1) ars)) (the (lookup (\<lambda>x. x = c2) ars))"
	+ using assms apply (simp add: coregular_tcsigs_def s1 s2 exe_ars_conds_def)
	+ by (metis domIff in_alist_imp_in_map_of map_of_is_SomeI option.distinct(1) option.sel
	+ p(1) p(2) p(3) p(4) ranI snd_conv translate_ars.simps)
	+ }
	+ note 1 = this
	+ show ?thesis
	+ by (auto simp add: coregular_tcsigs_def exe_coregular_tcsigs_def) (use 1 in blast)
	+qed
	+
	+lemma coregular_tcsigs_iff_exe_coregular_tcsigs:
	+ "exe_ars_conds arss \<Longrightarrow> coregular_tcsigs (set cs) (translate_ars arss) \<longleftrightarrow> exe_coregular_tcsigs cs arss"
	+ using coregular_tcsigs_imp_exe_coregular_tcsigs exe_coregular_tcsigs_imp_coregular_tcsigs by blast
	+
	+lemma "wf_subclass sub \<Longrightarrow> Field sub = Domain sub"
	+ using refl_on_def by fastforce
	+
	+definition [simp]: "exefield rel = List.union (map fst rel) (map snd rel)"
	+lemma Field_set_code: "Field (set rel) = set (exefield rel)"
	+ by (induction rel) fastforce+
	+
	+lemma class_ex_rec: "finite r \<Longrightarrow> class_ex (insert (a,b) r) c = (a=c \<or> b=c \<or> class_ex r c)"
	+ by (induction r rule: finite_induct) (auto simp add: class_ex_def)
	+
	+definition [simp]: "execlass_ex rel c = List.member (exefield rel) c"
	+lemma execlass_ex_code: "class_ex (set rel) c = execlass_ex rel c"
	+ by (metis Field_set_code class_ex_def execlass_ex_def in_set_member)
	+
	+definition [simp]: "exesort_ex rel S = (\<forall>x\<in>S . (List.member (exefield rel) x))"
	+lemma sort_ex_code: "sort_ex (set rel) S = exesort_ex rel S"
	+ by (simp add: execlass_ex_code sort_ex_class_ex)
	+
	+definition [simp]: "execlass_les cs c1 c2 = (List.member cs (c1,c2) \<and> \<not> List.member cs (c2,c1))"
	+lemma execlass_les_code: "class_les (set cs) c1 c2 = execlass_les cs c1 c2"
	+ by (simp add: class_leq_def class_les_def member_def)
	+
	+definition [simp]: "exenormalize_sort cs (s::sort)
	+ = {c \<in> s . \<not> (\<exists>c' \<in> s . execlass_les cs c' c)}"
	+definition [simp]: "exenormalized_sort cs s \<equiv> (exenormalize_sort cs s) = s"
	+
	+lemma normalize_sort_code[code]: "normalize_sort (set cs) s = exenormalize_sort cs s"
	+ by (auto simp add: normalize_sort_def List.member_def list_ex_iff class_leq_def class_les_def)
	+
	+lemma normalized_sort_code[code]: "normalized_sort (set cs) s = exenormalized_sort cs s"
	+ using exenormalized_sort_def normalize_sort_code by presburger
	+
	+definition [simp]: "exewf_sort sub S \<equiv> exenormalized_sort sub S \<and> exesort_ex sub S"
	+lemma wf_sort_code:
	+ assumes "exe_class_conds sub"
	+ shows "wf_sort (set sub) S = exewf_sort sub S"
	+ using normalized_sort_code sort_ex_code assms
	+ by (simp add: sort_ex_code wf_sort_def)
	+
	+declare exewf_sort_def[code del]
	+lemma [code]: "exewf_sort sub S \<equiv> (S = {} \<or> exenormalized_sort sub S \<and> exesort_ex sub S)"
	+ by simp (smt ball_empty bot_set_def empty_Collect_eq)
	+
	+definition "exe_all_normalized_and_ex_tcsigs cs arss
	+ \<equiv> (\<forall>ars \<in> snd ` set arss . \<forall>ss \<in> snd ` set ars . \<forall>s \<in> set ss. exewf_sort cs s)"
	+
	+lemma all_normalized_and_ex_tcsigs_imp_exe_all_normalized_and_ex_tcsigs:
	+ assumes "exe_ars_conds arss" "all_normalized_and_ex_tcsigs (set cs) (translate_ars arss)"
	+ shows "exe_all_normalized_and_ex_tcsigs cs arss"
	+proof-
	+ have ac: "alist_conds arss"
	+ using assms(1) exe_ars_conds_def by blast
	+ {
	+ fix s ars
	+ assume a1: "(s, ars) \<in> set arss"
	+ fix c Ss
	+ assume a2: "(c,Ss) \<in> set ars"
	+ fix S
	+ assume a3: "S \<in> set Ss"
	+
	+ have "map_of ars \<in> ran (map_of (map (apsnd map_of) arss))"
	+ using ac a1 by (metis in_alist_imp_in_map_of ranI translate_ars.simps)
	+ moreover have "Ss \<in> ran (map_of ars)"
	+ using a1 a2 assms(1) by (metis exe_ars_conds_def map_of_is_SomeI ranI ran_distinct)
	+ ultimately have "wf_sort (set cs) S"
	+ using assms(2) a1 a2 a3 by (auto simp add: all_normalized_and_ex_tcsigs_def )
	+ }
	+ thus ?thesis
	+ using normalize_sort_code wf_sort_def
	+ by (clarsimp simp add: all_normalized_and_ex_tcsigs_def exe_all_normalized_and_ex_tcsigs_def
	+ exe_ars_conds_def wf_sort_def wf_sort_code normalize_sort_def sort_ex_code)
	+qed
	+
	+lemma exe_all_normalized_and_ex_tcsigs_imp_all_normalized_and_ex_tcsigs:
	+ assumes "exe_ars_conds arss" "exe_all_normalized_and_ex_tcsigs cs arss"
	+ shows "all_normalized_and_ex_tcsigs (set cs) (translate_ars arss)"
	+proof-
	+ {
	+ fix ars ss s
	+ assume p: "ars \<in> ran (map_of (map (apsnd map_of) arss))"
	+ "ss \<in> ran ars" "s \<in> set ss"
	+
	+ from p(1) obtain name where "map_of (map (apsnd map_of) arss) name = Some ars"
	+ by (meson in_range_if_ex_key)
	+ from this obtain arsl where "(name, arsl) \<in> set arss" "map_of arsl = ars"
	+ using assms(1) by (auto simp add: exe_ars_conds_def)
	+ from this obtain c where c: "ars c = Some ss"
	+ using in_range_if_ex_key p(2) by force
	+ have "exewf_sort cs s"
	+ by (metis (no_types, hide_lams) \<open>(name, arsl) \<in> set arss\<close> \<open>map_of arsl = ars\<close> assms(1) assms(2)
	+ exe_all_normalized_and_ex_tcsigs_def exe_ars_conds_def image_iff p(2) p(3) ran_distinct snd_conv)
	+ hence "wf_sort (set cs) s"
	+ by (simp add: normalize_sort_code sort_ex_code wf_sort_def)
	+ }
	+ note 1 = this
	+ show ?thesis
	+ using 1 by (clarsimp simp add: wf_sort_def all_normalized_and_ex_tcsigs_def
	+ exe_all_normalized_and_ex_tcsigs_def)
	+qed
	+
	+lemma all_normalized_and_ex_tcsigs_iff_exe_all_normalized_and_ex_tcsigs:
	+ "exe_ars_conds arss \<Longrightarrow> all_normalized_and_ex_tcsigs (set cs) (translate_ars arss)
	+ \<longleftrightarrow> exe_all_normalized_and_ex_tcsigs cs arss"
	+ using all_normalized_and_ex_tcsigs_imp_exe_all_normalized_and_ex_tcsigs exe_all_normalized_and_ex_tcsigs_imp_all_normalized_and_ex_tcsigs by blast
	+
	+definition [simp]: "exe_wf_tcsigs (cs :: (class \<times> class) list) arss \<equiv>
	+ exe_coregular_tcsigs cs arss
	+ \<and> exe_complete_tcsigs cs arss
	+ \<and> exe_consistent_length_tcsigs arss
	+ \<and> exe_all_normalized_and_ex_tcsigs cs arss"
	+
	+lemma wf_tcsigs_iff_exe_wf_tcsigs:
	+ "exe_ars_conds arss \<Longrightarrow> wf_tcsigs (set cs) (translate_ars arss) \<longleftrightarrow> exe_wf_tcsigs cs arss"
	+ using all_normalized_and_ex_tcsigs_iff_exe_all_normalized_and_ex_tcsigs
	+ consistent_length_tcsigs_imp_exe_consistent_length_tcsigs
	+ coregular_tcsigs_iff_exe_coregular_tcsigs exe_complete_tcsigs_iff_complete_tcsigs
	+ exe_consistent_length_tcsigs_imp_consistent_length_tcsigs exe_wf_tcsigs_def wf_tcsigs_def
	+ by blast
	+
	+fun exe_antisym :: "('a \<times> 'a) list \<Rightarrow> bool" where
	+ "exe_antisym [] \<longleftrightarrow> True"
	+\| "exe_antisym ((x,y)#r) \<longleftrightarrow> ((y,x)\<in>set r \<longrightarrow> x=y) \<and> exe_antisym r"
	+
	+lemma exe_antisym_imp_antisym: "exe_antisym l \<Longrightarrow> antisym (set l)"
	+ by (induction l) (auto simp add: antisym_def)
	+
	+lemma antisym_imp_exe_antisym: "antisym (set l) \<Longrightarrow> exe_antisym l"
	+proof (induction l)
	+ case Nil
	+ then show ?case
	+ by simp
	+next
	+ case (Cons a l)
	+ then show ?case
	+ by (simp add: antisym_def) (metis exe_antisym.simps(2) surj_pair)
	+qed
	+
	+lemma antisym_iff_exe_antisym: "antisym (set l) = exe_antisym l"
	+ using antisym_imp_exe_antisym exe_antisym_imp_antisym by blast
	+
	+definition "exe_wf_subclass cs = (trans (set cs) \<and> exe_antisym cs \<and> Refl (set cs))"
	+
	+lemma wf_classes_iff_exe_wf_classes: "wf_subclass (set cs) \<longleftrightarrow> exe_wf_subclass cs"
	+ by (simp add: antisym_iff_exe_antisym exe_wf_subclass_def)
	+
	+definition [simp]: "exe_wf_osig oss \<equiv> exe_wf_subclass (execlasses oss)
	+ \<and> exe_wf_tcsigs (execlasses oss) (exetcsigs oss) \<and> exe_osig_conds oss"
	+
	+lemma exe_wf_osig_imp_wf_osig: "exe_wf_osig oss \<Longrightarrow> wf_osig (translate_osig oss)"
	+ using exe_coregular_tcsigs_imp_coregular_tcsigs exe_complete_tcsigs_imp_complete_tcsigs
	+ exe_complete_tcsigs_imp_complete_tcsigs exe_all_normalized_and_ex_tcsigs_imp_all_normalized_and_ex_tcsigs
	+ exe_consistent_length_tcsigs_imp_consistent_length_tcsigs
	+ by (cases oss) (auto simp add: exe_wf_subclass_def exe_antisym_imp_antisym exe_osig_conds_def)
	+
	+lemma classes_translate: "exe_osig_conds oss \<Longrightarrow> subclass (translate_osig oss) = set (execlasses oss)"
	+ by (cases oss) simp_all
	+
	+lemma tcsigs_translate: "exe_osig_conds oss
	+ \<Longrightarrow> tcsigs (translate_osig oss) = translate_ars (exetcsigs oss)"
	+ by (cases oss) simp_all
	+
	+lemma wf_osig_translate_imp_exe_osig_conds:
	+ "wf_osig (translate_osig oss) \<Longrightarrow> exe_osig_conds oss"
	+ using illformed_osig_not_wf_osig by (metis translate_osig.elims)
	+
	+lemma wf_osig_imp_exe_wf_osig:
	+ assumes "wf_osig (translate_osig oss)" shows "exe_wf_osig oss"
	+ apply (cases "translate_osig oss")
	+ using classes_translate tcsigs_translate assms wf_osig_translate_imp_exe_osig_conds
	+ by (metis (full_types) exe_osig_conds_def exe_wf_osig_def subclass.simps tcsigs.simps
	+ wf_classes_iff_exe_wf_classes wf_osig.simps wf_tcsigs_iff_exe_wf_tcsigs)
	+
	+lemma wf_osig_iff_exe_wf_osig: "wf_osig (translate_osig oss) \<longleftrightarrow> exe_wf_osig oss"
	+ using exe_wf_osig_imp_wf_osig wf_osig_imp_exe_wf_osig by blast
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Term.thy b/thys/Metalogic_ProofChecker/Term.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Term.thy
	@@ -0,0 +1,1500 @@
	+section "Terms"
	+
	+text\<open>
	+ Originally based on @{file "~~/src/Pure/term.ML"}.
	+ Diverged substantially, but some influences are still visible.
	+ Further influences from @{dir "~~/src/HOL/Proofs/Lambda/"}.\<close>
	+
	+theory Term
	+ imports Main Core Preliminaries
	+begin
	+
	+text\<open>Collecting parts of typs/terms and more substitutions\<close>
	+
	+fun tvsT :: "typ \<Rightarrow> (variable \<times> sort) set" where
	+ "tvsT (Tv v S) = {(v,S)}"
	+\| "tvsT (Ty _ Ts) = \<Union>(set (map tvsT Ts))"
	+
	+fun tvs :: "term \<Rightarrow> (variable \<times> sort) set" where
	+ "tvs (Ct _ T) = tvsT T"
	+\| "tvs (Fv _ T) = tvsT T"
	+\| "tvs (Bv _) = {}"
	+\| "tvs (Abs T t) = tvsT T \<union> tvs t"
	+\| "tvs (t $ u) = tvs t \<union> tvs u"
	+
	+abbreviation "tvs_set S \<equiv> \<Union>t\<in>S . tvs t"
	+
	+lemma tvsT_tsubstT: "tvsT (tsubstT \<sigma> \<rho>) = \<Union> {tvsT (\<rho> a s) \| a s. (a, s) \<in> tvsT \<sigma>}"
	+ by (induction \<sigma>) fastforce+
	+
	+lemma tsubstT_cong:
	+ "(\<forall>(v,S) \<in> tvsT \<sigma>. \<rho>1 v = \<rho>2 v) \<Longrightarrow> tsubstT \<sigma> \<rho>1 = tsubstT \<sigma> \<rho>2"
	+ by (induction \<sigma>) fastforce+
	+
	+lemma tsubstT_ith: "i < length Ts \<Longrightarrow> map (\<lambda>T . tsubstT T \<rho>) Ts ! i = tsubstT (Ts ! i) \<rho>"
	+ by simp
	+
	+lemma tsubstT_fun_typ_dist: "tsubstT (T \<rightarrow> T1) \<rho> = tsubstT T \<rho> \<rightarrow> tsubstT T1 \<rho>"
	+ by simp
	+
	+fun subst :: "term \<Rightarrow> (variable \<Rightarrow> typ \<Rightarrow> term) \<Rightarrow> term" where
	+ "subst (Ct s T) \<rho> = Ct s T"
	+\| "subst (Fv v T) \<rho> = \<rho> v T"
	+\| "subst (Bv i) _ = Bv i"
	+\| "subst (Abs T t) \<rho> = Abs T (subst t \<rho>)"
	+\| "subst (t $ u) \<rho> = subst t \<rho> $ subst u \<rho>"
	+
	+definition "tinst t1 t2 \<equiv> \<exists>\<rho>. tsubst t2 \<rho> = t1"
	+definition "inst t1 t2 \<equiv> \<exists>\<rho>. subst t2 \<rho> = t1"
	+
	+fun SortsT :: "typ \<Rightarrow> sort set" where
	+ "SortsT (Tv _ S) = {S}"
	+\| "SortsT (Ty _ Ts) = (\<Union>T\<in>set Ts . SortsT T)"
	+
	+fun Sorts :: "term \<Rightarrow> sort set" where
	+ "Sorts (Ct _ T) = SortsT T"
	+\| "Sorts (Fv _ T) = SortsT T"
	+\| "Sorts (Bv _) = {}"
	+\| "Sorts (Abs T t) = SortsT T \<union> Sorts t"
	+\| "Sorts (t $ u) = Sorts t \<union> Sorts u"
	+
	+fun Types :: "term \<Rightarrow> typ set" where
	+ "Types (Ct _ T) = {T}"
	+\| "Types (Fv _ T) = {T}"
	+\| "Types (Bv _) = {}"
	+\| "Types (Abs T t) = insert T (Types t)"
	+\| "Types (t $ u) = Types t \<union> Types u"
	+
	+abbreviation "tvs_Set S \<equiv> \<Union>s\<in>S . tvs s"
	+abbreviation "tvsT_Set S \<equiv> \<Union>s\<in>S . tvsT s"
	+
	+(* All those sets are finite *)
	+lemma finite_SortsT[simp]: "finite (SortsT T)"
	+ by (induction T) auto
	+lemma finite_Sorts[simp]: "finite (Sorts t)"
	+ by (induction t) auto
	+lemma finite_Types[simp]: "finite (Types t)"
	+ by (induction t) auto
	+lemma finite_tvsT[simp]: "finite (tvsT T)"
	+ by (induction T) auto
	+lemma no_tvsT_imp_tsubsT_unchanged: "tvsT T = {} \<Longrightarrow> tsubstT T \<rho> = T"
	+ by (induction T) (auto simp add: map_idI)
	+lemma finite_fv[simp]: "finite (fv t)"
	+ by (induction t) auto
	+lemma finite_tvs[simp]: "finite (tvs t)"
	+ by (induction t) auto
	+
	+lemma finite_FV: "finite S \<Longrightarrow> finite (FV S)"
	+ by (induction S rule: finite_induct) auto
	+lemma finite_tvs_Set: "finite S \<Longrightarrow> finite (tvs_Set S)"
	+ by (induction S rule: finite_induct) auto
	+lemma finite_tvsT_Set: "finite S \<Longrightarrow> finite (tvsT_Set S)"
	+ by (induction S rule: finite_induct) auto
	+
	+lemma no_tvs_imp_tsubst_unchanged: "tvs t = {} \<Longrightarrow> tsubst t \<rho> = t"
	+ by (induction t) (auto simp add: map_idI no_tvsT_imp_tsubsT_unchanged)
	+lemma no_fv_imp_subst_unchanged: "fv t = {} \<Longrightarrow> subst t \<rho> = t"
	+ by (induction t) (auto simp add: map_idI)
	+
	+text\<open>Functional(also executable) version of @{term has_typ}\<close>
	+
	+fun typ_of1 :: "typ list \<Rightarrow> term \<Rightarrow> typ option" where
	+ "typ_of1 _ ( Ct _ T) = Some T"
	+\| "typ_of1 Ts (Bv i) = (if i < length Ts then Some (nth Ts i) else None)"
	+\| "typ_of1 _ (Fv _ T) = Some T"
	+\| "typ_of1 Ts (Abs T body) = Option.bind (typ_of1 (T#Ts) body) (\<lambda>x. Some (T \<rightarrow> x))"
	+\| "typ_of1 Ts (t $ u) = Option.bind (typ_of1 Ts u) (\<lambda>U. Option.bind (typ_of1 Ts t) (\<lambda>T.
	+ case T of
	+ Ty fun [T1,T2] \<Rightarrow> if fun = STR ''fun'' then
	+ if T1=U then Some T2 else None
	+ else None
	+ \| _ \<Rightarrow> None
	+ ))"
	+
	+
	+text\<open>For historic reasons a lot of proofs/definitions are still in terms of @{term typ_of1} instead of
	+@{term has_typ1}\<close>
	+
	+lemma has_typ1_weaken_Ts: "has_typ1 Ts t rT \<Longrightarrow> has_typ1 (Ts@[T]) t rT"
	+proof (induction arbitrary: rule: has_typ1.induct)
	+ case (2 i Ts)
	+ hence "has_typ1 (Ts @ [T]) (Bv i) ((Ts@[T]) ! i)"
	+ by (auto intro: has_typ1.intros(2))
	+ then show ?case
	+ by (simp add: "2.hyps" nth_append)
	+qed (auto intro: has_typ1.intros) thm less_Suc_eq nth_butlast
	+
	+lemma has_typ1_imp_typ_of1: "has_typ1 Ts t ty \<Longrightarrow> typ_of1 Ts t = Some ty"
	+ by (induction rule: has_typ1.induct) auto
	+
	+lemma typ_of1_imp_has_typ1: "typ_of1 Ts t = Some ty \<Longrightarrow> has_typ1 Ts t ty"
	+proof (induction t arbitrary: Ts ty)
	+ case (App t u)
	+ from this obtain U where U: "typ_of1 Ts u = Some U" by fastforce
	+ from this App obtain T where T: "typ_of1 Ts t = Some T" by fastforce
	+ from U T App obtain T2 where "T = Ty STR ''fun'' [U, T2]"
	+ by (auto simp add: bind_eq_Some_conv intro!: has_typ1.intros
	+ split: if_splits typ.splits list.splits)
	+ from this U T show ?case using App by (auto intro!: has_typ1.intros(5))
	+qed (auto simp add: bind_eq_Some_conv intro!: has_typ1.intros split: if_splits)
	+
	+corollary has_typ1_iff_typ_of1[iff]: "has_typ1 Ts t ty \<longleftrightarrow> typ_of1 Ts t = Some ty"
	+ using has_typ1_imp_typ_of1 typ_of1_imp_has_typ1 by blast
	+corollary has_typ_iff_typ_of[iff]: "has_typ t ty \<longleftrightarrow> typ_of t = Some ty"
	+ by (force simp add: has_typ_def typ_of_def)
	+
	+corollary typ_of_imp_has_typ: "typ_of t = Some ty \<Longrightarrow> has_typ t ty"
	+ by simp
	+
	+lemma typ_of1_weaken_Ts: "typ_of1 Ts t = Some ty \<Longrightarrow> typ_of1 (Ts@[T]) t = Some ty"
	+ using has_typ1_weaken_Ts by simp
	+
	+lemma typ_of1_weaken:
	+ assumes "typ_of1 Ts t = Some T"
	+ shows "typ_of1 (Ts@Ts') t = Some T"
	+ using assms by (induction Ts t arbitrary: Ts' T rule: typ_of1.induct)
	+ (auto split: if_splits simp add: nth_append bind_eq_Some_conv)
	+
	+(* Instantiation of type variables produces instantiated types *)
	+lemma has_typ1_tsubst:
	+ "has_typ1 Ts t T \<Longrightarrow> has_typ1 (map (\<lambda>T. tsubstT T \<rho>) Ts) (tsubst t \<rho>) (tsubstT T \<rho>)"
	+proof (induction rule: has_typ1.induct)
	+ case (2 i Ts)
	+ (* tsubst_ith must be applied reversed, in this direction it can cause simplifier to loop *)
	+ then show ?case using tsubstT_ith by (metis has_typ1.intros(2) length_map tsubst.simps(3))
	+qed (auto simp add: tsubstT_fun_typ_dist intro: has_typ1.intros)
	+
	+corollary has_typ1_unique:
	+ assumes "has_typ1 \<tau>s t \<tau>1" and "has_typ1 \<tau>s t \<tau>2" shows "\<tau>1 = \<tau>2"
	+ using assms
	+ by (metis has_typ1_imp_typ_of1 option.inject)
	+
	+hide_fact typ_of_def
	+
	+lemma typ_of_def: "typ_of t \<equiv> typ_of1 [] t"
	+ by (smt has_typ1_iff_typ_of1 has_typ_def has_typ_iff_typ_of not_None_eq)
	+
	+text\<open>Loose bound variables\<close>
	+
	+fun loose_bvar :: "term \<Rightarrow> nat \<Rightarrow> bool" where
	+ "loose_bvar (Bv i) k \<longleftrightarrow> i \<ge> k"
	+\| "loose_bvar (t $ u) k \<longleftrightarrow> loose_bvar t k \<or> loose_bvar u k"
	+\| "loose_bvar (Abs _ t) k = loose_bvar t (k+1)"
	+\| "loose_bvar _ _ = False"
	+
	+fun loose_bvar1 :: "term \<Rightarrow> nat \<Rightarrow> bool" where
	+ "loose_bvar1 (Bv i) k \<longleftrightarrow> i = k"
	+\| "loose_bvar1 (t $ u) k \<longleftrightarrow> loose_bvar1 t k \<or> loose_bvar1 u k"
	+\| "loose_bvar1 (Abs _ t) k = loose_bvar1 t (k+1)"
	+\| "loose_bvar1 _ _ = False"
	+
	+
	+lemma loose_bvar1_imp_loose_bvar: "loose_bvar1 t n \<Longrightarrow> loose_bvar t n"
	+ by (induction t arbitrary: n) auto
	+lemma not_loose_bvar_imp_not_loose_bvar1: "\<not> loose_bvar t n \<Longrightarrow> \<not> loose_bvar1 t n"
	+ by (induction t arbitrary: n) auto
	+
	+lemma loose_bvar_iff_exist_loose_bvar1: "loose_bvar t lev \<longleftrightarrow> (\<exists>lev'\<ge>lev. loose_bvar1 t lev')"
	+ by (induction t arbitrary: lev) (auto dest: Suc_le_D)
	+
	+definition "is_open t \<equiv> loose_bvar t 0"
	+abbreviation "is_closed t \<equiv> \<not> is_open t"
	+definition "is_dependent t \<equiv> loose_bvar1 t 0"
	+
	+lemma loose_bvar_Suc: "loose_bvar t (Suc k) \<Longrightarrow> loose_bvar t k"
	+ by (induction t arbitrary: k) auto
	+lemma loose_bvar_leq: "k\<ge>p \<Longrightarrow> loose_bvar t k \<Longrightarrow> loose_bvar t p"
	+ by (induction rule: inc_induct) (use loose_bvar_Suc in auto)
	+
	+lemma has_typ1_imp_no_loose_bvar: "has_typ1 Ts t ty \<Longrightarrow> \<not> loose_bvar t (length Ts)"
	+ by (induction rule: has_typ1.induct) auto
	+
	+corollary has_typ_imp_closed: "has_typ t ty \<Longrightarrow> \<not> is_open t"
	+ unfolding is_open_def has_typ_def using has_typ1_imp_no_loose_bvar by fastforce
	+
	+corollary typ_of_imp_closed: "typ_of t = Some ty \<Longrightarrow> \<not> is_open t"
	+ by (simp add: has_typ_imp_closed)
	+
	+text\<open>Subterms\<close>
	+
	+(* probably ugly for proofs... *)
	+fun exists_subterm :: "(term \<Rightarrow> bool) \<Rightarrow> term \<Rightarrow> bool" where
	+ "exists_subterm P t \<longleftrightarrow> P t \<or> (case t of
	+ (t $ u) \<Rightarrow> exists_subterm P t \<or> exists_subterm P u
	+ \| Abs ty body \<Rightarrow> exists_subterm P body
	+ \| _ \<Rightarrow> False)"
	+(* Is this better? *)
	+fun exists_subterm' :: "(term \<Rightarrow> bool) \<Rightarrow> term \<Rightarrow> bool" where
	+ "exists_subterm' P (t $ u) \<longleftrightarrow> P (t $ u) \<or> exists_subterm' P t \<or> exists_subterm' P u"
	+\| "exists_subterm' P (Abs ty body) \<longleftrightarrow> P (Abs ty body) \<or> exists_subterm' P body"
	+\| "exists_subterm' P t \<longleftrightarrow> P t"
	+
	+lemma exists_subterm_iff_exists_subterm': "exists_subterm P t \<longleftrightarrow> exists_subterm' P t"
	+ by (induction t) auto
	+lemma "exists_subterm (\<lambda>t. t=Fv idx T) t \<longleftrightarrow> (idx, T) \<in> fv t"
	+ by (induction t) auto
	+
	+(* Fairly old, however still needed for some proofs about "subterms" *)
	+(* Must have no loose bounds in t, from Logic.ML*)
	+abbreviation "occs t u \<equiv> exists_subterm (\<lambda>s. t = s) u"
	+
	+lemma occs_Fv_eq_elem_fv: "occs (Fv v S) t \<longleftrightarrow> (v, S) \<in> fv t"
	+ by (induction t) auto
	+
	+lemma bind_fv2_unchanged:
	+ "\<not>loose_bvar tm lev \<Longrightarrow> bind_fv2 v lev tm = tm \<Longrightarrow> v \<notin> fv tm"
	+ by (induction v lev tm rule: bind_fv2.induct) auto
	+lemma bind_fv2_unchanged':
	+ "\<not>loose_bvar tm lev \<Longrightarrow> bind_fv2 v lev tm = tm \<Longrightarrow> \<not> occs (case_prod Fv v) tm"
	+ by (induction v lev tm rule: bind_fv2.induct) auto
	+
	+lemma bind_fv2_changed:
	+ "bind_fv2 v lev tm \<noteq> tm \<Longrightarrow> v \<in> fv tm"
	+ by (induction v lev tm rule: bind_fv2.induct) (auto split: if_splits)
	+lemma bind_fv2_changed':
	+ "bind_fv2 v lev tm \<noteq> tm \<Longrightarrow> occs (case_prod Fv v) tm"
	+ by (induction v lev tm rule: bind_fv2.induct) (auto split: if_splits)
	+
	+corollary bind_fv_changed: "bind_fv v tm \<noteq> tm \<Longrightarrow> v \<in> fv tm"
	+ unfolding is_open_def bind_fv_def using bind_fv2_changed by simp
	+corollary bind_fv_changed': "bind_fv v tm \<noteq> tm \<Longrightarrow> occs (case_prod Fv v) tm"
	+ unfolding is_open_def bind_fv_def using bind_fv2_changed' by simp
	+
	+corollary bind_fv_unchanged: "(x,\<tau>) \<notin> fv t \<Longrightarrow> bind_fv (x,\<tau>) t = t"
	+ using bind_fv_changed by auto
	+
	+inductive_cases has_typ1_app_elim: "has_typ1 Ts (t $ u) R"
	+lemma has_typ1_arg_typ: "has_typ1 Ts (t $ u) R \<Longrightarrow> has_typ1 Ts u U \<Longrightarrow> has_typ1 Ts t (U \<rightarrow> R)"
	+ using has_typ1_app_elim
	+ by (metis has_typ1_imp_typ_of1 option.inject typ_of1_imp_has_typ1)
	+
	+lemma has_typ1_fun_typ: "has_typ1 Ts (t $ u) R \<Longrightarrow> has_typ1 Ts t (U \<rightarrow> R) \<Longrightarrow> has_typ1 Ts u U"
	+ by (cases rule: has_typ1_app_elim[of Ts t u R "has_typ1 Ts u U"]) (use has_typ1_unique in auto)
	+
	+lemma typ_of1_arg_typ:
	+ "typ_of1 Ts (t $ u) = Some R \<Longrightarrow> typ_of1 Ts u = Some U \<Longrightarrow> typ_of1 Ts t = Some (U \<rightarrow> R)"
	+ using has_typ1_iff_typ_of1 has_typ1_arg_typ by simp
	+
	+corollary typ_of_arg: "typ_of (t$u) = Some R \<Longrightarrow> typ_of u = Some T \<Longrightarrow> typ_of t = Some (T \<rightarrow> R)"
	+ by (metis typ_of1_arg_typ typ_of_def)
	+
	+lemma typ_of1_fun_typ:
	+ "typ_of1 Ts (t $ u) = Some R \<Longrightarrow> typ_of1 Ts t = Some (U \<rightarrow> R) \<Longrightarrow> typ_of1 Ts u = Some U"
	+ using has_typ1_iff_typ_of1 has_typ1_fun_typ by blast
	+
	+corollary typ_of_fun: "typ_of (t$u) = Some R \<Longrightarrow> typ_of t = Some (U \<rightarrow> R) \<Longrightarrow> typ_of u = Some U"
	+ by (metis typ_of1_fun_typ typ_of_def)
	+
	+lemma typ_of_eta_expand: "typ_of f = Some (\<tau> \<rightarrow> \<tau>') \<Longrightarrow> typ_of (Abs \<tau> (f $ Bv 0)) = Some (\<tau> \<rightarrow> \<tau>')"
	+ using typ_of1_weaken by (fastforce simp add: bind_eq_Some_conv typ_of_def)
	+
	+lemma bind_fv2_preserves_type:
	+ assumes "typ_of1 Ts t = Some ty"
	+ shows "typ_of1 (Ts@[T]) (bind_fv2 (v, T) (length Ts) t) = Some ty"
	+ using assms by (induction "(v, T)" "length Ts" t arbitrary: T Ts ty rule: bind_fv2.induct)
	+ (force simp add: bind_eq_Some_conv nth_append split: if_splits)+
	+
	+lemma typ_of_Abs_bind_fv:
	+ assumes "typ_of A = Some ty"
	+ shows "typ_of (Abs bT (bind_fv (v, bT) A)) = Some (bT \<rightarrow> ty)"
	+ using bind_fv2_preserves_type bind_fv_def assms typ_of_def by fastforce
	+
	+corollary typ_of_Abs_fv:
	+ assumes "typ_of A = Some ty"
	+ shows "typ_of (Abs_fv v bT A) = Some (bT \<rightarrow> ty)"
	+ using assms typ_of_Abs_bind_fv typ_of_def by simp
	+
	+lemma typ_of_mk_all:
	+ assumes "typ_of A = Some propT"
	+ shows "typ_of (mk_all x ty A) = Some propT"
	+ using typ_of_Abs_bind_fv[OF assms, of ty] by (auto simp add: typ_of_def)
	+
	+fun incr_bv :: "nat \<Rightarrow> nat \<Rightarrow> term \<Rightarrow> term" where
	+ "incr_bv inc n (Bv i) = (if i \<ge> n then Bv (i+inc) else Bv i)"
	+\| "incr_bv inc n (Abs T body) = Abs T (incr_bv inc (n+1) body)"
	+\| "incr_bv inc n (App f t) = App (incr_bv inc n f) (incr_bv inc n t)"
	+\| "incr_bv _ _ u = u"
	+
	+(* Bridging *)
	+lemma lift_def: "lift t n = incr_bv 1 n t"
	+ by (induction t n rule: lift.induct) auto
	+
	+declare lift.simps[simp del]
	+declare lift_def[simp]
	+
	+definition "incr_boundvars inc t = incr_bv inc 0 t"
	+
	+fun decr :: "nat \<Rightarrow> term \<Rightarrow> term" where
	+ "decr lev (Bv i) = (if i \<ge> lev then Bv (i - 1) else Bv i)"
	+\| "decr lev (Abs T t) = Abs T (decr (lev + 1) t)"
	+\| "decr lev (t $ u) = (decr lev t $ decr lev u)"
	+\| "decr _ t = t"
	+
	+lemma incr_bv_0[simp]: "incr_bv 0 lev t = t"
	+ by (induction t arbitrary: lev) auto
	+
	+lemma loose_bvar_incr_bvar: "loose_bvar t lev \<longleftrightarrow> loose_bvar (incr_bv inc lev t) (lev+inc)"
	+ by (induction t arbitrary: inc lev) force+
	+
	+lemma no_loose_bvar_no_incr[simp]: "\<not> loose_bvar t lev \<Longrightarrow> incr_bv inc lev t = t"
	+ by (induction t arbitrary: inc lev) auto
	+
	+lemma is_close_no_incr_boundvars[simp]: "is_closed t \<Longrightarrow> incr_boundvars inc t = t"
	+ using no_loose_bvar_no_incr by (simp add: incr_boundvars_def is_open_def)
	+
	+lemma fv_incr_bv [simp]: "fv (incr_bv inc lev t) = fv t"
	+ by (induction inc lev t rule: incr_bv.induct) auto
	+lemma fv_incr_boundvars [simp]: "fv (incr_boundvars inc t) = fv t"
	+ by (simp add: incr_boundvars_def)
	+
	+lemma loose_bvar_decr: "\<not> loose_bvar t k \<Longrightarrow> \<not> loose_bvar (decr k t) k"
	+ by (induction t k rule: loose_bvar.induct) auto
	+lemma loose_bvar_decr_unchanged[simp]: "\<not> loose_bvar t k \<Longrightarrow> decr k t = t"
	+ by (induction t k rule: loose_bvar.induct) auto
	+lemma is_closed_decr_unchanged[simp]: "is_closed t \<Longrightarrow> decr 0 t = t"
	+ by (simp add: is_open_def)
	+
	+fun subst_bv1 :: "term \<Rightarrow> nat \<Rightarrow> term \<Rightarrow> term" where
	+ "subst_bv1 (Bv i) lev u = (if i < lev then Bv i
	+ else if i = lev then (incr_boundvars lev u)
	+ else (Bv (i - 1)))"
	+\| "subst_bv1 (Abs T body) lev u = Abs T (subst_bv1 body (lev + 1) u)"
	+\| "subst_bv1 (f $ t) lev u = subst_bv1 f lev u $ subst_bv1 t lev u"
	+\| "subst_bv1 t _ _ = t"
	+
	+lemma incr_bv_combine: "incr_bv m k (incr_bv n k s) = incr_bv (m+n) k s"
	+ by (induction s arbitrary: k) auto
	+
	+lemma substn_subst_n : "subst_bv1 t n s = subst_bv2 t n (incr_bv n 0 s)"
	+ by (induct t arbitrary: n) (auto simp add: incr_boundvars_def incr_bv_combine)
	+
	+theorem substn_subst_0: "subst_bv1 t 0 s = subst_bv2 t 0 s"
	+ by (simp add: substn_subst_n)
	+
	+corollary substn_subst_0': "subst_bv s t = subst_bv2 t 0 s"
	+ using subst_bv_def substn_subst_0 by simp
	+
	+lemma subst_bv2_eq [simp]: "subst_bv2 (Bv k) k u = u"
	+ by (simp add:)
	+
	+lemma subst_bv2_gt [simp]: "i < j \<Longrightarrow> subst_bv2 (Bv j) i u = Bv (j - 1)"
	+ by (simp add:)
	+
	+lemma subst_bv2_subst_lt [simp]: "j < i \<Longrightarrow> subst_bv2 (Bv j) i u = Bv j"
	+ by (simp add:)
	+
	+lemma lift_lift:
	+ "i < k + 1 \<Longrightarrow> lift (lift t i) (Suc k) = lift (lift t k) i"
	+ by (induct t arbitrary: i k) auto
	+
	+lemma lift_subst [simp]:
	+ "j < i + 1 \<Longrightarrow> lift (subst_bv2 t j s) i = subst_bv2 (lift t (i + 1)) j (lift s i)"
	+proof (induction t arbitrary: i j s)
	+ case (Abs T t)
	+ then show ?case
	+ by (simp_all add: diff_Suc lift_lift split: nat.split)
	+ (metis One_nat_def Suc_eq_plus1 lift_def lift_lift zero_less_Suc)
	+qed (simp_all add: diff_Suc lift_lift split: nat.split)
	+
	+lemma lift_subst_bv2_subst_lt:
	+ "i < j + 1 \<Longrightarrow> lift (subst_bv2 t j s) i = subst_bv2 (lift t i) (j + 1) (lift s i)"
	+proof (induction t arbitrary: i j s)
	+ case (Abs x1 t)
	+ then show ?case
	+ using lift_lift by force
	+qed (auto simp add: lift_lift)
	+
	+lemma subst_bv2_lift [simp]:
	+ "subst_bv2 (lift t k) k s = t"
	+ by (induct t arbitrary: k s) simp_all
	+
	+lemma subst_bv2_subst_bv2:
	+ "i < j + 1 \<Longrightarrow> subst_bv2 (subst_bv2 t (Suc j) (lift v i)) i (subst_bv2 u j v)
	+ = subst_bv2 (subst_bv2 t i u) j v"
	+proof(induction t arbitrary: i j u v)
	+ case (Abs s T t)
	+ then show ?case
	+ by (smt Suc_mono add.commute lift_lift lift_subst_bv2_subst_lt plus_1_eq_Suc subst_bv2.simps(2) zero_less_Suc)
	+qed (use subst_bv2_lift in \<open>auto simp add: diff_Suc lift_lift [symmetric] lift_subst_bv2_subst_lt split: nat.split\<close>)
	+
	+(* Bridging *)
	+hide_fact (open) subst_bv_def
	+lemma subst_bv_def: "subst_bv u t \<equiv> subst_bv1 t 0 u"
	+ by (simp add: substn_subst_0' substn_subst_n)
	+
	+(* Probably not necessary *)
	+fun subst_bvs1 :: "term \<Rightarrow> nat \<Rightarrow> term list \<Rightarrow> term" where
	+ "subst_bvs1 (Bv n) lev args = (if n < lev
	+ then Bv n
	+ else if n - lev < length args
	+ then incr_boundvars lev (nth args (n-lev))
	+ else Bv (n - length args))"
	+\| "subst_bvs1 (Abs T body) lev args = Abs T (subst_bvs1 body (lev+1) args)"
	+\| "subst_bvs1 (f $ t) lev args = subst_bvs1 f lev args $ subst_bvs1 t lev args"
	+\| "subst_bvs1 t _ _ = t"
	+
	+definition "subst_bvs args t \<equiv> subst_bvs1 t 0 args"
	+
	+lemma subst_bvs_App[simp]: "subst_bvs args (s$t) = subst_bvs args s $ subst_bvs args t"
	+ by (auto simp add: subst_bvs_def)
	+
	+lemma subst_bv1_special_case_subst_bvs1: "subst_bvs1 t lev [x] = subst_bv1 t lev x"
	+ by (induction t lev "[x]" arbitrary: x rule: subst_bvs1.induct) auto
	+
	+lemma no_loose_bvar_imp_no_subst_bv1: "\<not>loose_bvar t lev \<Longrightarrow> subst_bv1 t lev u = t"
	+ by (induction t arbitrary: lev) auto
	+lemma no_loose_bvar_imp_no_subst_bvs1: "\<not>loose_bvar t lev \<Longrightarrow> subst_bvs1 t lev us = t"
	+ by (induction t arbitrary: lev) auto
	+
	+(* The precondition in the following lemmas makes them fairly useless *)
	+lemma subst_bvs1_step:
	+ assumes "\<not> loose_bvar t lev"
	+ shows "subst_bvs1 t lev (args@[u]) = subst_bv1 (subst_bvs1 t lev args) lev u"
	+ using assms by (induction t arbitrary: lev args u) auto
	+
	+corollary closed_subst_bv_no_change: "is_closed t \<Longrightarrow> subst_bv u t = t"
	+ unfolding is_open_def subst_bv_def no_loose_bvar_imp_no_subst_bv1 by simp
	+
	+lemma is_variable_imp_incr_bv_unchanged: "incr_bv inc lev (Fv v T) = (Fv v T)"
	+ by simp
	+lemma is_variable_imp_incr_boundvars_unchganged: "incr_boundvars inc (Fv v T) = (Fv v T)"
	+ using is_variable_imp_incr_bv_unchanged incr_boundvars_def by simp
	+
	+lemma loose_bvar_subst_bv1:
	+ "\<not> loose_bvar (subst_bv1 t lev u) lev \<Longrightarrow> \<not> loose_bvar t (Suc lev)"
	+ by (induction t lev u rule: subst_bv1.induct) auto
	+lemma is_closed_subst_bv: "is_closed (subst_bv u t) \<Longrightarrow> \<not> loose_bvar t 1"
	+ by (simp add: is_open_def loose_bvar_subst_bv1 subst_bv_def)
	+
	+lemma subst_bv1_bind_fv2:
	+ assumes "\<not> loose_bvar t lev"
	+ shows "subst_bv1 (bind_fv2 (v, T) lev t) lev (Fv v T) = t"
	+ using assms by (induction t arbitrary: lev) (use is_variable_imp_incr_boundvars_unchganged in auto)
	+
	+corollary subst_bv_bind_fv:
	+ assumes "is_closed t"
	+ shows "subst_bv (Fv v T) (bind_fv (v, T) t) = t"
	+ unfolding bind_fv_def subst_bv_def using assms subst_bv1_bind_fv2 is_open_def
	+ by blast
	+
	+fun betapply :: "term \<Rightarrow> term \<Rightarrow> term" (infixl "\<bullet>" 52) where
	+ "betapply (Abs _ t) u = subst_bv u t"
	+\| "betapply t u = t $ u"
	+
	+lemma betapply_Abs_fv:
	+ assumes "is_closed t"
	+ shows "betapply (Abs_fv v T t) (Fv v T) = t"
	+using assms subst_bv_bind_fv by simp
	+
	+lemma typ_of1_imp_no_loose_bvar: "typ_of1 Ts t = Some ty \<Longrightarrow> \<not> loose_bvar t (length Ts)"
	+ by (simp add: has_typ1_imp_no_loose_bvar)
	+
	+lemma typ_of1_subst_bv:
	+ assumes "typ_of1 (Ts@[uty]) f = Some fty"
	+ and "typ_of u = Some uty"
	+ shows "typ_of1 Ts (subst_bv1 f (length Ts) u) = Some fty"
	+ using assms
	+proof (induction f "length Ts" u arbitrary: uty fty Ts rule: subst_bv1.induct)
	+ case (1 i arg)
	+ then show ?case
	+ using no_loose_bvar_no_incr typ_of1_imp_no_loose_bvar typ_of1_weaken
	+ by (force simp add: bind_eq_Some_conv incr_boundvars_def nth_append typ_of_def
	+ split: if_splits)
	+next
	+ case (2 a T body arg)
	+ then show ?case
	+ by (simp add: bind_eq_Some_conv typ_of_def) (smt append_Cons bind_eq_Some_conv length_Cons)
	+qed (auto simp add: bind_eq_Some_conv)
	+
	+lemma typ_of1_split_App:
	+ "typ_of1 Ts (t $ u) = Some ty \<Longrightarrow> (\<exists>uty . typ_of1 Ts t = Some (uty \<rightarrow> ty) \<and> typ_of1 Ts u = Some uty)"
	+ by (metis (no_types, lifting) bind.bind_lzero the_default.elims typ_of1.simps(5) typ_of1_arg_typ)
	+
	+corollary typ_of1_split_App_obtains:
	+ assumes "typ_of1 Ts (t $ u) = Some ty"
	+ obtains uty where "typ_of1 Ts t = Some (uty \<rightarrow> ty)" "typ_of1 Ts u = Some uty"
	+ using typ_of1_split_App assms by blast
	+
	+lemma typ_of1_incr_bv:
	+ assumes "typ_of1 Ts t = Some ty"
	+ and "lev \<le> length Ts"
	+ shows "typ_of1 (take lev Ts @ Ts' @ drop lev Ts) (incr_bv (length Ts') lev t) = Some ty"
	+ using assms by (induction t arbitrary: ty Ts Ts' lev)
	+ (fastforce simp add: nth_append bind_eq_Some_conv min_def split: if_splits)+
	+
	+corollary typ_of1_incr_bv_lev0:
	+ assumes "typ_of1 Ts t = Some ty"
	+ shows "typ_of1 (Ts' @ Ts) (incr_bv (length Ts') 0 t) = Some ty"
	+ using assms typ_of1_incr_bv[where lev=0] by simp
	+
	+lemma typ_of1_subst_bv_gen:
	+ assumes "typ_of1 (Ts'@[uty]@Ts) t = Some tty" and "typ_of1 Ts u = Some uty"
	+ shows "typ_of1 (Ts' @ Ts) (subst_bv1 t (length Ts') u) = Some tty"
	+ using assms
	+proof (induction t "length Ts'" u arbitrary: tty uty Ts Ts' rule: subst_bv1.induct)
	+next
	+ case (2 a T body arg)
	+ then show ?case
	+ by (simp add: bind_eq_Some_conv) (metis append_Cons length_Cons)
	+qed (auto simp add: bind_eq_Some_conv nth_append incr_boundvars_def
	+ typ_of1_incr_bv_lev0 split: if_splits)
	+
	+(* This is the correct version, the other one inserts "at the wrong side of the bounds" *)
	+lemma typ_of1_subst_bv_gen_depre:
	+ assumes "typ_of1 (Ts'@Ts) f = Some (fty)"
	+ and "typ_of1 (Ts) u = Some uty"
	+ and "last Ts' = uty" and "Ts' \<noteq> []"
	+ shows "typ_of1 (butlast Ts' @ Ts) (subst_bv1 f (length Ts'-1) u) = Some fty"
	+ using assms
	+proof (induction f "length Ts'" u arbitrary: fty uty Ts Ts' rule: subst_bv1.induct)
	+ case (1 i arg)
	+ from 1 consider (LT) "(length Ts' - 1) < i" \| (EQ) "(length Ts' - 1) = i" \| (GT) "(length Ts' - 1) > i"
	+ using linorder_neqE_nat by blast
	+ then show ?case
	+ by cases (metis "1.prems" append_assoc append_butlast_last_id length_butlast typ_of1_subst_bv_gen)+
	+next
	+ case (2 a T body arg)
	+ then show ?case
	+ by (metis append.assoc append_butlast_last_id length_butlast typ_of1_subst_bv_gen)
	+next
	+ case (3 f t arg)
	+ then show ?case
	+ by (auto simp add: bind_eq_Some_conv nth_append incr_boundvars_def subst_bv_def
	+ split: if_splits)
	+qed auto
	+
	+corollary typ_of1_subst_bv_gen':
	+ assumes "typ_of1 (uty#Ts) t = Some tty"
	+ and "typ_of1 Ts u = Some uty"
	+ shows "typ_of1 Ts (subst_bv1 t 0 u) = Some tty"
	+ using assms typ_of1_subst_bv_gen
	+ by (metis append.left_neutral append_Cons list.size(3))
	+
	+lemma typ_of_betapply:
	+ assumes "typ_of1 Ts (Abs uty t) = Some (uty \<rightarrow> tty)"
	+ assumes "typ_of1 Ts u = Some uty"
	+ shows "typ_of1 Ts ((Abs uty t) \<bullet> u) = Some tty"
	+ using assms typ_of1_subst_bv_gen'
	+ by (auto simp add: bind_eq_Some_conv subst_bv_def)
	+
	+lemma no_Bv_Type_param_irrelevant_typ_of:
	+ "\<not>exists_subterm (\<lambda>x . case x of Bv _ \<Rightarrow> True \| _ \<Rightarrow> False) t
	+ \<Longrightarrow> typ_of1 Ts t = typ_of1 Ts' t"
	+ by (induction t arbitrary: Ts Ts') (simp_all, metis+)
	+
	+lemma typ_of1_drop_extra_bounds:
	+ "\<not>loose_bvar t (length Ts)
	+ \<Longrightarrow> typ_of1 (Ts@rest) t = typ_of1 Ts t"
	+ by (induction Ts t arbitrary: rest rule: typ_of1.induct) (fastforce simp add: nth_append)+
	+
	+lemma typ_of_betaply:
	+ assumes "typ_of t = Some (uty \<rightarrow> tty)" "typ_of u = Some uty"
	+ shows "typ_of (t \<bullet> u) = Some tty"
	+proof (cases t)
	+ case (Abs T t)
	+ then show ?thesis
	+ proof (cases "is_open t")
	+ case True
	+ then show ?thesis
	+ unfolding is_open_def using assms Abs typ_of1_subst_bv
	+ apply (simp add: bind_eq_Some_conv subst_bv_def typ_of_def)
	+ by (metis append_Nil list.size(3) typ_of_def)
	+ next
	+ case False
	+ hence "typ_of1 [uty] t = Some tty" using assms(1)
	+ by (auto simp add: bind_eq_Some_conv typ_of_def is_open_def Abs)
	+
	+ then show ?thesis
	+ using assms False no_loose_bvar_imp_no_subst_bv1
	+ apply (simp add: bind_eq_Some_conv typ_of_def is_open_def subst_bv_def Abs)
	+ using no_Bv_Type_param_irrelevant_typ_of
	+ using typ_of1_drop_extra_bounds
	+ by (metis list.size(3) self_append_conv2)
	+ qed
	+qed (use assms in \<open>simp_all add: typ_of_def\<close>)
	+
	+fun beta_reducible :: "term \<Rightarrow> bool" where
	+ "beta_reducible (App (Abs _ _) _) = True"
	+\| "beta_reducible (Abs _ t) = beta_reducible t"
	+\| "beta_reducible (App t u) = (beta_reducible t \<or> beta_reducible u)"
	+\| "beta_reducible _ = False"
	+
	+fun eta_reducible :: "term \<Rightarrow> bool" where
	+ "eta_reducible (Abs _ (t $ Bv 0)) = (\<not> is_dependent t \<or> eta_reducible t)"
	+\| "eta_reducible (Abs _ t) = eta_reducible t"
	+\| "eta_reducible (App t u) = (eta_reducible t \<or> eta_reducible u)"
	+\| "eta_reducible _ = False"
	+
	+lemma "\<not> loose_bvar t lev \<Longrightarrow> decr lev t = t"
	+ by (induction t arbitrary: lev) auto
	+
	+lemma decr_incr_bv1: "decr lev (incr_bv 1 lev t) = t"
	+ by (induction t arbitrary: lev) auto
	+
	+(* For termination proofs *)
	+fun depth :: "term \<Rightarrow> nat" where
	+ "depth (Abs _ t) = depth t + 1"
	+\| "depth (t $ u) = max (depth t) (depth u) +1"
	+\| "depth t = 0"
	+
	+lemma depth_decr: "depth (decr lev t) = depth t"
	+ by (induction lev t rule: decr.induct) auto
	+
	+lemma loose_bvar1_decr: "lev > 0 \<Longrightarrow> \<not> loose_bvar1 t (Suc lev) \<Longrightarrow> \<not> loose_bvar1 (decr lev t) lev"
	+ by (induction lev t arbitrary: rule: decr.induct) auto
	+
	+lemma loose_bvar1_decr':
	+ "\<not> loose_bvar1 t (Suc lev) \<Longrightarrow> \<not> loose_bvar1 t lev \<Longrightarrow> \<not> loose_bvar1 (decr lev t) lev"
	+ by (induction lev t arbitrary: rule: decr.induct) auto
	+
	+lemma eta_reducible_Abs1: "\<not> eta_reducible (Abs T (t $ Bv 0)) \<Longrightarrow> \<not> eta_reducible t" by simp
	+
	+lemma eta_reducible_Abs2:
	+ assumes "\<not> (\<exists>f. t=f $ Bv 0)" "\<not> eta_reducible (Abs T t)"
	+ shows "\<not> eta_reducible t"
	+proof (cases t)
	+ case (Abs T body)
	+ then show ?thesis using assms(2) by (cases body) auto
	+next
	+ case (App f u)
	+ then show ?thesis using assms less_imp_Suc_add by (cases f; cases u) fastforce+
	+qed auto
	+
	+lemma eta_reducible_Abs: "\<not> eta_reducible (Abs T t) \<Longrightarrow> \<not> eta_reducible t"
	+ using eta_reducible_Abs1 eta_reducible_Abs2
	+ by (metis eta_reducible.simps(11) eta_reducible.simps(14))
	+
	+lemma loose_bvar1_decr'': "loose_bvar1 t lev \<Longrightarrow> lev < lev'\<Longrightarrow> loose_bvar1 (decr lev' t) lev"
	+ by (induction t arbitrary: lev lev') auto
	+lemma loose_bvar1_decr''': "loose_bvar1 t (Suc lev) \<Longrightarrow> lev' \<le> lev \<Longrightarrow> loose_bvar1 (decr lev' t) lev"
	+ by (induction t arbitrary: lev lev') auto
	+
	+lemma loose_bvar1_decr'''': "\<not> loose_bvar1 t lev' \<Longrightarrow> lev' \<le> lev \<Longrightarrow> \<not> loose_bvar1 t (Suc lev)
	+ \<Longrightarrow> \<not> loose_bvar1 (decr lev' t) lev"
	+ by (induction lev t arbitrary: lev' rule: decr.induct) auto
	+
	+lemma not_eta_reducible_decr:
	+ "\<not> eta_reducible t \<Longrightarrow> \<not> loose_bvar1 t lev \<Longrightarrow> \<not> eta_reducible (decr lev t) "
	+proof (induction lev t arbitrary: rule: decr.induct)
	+ case (2 lev T body)
	+ hence "\<not> eta_reducible body" using eta_reducible_Abs by blast
	+ hence I: "\<not> eta_reducible (decr (lev + 1) body)" using "2.IH"
	+ using "2.prems"(2) by simp
	+
	+ then show ?case
	+ proof(cases body)
	+ case (App f u)
	+ note app = this
	+ then show ?thesis
	+ proof (cases u)
	+ case (Bv n)
	+ then show ?thesis
	+ proof (cases "n")
	+ case 0
	+ have "is_dependent f" "\<not> eta_reducible f"
	+ using "0" "2.prems"(1) App Bv eta_reducible.simps(1) by blast+
	+ hence "loose_bvar1 f 0" by (simp add: is_dependent_def)
	+ hence "loose_bvar1 (decr (Suc lev) f) 0" using loose_bvar1_decr'' by simp
	+ then show ?thesis using I by (auto simp add: 0 Bv App is_dependent_def)
	+ next
	+ case (Suc nat)
	+ then show ?thesis
	+ using 2 App Bv
	+ by (auto elim: eta_reducible.elims(2) simp add: Suc Bv App is_dependent_def)
	+ qed
	+ next
	+ case (Abs T t)
	+ then show ?thesis
	+ using I by (auto split: if_splits simp add: App is_dependent_def)
	+ qed (use I in \<open>auto split: if_splits simp add: App is_dependent_def\<close>)
	+ qed (auto split: if_splits simp add: is_dependent_def)
	+qed auto
	+
	+
	+function (sequential, domintros) eta_norm :: "term \<Rightarrow> term" where
	+ "eta_norm (Abs T t) = (case eta_norm t of
	+ f $ Bv 0 \<Rightarrow> (if is_dependent f then Abs T (f $ Bv 0) else decr 0 (eta_norm f))
	+ \| body \<Rightarrow> Abs T body)"
	+\| "eta_norm (t $ u) = eta_norm t $ eta_norm u"
	+\| "eta_norm t = t"
	+ by pat_completeness auto
	+
	+lemma eta_norm_reduces_depth: "eta_norm_dom t \<Longrightarrow> depth (eta_norm t) <= depth t"
	+ by (induction t rule: eta_norm.pinduct)
	+ (use depth_decr in \<open>fastforce simp add: eta_norm.psimps eta_norm.domintros is_dependent_def
	+ split: term.splits nat.splits\<close>)+
	+
	+termination eta_norm
	+proof (relation "measure depth")
	+ fix T body t u n
	+ assume asms: "eta_norm body = t $ u" "u = Bv n" "n = 0" "\<not> is_dependent t" "eta_norm_dom body"
	+ have "depth t < depth (t $ Bv 0)" by auto
	+ moreover have "depth (eta_norm body) \<le> depth body" using asms eta_norm_reduces_depth by blast
	+ ultimately show "(t, Abs T body) \<in> measure depth" using asms by (auto simp add: eta_norm.psimps)
	+qed simp_all
	+
	+lemma loose_bvar1_eta_norm: "loose_bvar1 t lev \<Longrightarrow> loose_bvar1 (eta_norm t) lev"
	+ by (induction t arbitrary: lev rule: eta_norm.induct)
	+ (use loose_bvar1_decr''' in \<open>(fastforce split: term.splits nat.splits)+\<close>)
	+
	+lemma loose_bvar1_eta_norm': "\<not> loose_bvar1 t lev \<Longrightarrow> \<not> loose_bvar1 (eta_norm t) lev"
	+proof (induction t arbitrary: lev rule: eta_norm.induct)
	+ case (1 T body)
	+ hence "\<not> loose_bvar1 body (Suc lev)" by simp
	+ hence I: "\<not> loose_bvar1 (eta_norm body) (Suc lev)" using 1 by simp
	+ then show ?case
	+ proof (cases body)
	+ case (Abs ty b)
	+ show ?thesis
	+ using I loose_bvar1_decr''''
	+ by (auto split: term.splits nat.splits if_splits simp add: "1.IH"(2) is_dependent_def)
	+ next
	+ case (App T t)
	+ then show ?thesis using 1 I loose_bvar1_decr''''
	+ by (fastforce split: term.splits nat.splits if_splits simp add: is_dependent_def)
	+ qed (auto split: term.splits nat.splits simp add: is_dependent_def)
	+qed (auto split: term.splits nat.splits simp add: is_dependent_def)
	+
	+lemma not_eta_reducible_eta_norm: "\<not> eta_reducible (eta_norm t)"
	+proof (induction t rule: eta_norm.induct)
	+ case (1 T body)
	+ then show ?case
	+ proof (cases "eta_norm (body)")
	+ case (Abs T t)
	+ then show ?thesis using 1 by auto
	+ next
	+ case (App f u)
	+ then show ?thesis
	+ proof (cases "u = Bv 0")
	+ case True
	+ note u = this
	+ then show ?thesis
	+ proof (cases "is_dependent f")
	+ case True
	+ then show ?thesis
	+ using 1 App u by (auto simp add: is_dependent_def split: term.splits nat.splits if_splits)
	+ next
	+ case False
	+ have "\<not> eta_reducible f" using 1 App u by simp
	+ hence "\<not> eta_reducible (eta_norm f)"
	+ by (simp add: "1.IH"(2) App False u)
	+ have "\<not> loose_bvar1 f 0"
	+ using False is_dependent_def by blast
	+ hence "\<not> loose_bvar1 (eta_norm f) 0"
	+ using loose_bvar1_eta_norm' by blast
	+ show ?thesis
	+ using 1 App u False not_eta_reducible_decr loose_bvar1_eta_norm \<open>\<not> loose_bvar1 (eta_norm f) 0\<close>
	+ by (auto simp add: is_dependent_def split: term.splits nat.splits if_splits)
	+ qed
	+ next
	+ case False
	+ then show ?thesis using 1 App by (auto simp add: is_dependent_def
	+ split: term.splits nat.splits if_splits)
	+ qed
	+ qed auto
	+qed auto
	+
	+lemma not_eta_reducible_imp_eta_norm_no_change: "\<not> eta_reducible t \<Longrightarrow> eta_norm t = t"
	+ by (induction t rule: eta_norm.induct) (auto simp add: eta_reducible_Abs is_dependent_def
	+ split: term.splits nat.splits)
	+
	+lemma eta_norm_collapse: "eta_norm (eta_norm t) = eta_norm t"
	+ using not_eta_reducible_imp_eta_norm_no_change not_eta_reducible_eta_norm by blast
	+
	+lemma typ_of1_decr: "typ_of1 (Ts@[T]@Ts') t = Some ty \<Longrightarrow> \<not> loose_bvar1 t (length Ts)
	+ \<Longrightarrow> typ_of1 (Ts@Ts') (decr (length Ts) t) = Some ty"
	+proof (induction t arbitrary: Ts T Ts' ty)
	+ case (Abs bT t)
	+ then show ?case
	+ by (simp add: bind_eq_Some_conv) (metis append_Cons length_Cons)
	+qed (auto split: if_splits simp add: bind_eq_Some_conv nth_append)
	+
	+lemma typ_of1_decr_gen: "typ_of1 (Ts@[T]@Ts') t = tyo \<Longrightarrow> \<not> loose_bvar1 t (length Ts)
	+ \<Longrightarrow> typ_of1 (Ts@Ts') (decr (length Ts) t) = tyo"
	+proof (induction t arbitrary: Ts T Ts' tyo)
	+ case (Abs T t)
	+ then show ?case
	+ by (simp add: bind_eq_Some_conv) (metis append_Cons length_Cons)
	+next
	+ case (App t1 t2)
	+ then show ?case by simp
	+qed (auto split: if_splits simp add: bind_eq_Some_conv nth_append
	+ split: option.splits)
	+
	+lemma typ_of1_decr_gen': "typ_of1 (Ts@Ts') (decr (length Ts) t) = tyo\<Longrightarrow> \<not> loose_bvar1 t (length Ts)
	+ \<Longrightarrow> typ_of1 (Ts@[T]@Ts') t = tyo"
	+proof (induction t arbitrary: Ts T Ts' tyo)
	+ case (Abs T t)
	+ then show ?case
	+ by (simp add: bind_eq_Some_conv) (metis append_Cons length_Cons)
	+qed (auto split: if_splits simp add: bind_eq_Some_conv nth_append
	+ split: option.splits)
	+
	+(* Other direction does not necessarily hold, eta_norm could remove incorrect abstractions *)
	+lemma typ_of1_eta_norm: "typ_of1 Ts t = Some ty \<Longrightarrow> typ_of1 Ts (eta_norm t) = Some ty"
	+proof (induction Ts t arbitrary: ty rule: typ_of1.induct)
	+ case (4 Ts T body)
	+ then show ?case
	+ proof(cases "eta_norm body")
	+ case (App f u)
	+ then show ?thesis
	+ (* In dire need of cleanup *)
	+ proof (cases u)
	+ case (Bv n)
	+ then show ?thesis
	+ proof (cases n)
	+ case 0
	+ then show ?thesis
	+ proof (cases "is_dependent f")
	+ case True
	+ hence "eta_norm (Abs T body) = Abs T (f $ Bv 0)"
	+ by (auto simp add: App 0 "4.IH" Bv bind_eq_Some_conv is_dependent_def split: nat.splits)
	+ then show ?thesis
	+ using 4 by (force simp add: "0" Bv App is_dependent_def bind_eq_Some_conv split: if_splits)
	+ next
	+ case False
	+
	+ hence simp: "eta_norm (Abs T body) = decr 0 (eta_norm f)"
	+ by (auto simp add: App 0 "4.IH" Bv bind_eq_Some_conv bind_eq_None_conv
	+ is_dependent_def split: nat.splits)
	+
	+ obtain bT where bT: "typ_of1 (T # Ts) body = Some bT"
	+ using "4.prems" by fastforce
	+ hence "typ_of1 (T # Ts) (eta_norm body) = Some bT"
	+ using "4.IH" by blast
	+ moreover have "T \<rightarrow> bT = ty"
	+ using "4.prems" bT by auto
	+ ultimately have "typ_of1 (T#Ts) f = Some ty"
	+ by (metis "0" App Bv length_Cons nth_Cons_0 typ_of1.simps(2) typ_of1_arg_typ zero_less_Suc)
	+ hence "typ_of1 Ts (decr 0 f) = Some ty"
	+ by (metis False append_Cons append_Nil is_dependent_def list.size(3) typ_of1_decr)
	+ hence "typ_of1 Ts (decr 0 (eta_norm f)) = Some ty"
	+ by (metis App eta_reducible.simps(11) not_eta_reducible_eta_norm not_eta_reducible_imp_eta_norm_no_change)
	+
	+ then show ?thesis
	+ by(auto simp add: App 0 Bv False)
	+ qed
	+ next
	+ case (Suc nat)
	+ then show ?thesis
	+ using 4 apply (simp add: App "4.IH" Bv bind_eq_Some_conv split: option.splits)
	+ using option.sel by fastforce
	+ qed
	+ qed (use 4 in \<open>fastforce simp add: bind_eq_Some_conv nth_append split: if_splits\<close>)+
	+ qed (use 4 in \<open>fastforce simp add: bind_eq_Some_conv nth_append split: if_splits\<close>)+
	+next
	+ case (5 Ts f u)
	+ then show ?case
	+ apply (clarsimp split: term.splits typ.splits if_splits nat.splits option.splits
	+ simp add: bind_eq_Some_conv)
	+ by blast
	+qed (auto split: term.splits typ.splits if_splits nat.splits option.splits
	+ simp add: bind_eq_Some_conv)
	+
	+corollary typ_of_eta_norm: "typ_of t = Some ty \<Longrightarrow> typ_of (eta_norm t) = Some ty"
	+ using typ_of1_eta_norm typ_of_def by simp
	+
	+lemma typ_of_Abs_body_typ: "typ_of1 Ts (Abs T t) = Some ty \<Longrightarrow> \<exists>rty. ty = (T \<rightarrow> rty)"
	+ by (metis (no_types, lifting) bind_eq_Some_conv option.sel typ_of1.simps(4))
	+lemma typ_of_Abs_body_typ': "typ_of1 Ts (Abs T t) = Some ty
	+ \<Longrightarrow> \<exists>rty. ty = (T \<rightarrow> rty) \<and> typ_of1 (T#Ts) t = Some rty"
	+ by (metis (no_types, lifting) bind_eq_Some_conv option.sel typ_of1.simps(4))
	+
	+lemma typ_of_beta_redex_arg: "typ_of (Abs T s $ t) \<noteq> None \<Longrightarrow> typ_of t = Some T"
	+ by (metis list.inject not_Some_eq typ.inject(1) typ_of1_split_App typ_of_Abs_body_typ' typ_of_def)
	+
	+lemma [partial_function_mono]: "option.mono_body
	+ (\<lambda>beta_norm. map_option (Abs T) (beta_norm t))"
	+ by (smt flat_ord_def fun_ord_def map_option_is_None monotone_def)
	+lemma [partial_function_mono]: "option.mono_body
	+ (\<lambda>beta_norm.
	+ case beta_norm x of None \<Rightarrow> None
	+ \| Some (Ct list typ) \<Rightarrow>
	+ map_option (($) (Ct list typ)) (beta_norm u)
	+ \| Some (Fv p typ) \<Rightarrow>
	+ map_option (($) (Fv p typ)) (beta_norm u)
	+ \| Some (Bv n) \<Rightarrow>
	+ map_option (($) (Bv n)) (beta_norm u)
	+ \| Some (Abs T body) \<Rightarrow>
	+ beta_norm (subst_bv u body)
	+ \| Some (term1 $ term2) \<Rightarrow>
	+ map_option (($) (term1 $ term2)) (beta_norm u))"
	+proof(standard, goal_cases)
	+ case (1 a b)
	+ then show ?case
	+ proof(cases "a x"; cases "b x", simp_all add: flat_ord_def fun_ord_def, goal_cases)
	+ case (1 a)
	+ then show ?case
	+ by (metis option.discI)
	+ next
	+ case (2 r s)
	+ then show ?case
	+ apply (cases r; cases s)
	+ apply (simp_all add: flat_ord_def fun_ord_def)
	+ apply (metis option.distinct option.inject option.sel term.distinct term.inject)+
	+ done
	+ qed
	+qed
	+
	+(* Does not terminate in general :( *)
	+partial_function (option) beta_norm :: "term \<Rightarrow> term option" where
	+ "beta_norm t = (case t of
	+ (Abs T body) \<Rightarrow> map_option (Abs T) (beta_norm body)
	+ \| (Abs T body $ u) \<Rightarrow> beta_norm (subst_bv u body)
	+ \| (f $ u) \<Rightarrow> (case beta_norm f of
	+ Some (Abs T body) \<Rightarrow> beta_norm (subst_bv u body)
	+ \| Some f' \<Rightarrow> map_option (App f') (beta_norm u)
	+ \| None \<Rightarrow> None)
	+ \| t \<Rightarrow> Some t)"
	+
	+simps_of_case beta_norm_simps[simp]: beta_norm.simps
	+declare beta_norm_simps[code]
	+
	+lemma not_beta_reducible_imp_beta_norm_unchanged: "\<not> beta_reducible t \<Longrightarrow> beta_norm t = Some t"
	+proof (induction t)
	+ case (App t u)
	+ then show ?case by (cases t) auto
	+qed auto
	+
	+lemma not_beta_reducible_decr: "\<not> beta_reducible t \<Longrightarrow> \<not> beta_reducible (decr n t)"
	+ by (induction t arbitrary: n rule: beta_reducible.induct) auto
	+
	+lemma "\<not> beta_reducible t \<Longrightarrow> eta_norm t = t' \<Longrightarrow> \<not> beta_reducible t'"
	+proof (induction t arbitrary: t' rule: eta_norm.induct)
	+ case (1 T body)
	+ show ?case
	+ proof(cases "eta_norm body")
	+ case (Abs T' t)
	+ then show ?thesis using 1 by fastforce
	+ next
	+ case (App f u)
	+ note oApp = this
	+ show ?thesis
	+ proof(cases u)
	+ case (Bv n)
	+ show ?thesis
	+ proof(cases n)
	+ case 0
	+ then show ?thesis
	+ proof(cases "is_dependent f")
	+ case True
	+ then show ?thesis
	+ using 1 oApp Bv 0 apply simp
	+ using beta_reducible.simps(2) by blast
	+ next
	+ case False
	+ obtain body' where body': "eta_norm body = body'" by simp
	+ obtain f' where f': "eta_norm f = f'" by simp
	+ moreover have t': "t' = decr 0 f'" using "1.prems"(2)[symmetric] oApp Bv 0 False f' by simp
	+
	+ moreover have "\<not> beta_reducible t'"
	+ proof-
	+ have "\<not> beta_reducible (f $ Bv 0)"
	+ using "1.IH"(1) 1 oApp Bv 0 by simp
	+ hence "\<not> beta_reducible (decr 0 (f' $ Bv 0))"
	+ by (metis eta_reducible.simps(11) f' not_beta_reducible_decr
	+ not_eta_reducible_eta_norm not_eta_reducible_imp_eta_norm_no_change oApp)
	+ hence "\<not> beta_reducible (decr 0 f' $ Bv 0)" by simp
	+ hence "\<not> beta_reducible (decr 0 f')" by (auto elim: beta_reducible.elims)
	+ thus ?thesis using t' by simp
	+ qed
	+ ultimately show ?thesis by blast
	+ qed
	+ next
	+ case (Suc nat)
	+ then show ?thesis using 1 oApp Bv by auto
	+ qed
	+ qed (use 1 oApp in auto)
	+ qed (use 1 in auto)
	+next
	+ case (2 f u)
	+ hence "\<not> beta_reducible f" "\<not> beta_reducible u" by (blast elim!: beta_reducible.elims(3))+
	+ moreover obtain f' u' where "eta_norm f = f'" "eta_norm u = u'" by simp_all
	+ ultimately have "\<not> beta_reducible f'" "\<not> beta_reducible u'" using "2.IH" by simp_all
	+ show ?case
	+ proof(cases t')
	+ case (App l r)
	+ then show ?thesis
	+ using "2.IH"(2) "2.prems"(2) \<open>\<not> beta_reducible u\<close> \<open>\<not> beta_reducible f'\<close> \<open>eta_norm f = f'\<close> "2"(3)
	+ by (auto elim: beta_reducible.elims(3))
	+ qed (use "2.prems"(2) in auto)
	+qed auto
	+
	+fun is_variable :: "term \<Rightarrow> bool" where
	+ "is_variable (Fv _ _) = True"
	+\| "is_variable _ = False"
	+
	+lemma fv_occs: "(x,\<tau>) \<in> fv t \<Longrightarrow> occs (Fv x \<tau>) t"
	+ by (induction t) auto
	+
	+lemma fv_iff_occs: "(x,\<tau>) \<in> fv t \<longleftrightarrow> occs (Fv x \<tau>) t"
	+ by (induction t) auto
	+
	+(* Next few definitions directly from ML code *)
	+fun strip_abs :: "term \<Rightarrow> typ list * term" where
	+ "strip_abs (Abs T t) = (let (a', t') = strip_abs t in (T # a', t'))"
	+\| "strip_abs t = ([], t)"
	+
	+(maps (x1,...,xn)t to t)
	+fun strip_abs_body :: "term \<Rightarrow> term" where
	+ "strip_abs_body (Abs _ t) = strip_abs_body t"
	+\| "strip_abs_body u = u"
	+
	+(maps (x1,...,xn)t to [x1, ..., xn])
	+fun strip_abs_vars :: "term \<Rightarrow> typ list" where
	+ "strip_abs_vars (Abs T t) = T # strip_abs_vars t"
	+\| "strip_abs_vars u = []"
	+
	+(Dropped inner helper function, instead passing qnt along. )
	+fun strip_qnt_body :: "name \<Rightarrow> term \<Rightarrow> term" where
	+ "strip_qnt_body qnt ((Ct c ty) $ (Abs _ t)) =
	+ (if c=qnt then strip_qnt_body qnt t else (Ct c ty))"
	+\| "strip_qnt_body _ t = t"
	+
	+(Dropped inner helper function, instead passing qnt along. )
	+fun strip_qnt_vars :: "name \<Rightarrow> term \<Rightarrow> typ list" where
	+ "strip_qnt_vars qnt (Ct c _ $ Abs T t)= (if c=qnt then T # strip_qnt_vars qnt t else [])"
	+\| "strip_qnt_vars qnt t = []"
	+
	+(maps (f, [t1,...,tn]) to f(t1,...,tn))
	+definition list_comb :: "term * term list \<Rightarrow> term" where "list_comb = case_prod (foldl ($))"
	+(seems more natural curried...)
	+definition list_comb' :: "term \<Rightarrow> term list \<Rightarrow> term" where "list_comb' = foldl ($)"
	+
	+lemma "list_comb (h,t) = list_comb' h t" by (simp add: list_comb_def list_comb'_def)
	+
	+(curry this... ?)
	+fun strip_comb_imp where
	+ "strip_comb_imp (f$t, ts) = strip_comb_imp (f, t # ts)"
	+\| "strip_comb_imp x = x"
	+
	+(maps f(t1,...,tn) to (f, [t1,...,tn]) ; naturally tail-recursive)
	+definition strip_comb :: "term \<Rightarrow> term * term list" where
	+ "strip_comb u = strip_comb_imp (u,[])"
	+
	+(maps f(t1,...,tn) to f , which is never a combination)
	+fun head_of :: "term \<Rightarrow> term" where
	+ "head_of (f$t) = head_of f"
	+\| "head_of u = u"
	+
	+(some sanity check lemmas)
	+
	+lemma fst_strip_comb_imp_eq_head_of: "fst (strip_comb_imp (t,ts)) = head_of t"
	+ by (induction "(t,ts)" arbitrary: t ts rule: strip_comb_imp.induct) simp_all
	+corollary "fst (strip_comb t) = head_of t"
	+ using fst_strip_comb_imp_eq_head_of by (simp add: strip_comb_def)
	+
	+(not in ML)
	+fun is_app :: "term \<Rightarrow> bool" where
	+ "is_app (_ $ _) = True"
	+\| "is_app _ = False"
	+
	+lemma not_is_app_imp_strip_com_imp_unchanged: "\<not> is_app t \<Longrightarrow> strip_comb_imp (t,ts) = (t,ts)"
	+ by (cases t) simp_all
	+corollary not_is_app_imp_strip_com_unchanged: "\<not> is_app t \<Longrightarrow> strip_comb t = (t,[])"
	+ unfolding strip_comb_def using not_is_app_imp_strip_com_imp_unchanged .
	+
	+lemma list_comb_fuse: "list_comb (list_comb (t,ts), ss) = list_comb (t,ts@ss)"
	+ unfolding list_comb_def by simp
	+
	+fun add_size_term :: "term \<Rightarrow> int \<Rightarrow> int" where
	+ "add_size_term (t $ u) n = add_size_term t (add_size_term u n)"
	+\| "add_size_term (Abs _ t) n = add_size_term t (n + 1)"
	+\| "add_size_term _ n = n + 1"
	+
	+definition "size_of_term t = add_size_term t 0"
	+
	+fun add_size_type :: "typ \<Rightarrow> int \<Rightarrow> int" where
	+ "add_size_type (Ty _ tys) n = fold add_size_type tys (n + 1)"
	+\| "add_size_type _ n = n + 1"
	+
	+definition "size_of_type ty = add_size_type ty 0"
	+
	+fun map_types :: "(typ \<Rightarrow> typ) \<Rightarrow> term \<Rightarrow> term" where
	+ "map_types f (Ct a T) = Ct a (f T)"
	+\| "map_types f (Fv v T) = Fv v (f T)"
	+\| "map_types f (Bv i) = Bv i"
	+\| "map_types f (Abs T t) = Abs (f T) (map_types f t)"
	+\| "map_types f (t $ u) = map_types f t $ map_types f u"
	+
	+fun map_atyps :: "(typ \<Rightarrow> typ) \<Rightarrow> typ \<Rightarrow> typ" where
	+ "map_atyps f (Ty a Ts) = Ty a (map (map_atyps f) Ts)"
	+\| "map_atyps f T = f T"
	+
	+lemma "map_atyps id ty = ty"
	+ by (induction rule: typ.induct) (simp_all add: map_idI)
	+
	+fun map_aterms :: "(term \<Rightarrow> term) \<Rightarrow> term \<Rightarrow> term" where
	+ "map_aterms f (t $ u) = map_aterms f t $ map_aterms f u"
	+\| "map_aterms f (Abs T t) = Abs T (map_aterms f t)"
	+\| "map_aterms f t = f t"
	+
	+lemma "map_aterms id t = t"
	+ by (induction rule: term.induct) simp_all
	+
	+definition "map_type_tvar f = map_atyps (\<lambda>x . case x of Tv iname s \<Rightarrow> f iname s \| T \<Rightarrow> T)"
	+
	+lemma map_types_id[simp]: "map_types id t = t"
	+ by (induction t) simp_all
	+lemma map_types_id'[simp]: "map_types (\<lambda>a . a) t = t"
	+ using map_types_id by (simp add: id_def)
	+
	+(* fold types and terms *)
	+fun fold_atyps :: "(typ \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> typ \<Rightarrow> 'a \<Rightarrow> 'a" where
	+ "fold_atyps f (Ty _ Ts) s = fold (fold_atyps f) Ts s"
	+\| "fold_atyps f T s = f T s"
	+
	+definition "fold_atyps_sorts f =
	+ fold_atyps (\<lambda>x . case x of Tv vn S \<Rightarrow> f (Tv vn S) S)"
	+
	+fun fold_aterms :: "(term \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> term \<Rightarrow> 'a \<Rightarrow> 'a" where
	+ "fold_aterms f (t $ u) s = fold_aterms f u (fold_aterms f t s)"
	+\| "fold_aterms f (Abs _ t) s = fold_aterms f t s"
	+\| "fold_aterms f a s = f a s"
	+
	+fun fold_term_types :: "(term \<Rightarrow> typ \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> term \<Rightarrow> 'a \<Rightarrow> 'a" where
	+ "fold_term_types f (Ct n T) s = f (Ct n T) T s"
	+\| "fold_term_types f (Fv idn T) s = f (Fv idn T) T s"
	+\| "fold_term_types f (Bv _) s = s"
	+\| "fold_term_types f (Abs T b) s = fold_term_types f b (f (Abs T b) T s)"
	+\| "fold_term_types f (t $ u) s = fold_term_types f u (fold_term_types f t s)"
	+
	+definition "fold_types f = fold_term_types (\<lambda>x . f)"
	+
	+(* Patterns for empty list except with Bv missing. Probably need a precond when using *)
	+fun replace_types :: "term \<Rightarrow> typ list \<Rightarrow> term \<times> typ list" where
	+ "replace_types (Ct c _) (T # Ts) = (Ct c T, Ts)"
	+\| "replace_types (Fv xi _) (T # Ts) = (Fv xi T, Ts)"
	+\| "replace_types (Bv i) Ts = (Bv i, Ts)"
	+\| "replace_types (Abs _ b) (T # Ts) =
	+ (let (b', Ts') = replace_types b Ts
	+ in (Abs T b', Ts'))"
	+\| "replace_types (t $ u) Ts =
	+ (let
	+ (t', Ts') = replace_types t Ts in
	+ (let (u', Ts'') = replace_types u Ts
	+ in (t' $ u', Ts'')))"
	+
	+(*
	+ collect variables, is the order important? Or should I just return sets?
	+ The set case is basically just (T)fv(T)...
	+ List.insert should keep order, just no duplicates...
	+*)
	+definition "add_tvar_namesT' = fold_atyps (\<lambda>x l . case x of Tv xi _ => List.insert xi l \| _ => l)"
	+definition "add_tvar_names' = fold_types add_tvar_namesT'"
	+definition "add_tvarsT' = fold_atyps (\<lambda>x l . case x of Tv idn s => List.insert (idn,s) l \| _ => l)"
	+definition "add_tvars' = fold_types add_tvarsT'"
	+definition "add_vars' = fold_aterms (\<lambda>x l . case x of Fv idn s => List.insert (idn,s) l \| _ => l)"
	+definition "add_var_names' = fold_aterms (\<lambda>x l . case x of Fv xi _ => List.insert xi l \| _ => l)"
	+
	+definition "add_const_names' = fold_aterms (\<lambda>x l . case x of Ct c _ => List.insert c l \| _ => l)"
	+definition "add_consts' = fold_aterms (\<lambda>x l . case x of Ct n s => List.insert (n,s) l \| _ => l)"
	+
	+definition "add_tvar_namesT = fold_atyps (\<lambda>x . case x of Tv xi _ => insert xi \| _ => id)"
	+definition "add_tvar_names = fold_types add_tvar_namesT"
	+definition "add_tvarsT = fold_atyps (\<lambda>x . case x of Tv idn s => insert (idn,s) \| _ => id)"
	+definition "add_tvars = fold_types add_tvarsT"
	+definition "add_var_names = fold_aterms (\<lambda>x . case x of Fv xi _ => insert xi \| _ => id)"
	+definition "add_vars = fold_aterms (\<lambda>x . case x of Fv idn s => insert (idn,s) \| _ => id)"
	+
	+definition "add_const_names = fold_aterms (\<lambda>x . case x of Ct c _ => insert c \| _ => id)"
	+definition "add_consts = fold_aterms (\<lambda>x . case x of Ct n s => insert (n,s) \| _ => id)"
	+(which of those do I need ^ )
	+
	+(* Show that these behave like (T)fv(T)? *)
	+
	+lemma add_tvarsT'_tvsT_pre[simp]: "set (add_tvarsT' T acc) = set acc \<union> tvsT T"
	+ unfolding add_tvarsT'_def
	+proof (induction T arbitrary: acc)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts arbitrary: acc) auto
	+qed auto
	+
	+lemma add_tvars'_tvs_pre[simp]: "set (add_tvars' t acc) = set acc \<union> tvs t"
	+ by (induction t arbitrary: acc) (auto simp add: add_tvars'_def fold_types_def)
	+
	+lemma "add_tvarsT T acc = acc \<union> tvsT T"
	+ unfolding add_tvarsT_def
	+proof (induction T arbitrary: acc)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts arbitrary: acc) auto
	+qed auto
	+
	+lemma add_vars'_fv_pre: "set (add_vars' t acc) = set acc \<union> fv t"
	+ unfolding add_vars'_def by (induction t arbitrary: acc) auto
	+corollary add_vars'_fv: "set (add_vars' t []) = fv t"
	+ using add_vars'_fv_pre by simp
	+(extra type variables in a term, not covered by its type)
	+
	+(* For some experiments for handling \<And>*)
	+
	+(* I differ from the ML code here, requiring the correct typ for the \<And>*)
	+fun strip_all_body :: "term \<Rightarrow> term" where
	+ "strip_all_body (Ct all S $ Abs T t) = (if all= STR ''Pure.all'' \<and> S=(T\<rightarrow>propT)\<rightarrow>propT
	+ then strip_all_body t else (Ct all S $ Abs T t))"
	+\| "strip_all_body t = t"
	+
	+fun strip_all_vars :: "term \<Rightarrow> typ list" where
	+ "strip_all_vars (Ct all S $ Abs T t) = (if all= STR ''Pure.all'' \<and> S=(T\<rightarrow>propT)\<rightarrow>propT
	+ then T # strip_all_vars t else [])"
	+\| "strip_all_vars t = []"
	+
	+fun strip_all_single_body :: "term \<Rightarrow> term" where
	+ "strip_all_single_body (Ct all S $ Abs T t) = (if all= STR ''Pure.all'' \<and> S=(T\<rightarrow>propT)\<rightarrow>propT
	+ then t else (Ct all S $ Abs T t))"
	+\| "strip_all_single_body t = t"
	+
	+fun strip_all_single_var :: "term \<Rightarrow> typ option" where
	+ "strip_all_single_var (Ct all S $ Abs T t) = (if all= STR ''Pure.all'' \<and> S=(T\<rightarrow>propT)\<rightarrow>propT
	+ then Some T else None)"
	+\| "strip_all_single_var t = None"
	+
	+fun strip_all_multiple_body :: "nat \<Rightarrow> term \<Rightarrow> term" where
	+ "strip_all_multiple_body 0 t = t"
	+\| "strip_all_multiple_body (Suc n) (Ct all S $ Abs T t) = (if all= STR ''Pure.all'' \<and> S=(T\<rightarrow>propT)\<rightarrow>propT
	+ then strip_all_multiple_body n t else (Ct all S $ Abs T t))"
	+\| "strip_all_multiple_body _ t = t"
	+
	+fun strip_all_multiple_vars :: "nat \<Rightarrow> term \<Rightarrow> typ list" where
	+ "strip_all_multiple_vars 0 _ = []"
	+\| "strip_all_multiple_vars (Suc n) (Ct all S $ Abs T t) = (if all= STR ''Pure.all'' \<and> S=(T\<rightarrow>propT)\<rightarrow>propT
	+ then T # strip_all_multiple_vars n t else [])"
	+\| "strip_all_multiple_vars _ t = []"
	+
	+lemma strip_all_vars_strip_all_multiple_vars:
	+ "n\<ge>length (strip_all_vars t) \<Longrightarrow> strip_all_multiple_vars n t = strip_all_vars t"
	+ by (induction n t rule: strip_all_multiple_vars.induct) auto
	+lemma "n\<ge>length (strip_all_vars t) \<Longrightarrow> strip_all_multiple_body n t = strip_all_body t"
	+ by (induction n t rule: strip_all_multiple_vars.induct) (auto elim!: strip_all_vars.elims)
	+
	+lemma length_strip_all_multiple_vars: "length (strip_all_multiple_vars n t) \<le> n"
	+ by (induction n t rule: strip_all_multiple_vars.induct) auto
	+
	+lemma prefix_strip_all_multiple_vars: "prefix (strip_all_multiple_vars n t) (strip_all_vars t)"
	+ unfolding prefix_def by (induction n t rule: strip_all_multiple_vars.induct) auto
	+
	+definition "mk_all_list l t = fold (\<lambda>(n,T) acc . mk_all n T acc) l t"
	+
	+lemma mk_all_list_empty[simp]: "mk_all_list [] t = t" by (simp add: mk_all_list_def)
	+
	+(* Again, need correct typ here *)
	+fun is_all :: "term \<Rightarrow> bool" where
	+ "is_all (Ct all S $ Abs T t) = (all= STR ''Pure.all'' \<and> S=(T\<rightarrow>propT)\<rightarrow>propT)"
	+\| "is_all _ = False"
	+
	+lemma strip_all_single_var_is_all: "strip_all_single_var t \<noteq> None \<longleftrightarrow> is_all t"
	+ apply (cases t) apply simp_all
	+ subgoal for f u apply (cases f; cases u) by (auto elim: is_all.elims split: if_splits)
	+ done
	+
	+lemma "is_all t \<Longrightarrow> hd (strip_all_vars t) = the (strip_all_single_var t)"
	+ by (auto elim: is_all.elims)
	+
	+lemma strip_all_body_single_simp[simp]: "strip_all_body (strip_all_single_body t) = strip_all_body t"
	+ by (induction t rule: strip_all_body.induct) auto
	+lemma strip_all_body_single_simp'[simp]: "strip_all_single_body (strip_all_body t) = strip_all_body t"
	+ by (induction t rule: strip_all_body.induct) auto
	+
	+lemma strip_all_vars_step:
	+ "strip_all_single_var t = Some T \<Longrightarrow> T # strip_all_vars (strip_all_single_body t) = strip_all_vars t"
	+ by (induction t arbitrary: T rule: strip_all_vars.induct) (auto split: if_splits)
	+
	+lemma is_all_iff_strip_all_vars_not_empty: "is_all t \<longleftrightarrow> strip_all_vars t \<noteq> []"
	+ apply (cases t) apply simp_all
	+ subgoal for f u apply (cases f; cases u) by (auto elim: strip_all_vars.elims is_all.elims split: if_splits)
	+ done
	+
	+lemma strip_all_vars_bind_fv:
	+ "strip_all_vars (bind_fv2 v lev t) = (strip_all_vars t)"
	+ by (induction t arbitrary: lev rule: strip_all_vars.induct) auto
	+
	+lemma strip_all_vars_mk_all[simp]: "strip_all_vars (mk_all s ty t) = ty # strip_all_vars t"
	+ using bind_fv_def strip_all_vars_bind_fv typ_of_def by auto
	+
	+lemma strip_all_vars_mk_all_list:
	+ "\<not>is_all t \<Longrightarrow> strip_all_vars (mk_all_list l t) = rev (map snd l)"
	+proof (induction l rule: rev_induct)
	+ case Nil
	+ then show ?case using is_all_iff_strip_all_vars_not_empty by simp
	+next
	+ case (snoc v vs)
	+ hence I: "strip_all_vars (mk_all_list vs t) = rev (map snd vs)" by simp
	+ obtain s ty where v: "v = (s,ty)" by fastforce
	+
	+ have "strip_all_vars (mk_all_list (vs @ [v]) t)
	+ = strip_all_vars (mk_all s ty (mk_all_list vs t))"
	+ by (auto simp add: mk_all_list_def v)
	+ also have "\<dots> = ty # strip_all_vars (mk_all_list vs t)"
	+ using strip_all_vars_mk_all[of ty s "mk_all_list vs t"] by blast
	+ also have "\<dots> = ty # rev (map snd vs)"
	+ by (simp add: I)
	+ also have "\<dots> = rev (map snd (vs @ [v]))"
	+ using v by simp
	+ finally show ?case .
	+qed
	+
	+(* Move up *)
	+lemma subst_bv_no_loose_unchanged:
	+ assumes "\<And>x . x \<ge> lev \<Longrightarrow> \<not> loose_bvar1 t x"
	+ assumes "is_variable v"
	+ shows "(subst_bv1 t lev v) = t"
	+using assms proof (induction t arbitrary: lev)
	+ case (Bv x)
	+ then show ?case
	+ using loose_bvar_iff_exist_loose_bvar1 no_loose_bvar_imp_no_subst_bv1 by presburger
	+next
	+ case (Abs T t)
	+ then show ?case
	+ using loose_bvar_iff_exist_loose_bvar1 no_loose_bvar_imp_no_subst_bv1 by presburger
	+qed auto
	+
	+(* Should state those in terms "of \<in> fv", occs is a relict *)
	+lemma bind_fv2_no_occs_unchanged:
	+ assumes "\<not> occs (case_prod Fv v) t"
	+ shows "(bind_fv2 v lev t) = t"
	+ using assms by (induction t arbitrary: lev) auto
	+
	+lemma bind_fv2_subst_bv1_cancel:
	+ assumes "\<And>x . x > lev \<Longrightarrow> \<not> loose_bvar1 t x"
	+ assumes "\<not> occs (case_prod Fv v) t"
	+ shows "bind_fv2 v lev (subst_bv1 t lev (case_prod Fv v)) = t"
	+ using assms proof (induction t arbitrary: lev)
	+ case (Bv x)
	+ then show ?case
	+ using linorder_neqE_nat
	+ by (auto split: prod.splits simp add: is_variable_imp_incr_boundvars_unchganged)
	+next
	+ case (Abs T t)
	+ hence "bind_fv2 v (lev+1) (subst_bv1 t (lev+1) (case_prod Fv v)) = t"
	+ by (auto elim: Suc_lessE)
	+ then show ?case by simp
	+next
	+ (* This proof contains so much duplication it makes me vomit...
	+ Got even uglier after translation
	+ *)
	+ case (App t1 t2)
	+ then show ?case
	+ proof(cases "loose_bvar1 t1 lev")
	+ case True
	+ hence I1: "bind_fv2 v lev (subst_bv1 t1 lev (case_prod Fv v)) = t1" using App by auto
	+ then show ?thesis
	+ proof(cases "loose_bvar1 t2 lev")
	+ case True
	+ hence "bind_fv2 v lev (subst_bv1 t2 lev (case_prod Fv v)) = t2" using App by auto
	+ then show ?thesis using I1 App.prems is_variable.elims(2) by auto
	+ next
	+ case False
	+ hence "bind_fv2 v lev (subst_bv1 t2 lev (case_prod Fv v)) = t2"
	+ proof-
	+ have "subst_bv1 t2 lev (case_prod Fv v) = t2" using subst_bv_no_loose_unchanged
	+ using App.prems(1-2) False assms le_neq_implies_less loose_bvar1.simps(2)
	+ by (metis loose_bvar_iff_exist_loose_bvar1 no_loose_bvar_imp_no_subst_bv1)
	+ moreover have "bind_fv2 v lev t2 = t2"
	+ using App.prems(2) bind_fv2_no_occs_unchanged
	+ using App.prems(2) bind_fv2_changed' exists_subterm'.simps(1)
	+ exists_subterm_iff_exists_subterm' by blast
	+ ultimately show ?thesis by simp
	+ qed
	+ then show ?thesis using I1 App.prems is_variable.elims(2) by auto
	+ qed
	+ next
	+ case False
	+ hence I1: "bind_fv2 v lev (subst_bv1 t1 lev (case_prod Fv v)) = t1"
	+ proof-
	+ have "subst_bv1 t1 lev (case_prod Fv v) = t1" using subst_bv_no_loose_unchanged
	+ using App.prems(1-2) False le_neq_implies_less loose_bvar1.simps(2)
	+ by (metis loose_bvar_iff_exist_loose_bvar1 no_loose_bvar_imp_no_subst_bv1)
	+ moreover have "bind_fv2 v lev t1 = t1"
	+ using App.prems(2) bind_fv2_no_occs_unchanged by auto
	+ ultimately show ?thesis by simp
	+ qed
	+ then show ?thesis
	+ proof(cases "loose_bvar1 t2 lev")
	+ case True
	+ hence "bind_fv2 v lev (subst_bv1 t2 lev (case_prod Fv v)) = t2" using App by auto
	+ then show ?thesis using I1 App.prems is_variable.elims(2) by auto
	+ next
	+ case False
	+ hence "bind_fv2 v lev (subst_bv1 t2 lev (case_prod Fv v)) = t2"
	+ proof-
	+ have "subst_bv1 t2 lev (case_prod Fv v) = t2" using subst_bv_no_loose_unchanged
	+ using App.prems(1-2) False assms le_neq_implies_less loose_bvar1.simps(2)
	+ by (metis loose_bvar_iff_exist_loose_bvar1 no_loose_bvar_imp_no_subst_bv1)
	+ moreover have "bind_fv2 v lev t2 = t2"
	+ using App.prems(2) bind_fv2_no_occs_unchanged by auto
	+ ultimately show ?thesis by simp
	+ qed
	+ then show ?thesis using I1 App.prems is_variable.elims(2) by auto
	+ qed
	+ qed
	+qed auto
	+
	+lemma bind_fv_subst_bv_cancel:
	+ assumes "\<And>x . x > 0 \<Longrightarrow> \<not> loose_bvar1 t x"
	+ assumes "\<not> occs (case_prod Fv v) t"
	+ shows "bind_fv v (subst_bv (case_prod Fv v) t) = t"
	+ using bind_fv2_subst_bv1_cancel bind_fv_def assms subst_bv_def by auto
	+
	+lemma not_loose_bvar_imp_not_loose_bvar1_all_greater: "\<not> loose_bvar t lev \<Longrightarrow> x>lev \<Longrightarrow> \<not> loose_bvar1 t x"
	+ by (simp add: loose_bvar_iff_exist_loose_bvar1)
	+
	+lemma mk_all'_subst_bv_strip_all_single_body_cancel:
	+ assumes "strip_all_single_var t = Some T"
	+ assumes "is_closed t"
	+ assumes "(name, T) \<notin> fv t"
	+ shows "mk_all name T (subst_bv (Fv name T) (strip_all_single_body t) ) = t"
	+proof-
	+ from assms(1) obtain t' where t': "(Ct STR ''Pure.all'' ((T \<rightarrow> propT) \<rightarrow> propT) $ Abs T t') = t"
	+ by (auto elim!: strip_all_single_var.elims
	+ simp add: bind_eq_Some_conv typ_of_def split: if_splits option.splits if_splits)
	+
	+ hence s: "strip_all_single_body t = t'" by auto
	+
	+ have "\<And>x. x > 0 \<Longrightarrow> \<not> loose_bvar1 t x"
	+ using assms(2) is_open_def loose_bvar_iff_exist_loose_bvar1 by blast
	+
	+ have "0 < x \<Longrightarrow> \<not> loose_bvar1 t' x" for x
	+ using assms(2) by (auto simp add: is_open_def t'[symmetric] loose_bvar_iff_exist_loose_bvar1 gr0_conv_Suc)
	+
	+ have "occs t' t" by (simp add: t'[symmetric])
	+
	+ have "bind_fv (name, T) (subst_bv (Fv name T) (strip_all_single_body t)) =
	+ (strip_all_single_body t)"
	+ using assms(2-3) bind_fv_subst_bv_cancel gr0_conv_Suc
	+ by (force simp add: s is_open_def t'[symmetric]
	+ loose_bvar_iff_exist_loose_bvar1 fv_iff_occs intro!: bind_fv_subst_bv_cancel)
	+ then show ?thesis using assms by (auto simp add: s typ_of_def t')
	+qed
	+
	+lemma not_is_all_imp_strip_all_body_unchanged: "\<not> is_all t \<Longrightarrow> strip_all_body t = t"
	+ by (auto elim!: is_all.elims split: if_splits)
	+
	+lemma no_loose_bvar_imp_no_subst_bvs: "is_closed t \<Longrightarrow> subst_bvs [] t = t"
	+ using no_loose_bvar_imp_no_subst_bvs1 subst_bvs_def is_open_def by simp
	+
	+lemma "is_closed (Abs T t) \<Longrightarrow> \<not> loose_bvar t 1" unfolding is_open_def by simp
	+
	+lemma bind_fv2_Fv_fv[simp]: "fv (bind_fv2 (x, \<tau>) lev t) = fv t - {(x,\<tau>)}"
	+ by (induction "(x, \<tau>)" lev t rule: bind_fv2.induct) (auto split: if_splits term.splits)
	+
	+corollary mk_all_fv_unchanged: "fv (mk_all x \<tau> B) = fv B - {(x,\<tau>)}"
	+ using bind_fv2_Fv_fv bind_fv_def by auto
	+
	+lemma mk_all_list_fv_unchanged: "fv (mk_all_list l B) = fv B - set l"
	+proof (induction l arbitrary: B rule: rev_induct)
	+ case Nil
	+ then show ?case by simp
	+next
	+ (* After translation, look at proof again*)
	+ case (snoc x xs)
	+ have s: "mk_all_list (xs@[x]) B = case_prod mk_all x (mk_all_list xs B)"
	+ by (simp add: mk_all_list_def)
	+ show ?case
	+ by (simp only: s "snoc.IH" mk_all_fv_unchanged split: prod.splits) auto
	+qed
	+
	+(* Hs parameter to check if var is fixed by hypotheses *)
	+abbreviation "forall_intro_vars t Hs \<equiv> mk_all_list
	+ (diff_list (add_vars' t []) (fold (add_vars') Hs [])) t"
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Term_Subst.thy b/thys/Metalogic_ProofChecker/Term_Subst.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Term_Subst.thy
	@@ -0,0 +1,916 @@
	+section "More on Substitutions"
	+
	+(*
	+ Originally for stuff from Term_Subst.ML
	+
	+ Now has little do to with it and contains stuff about various substitutions in general
	+ Problem: Inconsistent naming
	+*)
	+
	+theory Term_Subst
	+ imports Term
	+begin
	+
	+fun subst_typ :: "((variable \<times> sort) \<times> typ) list \<Rightarrow> typ \<Rightarrow> typ" where
	+ "subst_typ insts (Ty a Ts) =
	+ Ty a (map (subst_typ insts) Ts)"
	+\| "subst_typ insts (Tv idn S) = the_default (Tv idn S)
	+ (lookup (\<lambda>x . x = (idn, S)) insts)"
	+
	+lemma subst_typ_nil[simp]: "subst_typ [] T = T"
	+ by (induction T) (auto simp add: map_idI)
	+
	+lemma subst_typ_irrelevant_order:
	+ assumes "distinct (map fst pairs)" and "distinct (map fst pairs')" and "set pairs = set pairs'"
	+shows "subst_typ pairs T = subst_typ pairs' T"
	+ using assms
	+proof(induction T)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts) auto
	+next
	+ case (Tv idn S)
	+ then show ?case using lookup_eq_order_irrelevant by (metis subst_typ.simps(2))
	+qed
	+
	+(* Core lemma, Isabelle/Pure's instantiateT_same function can simulate abstract type subtitutions
	+ in types *)
	+lemma subst_typ_simulates_tsubstT_gen': "distinct l \<Longrightarrow> tvsT T \<subseteq> set l
	+ \<Longrightarrow> tsubstT T \<rho> = subst_typ (map (\<lambda>(x,y).((x,y), \<rho> x y)) l) T"
	+proof(induction T arbitrary: l)
	+ case (Ty n Ts)
	+ then show ?case by (induction Ts) auto
	+next
	+ case (Tv idn S)
	+ hence d: "distinct (map fst (map (\<lambda>(x,y).((x,y), \<rho> x y)) l))"
	+ by (simp add: case_prod_beta map_idI)
	+ hence el: "((idn,S), \<rho> idn S) \<in> set (map (\<lambda>a. case a of (x, y) \<Rightarrow> ((x, y), \<rho> x y)) l)"
	+ using Tv by auto
	+ show ?case using iffD1[OF lookup_present_eq_key, OF _ el] Tv.prems d by auto
	+qed
	+
	+lemma subst_typ_simulates_tsubstT_gen: "tsubstT T \<rho>
	+ = subst_typ (map (\<lambda>(x,y).((x,y), \<rho> x y)) (SOME l . distinct l \<and> tvsT T \<subseteq> set l)) T"
	+proof(rule someI2_ex)
	+ show "\<exists>a. distinct a \<and> tvsT T \<subseteq> set a"
	+ using finite_tvsT finite_distinct_list
	+ by (metis order_refl)
	+next
	+ fix l assume l: "distinct l \<and> tvsT T \<subseteq> set l"
	+ then show "tsubstT T \<rho> = subst_typ (map (\<lambda>a. case a of (x, y) \<Rightarrow> ((x, y), \<rho> x y)) l) T"
	+ using subst_typ_simulates_tsubstT_gen' by blast
	+qed
	+
	+corollary subst_typ_simulates_tsubstT: "tsubstT T \<rho>
	+ = subst_typ (map (\<lambda>(x,y).((x,y), \<rho> x y)) (SOME l . distinct l \<and> set l = tvsT T)) T"
	+ apply (rule someI2_ex)
	+ using finite_tvsT finite_distinct_list apply metis
	+ using subst_typ_simulates_tsubstT_gen' apply simp
	+ done
	+
	+(* Other direction, can construct a abstract substitution for one performed by instantiateT_same *)
	+lemma tsubstT_simulates_subst_typ: "subst_typ insts T
	+ = tsubstT T (\<lambda>idn S . the_default (Tv idn S) (lookup (\<lambda>x. x=(idn, S)) insts))"
	+ by (induction T) auto
	+
	+(* Somewhat janky version of "composition" for subst_typ *)
	+lemma subst_typ_comp:
	+ "subst_typ inst1 (subst_typ inst2 T) = subst_typ (map (apsnd (subst_typ inst1)) inst2 @ inst1) T"
	+proof (induction inst2 T arbitrary: inst1 rule: subst_typ.induct)
	+ case (1 insts a Ts)
	+ then show ?case
	+ by auto
	+next
	+ case (2 insts idn S)
	+ then show ?case
	+ by (induction insts) auto
	+qed
	+(* To make insts distinct again *)
	+lemma subst_typ_AList_clearjunk: "subst_typ insts T = subst_typ (AList.clearjunk insts) T"
	+proof (induction T)
	+ case (Ty n Ts)
	+ then show ?case
	+ by auto
	+next
	+ case (Tv n S)
	+ then show ?case
	+ proof(induction insts)
	+ case Nil
	+ then show ?case
	+ by auto
	+ next
	+ case (Cons inst insts)
	+ then show ?case
	+ by simp (metis clearjunk.simps(2) lookup_AList_clearjunk)
	+ qed
	+qed
	+
	+fun subst_type_term :: "((variable \<times> sort) \<times> typ) list \<Rightarrow>
	+ ((variable \<times> typ) \<times> term) list \<Rightarrow> term \<Rightarrow> term" where
	+ "subst_type_term instT insts (Ct c T) = Ct c (subst_typ instT T)"
	+\| "subst_type_term instT insts (Fv idn T) = (let T' = subst_typ instT T in
	+ the_default (Fv idn T') (lookup (\<lambda>x. x = (idn, T')) insts))"
	+\| "subst_type_term _ _ (Bv n) = Bv n"
	+\| "subst_type_term instT insts (Abs T t) = Abs (subst_typ instT T) (subst_type_term instT insts t)"
	+\| "subst_type_term instT insts (t $ u) = subst_type_term instT insts t $ subst_type_term instT insts u"
	+
	+lemma subst_type_term_empty_no_change[simp]: "subst_type_term [] [] t = t"
	+ by (induction t) (simp_all add:)
	+
	+lemma subst_type_term_irrelevant_order:
	+ assumes instT_assms: "distinct (map fst instT)" "distinct (map fst instT')" "set instT = set instT'"
	+ assumes insts_assms: "distinct (map fst insts)" "distinct (map fst insts')" "set insts = set insts'"
	+shows "subst_type_term instT insts t = subst_type_term instT' insts' t"
	+ using assms
	+proof(induction t)
	+ case (Fv idn T)
	+ then show ?case
	+ apply (simp add: Let_def subst_typ_irrelevant_order[OF Fv.prems(1-3)])
	+ using lookup_eq_order_irrelevant by (metis Fv.prems(4) Fv.prems(5) insts_assms)
	+next
	+ case (Abs T t)
	+ then show ?case using subst_typ_irrelevant_order[OF instT_assms] by simp
	+qed (simp_all add: subst_typ_irrelevant_order[OF instT_assms])
	+
	+(* Core lemma, Isabelle/Pure's instantiate_same function can simulate abstract
	+ term/type subtitutions in terms
	+
	+ The tsubst should be no problem, can be rewritten to subst_type using previous simulation lemma
	+*)
	+lemma subst_type_term_simulates_subst_tsubst_gen':
	+ assumes lty_assms: "distinct lty" "tvs t \<subseteq> set lty"
	+ assumes lt_assms: "distinct lt" "fv (tsubst t \<rho>ty) \<subseteq> set lt"
	+ shows "subst (tsubst t \<rho>ty) \<rho>t
	+ = subst_type_term (map (\<lambda>(x,y).((x,y), \<rho>ty x y)) lty) (map (\<lambda>(x,y).((x,y), \<rho>t x y)) lt) t"
	+proof-
	+ let ?lty = "map (\<lambda>(x,y).((x,y), \<rho>ty x y)) lty"
	+
	+ have p1ty: "distinct (map fst ?lty)" using lty_assms
	+ by (simp add: case_prod_beta map_idI)
	+
	+ let ?lt = "map (\<lambda>(x,y).((x,y), \<rho>t x y)) lt"
	+
	+ have p1t: "distinct (map fst ?lt)" using lt_assms
	+ by (simp add: case_prod_beta map_idI)
	+
	+ show ?thesis using assms
	+ proof(induction t arbitrary: lty lt)
	+ case (Fv idn T)
	+
	+ let ?T = "tsubstT T \<rho>ty"
	+ have el: "((idn, ?T), \<rho>t idn ?T) \<in> set (map (\<lambda>(x,y).((x,y), \<rho>t x y)) lt)"
	+ using Fv by auto
	+ have d: "distinct (map fst (map (\<lambda>(x,y).((x,y), \<rho>t x y)) lt))"
	+ using Fv by (simp add: case_prod_beta map_idI)
	+ show ?case using Fv.prems d
	+ by (auto simp add: iffD1[OF lookup_present_eq_key, OF d el]
	+ subst_typ_simulates_tsubstT_gen'[symmetric] Let_def)
	+ qed (simp_all add: subst_typ_simulates_tsubstT_gen')
	+qed
	+
	+corollary subst_type_term_simulates_subst_tsubst: "subst (tsubst t \<rho>ty) \<rho>t
	+ = subst_type_term (map (\<lambda>(x,y).((x,y), \<rho>ty x y)) (SOME lty . distinct lty \<and> tvs t = set lty))
	+ (map (\<lambda>(x,y).((x,y), \<rho>t x y)) (SOME lt . distinct lt \<and> fv (tsubst t \<rho>ty) = set lt)) t"
	+ apply (rule someI2_ex)
	+ using finite_fv finite_distinct_list apply metis
	+ apply (rule someI2_ex)
	+ using finite_tvs finite_distinct_list apply metis
	+ using subst_type_term_simulates_subst_tsubst_gen' by simp
	+
	+abbreviation "subst_typ' pairs t \<equiv> map_types (subst_typ pairs) t"
	+
	+lemma subst_typ'_nil[simp]: "subst_typ' [] A = A"
	+ by (induction A) (auto simp add:)
	+
	+lemma subst_typ'_simulates_tsubst_gen': "distinct pairs \<Longrightarrow> tvs t \<subseteq> set pairs
	+ \<Longrightarrow> tsubst t \<rho> = subst_typ' (map (\<lambda>(x,y).((x,y), \<rho> x y)) pairs) t"
	+ by (induction t arbitrary: pairs \<rho>)
	+ (auto simp add: subst_typ_simulates_tsubstT_gen')
	+
	+lemma subst_typ'_simulates_tsubst_gen: "tsubst t \<rho>
	+ = subst_typ' (map (\<lambda>(x,y).((x,y), \<rho> x y)) (SOME l . distinct l \<and> tvs t \<subseteq> set l)) t"
	+proof(rule someI2_ex)
	+ show "\<exists>a. distinct a \<and> tvs t \<subseteq> set a"
	+ using finite_tvs finite_distinct_list
	+ by (metis order_refl)
	+next
	+ fix l assume l: "distinct l \<and> tvs t \<subseteq> set l"
	+
	+ then show "tsubst t \<rho> = subst_typ' (map (\<lambda>a. case a of (x, y) \<Rightarrow> ((x, y), \<rho> x y)) l) t"
	+ using subst_typ'_simulates_tsubst_gen' by blast
	+qed
	+
	+lemma tsubst_simulates_subst_typ': "subst_typ' insts T
	+ = tsubst T (\<lambda>idn S . the_default (Tv idn S) (lookup (\<lambda>x. x=(idn, S)) insts))"
	+ by (induction T) (auto simp add: tsubstT_simulates_subst_typ)
	+
	+(*
	+ Naming!
	+*)
	+lemma subst_type_add_degenerate_instance:
	+ "(idx,s) \<notin> set (map fst insts) \<Longrightarrow> subst_typ insts T = subst_typ (((idx,s), Tv idx s)#insts) T"
	+ by (induction T) (auto simp add: lookup_eq_key_not_present)
	+
	+lemma subst_typ'_add_degenerate_instance:
	+ "(idx,s) \<notin> set (map fst insts) \<Longrightarrow> subst_typ' insts t = subst_typ' (((idx,s), Tv idx s)#insts) t"
	+ by (induction t) (auto simp add: subst_type_add_degenerate_instance)
	+
	+(* Again, janky composition *)
	+lemma subst_typ'_comp:
	+ "subst_typ' inst1 (subst_typ' inst2 t) = subst_typ' (map (apsnd (subst_typ inst1)) inst2 @ inst1) t"
	+ by (induction t) (use subst_typ_comp in auto)
	+
	+(* To make insts distinct again *)
	+lemma subst_typ'_AList_clearjunk: "subst_typ' insts t = subst_typ' (AList.clearjunk insts) t"
	+ by (induction t) (use subst_typ_AList_clearjunk in auto)
	+
	+fun subst_term :: "((variable * typ) * term) list \<Rightarrow> term \<Rightarrow> term" where
	+ "subst_term insts (Ct c T) = Ct c T"
	+\| "subst_term insts (Fv idn T) = the_default (Fv idn T) (lookup (\<lambda>x. x=(idn, T)) insts)"
	+\| "subst_term _ (Bv n) = Bv n"
	+\| "subst_term insts (Abs T t) = Abs T (subst_term insts t)"
	+\| "subst_term insts (t $ u) = subst_term insts t $ subst_term insts u"
	+
	+lemma subst_term_empty_no_change[simp]: "subst_term [] t = t"
	+ by (induction t) auto
	+
	+lemma subst_type_term_without_type_insts_eq_subst_term[simp]:
	+ "subst_type_term [] insts t = subst_term insts t"
	+ by (induction insts t rule: subst_term.induct) simp_all
	+
	+lemma subst_type_term_split_levels:
	+ "subst_type_term instT insts t = subst_term insts (subst_typ' instT t)"
	+ by (induction t) (auto simp add: Let_def)
	+
	+(* Express parallel substitution as a series of single substitutions. *)
	+
	+(* Deleted assms in the induction once, recheck proofs, maybe some get easier. *)
	+lemma subst_typ_stepwise:
	+ assumes "distinct (map fst instT)"
	+ assumes "\<And>x . x \<in> (\<Union>t \<in> snd ` set instT . tvsT t) \<Longrightarrow> x \<notin> fst ` set instT"
	+ shows "subst_typ instT T = fold (\<lambda>single acc . subst_typ [single] acc) instT T"
	+using assms proof (induction instT T rule: subst_typ.induct)
	+ case (1 inst a Ts)
	+ then show ?case
	+ proof (induction Ts arbitrary: inst)
	+ case Nil
	+ then show ?case by (induction inst) auto
	+ next
	+ case (Cons T Ts)
	+ hence "subst_typ inst (Ty a Ts) = fold (\<lambda>single. subst_typ [single]) inst (Ty a Ts)"
	+ by simp
	+ moreover have "subst_typ inst T = fold (\<lambda>single. subst_typ [single]) inst T"
	+ using Cons 1 by simp
	+ moreover have "fold (\<lambda>single. subst_typ [single]) inst (Ty a (T#Ts))
	+ = (Ty a (map (fold (\<lambda>single. subst_typ [single]) inst) (T#Ts)))"
	+ proof (induction inst rule: rev_induct)
	+ case Nil
	+ then show ?case by simp
	+ next
	+ case (snoc x xs)
	+ hence "fold (\<lambda>single. subst_typ [single]) (xs @ [x]) (Ty a (T # Ts)) =
	+ Ty a (map (subst_typ [x]) (map (fold (\<lambda>single. subst_typ [single]) xs) (T # Ts)))"
	+ by simp
	+ then show ?case by simp
	+ qed
	+ ultimately show ?case
	+ using Cons.prems(1) Cons.prems(2) local.Cons(4) by auto
	+ qed
	+next
	+ case (2 inst idn S)
	+ then show ?case
	+ proof (cases "lookup (\<lambda>x . x = (idn, S)) (inst)")
	+ case None
	+ hence "fst p \<noteq> (idn, S)" if "p\<in>set inst" for p using that by (auto simp add: lookup_None_iff)
	+ hence "subst_typ [p] (Tv idn S) = Tv idn S" if "p\<in>set inst" for p
	+ using that by (cases p) fastforce
	+ from this None show ?thesis by (induction inst) (auto split: if_splits)
	+ next
	+ case (Some a)
	+
	+ have elem: "((idn, S), a) \<in> set inst" using Some lookup_present_eq_key'' 2 by fastforce
	+ from this obtain fs bs where split: "inst = fs @ ((idn, S), a) # bs"
	+ by (meson split_list)
	+ hence "(idn, S) \<notin> set (map fst fs)" and "(idn, S) \<notin> set (map fst bs)" using 2 by simp_all
	+
	+ hence "fst p \<noteq> (idn, S)" if "p\<in>set fs" for p
	+ using that by force
	+ hence id_subst_fs: "subst_typ [p] (Tv idn S) = Tv idn S" if "p\<in>set fs" for p
	+ using that by (cases p) fastforce
	+ hence fs_step: "fold (\<lambda>single. subst_typ [single]) fs (Tv idn S) = Tv idn S"
	+ by (induction fs) (auto split: if_splits)
	+
	+ have change_step: "subst_typ [((idn, S), a)] (Tv idn S) = a" by simp
	+
	+ have bs_sub: "set bs \<subseteq> set inst" using split by auto
	+ hence "x \<notin> fst ` set bs"
	+ if "x\<in> \<Union> (tvsT ` snd ` set bs)" for x
	+ using 2 that split by (auto simp add: image_iff)
	+
	+ have "v \<notin> fst ` set bs" if "v \<in> tvsT a" for v
	+ using that 2 elem bs_sub by (fastforce simp add: image_iff)
	+
	+ hence id_subst_bs: "subst_typ [p] a = a" if "p \<in> set bs" for p
	+ using that proof(cases p, induction a)
	+ case (Ty n Ts)
	+ then show ?case
	+ by (induction Ts) auto
	+ next
	+ case (Tv n S)
	+ then show ?case
	+ by force
	+ qed
	+ hence bs_step: "fold (\<lambda>single. subst_typ [single]) bs a = a"
	+ by (induction bs) auto
	+
	+ from fs_step change_step bs_step split Some show ?thesis by simp
	+ qed
	+qed
	+
	+corollary subst_typ_split_first:
	+ assumes "distinct (map fst (x#xs))"
	+ assumes "\<And>y . y \<in> (\<Union>t \<in> snd ` set (x#xs) . tvsT t) \<Longrightarrow> y \<notin> fst ` (set (x#xs))"
	+ shows "subst_typ (x#xs) T = subst_typ xs (subst_typ [x] T)"
	+proof-
	+ have "subst_typ (x#xs) T = fold (\<lambda>single . subst_typ [single]) (x#xs) T"
	+ using assms subst_typ_stepwise by blast
	+ also have "\<dots> = fold (\<lambda>single . subst_typ [single]) xs (subst_typ [x] T)"
	+ by simp
	+ also have "\<dots> = subst_typ xs (subst_typ [x] T)"
	+ using assms subst_typ_stepwise by simp
	+ finally show ?thesis .
	+qed
	+
	+corollary subst_typ_split_last:
	+ assumes "distinct (map fst (xs @ [x]))"
	+ assumes "\<And>y . y \<in> (\<Union>t \<in> snd ` (set (xs @ [x])) . tvsT t) \<Longrightarrow> y \<notin> fst ` (set (xs @ [x]))"
	+ shows "subst_typ (xs @ [x]) T = subst_typ [x] (subst_typ xs T)"
	+proof-
	+ have "subst_typ (xs @ [x]) T = fold (\<lambda>single . subst_typ [single]) (xs@[x]) T"
	+ using assms subst_typ_stepwise by blast
	+ also have "\<dots> = subst_typ [x] (fold (\<lambda>single . subst_typ [single]) xs T)"
	+ by simp
	+ also have "\<dots> = subst_typ [x] (subst_typ xs T)"
	+ using assms subst_typ_stepwise by simp
	+ finally show ?thesis .
	+qed
	+
	+lemma subst_typ'_stepwise:
	+ assumes "distinct (map fst instT)"
	+ assumes "\<And>x . x \<in> (\<Union>t \<in> snd ` (set instT) . tvsT t) \<Longrightarrow> x \<notin> fst ` (set instT)"
	+ shows "subst_typ' instT t = fold (\<lambda>single acc . subst_typ' [single] acc) instT t"
	+(* I switched the order of inductions and 99% of the proof vanished *)
	+using assms proof (induction instT arbitrary: t rule: rev_induct)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (snoc x xs)
	+ then show ?case
	+ apply (induction t)
	+ using subst_typ_split_last apply simp_all
	+ apply (metis map_types.simps)+ (* ... *)
	+ done
	+qed
	+
	+
	+lemma subst_term_stepwise:
	+ assumes "distinct (map fst insts)"
	+ assumes "\<And>x . x \<in> (\<Union>t \<in> snd ` (set insts) . fv t) \<Longrightarrow> x \<notin> fst ` (set insts)"
	+ shows "subst_term insts t = fold (\<lambda>single acc . subst_term [single] acc) insts t"
	+using assms proof (induction insts arbitrary: t rule: rev_induct)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (snoc x xs)
	+ then show ?case
	+ proof (induction t)
	+ case (Fv idn T)
	+ (* Allows more direct copy paste, hide structure of list, do proof properly later *)
	+ define insts where insts_def: "insts = xs @ [x]"
	+ have insts_thm1: "distinct (map fst insts)" using insts_def snoc by simp
	+ have insts_thm2: "x \<notin> fst ` set insts" if "x \<in> \<Union> (fv ` snd ` set insts)" for x
	+ using insts_def snoc that by blast
	+ from Fv show ?case
	+ (* Proof copied from subst_typ *)
	+ proof (cases "lookup (\<lambda>x . x = (idn, T)) insts")
	+ case None
	+ hence "fst p \<noteq> (idn, T)" if "p\<in>set insts" for p using that by (auto simp add: lookup_None_iff)
	+ hence "subst_term [p] (Fv idn T) = Fv idn T" if "p\<in>set insts" for p
	+ using that by (cases p) fastforce
	+ from this None show ?thesis
	+ unfolding insts_def[symmetric]
	+ by (induction insts) (auto split: if_splits)
	+ next
	+ case (Some a)
	+
	+ have elem: "((idn, T), a) \<in> set insts" using Some lookup_present_eq_key'' insts_thm1 by fastforce
	+ from this obtain fs bs where split: "insts = fs @ ((idn, T), a) # bs"
	+ by (meson split_list)
	+ hence "(idn, T) \<notin> set (map fst fs)" and "(idn, T) \<notin> set (map fst bs)" using insts_thm1 by simp_all
	+
	+ hence "fst p ~= (idn, T)" if "p\<in>set fs" for p
	+ using that by force
	+ hence id_subst_fs: "subst_term [p] (Fv idn T) = Fv idn T" if "p\<in>set fs" for p
	+ using that by (cases p) fastforce
	+ hence fs_step: "fold (\<lambda>single. subst_term [single]) fs (Fv idn T) = Fv idn T"
	+ by (induction fs) (auto split: if_splits)
	+
	+ have change_step: "subst_term [((idn, T), a)] (Fv idn T) = a" by simp
	+
	+ have bs_sub: "set bs \<subseteq> set insts" using split by auto
	+ hence "x \<notin> fst ` set bs"
	+ if "x\<in> \<Union> (fv ` snd ` set bs)" for x
	+ using insts_thm2 that split by (auto simp add: image_iff)
	+
	+ have "v \<notin> fst ` set bs" if "v \<in> fv a" for v
	+ using that insts_thm2 elem bs_sub by (fastforce simp add: image_iff)
	+
	+ hence id_subst_bs: "subst_term [p] a = a" if "p\<in>set bs" for p
	+ using that by (cases p, induction a) force+
	+ hence bs_step: "fold (\<lambda>single. subst_term [single]) bs a = a"
	+ by (induction bs) auto
	+
	+ from fs_step change_step bs_step split Some show ?thesis by (simp add: insts_def)
	+ qed
	+ qed (simp, metis subst_term.simps)+
	+qed
	+
	+corollary subst_term_split_last:
	+ assumes "distinct (map fst (xs @ [x]))"
	+ assumes "\<And>y . y \<in> (\<Union>t \<in> snd ` (set (xs @ [x])) . fv t) \<Longrightarrow> y \<notin> fst ` (set (xs @ [x]))"
	+ shows "subst_term (xs @ [x]) t = subst_term [x] (subst_term xs t)"
	+proof-
	+ have "subst_term (xs @ [x]) t = fold (\<lambda>single . subst_term [single]) (xs@[x]) t"
	+ using assms subst_term_stepwise by blast
	+ also have "\<dots> = subst_term [x] (fold (\<lambda>single . subst_term [single]) xs t)"
	+ by simp
	+ also have "\<dots> = subst_term [x] (subst_term xs t)"
	+ using assms subst_term_stepwise by simp
	+ finally show ?thesis .
	+qed
	+
	+corollary subst_type_term_stepwise:
	+ assumes "distinct (map fst instT)"
	+ assumes "\<And>x . x \<in> (\<Union>T \<in> snd ` (set instT) . tvsT T) \<Longrightarrow> x \<notin> fst ` (set instT)"
	+ assumes "distinct (map fst insts)"
	+ assumes "\<And>x . x \<in> (\<Union>t \<in> snd ` (set insts) . fv t) \<Longrightarrow> x \<notin> fst ` (set insts)"
	+ shows "subst_type_term instT insts t
	+ = fold (\<lambda>single . subst_term [single]) insts (fold (\<lambda>single . subst_typ' [single]) instT t)"
	+ using assms subst_typ'_stepwise subst_term_stepwise subst_type_term_split_levels by auto
	+
	+(* MOVE *)
	+lemma distinct_fst_imp_distinct: "distinct (map fst l) \<Longrightarrow> distinct l" by (induction l) auto
	+lemma distinct_kv_list: "distinct l \<Longrightarrow> distinct (map (\<lambda>x. (x, f x)) l)" by (induction l) auto
	+
	+lemma subst_subst_term:
	+ assumes "distinct l" and "fv t \<subseteq> set l"
	+ shows "subst t \<rho> = subst_term (map (\<lambda>x.(x, case_prod \<rho> x)) l) t"
	+using assms proof (induction t arbitrary: l)
	+ case (Fv idn T)
	+ then show ?case
	+ proof (cases "(idn, T) \<in> set l")
	+ case True
	+ hence "((idn, T), \<rho> idn T) \<in> set (map (\<lambda>x.(x, case_prod \<rho> x)) l)" by auto
	+ moreover have "distinct (map fst (map (\<lambda>x.(x, case_prod \<rho> x)) l))"
	+ using Fv(1) by (induction l) auto
	+ ultimately have "(lookup (\<lambda>x. x = (idn, T)) (map (\<lambda>x. (x, case x of (x, xa) \<Rightarrow> \<rho> x xa)) l))
	+ = Some (\<rho> idn T)" using lookup_present_eq_key by fast
	+ then show ?thesis by simp
	+ next
	+ case False
	+ then show ?thesis using Fv by simp
	+ qed
	+qed auto
	+
	+
	+lemma subst_term_subst:
	+ assumes "distinct (map fst l)"
	+ shows "subst_term l t = subst t (fold (\<lambda>((idn, T), t) f x y. if x=idn \<and>y=T then t else f x y) l Fv)"
	+using assms proof (induction t)
	+ case (Fv idn T)
	+ then show ?case
	+ proof (cases "lookup (\<lambda>x. x = (idn, T)) l")
	+ case None
	+ hence "(idn, T) \<notin> set (map fst l)"
	+ by (metis (full_types) lookup_None_iff)
	+
	+ hence "(fold (\<lambda>((idn, T), t) f x y. if x=idn \<and>y=T then t else f x y) l Fv) idn T = Fv idn T"
	+ by (induction l rule: rev_induct) (auto split: if_splits prod.splits)
	+
	+ then show ?thesis by (simp add: None)
	+ next
	+ case (Some a)
	+
	+ have elem: "((idn, T), a) \<in> set l"
	+ using Some lookup_present_eq_key'' Fv by fastforce
	+ from this obtain fs bs where split: "l = fs @ ((idn, T), a) # bs"
	+ by (meson split_list)
	+ hence "(idn, T) \<notin> set (map fst fs)" and not_in_bs: "(idn, T) \<notin> set (map fst bs)" using Fv by simp_all
	+
	+ hence "fst p ~= (idn, T)" if "p\<in>set fs" for p
	+ using that by force
	+ hence fs_step: "(fold (\<lambda>((idn, T), t) f x y. if x=idn \<and>y=T then t else f x y) fs Fv) idn T = Fv idn T"
	+ by (induction fs rule: rev_induct) (fastforce split: if_splits prod.splits)+
	+
	+ have bs_sub: "set bs \<subseteq> set l" using split by auto
	+
	+ have "fst p ~= (idn, T)" if "p\<in>set bs" for p
	+ using that not_in_bs by force
	+ hence bs_step: "(fold (\<lambda>((idn, T), t) f x y. if x=idn \<and>y=T then t else f x y) bs f) idn T = f idn T"
	+ for f
	+ by (induction bs rule: rev_induct) (fastforce split: if_splits prod.splits)+
	+
	+ from fs_step bs_step split Some show ?thesis by simp
	+ qed
	+qed auto
	+
	+lemma subst_typ_combine_single:
	+ assumes "fresh_idn \<notin> fst ` tvsT \<tau>"
	+ shows "subst_typ [((fresh_idn, S), \<tau>2)] (subst_typ [((idn, S), Tv fresh_idn S)] \<tau>)
	+ = subst_typ [((idn, S), \<tau>2)] \<tau>"
	+ using assms by (induction \<tau>) auto
	+
	+lemma subst_typ_combine:
	+ assumes "length fresh_idns = length insts"
	+ assumes "distinct fresh_idns"
	+ assumes "distinct (map fst insts)"
	+ assumes "\<forall>idn \<in> set fresh_idns . idn \<notin> fst ` (tvsT \<tau> \<union> (\<Union>ty\<in>snd ` set insts . (tvsT ty))
	+ \<union> (fst ` set insts))"
	+ shows "subst_typ insts \<tau>
	+ = subst_typ (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>)"
	+ using assms proof (induction insts \<tau> arbitrary: fresh_idns rule: subst_typ.induct)
	+ case (1 inst a Ts)
	+ then show ?case by fastforce (* LOL, I wanted to do another induction *)
	+next
	+ case (2 inst idn S)
	+ show ?case
	+ proof (cases "lookup (\<lambda>x. x = (idn, S)) inst")
	+ case None
	+ hence "((idn, S)) \<notin> fst ` set inst"
	+ by (metis (mono_tags, lifting) list.set_map lookup_None_iff)
	+ hence 1: "(lookup (\<lambda>x. x = (idn, S))
	+ (zip (map fst inst) (map2 Tv fresh_idns (map (snd \<circ> fst) inst)))) = None"
	+ using 2 by (simp add: lookup_eq_key_not_present)
	+
	+ have "(idn, S) \<notin> set (zip fresh_idns (map (snd \<circ> fst) inst))"
	+ using 2 set_zip_leftD by fastforce
	+ hence "(lookup (\<lambda>x. x = (idn, S))
	+ (zip (zip fresh_idns (map (snd \<circ> fst) inst)) (map snd inst))) = None"
	+ using 2 by (simp add: lookup_eq_key_not_present)
	+
	+ then show ?thesis using None 1 by simp
	+ next
	+ case (Some ty)
	+ from this obtain idx where idx: "inst ! idx = ((idn, S), ty)" "idx < length inst"
	+ proof (induction inst)
	+ case Nil
	+ then show ?case
	+ by simp
	+ next
	+ case (Cons a as) thm Cons.IH
	+ have "(\<And>idx. as ! idx = ((idn, S), ty) \<Longrightarrow> idx < length as \<Longrightarrow> thesis)"
	+ by (metis Cons.prems(1) in_set_conv_nth list.set_intros(2))
	+ then show ?case
	+ by (meson Cons.prems(1) Cons.prems(2) in_set_conv_nth lookup_present_eq_key')
	+ qed
	+
	+ from this obtain fresh_idn where fresh_idn: "fresh_idns ! idx = fresh_idn" by simp
	+
	+ from 2(1) idx fresh_idn have ren:
	+ "(zip (map fst inst) (map2 Tv fresh_idns (map (snd \<circ> fst) inst))) ! idx
	+ = ((idn, S), Tv fresh_idn S) "
	+ by auto
	+ from this idx(2) have "((idn, S), Tv fresh_idn S) \<in> set
	+ (zip (map fst inst) (map2 Tv fresh_idns (map (snd \<circ> fst) inst)))"
	+ by (metis (no_types, hide_lams) "2.prems"(1) length_map map_fst_zip map_map map_snd_zip nth_mem)
	+ from this have 1: "(lookup (\<lambda>x. x = (idn, S))
	+ (zip (map fst inst) (map2 Tv fresh_idns (map (snd \<circ> fst) inst)))) = Some (Tv fresh_idn S)"
	+ by (simp add: "2.prems"(1) "2.prems"(3) lookup_present_eq_key'')
	+
	+ from 2(1) idx fresh_idn 1 have "((fresh_idn, S), ty)
	+ \<in> set (zip (zip fresh_idns (map (snd \<circ> fst) inst)) (map snd inst))"
	+ using in_set_conv_nth by fastforce
	+ hence 2: "(lookup (\<lambda>x. x = (fresh_idn, S))
	+ (zip (zip fresh_idns (map (snd \<circ> fst) inst)) (map snd inst))) = Some ty"
	+ by (simp add: "2.prems"(1) "2.prems"(2) distinct_zipI1 lookup_present_eq_key'')
	+ then show ?thesis using Some 1 2 by simp
	+ qed
	+qed
	+
	+lemma subst_typ_combine':
	+ assumes "length fresh_idns = length insts"
	+ assumes "distinct fresh_idns"
	+ assumes "distinct (map fst insts)"
	+ assumes "\<forall>idn \<in> set fresh_idns . idn \<notin> fst ` (tvsT \<tau> \<union> (\<Union>ty\<in>snd ` set insts . (tvsT ty))
	+ \<union> (fst ` set insts))"
	+ shows "subst_typ insts \<tau>
	+ = fold (\<lambda>single acc . subst_typ [single] acc) (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (fold (\<lambda>single acc . subst_typ [single] acc) (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>)"
	+proof-
	+ have s1: "fst ` set (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts))))
	+ = fst ` set insts "
	+ proof-
	+ have "fst ` set (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts))))
	+ = set (map fst (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))))"
	+ by auto
	+ also have "\<dots> = set (map fst insts)" using map_fst_zip assms(1) by auto
	+ also have "\<dots> = fst ` set insts" by simp
	+ finally show ?thesis .
	+ qed
	+
	+ have "snd ` set (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts))))
	+ = set (map2 Tv fresh_idns (map snd (map fst insts)))" using map_snd_zip assms(1)
	+ by (metis (no_types, lifting) image_set length_map)
	+ hence "(\<Union> (tvsT ` snd ` set (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts))))))
	+ = (\<Union> (tvsT ` set (map2 Tv fresh_idns (map snd (map fst insts)))))"
	+ by simp
	+ from assms(1) this have s2:
	+ "(\<Union> (tvsT ` snd ` set (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts))))))
	+ = (set (zip fresh_idns (map snd (map fst insts))))"
	+ using assms(1) by (induction fresh_idns insts rule: list_induct2) auto
	+ hence s3: "\<Union> (tvsT ` snd ` set (zip (map fst insts)
	+ (map2 Tv fresh_idns (map (snd \<circ> fst) insts))))
	+ = set (zip fresh_idns (map snd (map fst insts)))" by simp
	+ have "idn \<notin> fst ` fst ` set insts" if "idn \<in> set fresh_idns" for idn
	+ using that assms by auto
	+ hence I: "(idn, S) \<notin> fst ` set insts" if "idn \<in> set fresh_idns" for idn S
	+ using that assms by (metis fst_conv image_eqI)
	+
	+ have u1: "(subst_typ (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>)
	+ = fold (\<lambda>single acc . subst_typ [single] acc) (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>"
	+ apply (rule subst_typ_stepwise)
	+ using assms apply simp
	+ apply (simp only: s1 s2)
	+ using assms I by (metis prod.collapse set_zip_leftD)
	+
	+ moreover have u2: "subst_typ (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>)
	+ = fold (\<lambda>single acc . subst_typ [single] acc) (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>)"
	+ apply (rule subst_typ_stepwise)
	+ using assms apply (simp add: distinct_zipI1)
	+ using assms
	+ by (smt UnCI imageE image_eqI length_map map_snd_zip prod.collapse set_map set_zip_leftD)
	+ ultimately have unfold: "subst_typ (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>)
	+ = fold (\<lambda>single acc . subst_typ [single] acc) (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (fold (\<lambda>single acc . subst_typ [single] acc) (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) \<tau>)"
	+ by simp
	+ show ?thesis using assms subst_typ_combine unfold by auto
	+qed
	+
	+lemma subst_typ'_combine:
	+ assumes "length fresh_idns = length insts"
	+ assumes "distinct fresh_idns"
	+ assumes "distinct (map fst insts)"
	+ assumes "\<forall>idn \<in> set fresh_idns . idn \<notin> fst ` (tvs t \<union> (\<Union>ty\<in>snd ` set insts . (tvsT ty))
	+ \<union> (fst ` set insts))"
	+ shows "subst_typ' insts t
	+ = subst_typ' (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ' (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) t)"
	+using assms proof (induction t arbitrary: fresh_idns insts)
	+ case (Abs T t)
	+ moreover have "tvs t \<subseteq> tvs (Abs T t) " by simp
	+ ultimately have "subst_typ' insts t =
	+ subst_typ' (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ' (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) t)"
	+ by blast
	+ moreover have "subst_typ insts T =
	+ subst_typ (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) T)"
	+ using subst_typ_combine Abs.prems by fastforce
	+ ultimately show ?case by simp
	+next
	+ case (App t1 t2)
	+ moreover have "tvs t1 \<subseteq> tvs (t1 $ t2)" "tvs t2 \<subseteq> tvs (t1 $ t2)" by auto
	+ ultimately have "subst_typ' insts t1 =
	+ subst_typ' (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ' (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) t1)"
	+ and "subst_typ' insts t2 =
	+ subst_typ' (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_typ' (zip (map fst insts) (map2 Tv fresh_idns (map snd (map fst insts)))) t2)"
	+ by blast+
	+ then show ?case by simp
	+qed (use subst_typ_combine in auto)
	+
	+(* Only interesting case is Fv, and that one is copied directly from subst_typ *)
	+lemma subst_term_combine:
	+ assumes "length fresh_idns = length insts"
	+ assumes "distinct fresh_idns"
	+ assumes "distinct (map fst insts)"
	+ assumes "\<forall>idn \<in> set fresh_idns . idn \<notin> fst ` (fv t \<union> (\<Union>t\<in>snd ` set insts . (fv t))
	+ \<union> (fst ` set insts))"
	+ shows "subst_term insts t
	+ = subst_term (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_term (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t)"
	+using assms proof (induction t arbitrary: fresh_idns insts)
	+ case (Fv idn ty)
	+
	+ then show ?case
	+ proof (cases "lookup (\<lambda>x. x = (idn, ty)) insts")
	+ case None
	+ hence "((idn, ty)) \<notin> fst ` set insts"
	+ by (metis (mono_tags, lifting) list.set_map lookup_None_iff)
	+ hence 1: "(lookup (\<lambda>x. x = (idn, ty))
	+ (zip (map fst insts) (map2 Fv fresh_idns (map (snd \<circ> fst) insts)))) = None"
	+ using Fv by (simp add: lookup_eq_key_not_present)
	+
	+ have "(idn, ty) \<notin> set (zip fresh_idns (map (snd \<circ> fst) insts))"
	+ using Fv set_zip_leftD by fastforce
	+ hence "(lookup (\<lambda>x. x = (idn, ty))
	+ (zip (zip fresh_idns (map (snd \<circ> fst) insts)) (map snd insts))) = None"
	+ using Fv by (simp add: lookup_eq_key_not_present)
	+
	+ then show ?thesis using None 1 by simp
	+ next
	+ case (Some u)
	+ from this obtain idx where idx: "insts ! idx = ((idn, ty), u)" "idx < length insts"
	+ proof (induction insts)
	+ case Nil
	+ then show ?case
	+ by simp
	+ next
	+ case (Cons a as)
	+ have "(\<And>idx. as ! idx = ((idn, ty), u) \<Longrightarrow> idx < length as \<Longrightarrow> thesis)"
	+ by (metis Cons.prems(1) in_set_conv_nth insert_iff list.set(2))
	+ then show ?case
	+ by (meson Cons.prems(1) Cons.prems(2) in_set_conv_nth lookup_present_eq_key')
	+ qed
	+
	+ from this obtain fresh_idn where fresh_idn: "fresh_idns ! idx = fresh_idn" by simp
	+
	+ from Fv(1) idx fresh_idn have ren:
	+ "(zip (map fst insts) (map2 Fv fresh_idns (map (snd \<circ> fst) insts))) ! idx
	+ = ((idn, ty), Fv fresh_idn ty)"
	+ by auto
	+ from this idx(2) have "((idn, ty), Fv fresh_idn ty) \<in> set
	+ (zip (map fst insts) (map2 Fv fresh_idns (map (snd \<circ> fst) insts)))"
	+ by (metis (no_types, hide_lams) "Fv.prems"(1) length_map map_fst_zip map_map map_snd_zip nth_mem)
	+ from this have 1: "(lookup (\<lambda>x. x = (idn, ty))
	+ (zip (map fst insts) (map2 Fv fresh_idns (map (snd \<circ> fst) insts)))) = Some (Fv fresh_idn ty)"
	+ by (simp add: "Fv.prems"(1) "Fv.prems"(3) lookup_present_eq_key'')
	+
	+ (* Feels doable with better simp setup *)
	+ from Fv(1) idx fresh_idn 1 have "((fresh_idn, ty), u)
	+ \<in> set (zip (zip fresh_idns (map (snd \<circ> fst) insts)) (map snd insts))"
	+ using in_set_conv_nth by fastforce
	+ hence 2: "(lookup (\<lambda>x. x = (fresh_idn, ty))
	+ (zip (zip fresh_idns (map (snd \<circ> fst) insts)) (map snd insts))) = Some u"
	+ by (simp add: "Fv.prems"(1) "Fv.prems"(2) distinct_zipI1 lookup_present_eq_key'')
	+ then show ?thesis using Some 1 2 by simp
	+ qed
	+next
	+ case (App t1 t2)
	+ moreover have "fv t1 \<subseteq> fv (t1 $ t2)" "fv t2 \<subseteq> fv (t1 $ t2)" by simp_all
	+ ultimately have "subst_term insts t1 =
	+ subst_term (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_term (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t1)"
	+ and "subst_term insts t2 =
	+ subst_term (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_term (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t2)"
	+ by blast+
	+ then show ?case by simp
	+qed auto
	+
	+corollary subst_term_combine':
	+ assumes "length fresh_idns = length insts"
	+ assumes "distinct fresh_idns"
	+ assumes "distinct (map fst insts)"
	+ assumes "\<forall>idn \<in> set fresh_idns . idn \<notin> fst ` (fv t \<union> (\<Union>t\<in>snd ` set insts . (fv t))
	+ \<union> (fst ` set insts))"
	+ shows "subst_term insts t
	+ = fold (\<lambda>single acc . subst_term [single] acc) (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (fold (\<lambda>single acc . subst_term [single] acc) (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t)"
	+proof-
	+ have s1: "fst ` set (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts))))
	+ = fst ` set insts "
	+ proof-
	+ have "fst ` set (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts))))
	+ = set (map fst (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))))"
	+ by auto
	+ also have "\<dots> = set (map fst insts)" using map_fst_zip assms(1) by auto
	+ also have "\<dots> = fst ` set insts" by simp
	+ finally show ?thesis .
	+ qed
	+
	+ have "snd ` set (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts))))
	+ = set (map2 Fv fresh_idns (map snd (map fst insts)))" using map_snd_zip assms(1)
	+ by (metis (no_types, lifting) image_set length_map)
	+ hence "(\<Union> (fv ` snd ` set (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts))))))
	+ = (\<Union> (fv ` set (map2 Fv fresh_idns (map snd (map fst insts)))))"
	+ by simp
	+ from assms(1) this have s2:
	+ "(\<Union> (fv ` snd ` set (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts))))))
	+ = (set (zip fresh_idns (map snd (map fst insts))))"
	+ using assms(1) by (induction fresh_idns insts rule: list_induct2) auto
	+ hence s3: "\<Union> (fv ` snd ` set (zip (map fst insts)
	+ (map2 Fv fresh_idns (map (snd \<circ> fst) insts))))
	+ = set (zip fresh_idns (map snd (map fst insts)))" by simp
	+ have "idn \<notin> fst ` fst ` set insts" if "idn \<in> set fresh_idns" for idn
	+ using that assms by auto
	+ hence I: "(idn, T) \<notin> fst ` set insts" if "idn \<in> set fresh_idns" for idn T
	+ using that assms by (metis fst_conv image_eqI)
	+
	+ have u1: "(subst_term (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t)
	+ = fold (\<lambda>single acc . subst_term [single] acc) (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t"
	+ apply (rule subst_term_stepwise)
	+ using assms apply simp
	+ apply (simp only: s1 s2)
	+ using assms I by (metis prod.collapse set_zip_leftD)
	+
	+ moreover have u2: "subst_term (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_term (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t)
	+ = fold (\<lambda>single acc . subst_term [single] acc) (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_term (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t)"
	+ apply (rule subst_term_stepwise)
	+ using assms apply (simp add: distinct_zipI1)
	+ using assms
	+ by (smt UnCI imageE image_eqI length_map map_snd_zip prod.collapse set_map set_zip_leftD)
	+ ultimately have unfold: "subst_term (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (subst_term (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t)
	+ = fold (\<lambda>single acc . subst_term [single] acc) (zip (zip fresh_idns (map snd (map fst insts))) (map snd insts))
	+ (fold (\<lambda>single acc . subst_term [single] acc) (zip (map fst insts) (map2 Fv fresh_idns (map snd (map fst insts)))) t)"
	+ by simp
	+ show ?thesis using assms subst_term_combine unfold by auto
	+qed
	+
	+
	+lemma subst_term_not_loose_bvar:
	+ assumes "\<not> loose_bvar t n" "is_closed b"
	+ shows "\<not> loose_bvar (subst_term [((idn,T),b)] t) n"
	+ using assms by (induction t arbitrary: n idn T b) (auto simp add: is_open_def loose_bvar_leq)
	+
	+(* This seems a bit to weak, second premise probably needs to be more general *)
	+lemma bind_fv2_subst_bv1_eq_subst_term:
	+ assumes "\<not>loose_bvar t n" "is_closed b"
	+ shows "subst_term [((idn,T),b)] t = subst_bv1 (bind_fv2 (idn, T) n t) n b"
	+ using assms by (induction t arbitrary: n idn T b) (auto simp add: is_open_def incr_boundvars_def)
	+
	+corollary
	+ assumes "is_closed t" "is_closed b"
	+ shows "subst_bv b (bind_fv (idn, T) t) = (subst_term [((idn, T),b)] t)"
	+ using assms bind_fv2_subst_bv1_eq_subst_term
	+ by (simp add: bind_fv_def subst_bv_def is_open_def)
	+
	+corollary instantiate_var_same_typ:
	+ assumes typ_a: "typ_of a = Some \<tau>"
	+ assumes closed_B: "\<not> loose_bvar B lev"
	+ shows "subst_bv1 (bind_fv2 (x, \<tau>) lev B) lev a = subst_term [((x, \<tau>), a)] B"
	+ using bind_fv2_subst_bv1_eq_subst_term assms typ_of_imp_closed by metis
	+
	+corollary instantiate_var_same_typ':
	+ assumes typ_a: "typ_of a = Some \<tau>"
	+ assumes closed_B: "is_closed B"
	+ shows "subst_bv a (bind_fv (x, \<tau>) B) = subst_term [((x, \<tau>), a)] B"
	+ using instantiate_var_same_typ bind_fv_def subst_bv_def is_open_def assms by auto
	+
	+corollary instantiate_var_same_type'':
	+ assumes typ_a: "typ_of a = Some \<tau>"
	+ assumes closed_B: "is_closed B"
	+ shows "Abs \<tau> (bind_fv (x, \<tau>) B) \<bullet> a = subst_term [((x, \<tau>), a)] B"
	+ using assms instantiate_var_same_typ' by simp
	+
	+lemma instantiate_vars_same_typ:
	+ assumes typs: "list_all (\<lambda>((idx, ty), t) . typ_of t = Some ty) insts"
	+ assumes closed_B: "\<not> loose_bvar B lev"
	+ shows "fold (\<lambda>((idx, ty), t) B . subst_bv1 (bind_fv2 (idx, ty) lev B) lev t) insts B
	+ = fold (\<lambda>single . subst_term [single]) insts B"
	+using assms proof (induction insts arbitrary: B lev)
	+ case Nil
	+ then show ?case by simp
	+next
	+ case (Cons x xs)
	+
	+ from this obtain idn ty t where x: "x = ((idn, ty), t)" by (metis prod.collapse)
	+
	+ hence typ_a: "typ_of t = Some ty" using Cons.prems by simp
	+ have typs: "list_all (\<lambda>((idx, ty), t) . typ_of t = Some ty) xs" using Cons.prems by simp
	+ have not_loose: "\<not> loose_bvar (subst_term [((idn, ty), t)] B) lev"
	+ using Cons.prems subst_term_not_loose_bvar typ_a typ_of_imp_closed by simp
	+
	+ note single = instantiate_var_same_typ[OF typ_a Cons.prems(2), of idn]
	+
	+ have "fold (\<lambda>((idx, ty), t) B . subst_bv1 (bind_fv2 (idx, ty) lev B) lev t) (x # xs) B
	+ = fold (\<lambda>((idx, ty), t) B. subst_bv1 (bind_fv2 (idx, ty) lev B) lev t) xs
	+ (subst_bv1 (bind_fv2 (idn, ty) lev B) lev t)"
	+ by (simp add: x)
	+ also have "\<dots> = fold (\<lambda>((idx, ty), t) B. subst_bv1 (bind_fv2 (idx, ty) lev B) lev t) xs
	+ (subst_term [((idn, ty), t)] B)"
	+ using single by simp
	+ also have "\<dots> = fold (\<lambda>single. subst_term [single]) xs (subst_term [((idn, ty), t)] B)"
	+ using Cons.IH[where B = "subst_term [((idn, ty), t)] B", OF typs not_loose] Cons.prems by blast
	+ also have "\<dots> = fold (\<lambda>single. subst_term [single]) (x # xs) B"
	+ by (simp add: x)
	+ finally show ?case .
	+qed
	+
	+corollary instantiate_vars_same_typ':
	+ assumes typs: "list_all (\<lambda>((idx, ty), t) . typ_of t = Some ty) insts"
	+ assumes closed_B: "\<not> loose_bvar B lev"
	+ assumes distinct: "distinct (map fst insts)"
	+ assumes no_overlap: "\<And>x . x \<in> (\<Union>t \<in> snd ` (set insts) . fv t) \<Longrightarrow> x \<notin> fst ` (set insts)"
	+ shows "fold (\<lambda>((idx, ty), t) B . subst_bv1 (bind_fv2 (idx, ty) lev B) lev t) insts B
	+ = subst_term insts B"
	+ using instantiate_vars_same_typ subst_term_stepwise[symmetric] assms by simp
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/Theory.thy b/thys/Metalogic_ProofChecker/Theory.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/Theory.thy
	@@ -0,0 +1,193 @@
	+
	+section "Wellformed Signature and Theory"
	+
	+theory Theory
	+ imports Term Sorts SortConstants
	+begin
	+
	+(* Functional versions of wf_type/wf_term, for historic reasons still used in definitions and proofs *)
	+fun typ_ok_sig :: "signature \<Rightarrow> typ \<Rightarrow> bool" where
	+ "typ_ok_sig \<Sigma> (Ty c Ts) = (case type_arity \<Sigma> c of
	+ None \<Rightarrow> False
	+ \| Some ar \<Rightarrow> length Ts = ar \<and> list_all (typ_ok_sig \<Sigma>) Ts)"
	+\| "typ_ok_sig \<Sigma> (Tv _ S) = wf_sort (subclass (osig \<Sigma>)) S"
	+
	+lemma typ_ok_sig_imp_wf_type: "typ_ok_sig \<Sigma> T \<Longrightarrow> wf_type \<Sigma> T"
	+ by (induction T) (auto split: option.splits intro: wf_type.intros simp add: list_all_iff)
	+lemma wf_type_imp_typ_ok_sig: "wf_type \<Sigma> T \<Longrightarrow> typ_ok_sig \<Sigma> T"
	+ by (induction \<Sigma> T rule: wf_type.induct) (simp_all split: option.splits add: list_all_iff)
	+
	+corollary wf_type_iff_typ_ok_sig[iff]: "wf_type \<Sigma> T = typ_ok_sig \<Sigma> T"
	+ using wf_type_imp_typ_ok_sig typ_ok_sig_imp_wf_type by blast
	+
	+fun term_ok' :: "signature \<Rightarrow> term \<Rightarrow> bool" where
	+ "term_ok' \<Sigma> (Fv _ T) = typ_ok_sig \<Sigma> T"
	+\| "term_ok' \<Sigma> (Bv _) = True"
	+\| "term_ok' \<Sigma> (Ct s T) = (case const_type \<Sigma> s of
	+ None \<Rightarrow> False
	+ \| Some ty \<Rightarrow> typ_ok_sig \<Sigma> T \<and> tinstT T ty)"
	+\| "term_ok' \<Sigma> (t $ u) \<longleftrightarrow> term_ok' \<Sigma> t \<and> term_ok' \<Sigma> u"
	+\| "term_ok' \<Sigma> (Abs T t) \<longleftrightarrow> typ_ok_sig \<Sigma> T \<and> term_ok' \<Sigma> t"
	+
	+lemma term_ok'_imp_wf_term: "term_ok' \<Sigma> t \<Longrightarrow> wf_term \<Sigma> t"
	+ by (induction t) (auto intro: wf_term.intros split: option.splits)
	+lemma wf_term_imp_term_ok': "wf_term \<Sigma> t \<Longrightarrow> term_ok' \<Sigma> t"
	+ by (induction \<Sigma> t rule: wf_term.induct) (auto split: option.splits)
	+corollary wf_term_iff_term_ok'[iff]: "wf_term \<Sigma> t = term_ok' \<Sigma> t"
	+ using term_ok'_imp_wf_term wf_term_imp_term_ok' by blast
	+
	+lemma acyclic_empty[simp]: "acyclic {}" unfolding acyclic_def by simp
	+
	+lemma "wf_sig (Map.empty, Map.empty, empty_osig)"
	+ by (simp add: coregular_tcsigs_def complete_tcsigs_def consistent_length_tcsigs_def
	+ all_normalized_and_ex_tcsigs_def)
	+lemma
	+ term_ok_imp_typ_ok_pre:
	+ "is_std_sig \<Sigma> \<Longrightarrow> wf_term \<Sigma> t \<Longrightarrow> list_all (typ_ok_sig \<Sigma>) Ts
	+ \<Longrightarrow> typ_of1 Ts t = Some ty \<Longrightarrow> typ_ok_sig \<Sigma> ty"
	+proof (induction Ts t arbitrary: ty rule: typ_of1.induct)
	+ case (2 Ts i)
	+ then show ?case by (auto simp add: bind_eq_Some_conv list_all_length split: option.splits if_splits)
	+next
	+ case (4 Ts T body)
	+ obtain bodyT where bodyT: "typ_of1 (T#Ts) body = Some bodyT"
	+ using "4.prems" by fastforce
	+ hence ty: "ty = T \<rightarrow> bodyT"
	+ using 4 by simp
	+ have "typ_ok_sig \<Sigma> bodyT"
	+ using 4 bodyT by simp
	+ thus ?case
	+ using ty 4 by (cases \<Sigma>) auto
	+next
	+ case (5 Ts f u T)
	+ from this obtain U where "typ_of1 Ts u = Some U"
	+ using typ_of1_split_App by blast
	+ moreover hence "typ_of1 Ts f = Some (U \<rightarrow> T)"
	+ using "5.prems"(4) by (meson typ_of1_arg_typ)
	+ ultimately have "typ_ok_sig \<Sigma> (U \<rightarrow> T)"
	+ using "5.IH"(2) "5.prems"(1) "5.prems"(2) "5.prems"(3) term_ok'.simps(4) by blast
	+ then show ?case
	+ by (auto simp add: bind_eq_Some_conv split: option.splits if_splits)
	+qed (auto simp add: bind_eq_Some_conv split: option.splits if_splits)
	+
	+(* This might now be doable with just prod rules *)
	+lemma theory_full_exhaust: "(\<And>cto tao sorts axioms.
	+ \<Theta> = ((cto, tao, sorts), axioms) \<Longrightarrow> P)
	+ \<Longrightarrow> P"
	+ apply (cases \<Theta>) subgoal for \<Sigma> axioms apply (cases \<Sigma>) by auto done
	+
	+definition [simp]: "typ_ok \<Theta> T \<equiv> wf_type (sig \<Theta>) T"
	+definition [simp]: "term_ok \<Theta> t \<equiv> wt_term (sig \<Theta>) t"
	+
	+corollary typ_of_subst_bv_no_change: "typ_of t \<noteq> None \<Longrightarrow> subst_bv u t = t"
	+ using closed_subst_bv_no_change typ_of_imp_closed by auto
	+corollary term_ok_subst_bv_no_change: "term_ok \<Theta> t \<Longrightarrow> subst_bv u t = t"
	+ using typ_of_subst_bv_no_change wt_term_def by auto
	+
	+lemmas eq_axs_def = eq_reflexive_ax_def eq_symmetric_ax_def eq_transitive_ax_def eq_intr_ax_def
	+ eq_elim_ax_def eq_combination_ax_def eq_abstract_rule_ax_def
	+
	+bundle eq_axs_simp
	+begin
	+declare eq_axs_def[simp]
	+declare mk_all_list_def[simp] add_vars'_def[simp] bind_eq_Some_conv[simp] bind_fv_def[simp]
	+end
	+
	+lemma typ_of_eq_ax: "typ_of (eq_reflexive_ax) = Some propT"
	+ "typ_of (eq_symmetric_ax) = Some propT"
	+ "typ_of (eq_transitive_ax) = Some propT"
	+ "typ_of (eq_intr_ax) = Some propT"
	+ "typ_of (eq_elim_ax) = Some propT"
	+ "typ_of (eq_combination_ax) = Some propT"
	+ "typ_of (eq_abstract_rule_ax) = Some propT"
	+ by (auto simp add: typ_of_def eq_axs_def mk_all_list_def add_vars'_def bind_eq_Some_conv bind_fv_def)
	+
	+lemma term_ok_eq_ax:
	+ assumes "is_std_sig (sig \<Theta>)"
	+ shows "term_ok \<Theta> (eq_reflexive_ax)"
	+ "term_ok \<Theta> (eq_symmetric_ax)"
	+ "term_ok \<Theta> (eq_transitive_ax)"
	+ "term_ok \<Theta> (eq_intr_ax)"
	+ "term_ok \<Theta> (eq_elim_ax)"
	+ "term_ok \<Theta> (eq_combination_ax)"
	+ "term_ok \<Theta> (eq_abstract_rule_ax)"
	+ using assms
	+ by (all \<open>cases \<Theta> rule: theory_full_exhaust\<close>)
	+ (auto simp add: wt_term_def typ_of_def tinstT_def eq_axs_def bind_eq_Some_conv
	+ bind_fv_def sort_ex_def normalize_sort_def mk_all_list_def add_vars'_def wf_sort_def)
	+
	+lemma wf_theory_imp_is_std_sig: "wf_theory \<Theta> \<Longrightarrow> is_std_sig (sig \<Theta>)"
	+ by (cases \<Theta> rule: theory_full_exhaust) simp
	+lemma wf_theory_imp_wf_sig: "wf_theory \<Theta> \<Longrightarrow> wf_sig (sig \<Theta>)"
	+ by (cases \<Theta> rule: theory_full_exhaust) simp
	+
	+lemma
	+ term_ok_imp_typ_ok:
	+ "wf_theory thy \<Longrightarrow> term_ok thy t \<Longrightarrow> typ_of t = Some ty \<Longrightarrow> typ_ok thy ty"
	+ apply (cases thy)
	+ using term_ok_imp_typ_ok_pre term_ok_def
	+ by (metis list.pred_inject(1) wt_term_def wf_theory_imp_is_std_sig typ_of_def typ_ok_def wf_type_iff_typ_ok_sig)
	+
	+lemma axioms_terms_ok: "wf_theory thy \<Longrightarrow> A\<in>axioms thy \<Longrightarrow> term_ok thy A"
	+ using wt_term_def by (cases thy rule: theory_full_exhaust) simp
	+
	+lemma axioms_typ_of_propT: "wf_theory thy \<Longrightarrow> A\<in>axioms thy \<Longrightarrow> typ_of A = Some propT"
	+ using has_typ_iff_typ_of by (cases thy rule: theory_full_exhaust) simp
	+
	+lemma propT_ok[simp]: "wf_theory \<Theta> \<Longrightarrow> typ_ok \<Theta> propT"
	+ using term_ok_imp_typ_ok wf_theory.elims(2)
	+ by (metis sig.simps term_ok_eq_ax(4) typ_of_eq_ax(4))
	+
	+lemma term_ok_mk_eqD: "term_ok \<Theta> (mk_eq s t) \<Longrightarrow> term_ok \<Theta> s \<and> term_ok \<Theta> t"
	+ using term_ok'.simps(4) wt_term_def typ_of_def by (auto simp add: bind_eq_Some_conv)
	+lemma term_ok_app_eqD: "term_ok \<Theta> (s $ t) \<Longrightarrow> term_ok \<Theta> s \<and> term_ok \<Theta> t"
	+ using term_ok'.simps(4) wt_term_def typ_of_def by (auto simp add: bind_eq_Some_conv)
	+
	+lemma wf_type_Type_imp_mgd:
	+ "wf_sig \<Sigma> \<Longrightarrow> wf_type \<Sigma> (Ty n Ts) \<Longrightarrow> tcsigs (osig \<Sigma>) n \<noteq> None"
	+ by (cases \<Sigma>) (auto split: option.splits)
	+
	+lemma term_ok_eta_expand:
	+ assumes "wf_theory \<Theta>" "term_ok \<Theta> f" "typ_of f = Some (\<tau> \<rightarrow> \<tau>')" "typ_ok \<Theta> \<tau>"
	+ shows "term_ok \<Theta> (Abs \<tau> (f $ Bv 0))"
	+ using assms typ_of_eta_expand by (auto simp add: wt_term_def)
	+
	+lemma term_ok'_incr_bv: "term_ok' \<Sigma> t \<Longrightarrow> term_ok' \<Sigma> (incr_bv inc lev t)"
	+ by (induction inc lev t rule: incr_bv.induct) auto
	+
	+lemma term_ok'_subst_bv2: "term_ok' \<Sigma> s \<Longrightarrow> term_ok' \<Sigma> u \<Longrightarrow> term_ok' \<Sigma> (subst_bv2 s lev u)"
	+ by (induction s lev u rule: subst_bv2.induct) (auto simp add: term_ok'_incr_bv)
	+
	+lemma term_ok'_subst_bv: "term_ok' \<Sigma> (Abs T t) \<Longrightarrow> term_ok' \<Sigma> (subst_bv (Fv x T) t)"
	+ by (simp add: substn_subst_0' term_ok'_subst_bv2)
	+lemma term_ok_subst_bv: "term_ok \<Theta> (Abs T t) \<Longrightarrow> term_ok \<Theta> (subst_bv (Fv x T) t)"
	+ apply (simp add: term_ok'_subst_bv wt_term_def)
	+ using subst_bv_def typ_of1_subst_bv_gen' typ_of_Abs_body_typ' typ_of_def by fastforce
	+
	+lemma term_ok_subst_bv2_0: "term_ok \<Theta> (Abs T t) \<Longrightarrow> term_ok \<Theta> (subst_bv2 t 0 (Fv x T))"
	+ apply (clarsimp simp add: term_ok'_subst_bv2 wt_term_def)
	+ using substn_subst_0' typ_of1_subst_bv_gen' typ_of_Abs_body_typ' typ_of_def
	+ wt_term_def term_ok_subst_bv by auto
	+
	+lemma has_sort_empty[simp]:
	+ assumes "wf_sig \<Sigma>" "wf_type \<Sigma> T"
	+ shows "has_sort (osig \<Sigma>) T full_sort"
	+proof(cases T)
	+ case (Ty n Ts)
	+ obtain cl tcs where cltcs: "osig \<Sigma> = (cl, tcs)"
	+ by fastforce
	+ obtain mgd where mgd: "tcsigs (osig \<Sigma>) n = Some mgd"
	+ using wf_type_Type_imp_mgd assms Ty by blast
	+ show ?thesis
	+ using mgd cltcs by (auto simp add: Ty intro!: has_sort_Ty)
	+next
	+ case (Tv v S)
	+ then show ?thesis
	+ by (cases "osig \<Sigma>") (auto simp add: sort_leq_def split: prod.splits)
	+qed
	+
	+lemma typ_Fv_of_full_sort[simp]:
	+ "wf_theory \<Theta> \<Longrightarrow> term_ok \<Theta> (Fv v T) \<Longrightarrow> has_sort (osig (sig \<Theta>)) T full_sort"
	+ by (simp add: wt_term_def wf_theory_imp_wf_sig)
	+
	+end
	diff --git a/thys/Metalogic_ProofChecker/TheoryExe.thy b/thys/Metalogic_ProofChecker/TheoryExe.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/TheoryExe.thy
	@@ -0,0 +1,411 @@
	+section "Executable Signature and Theory"
	+
	+(* Proofs are ugly, clean up if time *)
	+
	+theory TheoryExe
	+ imports SortsExe Theory Instances
	+begin
	+
	+datatype exesignature = ExeSignature
	+ (execonst_type_of: "(name \<times> typ) list")
	+ (exetyp_arity_of: "(name \<times> nat) list")
	+ (exesorts: exeosig)
	+
	+lemma exe_const_type_of_ok: "
	+ alist_conds cto \<Longrightarrow>
	+ (\<forall>ty \<in> Map.ran (map_of cto) . typ_ok_sig (map_of cto, ta, sa) ty)
	+ \<longleftrightarrow> (\<forall>ty \<in> snd ` set cto . typ_ok_sig (map_of cto, ta, sa) ty)"
	+ by (simp add: ran_distinct)
	+
	+fun exe_wf_sig where
	+ "exe_wf_sig (ExeSignature cto tao sa) = (exe_wf_osig sa \<and>
	+ fst ` set (exetcsigs sa) = fst ` set tao
	+ \<and> (\<forall>type \<in> fst ` set (exetcsigs sa).
	+ (\<forall>ars \<in> snd ` set (the (lookup (\<lambda>k. k=type) (exetcsigs sa))) .
	+ the (lookup (\<lambda>k. k=type) tao) = length ars))
	+ \<and> (\<forall>ty \<in> snd ` set cto . typ_ok_sig (map_of cto, map_of tao, translate_osig sa) ty))"
	+
	+lemma exe_wf_sig_imp_wf_sig:
	+ assumes "alist_conds cto" "alist_conds tao" "exe_osig_conds sa" "(exe_wf_osig sa
	+ \<and> fst ` set (exetcsigs sa) = fst ` set tao
	+ \<and> (\<forall>type \<in> fst ` set (exetcsigs sa).
	+ (\<forall>ars \<in> snd ` set (the (lookup (\<lambda>k. k=type) (exetcsigs sa))) .
	+ the (lookup (\<lambda>k. k=type) tao) = length ars)))
	+ \<and> (\<forall>ty \<in> snd ` set cto . typ_ok_sig (map_of cto, map_of tao, translate_osig sa) ty)"
	+ shows "wf_sig (map_of cto, map_of tao, translate_osig sa)"
	+proof-
	+ {
	+ fix type y
	+ assume p: "exe_osig_conds sa" "trans (fst (translate_osig sa))" "snd (translate_osig sa) type = Some y"
	+ hence "exe_ars_conds (exetcsigs sa)"
	+ using exe_osig_conds_def by blast
	+ from p have "translate_ars (exetcsigs sa) type = Some y"
	+ by (metis snd_conv translate_osig.elims)
	+ hence "(type, y) \<in> set (map (apsnd map_of) (exetcsigs sa))"
	+ using map_of_SomeD by force
	+ hence "type \<in> fst ` set (exetcsigs sa)" by force
	+ from this obtain x where "lookup (\<lambda>x. x=type) (exetcsigs sa) = Some x"
	+ using key_present_imp_eq_lookup_finds_value by metis
	+ hence "map_of x = y"
	+ by (metis \<open>exe_ars_conds (snd sa)\<close> \<open>translate_ars (snd sa) type = Some y\<close>
	+ exe_ars_conds_def in_alist_imp_in_map_of lookup_eq_map_of_ap
	+ map_of_SomeD option.sel)
	+ have "\<exists>y. (type, y) \<in> set tao"
	+ using \<open>type \<in> fst ` set (exetcsigs sa)\<close> assms(4) by auto
	+ }
	+ note 1 = this
	+
	+ {
	+ fix ars type y
	+ assume p: "exe_osig_conds sa"
	+ "trans (fst (translate_osig sa))"
	+ "\<forall>x\<in>set cto. typ_ok_sig (map_of cto, map_of tao, translate_osig sa) (snd x)"
	+ "ars \<in> ran y"
	+ "snd (translate_osig sa) type = Some y"
	+
	+ hence "exe_ars_conds (exetcsigs sa)"
	+ using exe_osig_conds_def by blast
	+ from p(1-2) p(5) have "translate_ars (exetcsigs sa) type = Some y"
	+ by (metis snd_conv translate_osig.elims)
	+ hence "(type, y) \<in> set (map (apsnd map_of) (exetcsigs sa))"
	+ using map_of_SomeD by force
	+ hence dom: "type \<in> fst ` set (exetcsigs sa)" by force
	+ from this obtain x where x: "lookup (\<lambda>x. x=type) (exetcsigs sa) = Some x"
	+ using key_present_imp_eq_lookup_finds_value by metis
	+ hence "map_of x = y"
	+ by (metis \<open>exe_ars_conds (snd sa)\<close> \<open>translate_ars (snd sa) type = Some y\<close>
	+ exe_ars_conds_def in_alist_imp_in_map_of lookup_eq_map_of_ap map_of_SomeD option.sel)
	+ have "ars \<in> snd ` set x"
	+ by (metis \<open>map_of x = y\<close> image_iff in_range_if_ex_key map_of_SomeD p(4) snd_conv)
	+
	+ have "type \<in> fst ` set tao"
	+ apply (simp add: \<open>type \<in> fst ` set (exetcsigs sa)\<close> assms(4))
	+ using assms(4) dom by blast
	+ moreover have 1: "(\<forall>ars \<in> snd ` set (the (lookup (\<lambda>k. k=type) (exetcsigs sa))) .
	+ the (lookup (\<lambda>k. k=type) tao) = length ars)"
	+ using \<open>type \<in> fst ` set (exetcsigs sa)\<close> assms(4) by blast
	+
	+ ultimately have "the (lookup (\<lambda>k. k = type) tao) = length ars"
	+ using \<open>lookup (\<lambda>x. x = type) (exetcsigs sa) = Some x\<close> \<open>map_of x = y\<close>
	+ in_range_if_ex_key map_of_SomeD option.sel p(3) snd_conv
	+ by (simp add: 1 \<open>ars \<in> snd ` set x\<close>)
	+ hence "the (map_of tao type) = length ars"
	+ by (metis \<open>the (lookup (\<lambda>k. k = type) tao) = length ars\<close> lookup_eq_map_of_ap)
	+ }
	+ note 2 = this
	+ {
	+ fix a b x y
	+ assume p: "fst ` set b = fst ` set tao"
	+ "(x, y) \<in> set tao"
	+ "sa = (a, b)"
	+
	+ have "x \<in> fst ` set b"
	+ by (metis fst_conv image_iff p(1) p(2))
	+ from this obtain ars where "lookup (\<lambda>k. k=x) b = Some ars"
	+ by (metis key_present_imp_eq_lookup_finds_value)
	+ hence "(x,ars) \<in> set b"
	+ by (simp add: lookup_present_eq_key')
	+ hence "lookup (\<lambda>k. k=x) (map (apsnd map_of) b) = Some (map_of ars)"
	+ by (metis assms(3) exe_ars_conds_def exe_osig_conds_def in_alist_imp_in_map_of
	+ lookup_eq_map_of_ap p(3) snd_conv translate_ars.simps)
	+ hence "\<exists>y. map_of (map (apsnd map_of) b) x = Some y"
	+ by (metis lookup_eq_map_of_ap)
	+ }
	+ note 3 = this
	+ {
	+ fix a b x
	+ assume p: "alist_conds cto"
	+ "x \<in> ran (map_of cto)"
	+ "sa = (a, b)"
	+ have "typ_ok_sig (map_of cto, map_of tao, set a, map_of (map (apsnd map_of) b)) x"
	+ using assms(4) p(1) p(2) p(3) ran_distinct by fastforce
	+ }
	+ note 4 = this
	+ have "wf_osig (translate_osig sa)"
	+ using assms(4) wf_osig_iff_exe_wf_osig by simp
	+ thus ?thesis apply (cases sa)
	+ using 1 2 3 4 assms by auto
	+qed
	+
	+lemma wf_sig_imp_exe_wf_sig:
	+ assumes "alist_conds cto" "alist_conds tao" "exe_osig_conds sa"
	+ "wf_sig (map_of cto, map_of tao, translate_osig sa)"
	+ shows "(exe_wf_osig sa
	+ \<and> fst ` set (exetcsigs sa) = fst ` set tao
	+ \<and> (\<forall>type \<in> fst ` set (exetcsigs sa).
	+ (\<forall>ars \<in> snd ` set (the (lookup (\<lambda>k. k=type) (exetcsigs sa))) .
	+ the (lookup (\<lambda>k. k=type) tao) = length ars)))
	+ \<and> (\<forall>ty \<in> snd ` set cto . typ_ok_sig (map_of cto, map_of tao, translate_osig sa) ty)"
	+proof-
	+ {
	+ fix a b x y
	+ assume p: "alist_conds tao"
	+ "exe_ars_conds b"
	+ "dom (map_of (map (apsnd map_of) b)) = dom (map_of tao)"
	+ "(x, y) \<in> set b"
	+
	+ hence "x \<in> fst ` set tao"
	+ by (metis domIff dom_map_of_conv_image_fst exe_ars_conds_def
	+ in_alist_imp_in_map_of option.distinct(1) translate_ars.simps)
	+ }
	+ note 1 = this
	+ {
	+ fix cl n ar and tcs :: "(String.literal \<times> (String.literal \<times> String.literal set list) list) list"
	+ assume p: "dom (map_of (map (apsnd map_of) tcs)) = dom (map_of tao)"
	+ "alist_conds tao"
	+ "(n, ar) \<in> set tao"
	+
	+ obtain mgd where "translate_ars tcs n = Some mgd"
	+ using p by (metis Some_eq_map_of_iff domI domIff option.exhaust_sel translate_ars.simps)
	+ hence "map_of (map (apsnd map_of) tcs) n = Some mgd"
	+ by (simp add: tcsigs_translate exe_osig_conds_def p)
	+ hence "n \<in> fst ` set (map (apsnd map_of) tcs)"
	+ by (meson domI domIff map_of_eq_None_iff)
	+ then have "n \<in> fst ` set tcs"
	+ by force
	+ }
	+ note 2 = this
	+ {
	+ fix cl tcs n K c Ss
	+ assume p: "(n, K) \<in> set tcs"
	+ "(c, Ss) \<in> set (the (lookup (\<lambda>k. k = n) tcs))"
	+ "exe_ars_conds tcs"
	+ "dom (map_of (map (apsnd map_of) tcs)) = dom (map_of tao)"
	+ "\<forall>type\<in>dom (map_of tao). \<forall>ars\<in>ran (the (map_of (map (apsnd map_of) tcs) type)).
	+ the (map_of tao type) = length ars"
	+
	+ have 1: "translate_ars tcs n = Some (map_of K)"
	+ using exe_ars_conds_def in_alist_imp_in_map_of p(1-3) by blast
	+ have 2: "map_of K c = Some Ss"
	+ using p(1-3)
	+ by (metis Some_eq_map_of_iff exe_ars_conds_def image_iff lookup_eq_map_of_ap
	+ option.sel snd_conv)
	+ have "the (lookup (\<lambda>k. k = n) tao) = length Ss"
	+ using 1 2 p(4,5)
	+ by (metis domIff lookup_eq_map_of_ap option.distinct(1) option.sel ranI translate_ars.simps)
	+ }
	+ note 3 = this
	+
	+ have 1: "wf_osig (translate_osig sa)" "dom (tcsigs (translate_osig sa)) = dom (map_of tao)"
	+ "(\<forall>type \<in> dom (tcsigs (translate_osig sa)).
	+ (\<forall>ars \<in> ran (the (tcsigs (translate_osig sa) type)) . the ((map_of tao) type) = length ars))"
	+ "(\<forall>ty \<in> Map.ran (map_of cto) . wf_type (map_of cto, map_of tao, translate_osig sa) ty)"
	+ using assms(4) by auto
	+ note pre = 1
	+
	+ have "exe_wf_osig sa"
	+ using "1"(1) wf_osig_iff_exe_wf_osig by blast
	+ moreover have "fst ` set (snd sa) = fst ` set tao"
	+ proof
	+ show "fst ` set (snd sa) \<subseteq> fst ` set tao"
	+ using assms(3-4)
	+ by (clarsimp simp add: dom_map_of_conv_image_fst exe_ars_conds_def exe_osig_conds_def)
	+ (metis tcsigs_translate assms(3) domIff in_alist_imp_in_map_of option.simps(3))
	+ next
	+ show "fst ` set (snd sa) \<supseteq> fst ` set tao"
	+ using "1"(2) "2" assms(2-3) tcsigs_translate by auto
	+ qed
	+ moreover have "(\<forall>type\<in>fst ` set (snd sa). \<forall>ars\<in>snd ` set (the (lookup (\<lambda>k. k = type) (snd sa))).
	+ the (lookup (\<lambda>k. k = type) tao) = length ars)"
	+ proof (standard+, goal_cases)
	+ case (1 n Ss)
	+ obtain c where c: "(c, Ss) \<in> set (the (lookup (\<lambda>k. k = n) (snd sa)))"
	+ using "1"(2) by force
	+ have "dom (map_of (map (apsnd map_of) (snd sa))) = dom (map_of tao)"
	+ using assms(3) pre(2) tcsigs_translate by fastforce
	+ show ?case
	+ using assms(3) pre(2) c tcsigs_translate pre(2-3) domI
	+ by (fastforce simp add: exe_osig_conds_def tcsigs_translate[OF assms(3)]
	+ "1"(1) key_present_imp_eq_lookup_finds_value lookup_present_eq_key'
	+ split: option.splits intro!: 3[of _ "the (lookup (\<lambda>k. k = n) (snd sa))" "snd sa" c])+
	+ qed
	+ moreover have "(\<forall>ty \<in> Map.ran (map_of cto) . wf_type (map_of cto, map_of tao, translate_osig sa) ty)"
	+ using "1"(4) by blast
	+ ultimately show ?thesis
	+ by (simp add: assms(1) ran_distinct)
	+qed
	+
	+lemma wf_sig_iff_exe_wf_sig_pre: "alist_conds cto \<Longrightarrow> alist_conds tao \<Longrightarrow> exe_osig_conds sa
	+ \<Longrightarrow> wf_sig (map_of cto, map_of tao, translate_osig sa) = (exe_wf_osig sa
	+ \<and> fst ` set (exetcsigs sa) = fst ` set tao
	+ \<and> (\<forall>type \<in> fst ` set (exetcsigs sa).
	+ (\<forall>ars \<in> snd ` set (the (lookup (\<lambda>k. k=type) (exetcsigs sa))) .
	+ the (lookup (\<lambda>k. k=type) tao) = length ars))
	+ \<and> (\<forall>ty \<in> snd ` set cto . typ_ok_sig (map_of cto, map_of tao, translate_osig sa) ty))"
	+ using exe_wf_sig_imp_wf_sig wf_sig_imp_exe_wf_sig by meson
	+
	+lemma wf_sig_iff_exe_wf_sig: "alist_conds cto \<Longrightarrow> alist_conds tao \<Longrightarrow> exe_osig_conds sa
	+ \<Longrightarrow> wf_sig (map_of cto, map_of tao, translate_osig sa)
	+ \<longleftrightarrow> exe_wf_sig (ExeSignature cto tao sa)"
	+ unfolding exe_wf_sig.simps
	+ using wf_sig_iff_exe_wf_sig_pre by presburger
	+
	+fun translate_signature :: "exesignature \<Rightarrow> signature" where
	+ "translate_signature (ExeSignature cto tao sa)
	+ = (map_of cto, map_of tao, translate_osig sa)"
	+
	+fun exetyp_ok_sig :: "exesignature \<Rightarrow> typ \<Rightarrow> bool" where
	+ "exetyp_ok_sig \<Sigma> (Ty c Ts) = (case lookup (\<lambda>k. k=c) (exetyp_arity_of \<Sigma>) of
	+ None \<Rightarrow> False
	+ \| Some ar \<Rightarrow> length Ts = ar \<and> list_all (exetyp_ok_sig \<Sigma>) Ts)"
	+\| "exetyp_ok_sig \<Sigma> (Tv _ S) = exewf_sort (execlasses (exesorts \<Sigma>)) S"
	+
	+thm exewf_sort_def
	+definition [simp]: "exesort_ok_sig \<Sigma> S \<equiv> exesort_ex (execlasses (exesorts \<Sigma>)) S
	+ \<and> exenormalized_sort (execlasses (exesorts \<Sigma>)) S"
	+
	+lemma typ_arity_lookup_code: "type_arity (translate_signature \<Sigma>) n = lookup (\<lambda>k. k = n) (exetyp_arity_of \<Sigma>)"
	+ by (cases \<Sigma>) (simp add: lookup_eq_map_of_ap)
	+
	+lemma typ_ok_sig_code:
	+ assumes "exe_osig_conds (exesorts \<Sigma>)"
	+ shows "typ_ok_sig (translate_signature \<Sigma>) ty = exetyp_ok_sig \<Sigma> ty"
	+ using assms apply (induction ty) apply simp
	+ apply (auto split: option.splits simp add: wf_sort_def list_all_iff typ_arity_lookup_code)[]
	+ using wf_sort_code by (cases \<Sigma>) (simp add: exe_osig_conds_def classes_translate)
	+
	+fun exe_wf_sig' where
	+ "exe_wf_sig' (ExeSignature cto tao sa) = (exe_wf_osig sa \<and>
	+ fst ` set (exetcsigs sa) = fst ` set tao
	+ \<and> (\<forall>type \<in> fst ` set (exetcsigs sa).
	+ (\<forall>ars \<in> snd ` set (the (lookup (\<lambda>k. k=type) (exetcsigs sa))) .
	+ the (lookup (\<lambda>k. k=type) tao) = length ars))
	+ \<and> (\<forall>ty \<in> snd ` set cto . exetyp_ok_sig (ExeSignature cto tao sa) ty))"
	+
	+lemma exe_wf_sig_code[code]: "exe_wf_sig \<Sigma> = exe_wf_sig' \<Sigma>"
	+ using typ_ok_sig_code by (cases \<Sigma>, simp, metis exesignature.sel(3) translate_signature.simps)
	+
	+fun exeterm_ok' :: "exesignature \<Rightarrow> term \<Rightarrow> bool" where
	+ "exeterm_ok' \<Sigma> (Fv _ T) = exetyp_ok_sig \<Sigma> T"
	+\| "exeterm_ok' \<Sigma> (Bv _) = True"
	+\| "exeterm_ok' \<Sigma> (Ct s T) = (case lookup (\<lambda>k. k=s) (execonst_type_of \<Sigma>) of
	+ None \<Rightarrow> False
	+ \| Some ty \<Rightarrow> exetyp_ok_sig \<Sigma> T \<and> tinstT T ty)"
	+\| "exeterm_ok' \<Sigma> (t $ u) \<longleftrightarrow> exeterm_ok' \<Sigma> t \<and> exeterm_ok' \<Sigma> u"
	+\| "exeterm_ok' \<Sigma> (Abs T t) \<longleftrightarrow> exetyp_ok_sig \<Sigma> T \<and> exeterm_ok' \<Sigma> t"
	+
	+lemma const_type_of_lookup_code: "const_type (translate_signature \<Sigma>) n = lookup (\<lambda>k. k = n) (execonst_type_of \<Sigma>)"
	+ by (cases \<Sigma>) (simp add: lookup_eq_map_of_ap)
	+
	+lemma wt_term_code:
	+ assumes "exe_osig_conds (exesorts \<Sigma>)"
	+ shows "term_ok' (translate_signature \<Sigma>) t = exeterm_ok' \<Sigma> t"
	+ by (induction t) (auto simp add: const_type_of_lookup_code assms typ_ok_sig_code split: option.splits)
	+
	+datatype exetheory = ExeTheory (exesig: exesignature) (exeaxioms_of: "term list")
	+
	+lemma exetheory_full_exhaust: "(\<And>const_type typ_arity sorts axioms.
	+ \<Theta> = (ExeTheory (ExeSignature const_type typ_arity sorts) axioms) \<Longrightarrow> P)
	+ \<Longrightarrow> P"
	+ apply (cases \<Theta>) subgoal for \<Sigma> axioms apply (cases \<Sigma>) by auto done
	+
	+definition "exe_sig_conds \<Sigma> \<equiv> alist_conds (execonst_type_of \<Sigma>) \<and> alist_conds (exetyp_arity_of \<Sigma>)
	+ \<and> exe_osig_conds (exesorts \<Sigma>)"
	+
	+abbreviation "illformed_theory \<equiv> ((Map.empty, Map.empty, illformed_osig), {})"
	+
	+lemma illformed_theory_not_wf_theory: "\<not> wf_theory illformed_theory"
	+ by simp
	+
	+fun translate_theory :: "exetheory \<Rightarrow> theory" where
	+ "translate_theory (ExeTheory \<Sigma> ax) = (if exe_sig_conds \<Sigma> then
	+ (translate_signature \<Sigma>, set ax) else illformed_theory)"
	+
	+fun exe_wf_theory where "exe_wf_theory (ExeTheory (ExeSignature cto tao sa) ax) \<longleftrightarrow>
	+ exe_sig_conds (ExeSignature cto tao sa) \<and>
	+ (\<forall>p \<in> set ax . term_ok (translate_theory (ExeTheory (ExeSignature cto tao sa) ax)) p \<and> typ_of p = Some propT)
	+ \<and> is_std_sig (translate_signature (ExeSignature cto tao sa))
	+ \<and> exe_wf_sig (ExeSignature cto tao sa)
	+ \<and> eq_axs \<subseteq> set ax"
	+
	+lemma wf_sig_iff_exe_wf_sig': "exe_sig_conds \<Sigma> \<Longrightarrow>
	+ wf_sig (translate_signature \<Sigma>) \<longleftrightarrow>
	+ exe_wf_sig \<Sigma>"
	+ by (metis exe_sig_conds_def exesignature.exhaust_sel wf_sig_iff_exe_wf_sig translate_signature.simps)
	+
	+lemma wf_sig_imp_exe_wf_sig': "exe_sig_conds \<Sigma> \<Longrightarrow>
	+ wf_sig (translate_signature \<Sigma>) \<Longrightarrow>
	+ exe_wf_sig \<Sigma>"
	+ by (metis exe_sig_conds_def exesignature.exhaust_sel wf_sig_iff_exe_wf_sig translate_signature.simps)
	+
	+lemma exe_wf_sig_imp_wf_sig': "exe_sig_conds \<Sigma> \<Longrightarrow>
	+ exe_wf_sig \<Sigma>
	+ \<Longrightarrow> wf_sig (translate_signature \<Sigma>)"
	+ by (metis exe_sig_conds_def exesignature.exhaust_sel wf_sig_iff_exe_wf_sig translate_signature.simps)
	+
	+lemma wf_theory_translate_imp_exe_wf_theory:
	+ assumes "wf_theory (translate_theory a)" shows "exe_wf_theory a"
	+proof-
	+ have "exe_sig_conds (exesig a)" using assms
	+ by (metis exetheory.collapse illformed_theory_not_wf_theory translate_theory.simps)
	+ moreover have "wf_sig (translate_signature (exesig a))
	+ \<longleftrightarrow> exe_wf_sig (exesig a)"
	+ by (simp add: calculation(1) wf_sig_iff_exe_wf_sig')
	+ ultimately show ?thesis using assms
	+ by (cases a rule: exe_wf_theory.cases) (fastforce simp add: image_iff eq_fst_iff)
	+qed
	+
	+lemma exe_wf_theory_translate_imp_wf_theory:
	+ assumes "exe_wf_theory a" shows "wf_theory (translate_theory a)"
	+proof-
	+ have "exe_sig_conds (exesig a)" using assms
	+ by (metis (full_types) exe_wf_theory.simps exesignature.exhaust_sel exetheory.sel(1) translate_theory.cases)
	+ moreover hence "
	+ (\<forall>ty \<in> Map.ran (map_of (execonst_type_of (exesig a))) . typ_ok_sig (translate_signature (exesig a)) ty)
	+ \<longleftrightarrow> (\<forall>ty \<in> snd ` set (execonst_type_of (exesig a)) . typ_ok_sig (translate_signature (exesig a)) ty)"
	+ by (simp add: exe_sig_conds_def ran_distinct)
	+ moreover have "wf_sig (translate_signature (exesig a))
	+ \<longleftrightarrow> exe_wf_sig (exesig a)"
	+ by (simp add: calculation(1) wf_sig_iff_exe_wf_sig')
	+ ultimately show ?thesis
	+ using assms by (cases a rule: exe_wf_theory.cases) auto
	+qed
	+
	+lemma wf_theory_translate_iff_exe_wf_theory:
	+ "wf_theory (translate_theory a) \<longleftrightarrow> exe_wf_theory a"
	+ using exe_wf_theory_translate_imp_wf_theory wf_theory_translate_imp_exe_wf_theory by blast
	+
	+fun exeis_std_sig where "exeis_std_sig (ExeSignature cto tao sorts) \<longleftrightarrow>
	+ lookup (\<lambda>k. k = STR ''fun'') tao = Some 2 \<and> lookup (\<lambda>k. k = STR ''prop'') tao = Some 0
	+ \<and> lookup (\<lambda>k. k = STR ''itself'') tao = Some 1
	+ \<and> lookup (\<lambda>k. k = STR ''Pure.eq'') cto
	+ = Some ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> ((Tv (Var (STR '''a'', 0)) full_sort) \<rightarrow> propT))
	+ \<and> lookup (\<lambda>k. k = STR ''Pure.all'') cto = Some ((Tv (Var (STR '''a'', 0)) full_sort \<rightarrow> propT) \<rightarrow> propT)
	+ \<and> lookup (\<lambda>k. k = STR ''Pure.imp'') cto = Some (propT \<rightarrow> (propT \<rightarrow> propT))
	+ \<and> lookup (\<lambda>k. k = STR ''Pure.type'') cto = Some (itselfT (Tv (Var (STR '''a'', 0)) full_sort))"
	+
	+lemma is_std_sig_code: "is_std_sig (translate_signature \<Sigma>) = exeis_std_sig \<Sigma>"
	+ by (cases \<Sigma>) (auto simp add: lookup_eq_map_of_ap)
	+
	+fun exe_wf_theory' where "exe_wf_theory' (ExeTheory (ExeSignature cto tao sa) ax) \<longleftrightarrow>
	+ exe_sig_conds (ExeSignature cto tao sa) \<and>
	+ (\<forall>p \<in> set ax . exeterm_ok' (ExeSignature cto tao sa) p \<and> typ_of p = Some propT)
	+ \<and> exeis_std_sig (ExeSignature cto tao sa)
	+ \<and> exe_wf_sig (ExeSignature cto tao sa)
	+ \<and> eq_axs \<subseteq> set ax"
	+
	+lemma term_ok'_code:
	+ assumes "exe_osig_conds (exesorts (ExeSignature cto tao sa))"
	+ shows "(term_ok' (translate_signature (ExeSignature cto tao sa)) p \<and> typ_of p = Some propT)
	+ = (exeterm_ok' (ExeSignature cto tao sa) p \<and> typ_of p = Some propT)"
	+ using wt_term_code[OF assms] by force
	+
	+lemma term_ok_translate_code_step:
	+ assumes "exe_sig_conds (ExeSignature cto tao sa)"
	+ shows "(term_ok (translate_theory (ExeTheory (ExeSignature cto tao sa) ax)) p \<and> typ_of p = Some propT)
	+ = (term_ok' (translate_signature (ExeSignature cto tao sa)) p \<and> typ_of p = Some propT)"
	+ using assms by (auto simp add: wt_term_def split: if_splits)
	+
	+lemma term_ok_theory_cond_code:
	+ assumes "exe_sig_conds (ExeSignature cto tao sa)"
	+ shows"(\<forall>p \<in> set ax . term_ok (translate_theory (ExeTheory (ExeSignature cto tao sa) ax)) p \<and> typ_of p = Some propT)
	+ = (\<forall>p \<in> set ax . exeterm_ok' (ExeSignature cto tao sa) p \<and> typ_of p = Some propT)"
	+ using assms wf_term_imp_term_ok' exe_sig_conds_def wt_term_code
	+ by (fastforce simp add: term_ok_translate_code_step wt_term_code wt_term_def)
	+
	+lemma exe_wf_theory_code[code]: "exe_wf_theory \<Theta> = exe_wf_theory' \<Theta>"
	+ apply (cases \<Theta> rule: exetheory_full_exhaust)
	+ apply (simp only: exe_wf_theory.simps exe_wf_theory'.simps)
	+ using term_ok_theory_cond_code is_std_sig_code by meson
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Metalogic_ProofChecker/document/root.bib b/thys/Metalogic_ProofChecker/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/document/root.bib
	@@ -0,0 +1,42 @@
	+@string{JAR="J. Automated Reasoning"}
	+@string{JFP="J. Functional Programming"}
	+@string{LNCS="Lect.\ Notes in Comp.\ Sci."}
	+@string{Springer="Springer"}
	+
	+@inproceedings{BerghoferN-TPHOLs00,author={Stefan Berghofer and Tobias Nipkow},
	+title={Proof terms for simply typed higher order logic},
	+booktitle={Theorem Proving in Higher Order Logics},
	+editor={J. Harrison and M. Aagaard},
	+year=2000,publisher=Springer,series=LNCS,volume=1869,pages="38--52"}
	+
	+
	+@article{Paulson-JAR-89,author="Lawrence C. Paulson",
	+title="The Foundation of a Generic Theorem Prover",
	+journal=JAR,year=1989,volume=5,pages="363--397"}
	+
	+
	+@inproceedings{tphol/Wenzel97,
	+ author = {Markus Wenzel},
	+ editor = {Elsa L. Gunter and
	+ Amy P. Felty},
	+ title = {Type Classes and Overloading in Higher-Order Logic},
	+ booktitle = {Theorem Proving in Higher Order Logics, {TPHOLs}'97},
	+ series = LNCS,
	+ volume = {1275},
	+ pages = {307--322},
	+ publisher = Springer,
	+ year = {1997},
	+ url = {https://doi.org/10.1007/BFb0028402},
	+}
	+
	+@misc{implementation, author={Makarius Wenzel}, title={The Isabelle/Isar Implementation},note={https://isabelle.in.tum.de/doc/implementation.pdf}}
	+
	+@inproceedings{cade28,
	+ author = {Tobias Nipkow and Simon Roßkopf},
	+ title = {Isabelle's Metalogic: Formalization and Proof Checker},
	+ editor = {A. Platzer, G. Sutcliffe},
	+ series = LNCS,
	+ booktitle = {28th International Conference on Automated Deduction (CADE-28)},
	+ publisher = Springer,
	+ year = {2021}
	+}
	diff --git a/thys/Metalogic_ProofChecker/document/root.tex b/thys/Metalogic_ProofChecker/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Metalogic_ProofChecker/document/root.tex
	@@ -0,0 +1,42 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+
	+\begin{document}
	+
	+\title{Isabelle's Metalogic: Formalization and Proof Checker}
	+\author{Tobias Nipkow and Simon Roßkopf}
	+\maketitle
	+
	+\begin{abstract}
	+In this entry we formalize Isabelle's metalogic in Isabelle/HOL. Furthermore, we define a language of proof terms and an executable proof checker and prove its soundness wrt. the metalogic.
	+
	+The formalization is intentionally kept close to the Isabelle implementation(for example using de Brujin indices) to enable easy integration of generated code with the Isabelle system without a complicated translation layer.
	+
	+The formalization is described in our CADE 28 paper\cite{cade28}.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+% include generated text of all theories
	+\input{session}
	+
	+\nocite{BerghoferN-TPHOLs00}
	+\nocite{Paulson-JAR-89}
	+\nocite{tphol/Wenzel97}
	+\nocite{implementation}
	+
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	diff --git a/thys/Padic_Ints/Cring_Poly.thy b/thys/Padic_Ints/Cring_Poly.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Cring_Poly.thy
	@@ -0,0 +1,7052 @@
	+theory Cring_Poly
	+ imports "HOL-Algebra.UnivPoly" "HOL-Algebra.Subrings" Function_Ring
	+begin
	+
	+text\<open>
	+ This theory extends the material in \<^theory>\<open>HOL-Algebra.UnivPoly\<close>. The main additions are
	+ material on Taylor expansions of polynomials and polynomial derivatives, and various applications
	+ of the universal property of polynomial evaluation. These include construing polynomials as
	+ functions from the base ring to itself, composing one polynomial with another, and extending
	+ homomorphisms between rings to homomoprhisms of their polynomial rings. These formalizations
	+ are necessary components of the proof of Hensel's lemma for $p$-adic integers, and for the
	+ proof of $p$-adic quantifier elimination. \<close>
	+
	+lemma(in ring) ring_hom_finsum:
	+ assumes "h \<in> ring_hom R S"
	+ assumes "ring S"
	+ assumes "finite I"
	+ assumes "F \<in> I \<rightarrow> carrier R"
	+ shows "h (finsum R F I) = finsum S (h \<circ> F) I"
	+proof-
	+ have I: "(h \<in> ring_hom R S \<and> F \<in> I \<rightarrow> carrier R) \<longrightarrow> h (finsum R F I) = finsum S (h \<circ> F) I"
	+ apply(rule finite_induct, rule assms)
	+ using assms ring_hom_zero[of h R S]
	+ apply (metis abelian_group_def abelian_monoid.finsum_empty is_ring ring_def)
	+ proof(rule)
	+ fix A a
	+ assume A: "finite A" "a \<notin> A" "h \<in> ring_hom R S \<and> F \<in> A \<rightarrow> carrier R \<longrightarrow>
	+ h (finsum R F A) = finsum S (h \<circ> F) A" "h \<in> ring_hom R S \<and> F \<in> insert a A \<rightarrow> carrier R"
	+ have 0: "h \<in> ring_hom R S \<and> F \<in> A \<rightarrow> carrier R "
	+ using A by auto
	+ have 1: "h (finsum R F A) = finsum S (h \<circ> F) A"
	+ using A 0 by auto
	+ have 2: "abelian_monoid S"
	+ using assms ring_def abelian_group_def by auto
	+ have 3: "h (F a \<oplus> finsum R F A) = h (F a) \<oplus>\<^bsub>S\<^esub> (finsum S (h \<circ> F) A) "
	+ using ring_hom_add assms finsum_closed 1 A(4) by fastforce
	+ have 4: "finsum R F (insert a A) = F a \<oplus> finsum R F A"
	+ using finsum_insert[of A a F] A assms by auto
	+ have 5: "finsum S (h \<circ> F) (insert a A) = (h \<circ> F) a \<oplus>\<^bsub>S\<^esub> finsum S (h \<circ> F) A"
	+ apply(rule abelian_monoid.finsum_insert[of S A a "h \<circ> F"])
	+ apply (simp add: "2")
	+ apply(rule A)
	+ apply(rule A)
	+ using ring_hom_closed A "0" apply fastforce
	+ using A ring_hom_closed by auto
	+ show "h (finsum R F (insert a A)) =
	+ finsum S (h \<circ> F) (insert a A)"
	+ unfolding 4 5 3 by auto
	+ qed
	+ thus ?thesis using assms by blast
	+qed
	+
	+lemma(in ring) ring_hom_a_inv:
	+ assumes "ring S"
	+ assumes "h \<in> ring_hom R S"
	+ assumes "b \<in> carrier R"
	+ shows "h (\<ominus> b) = \<ominus>\<^bsub>S\<^esub> h b"
	+proof-
	+ have "h b \<oplus>\<^bsub>S\<^esub> h (\<ominus> b) = \<zero>\<^bsub>S\<^esub>"
	+ by (metis (no_types, hide_lams) abelian_group.a_inv_closed assms(1) assms(2) assms(3)
	+ is_abelian_group local.ring_axioms r_neg ring_hom_add ring_hom_zero)
	+ then show ?thesis
	+ by (metis (no_types, lifting) abelian_group.minus_equality add.inv_closed assms(1)
	+ assms(2) assms(3) ring.is_abelian_group ring.ring_simprules(10) ring_hom_closed)
	+qed
	+
	+lemma(in ring) ring_hom_minus:
	+ assumes "ring S"
	+ assumes "h \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "h (a \<ominus> b) = h a \<ominus>\<^bsub>S\<^esub> h b"
	+ using assms ring_hom_add[of h R S a "\<ominus>\<^bsub>R\<^esub> b"]
	+ unfolding a_minus_def
	+ using ring_hom_a_inv[of S h b] by auto
	+
	+lemma ring_hom_nat_pow:
	+ assumes "ring R"
	+ assumes "ring S"
	+ assumes "h \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ shows "h (a[^]\<^bsub>R\<^esub>(n::nat)) = (h a)[^]\<^bsub>S\<^esub>(n::nat)"
	+ using assms by (simp add: ring_hom_ring.hom_nat_pow ring_hom_ringI2)
	+
	+lemma (in ring) Units_not_right_zero_divisor:
	+ assumes "a \<in> Units R"
	+ assumes "b \<in> carrier R"
	+ assumes "a \<otimes> b = \<zero>"
	+ shows "b = \<zero>"
	+proof-
	+ have "inv a \<otimes> a \<otimes> b = \<zero> "
	+ using assms Units_closed Units_inv_closed r_null m_assoc[of "inv a" a b] by presburger
	+ thus ?thesis using assms
	+ by (metis Units_l_inv l_one)
	+qed
	+
	+lemma (in ring) Units_not_left_zero_divisor:
	+ assumes "a \<in> Units R"
	+ assumes "b \<in> carrier R"
	+ assumes "b \<otimes> a = \<zero>"
	+ shows "b = \<zero>"
	+proof-
	+ have "b \<otimes> (a \<otimes> inv a) = \<zero> "
	+ using assms Units_closed Units_inv_closed l_null m_assoc[of b a"inv a"] by presburger
	+ thus ?thesis using assms
	+ by (metis Units_r_inv r_one)
	+qed
	+
	+lemma (in cring) finsum_remove:
	+ assumes "\<And>i. i \<in> Y \<Longrightarrow> f i \<in> carrier R"
	+ assumes "finite Y"
	+ assumes "i \<in> Y"
	+ shows "finsum R f Y = f i \<oplus> finsum R f (Y - {i})"
	+proof-
	+ have "finsum R f (insert i (Y - {i})) = f i \<oplus> finsum R f (Y - {i})"
	+ apply(rule finsum_insert)
	+ using assms apply blast apply blast using assms apply blast
	+ using assms by blast
	+ thus ?thesis using assms
	+ by (metis insert_Diff)
	+qed
	+
	+
	+type_synonym degree = nat
	+text\<open>The composition of two ring homomorphisms is a ring homomorphism\<close>
	+lemma ring_hom_compose:
	+ assumes "ring R"
	+ assumes "ring S"
	+ assumes "ring T"
	+ assumes "h \<in> ring_hom R S"
	+ assumes "g \<in> ring_hom S T"
	+ assumes "\<And>c. c \<in> carrier R \<Longrightarrow> f c = g (h c)"
	+ shows "f \<in> ring_hom R T"
	+proof(rule ring_hom_memI)
	+ show "\<And>x. x \<in> carrier R \<Longrightarrow> f x \<in> carrier T"
	+ using assms by (metis ring_hom_closed)
	+ show " \<And>x y. x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> f (x \<otimes>\<^bsub>R\<^esub> y) = f x \<otimes>\<^bsub>T\<^esub> f y"
	+ proof-
	+ fix x y
	+ assume A: "x \<in> carrier R" "y \<in> carrier R"
	+ show "f (x \<otimes>\<^bsub>R\<^esub> y) = f x \<otimes>\<^bsub>T\<^esub> f y"
	+ proof-
	+ have "f (x \<otimes>\<^bsub>R\<^esub> y) = g (h (x \<otimes>\<^bsub>R\<^esub> y))"
	+ by (simp add: A(1) A(2) assms(1) assms(6) ring.ring_simprules(5))
	+ then have "f (x \<otimes>\<^bsub>R\<^esub> y) = g ((h x) \<otimes>\<^bsub>S\<^esub> (h y))"
	+ using A(1) A(2) assms(4) ring_hom_mult by fastforce
	+ then have "f (x \<otimes>\<^bsub>R\<^esub> y) = g (h x) \<otimes>\<^bsub>T\<^esub> g (h y)"
	+ using A(1) A(2) assms(4) assms(5) ring_hom_closed ring_hom_mult by fastforce
	+ then show ?thesis
	+ by (simp add: A(1) A(2) assms(6))
	+ qed
	+ qed
	+ show "\<And>x y. x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> f (x \<oplus>\<^bsub>R\<^esub> y) = f x \<oplus>\<^bsub>T\<^esub> f y"
	+ proof-
	+ fix x y
	+ assume A: "x \<in> carrier R" "y \<in> carrier R"
	+ show "f (x \<oplus>\<^bsub>R\<^esub> y) = f x \<oplus>\<^bsub>T\<^esub> f y"
	+ proof-
	+ have "f (x \<oplus>\<^bsub>R\<^esub> y) = g (h (x \<oplus>\<^bsub>R\<^esub> y))"
	+ by (simp add: A(1) A(2) assms(1) assms(6) ring.ring_simprules(1))
	+ then have "f (x \<oplus>\<^bsub>R\<^esub> y) = g ((h x) \<oplus>\<^bsub>S\<^esub> (h y))"
	+ using A(1) A(2) assms(4) ring_hom_add by fastforce
	+ then have "f (x \<oplus>\<^bsub>R\<^esub> y) = g (h x) \<oplus>\<^bsub>T\<^esub> g (h y)"
	+ by (metis (no_types, hide_lams) A(1) A(2) assms(4) assms(5) ring_hom_add ring_hom_closed)
	+ then show ?thesis
	+ by (simp add: A(1) A(2) assms(6))
	+ qed
	+ qed
	+ show "f \<one>\<^bsub>R\<^esub> = \<one>\<^bsub>T\<^esub>"
	+ by (metis assms(1) assms(4) assms(5) assms(6) ring.ring_simprules(6) ring_hom_one)
	+qed
	+
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Basic Notions about Polynomials\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+context UP_ring
	+begin
	+
	+
	+text\<open>rings are closed under monomial terms\<close>
	+lemma monom_term_car:
	+ assumes "c \<in> carrier R"
	+ assumes "x \<in> carrier R"
	+ shows "c \<otimes> x[^](n::nat) \<in> carrier R"
	+ using assms monoid.nat_pow_closed
	+ by blast
	+
	+text\<open>Univariate polynomial ring over R\<close>
	+
	+lemma P_is_UP_ring:
	+"UP_ring R"
	+ by (simp add: UP_ring_axioms)
	+
	+text\<open>Degree function\<close>
	+abbreviation(input) degree where
	+"degree f \<equiv> deg R f"
	+
	+lemma UP_car_memI:
	+ assumes "\<And>n. n > k \<Longrightarrow> p n = \<zero>"
	+ assumes "\<And>n. p n \<in> carrier R"
	+ shows "p \<in> carrier P"
	+proof-
	+ have "bound \<zero> k p"
	+ by (simp add: assms(1) bound.intro)
	+ then show ?thesis
	+ by (metis (no_types, lifting) P_def UP_def assms(2) mem_upI partial_object.select_convs(1))
	+qed
	+
	+lemma(in UP_cring) UP_car_memI':
	+ assumes "\<And>x. g x \<in> carrier R"
	+ assumes "\<And>x. x > k \<Longrightarrow> g x = \<zero>"
	+ shows "g \<in> carrier (UP R)"
	+proof-
	+ have "bound \<zero> k g"
	+ using assms unfolding bound_def by blast
	+ then show ?thesis
	+ using P_def UP_car_memI assms(1) by blast
	+qed
	+
	+lemma(in UP_cring) UP_car_memE:
	+ assumes "g \<in> carrier (UP R)"
	+ shows "\<And>x. g x \<in> carrier R"
	+ "\<And>x. x > (deg R g) \<Longrightarrow> g x = \<zero>"
	+ using P_def assms UP_def[of R] apply (simp add: mem_upD)
	+ using assms UP_def[of R] up_def[of R]
	+ by (smt R.ring_axioms UP_ring.deg_aboveD UP_ring.intro partial_object.select_convs(1) restrict_apply up_ring.simps(2))
	+
	+end
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Lemmas About Coefficients\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+context UP_ring
	+begin
	+text\<open>The goal here is to reduce dependence on the function coeff from Univ\_Poly, in favour of using
	+a polynomial itself as its coefficient function.\<close>
	+
	+lemma coeff_simp:
	+ assumes "f \<in> carrier P"
	+ shows "coeff (UP R) f = f "
	+proof fix x show "coeff (UP R) f x = f x"
	+ using assms P_def UP_def[of R] by auto
	+qed
	+
	+text\<open>Coefficients are in R\<close>
	+
	+lemma cfs_closed:
	+ assumes "f \<in> carrier P"
	+ shows "f n \<in> carrier R"
	+ using assms coeff_simp[of f] P_def coeff_closed
	+ by fastforce
	+
	+lemma cfs_monom:
	+ "a \<in> carrier R ==> (monom P a m) n = (if m=n then a else \<zero>)"
	+using coeff_simp P_def coeff_monom monom_closed by auto
	+
	+lemma cfs_zero [simp]: "\<zero>\<^bsub>P\<^esub> n = \<zero>"
	+ using P_def UP_zero_closed coeff_simp coeff_zero by auto
	+
	+lemma cfs_one [simp]: "\<one>\<^bsub>P\<^esub> n = (if n=0 then \<one> else \<zero>)"
	+ by (metis P_def R.one_closed UP_ring.cfs_monom UP_ring_axioms monom_one)
	+
	+lemma cfs_smult [simp]:
	+ "[\| a \<in> carrier R; p \<in> carrier P \|] ==> (a \<odot>\<^bsub>P\<^esub> p) n = a \<otimes> p n"
	+ using P_def UP_ring.coeff_simp UP_ring_axioms UP_smult_closed coeff_smult by fastforce
	+
	+lemma cfs_add [simp]:
	+ "[\| p \<in> carrier P; q \<in> carrier P \|] ==> (p \<oplus>\<^bsub>P\<^esub> q) n = p n \<oplus> q n"
	+ by (metis P.add.m_closed P_def UP_ring.coeff_add UP_ring.coeff_simp UP_ring_axioms)
	+
	+lemma cfs_a_inv [simp]:
	+ assumes R: "p \<in> carrier P"
	+ shows "(\<ominus>\<^bsub>P\<^esub> p) n = \<ominus> (p n)"
	+ using P.add.inv_closed P_def UP_ring.coeff_a_inv UP_ring.coeff_simp UP_ring_axioms assms
	+ by fastforce
	+
	+lemma cfs_minus [simp]:
	+ "[\| p \<in> carrier P; q \<in> carrier P \|] ==> (p \<ominus>\<^bsub>P\<^esub> q) n = p n \<ominus> q n"
	+ using P.minus_closed P_def coeff_minus coeff_simp by auto
	+
	+lemma cfs_monom_mult_r:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "(monom P a n \<otimes>\<^bsub>P\<^esub> p) (k + n) = a \<otimes> p k"
	+ using coeff_monom_mult assms P.m_closed P_def coeff_simp monom_closed by auto
	+
	+lemma(in UP_cring) cfs_monom_mult_l:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "(p \<otimes>\<^bsub>P\<^esub> monom P a n) (k + n) = a \<otimes> p k"
	+ using UP_m_comm assms(1) assms(2) cfs_monom_mult_r by auto
	+
	+lemma(in UP_cring) cfs_monom_mult_l':
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "m \<ge> n"
	+ shows "(f \<otimes>\<^bsub>P\<^esub> (monom P a n)) m = a \<otimes> (f (m - n))"
	+ using cfs_monom_mult_l[of f a n "m-n"] assms
	+ by simp
	+
	+lemma(in UP_cring) cfs_monom_mult_r':
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "m \<ge> n"
	+ shows "((monom P a n) \<otimes>\<^bsub>P\<^esub> f) m = a \<otimes> (f (m - n))"
	+ using cfs_monom_mult_r[of f a n "m-n"] assms
	+ by simp
	+end
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Degree Bound Lemmas\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+context UP_ring
	+begin
	+
	+lemma bound_deg_sum:
	+ assumes " f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ assumes "degree f \<le> n"
	+ assumes "degree g \<le> n"
	+ shows "degree (f \<oplus>\<^bsub>P\<^esub> g) \<le> n"
	+ using P_def UP_ring_axioms assms(1) assms(2) assms(3) assms(4)
	+ by (meson deg_add max.boundedI order_trans)
	+
	+lemma bound_deg_sum':
	+ assumes " f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ assumes "degree f < n"
	+ assumes "degree g < n"
	+ shows "degree (f \<oplus>\<^bsub>P\<^esub> g) < n"
	+ using P_def UP_ring_axioms assms(1) assms(2)
	+ assms(3) assms(4)
	+ by (metis bound_deg_sum le_neq_implies_less less_imp_le_nat not_less)
	+
	+lemma equal_deg_sum:
	+ assumes " f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ assumes "degree f < n"
	+ assumes "degree g = n"
	+ shows "degree (f \<oplus>\<^bsub>P\<^esub> g) = n"
	+proof-
	+ have 0: "degree (f \<oplus>\<^bsub>P\<^esub> g) \<le>n"
	+ using assms bound_deg_sum
	+ P_def UP_ring_axioms by auto
	+ show "degree (f \<oplus>\<^bsub>P\<^esub> g) = n"
	+ proof(rule ccontr)
	+ assume "degree (f \<oplus>\<^bsub>P\<^esub> g) \<noteq> n "
	+ then have 1: "degree (f \<oplus>\<^bsub>P\<^esub> g) < n"
	+ using 0 by auto
	+ have 2: "degree (\<ominus>\<^bsub>P\<^esub> f) < n"
	+ using assms by simp
	+ have 3: "g = (f \<oplus>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> (\<ominus>\<^bsub>P\<^esub> f)"
	+ using assms
	+ by (simp add: P.add.m_comm P.r_neg1)
	+ then show False using 1 2 3 assms
	+ by (metis UP_a_closed UP_a_inv_closed deg_add leD le_max_iff_disj)
	+ qed
	+qed
	+
	+lemma equal_deg_sum':
	+ assumes "f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ assumes "degree g < n"
	+ assumes "degree f = n"
	+ shows "degree (f \<oplus>\<^bsub>P\<^esub> g) = n"
	+ using P_def UP_a_comm UP_ring.equal_deg_sum UP_ring_axioms assms(1) assms(2) assms(3) assms(4)
	+ by fastforce
	+
	+lemma degree_of_sum_diff_degree:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree q < degree p"
	+ shows "degree (p \<oplus>\<^bsub>P\<^esub> q) = degree p"
	+ by(rule equal_deg_sum', auto simp: assms)
	+
	+lemma degree_of_difference_diff_degree:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree q < degree p"
	+ shows "degree (p \<ominus>\<^bsub>P\<^esub> q) = degree p"
	+proof-
	+ have A: "(p \<ominus>\<^bsub>P\<^esub> q) = p \<oplus>\<^bsub>P\<^esub> (\<ominus>\<^bsub>P\<^esub> q)"
	+ by (simp add: P.minus_eq)
	+ have "degree (\<ominus>\<^bsub>P\<^esub> q) = degree q "
	+ by (simp add: assms(2))
	+ then show ?thesis
	+ using assms A
	+ by (simp add: degree_of_sum_diff_degree)
	+qed
	+
	+lemma (in UP_ring) deg_diff_by_const:
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ assumes "h = g \<oplus>\<^bsub>UP R\<^esub> up_ring.monom (UP R) a 0"
	+ shows "deg R g = deg R h"
	+ unfolding assms using assms
	+ by (metis P_def UP_ring.bound_deg_sum UP_ring.deg_monom_le UP_ring.monom_closed UP_ring_axioms degree_of_sum_diff_degree gr_zeroI not_less)
	+
	+lemma (in UP_ring) deg_diff_by_const':
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ assumes "h = g \<ominus>\<^bsub>UP R\<^esub> up_ring.monom (UP R) a 0"
	+ shows "deg R g = deg R h"
	+ apply(rule deg_diff_by_const[of _ "\<ominus> a"])
	+ using assms apply blast
	+ using assms apply blast
	+ by (metis P.minus_eq P_def assms(2) assms(3) monom_a_inv)
	+
	+lemma(in UP_ring) deg_gtE:
	+ assumes "p \<in> carrier P"
	+ assumes "i > deg R p"
	+ shows "p i = \<zero>"
	+ using assms P_def coeff_simp deg_aboveD by metis
	+end
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Leading Term Function\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+definition leading_term where
	+"leading_term R f = monom (UP R) (f (deg R f)) (deg R f)"
	+
	+context UP_ring
	+begin
	+
	+abbreviation(input) ltrm where
	+"ltrm f \<equiv> monom P (f (deg R f)) (deg R f)"
	+
	+text\<open>leading term is a polynomial\<close>
	+lemma ltrm_closed:
	+ assumes "f \<in> carrier P"
	+ shows "ltrm f \<in> carrier P"
	+ using assms
	+ by (simp add: cfs_closed)
	+
	+text\<open>Simplified coefficient function description for leading term\<close>
	+lemma ltrm_coeff:
	+ assumes "f \<in> carrier P"
	+ shows "coeff P (ltrm f) n = (if (n = degree f) then (f (degree f)) else \<zero>)"
	+ using assms
	+ by (simp add: cfs_closed)
	+
	+lemma ltrm_cfs:
	+ assumes "f \<in> carrier P"
	+ shows "(ltrm f) n = (if (n = degree f) then (f (degree f)) else \<zero>)"
	+ using assms
	+ by (simp add: cfs_closed cfs_monom)
	+
	+lemma ltrm_cfs_above_deg:
	+ assumes "f \<in> carrier P"
	+ assumes "n > degree f"
	+ shows "ltrm f n = \<zero>"
	+ using assms
	+ by (simp add: ltrm_cfs)
	+
	+text\<open>The leading term of f has the same degree as f\<close>
	+
	+lemma deg_ltrm:
	+ assumes "f \<in> carrier P"
	+ shows "degree (ltrm f) = degree f"
	+ using assms
	+ by (metis P_def UP_ring.lcoeff_nonzero_deg UP_ring_axioms cfs_closed coeff_simp deg_const deg_monom)
	+
	+text\<open>Subtracting the leading term yields a drop in degree\<close>
	+
	+lemma minus_ltrm_degree_drop:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = Suc n"
	+ shows "degree (f \<ominus>\<^bsub>P\<^esub> (ltrm f)) \<le> n"
	+proof(rule UP_ring.deg_aboveI)
	+ show C0: "UP_ring R"
	+ by (simp add: UP_ring_axioms)
	+ show C1: "f \<ominus>\<^bsub>P\<^esub> ltrm f \<in> carrier (UP R)"
	+ using assms ltrm_closed P.minus_closed P_def
	+ by blast
	+ show C2: "\<And>m. n < m \<Longrightarrow> coeff (UP R) (f \<ominus>\<^bsub>P\<^esub> ltrm f) m = \<zero>"
	+ proof-
	+ fix m
	+ assume A: "n<m"
	+ show "coeff (UP R) (f \<ominus>\<^bsub>P\<^esub> ltrm f) m = \<zero>"
	+ proof(cases " m = Suc n")
	+ case True
	+ have B: "f m \<in> carrier R"
	+ using UP.coeff_closed P_def assms(1) cfs_closed by blast
	+ have "m = degree f"
	+ using True by (simp add: assms(2))
	+ then have "f m = (ltrm f) m"
	+ using ltrm_cfs assms(1) by auto
	+ then have "(f m) \<ominus>\<^bsub>R\<^esub>( ltrm f) m = \<zero>"
	+ using B UP_ring_def P_is_UP_ring
	+ B R.add.r_inv R.is_abelian_group abelian_group.minus_eq by fastforce
	+ then have "(f \<ominus>\<^bsub>UP R\<^esub> ltrm f) m = \<zero>"
	+ by (metis C1 ltrm_closed P_def assms(1) coeff_minus coeff_simp)
	+ then show ?thesis
	+ using C1 P_def UP_ring.coeff_simp UP_ring_axioms by fastforce
	+ next
	+ case False
	+ have D0: "m > degree f" using False
	+ using A assms(2) by linarith
	+ have B: "f m \<in> carrier R"
	+ using UP.coeff_closed P_def assms(1) cfs_closed
	+ by blast
	+ have "f m = (ltrm f) m"
	+ using D0 ltrm_cfs_above_deg P_def assms(1) coeff_simp deg_aboveD
	+ by auto
	+ then show ?thesis
	+ by (metis B ltrm_closed P_def R.r_neg UP_ring.coeff_simp UP_ring_axioms a_minus_def assms(1) coeff_minus)
	+ qed
	+ qed
	+qed
	+
	+lemma ltrm_decomp:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f >(0::nat)"
	+ obtains g where "g \<in> carrier P \<and> f = g \<oplus>\<^bsub>P\<^esub> (ltrm f) \<and> degree g < degree f"
	+proof-
	+ have 0: "f \<ominus>\<^bsub>P\<^esub> (ltrm f) \<in> carrier P"
	+ using ltrm_closed assms(1) by blast
	+ have 1: "f = (f \<ominus>\<^bsub>P\<^esub> (ltrm f)) \<oplus>\<^bsub>P\<^esub> (ltrm f)"
	+ using assms
	+ by (metis "0" ltrm_closed P.add.inv_solve_right P.minus_eq)
	+ show ?thesis using assms 0 1 minus_ltrm_degree_drop[of f]
	+ by (metis ltrm_closed Suc_diff_1 Suc_n_not_le_n deg_ltrm equal_deg_sum' linorder_neqE_nat that)
	+qed
	+
	+text\<open>leading term of a sum\<close>
	+lemma coeff_of_sum_diff_degree0:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree q < n"
	+ shows "(p \<oplus>\<^bsub>P\<^esub> q) n = p n"
	+ using assms P_def UP_ring.deg_aboveD UP_ring_axioms cfs_add coeff_simp cfs_closed deg_aboveD
	+ by auto
	+
	+lemma coeff_of_sum_diff_degree1:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree q < degree p"
	+ shows "(p \<oplus>\<^bsub>P\<^esub> q) (degree p) = p (degree p)"
	+ using assms(1) assms(2) assms(3) coeff_of_sum_diff_degree0 by blast
	+
	+
	+
	+lemma ltrm_of_sum_diff_degree:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree p > degree q"
	+ shows "ltrm (p \<oplus>\<^bsub>P\<^esub> q) = ltrm p"
	+ unfolding leading_term_def
	+ using assms(1) assms(2) assms(3) coeff_of_sum_diff_degree1 degree_of_sum_diff_degree
	+ by presburger
	+
	+text\<open>leading term of a monomial\<close>
	+
	+lemma ltrm_monom:
	+ assumes "a \<in> carrier R"
	+ assumes "f = monom P a n"
	+ shows "ltrm f = f"
	+ unfolding leading_term_def
	+ by (metis P_def UP_ring.cfs_monom UP_ring.monom_zero UP_ring_axioms assms(1) assms(2) deg_monom)
	+
	+lemma ltrm_monom_simp:
	+ assumes "a \<in> carrier R"
	+ shows "ltrm (monom P a n) = monom P a n"
	+ using assms ltrm_monom by auto
	+
	+lemma ltrm_inv_simp[simp]:
	+ assumes "f \<in> carrier P"
	+ shows "ltrm (ltrm f) = ltrm f"
	+ by (metis assms deg_ltrm ltrm_cfs)
	+
	+lemma ltrm_deg_0:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p = 0"
	+ shows "ltrm p = p"
	+ using ltrm_monom assms P_def UP_ring.deg_zero_impl_monom UP_ring_axioms coeff_simp
	+ by fastforce
	+
	+lemma ltrm_prod_ltrm:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "ltrm ((ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)) = (ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)"
	+ using ltrm_monom R.m_closed assms(1) assms(2) cfs_closed monom_mult
	+ by metis
	+
	+text\<open>lead coefficient function\<close>
	+
	+abbreviation(input) lcf where
	+"lcf p \<equiv> p (deg R p)"
	+
	+lemma(in UP_ring) lcf_ltrm:
	+"ltrm p = monom P (lcf p) (degree p)"
	+ by auto
	+
	+lemma lcf_closed:
	+ assumes "f \<in> carrier P"
	+ shows "lcf f \<in> carrier R"
	+ by (simp add: assms cfs_closed)
	+
	+lemma(in UP_cring) lcf_monom:
	+ assumes "a \<in> carrier R"
	+ shows "lcf (monom P a n) = a" "lcf (monom (UP R) a n) = a"
	+ using assms deg_monom cfs_monom apply fastforce
	+ by (metis UP_ring.cfs_monom UP_ring.deg_monom UP_ring_axioms assms)
	+
	+
	+end
	+
	+text\<open>Function which truncates a polynomial by removing the leading term\<close>
	+
	+definition truncate where
	+"truncate R f = f \<ominus>\<^bsub>(UP R)\<^esub> (leading_term R f)"
	+
	+context UP_ring
	+begin
	+
	+abbreviation(input) trunc where
	+"trunc \<equiv> truncate R"
	+
	+lemma trunc_closed:
	+ assumes "f \<in> carrier P"
	+ shows "trunc f \<in> carrier P"
	+ using assms unfolding truncate_def
	+ by (metis ltrm_closed P_def UP_ring.UP_ring UP_ring_axioms leading_term_def ring.ring_simprules(4))
	+
	+lemma trunc_simps:
	+ assumes "f \<in> carrier P"
	+ shows "f = (trunc f) \<oplus>\<^bsub>P\<^esub> (ltrm f)"
	+ "f \<ominus>\<^bsub>P\<^esub> (trunc f) = ltrm f"
	+ apply (metis ltrm_closed P.add.inv_solve_right P.minus_closed P_def a_minus_def assms Cring_Poly.truncate_def leading_term_def)
	+ using trunc_closed[of f] ltrm_closed[of f] P_def P.add.inv_solve_right[of "ltrm f" f "trunc f"]
	+ assms unfolding UP_cring_def
	+ by (metis P.add.inv_closed P.add.m_lcomm P.add.r_inv_ex P.minus_eq P.minus_minus
	+ P.r_neg2 P.r_zero Cring_Poly.truncate_def leading_term_def)
	+
	+lemma trunc_zero:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = 0"
	+ shows "trunc f = \<zero>\<^bsub>P\<^esub>"
	+ unfolding truncate_def
	+ using assms ltrm_deg_0[of f]
	+ by (metis P.r_neg P_def a_minus_def leading_term_def)
	+
	+lemma trunc_degree:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f > 0"
	+ shows "degree (trunc f) < degree f"
	+ unfolding truncate_def using assms
	+ by (metis ltrm_closed ltrm_decomp P.add.right_cancel Cring_Poly.truncate_def trunc_closed trunc_simps(1))
	+
	+text\<open>The coefficients of trunc agree with f for small degree\<close>
	+
	+lemma trunc_cfs:
	+ assumes "p \<in> carrier P"
	+ assumes "n < degree p"
	+ shows " (trunc p) n = p n"
	+ using P_def assms(1) assms(2) unfolding truncate_def
	+ by (smt ltrm_closed ltrm_cfs R.minus_zero R.ring_axioms UP_ring.cfs_minus
	+ UP_ring_axioms a_minus_def cfs_closed leading_term_def nat_neq_iff ring.ring_simprules(15))
	+
	+text\<open>monomial predicate\<close>
	+
	+definition is_UP_monom where
	+"is_UP_monom = (\<lambda>f. f \<in> carrier (UP R) \<and> f = ltrm f)"
	+
	+lemma is_UP_monomI:
	+ assumes "a \<in> carrier R"
	+ assumes "p = monom P a n"
	+ shows "is_UP_monom p"
	+ using assms(1) assms(2) is_UP_monom_def ltrm_monom P_def monom_closed
	+ by auto
	+
	+lemma is_UP_monomI':
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "f = ltrm f"
	+ shows "is_UP_monom f"
	+ using assms P_def unfolding is_UP_monom_def by blast
	+
	+lemma monom_is_UP_monom:
	+ assumes "a \<in> carrier R"
	+ shows "is_UP_monom (monom P a n)" "is_UP_monom (monom (UP R) a n)"
	+ using assms P_def ltrm_monom_simp monom_closed
	+ unfolding is_UP_monom_def
	+ by auto
	+
	+lemma is_UP_monomE:
	+ assumes "is_UP_monom f"
	+ shows "f \<in> carrier P" "f = monom P (lcf f) (degree f)" "f = monom (UP R) (lcf f) (degree f)"
	+ using assms unfolding is_UP_monom_def
	+ by(auto simp: P_def )
	+
	+lemma ltrm_is_UP_monom:
	+ assumes "p \<in> carrier P"
	+ shows "is_UP_monom (ltrm p)"
	+ using assms
	+ by (simp add: cfs_closed monom_is_UP_monom(1))
	+
	+lemma is_UP_monom_mult:
	+ assumes "is_UP_monom p"
	+ assumes "is_UP_monom q"
	+ shows "is_UP_monom (p \<otimes>\<^bsub>P\<^esub> q)"
	+ apply(rule is_UP_monomI')
	+ using assms is_UP_monomE P_def UP_mult_closed
	+ apply simp
	+ using assms is_UP_monomE[of p] is_UP_monomE[of q]
	+ P_def monom_mult
	+ by (metis lcf_closed ltrm_monom R.m_closed)
	+end
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Properties of Leading Terms and Leading Coefficients in Commutative Rings and Domains\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+context UP_cring
	+begin
	+
	+lemma cring_deg_mult:
	+ assumes "q \<in> carrier P"
	+ assumes "p \<in> carrier P"
	+ assumes "lcf q \<otimes> lcf p \<noteq>\<zero>"
	+ shows "degree (q \<otimes>\<^bsub>P\<^esub> p) = degree p + degree q"
	+proof-
	+ have "q \<otimes>\<^bsub>P\<^esub> p = (trunc q \<oplus>\<^bsub>P\<^esub> ltrm q) \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)"
	+ using assms(1) assms(2) trunc_simps(1) by auto
	+ then have "q \<otimes>\<^bsub>P\<^esub> p = (trunc q \<oplus>\<^bsub>P\<^esub> ltrm q) \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)"
	+ by linarith
	+ then have 0: "q \<otimes>\<^bsub>P\<^esub> p = (trunc q \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) \<oplus>\<^bsub>P\<^esub> ( ltrm q \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p))"
	+ by (simp add: P.l_distr assms(1) assms(2) ltrm_closed trunc_closed)
	+ have 1: "(trunc q \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) (degree p + degree q) = \<zero>"
	+ proof(cases "degree q = 0")
	+ case True
	+ then show ?thesis
	+ using assms(1) assms(2) trunc_simps(1) trunc_zero by auto
	+ next
	+ case False
	+ have "degree ((trunc q) \<otimes>\<^bsub>P\<^esub> p) \<le> degree (trunc q) + degree p"
	+ using assms trunc_simps[of q] deg_mult_ring[of "trunc q" p] trunc_closed
	+ by blast
	+ then have "degree (trunc q \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) < degree q + degree p"
	+ using False assms(1) assms(2) trunc_degree trunc_simps(1) by fastforce
	+ then show ?thesis
	+ by (metis P_def UP_mult_closed UP_ring.coeff_simp UP_ring_axioms
	+ add.commute assms(1) assms(2) deg_belowI not_less trunc_closed trunc_simps(1))
	+ qed
	+ have 2: "(q \<otimes>\<^bsub>P\<^esub> p) (degree p + degree q) =
	+ ( ltrm q \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) (degree p + degree q)"
	+ using 0 1 assms cfs_closed trunc_closed by auto
	+ have 3: "(q \<otimes>\<^bsub>P\<^esub> p) (degree p + degree q) =
	+ ( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) (degree p + degree q) \<oplus> ( ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p) (degree p + degree q)"
	+ by (simp add: "2" ltrm_closed UP_r_distr assms(1) assms(2) trunc_closed)
	+ have 4: "( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) (degree p + degree q) = \<zero>"
	+ proof(cases "degree p = 0")
	+ case True
	+ then show ?thesis
	+ using "2" "3" assms(1) assms(2) cfs_closed ltrm_closed trunc_zero by auto
	+ next
	+ case False
	+ have "degree ( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) \<le> degree (ltrm q) + degree (trunc p)"
	+ using assms trunc_simps deg_mult_ring ltrm_closed trunc_closed by presburger
	+ then have "degree ( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) < degree q + degree p"
	+ using False assms(1) assms(2) trunc_degree trunc_simps(1) deg_ltrm by fastforce
	+ then show ?thesis
	+ by (metis ltrm_closed P_def UP_mult_closed UP_ring.coeff_simp UP_ring_axioms add.commute assms(1) assms(2) deg_belowI not_less trunc_closed)
	+ qed
	+ have 5: "(q \<otimes>\<^bsub>P\<^esub> p) (degree p + degree q) = ( ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p) (degree p + degree q)"
	+ by (simp add: "3" "4" assms(1) assms(2) cfs_closed)
	+ have 6: "ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p = monom P (lcf q \<otimes> lcf p) (degree p + degree q)"
	+ unfolding leading_term_def
	+ by (metis P_def UP_ring.monom_mult UP_ring_axioms add.commute assms(1) assms(2) cfs_closed)
	+ have 7: "( ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p) (degree p + degree q) \<noteq>\<zero>"
	+ using 5 6 assms
	+ by (metis R.m_closed cfs_closed cfs_monom)
	+ have 8: "degree (q \<otimes>\<^bsub>P\<^esub> p) \<ge>degree p + degree q"
	+ using 5 6 7 P_def UP_mult_closed assms(1) assms(2)
	+ by (simp add: UP_ring.coeff_simp UP_ring_axioms deg_belowI)
	+ then show ?thesis
	+ using assms(1) assms(2) deg_mult_ring by fastforce
	+qed
	+
	+text\<open>leading term is multiplicative\<close>
	+
	+lemma ltrm_of_sum_diff_deg:
	+ assumes "q \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq>\<zero>"
	+ assumes "degree q < n"
	+ assumes "p = q \<oplus>\<^bsub>P\<^esub> (monom P a n)"
	+ shows "ltrm p = (monom P a n)"
	+proof-
	+ have 0: "degree (monom P a n) = n"
	+ by (simp add: assms(2) assms(3))
	+ have 1: "(monom P a n) \<in> carrier P"
	+ using assms(2) by auto
	+ have 2: "ltrm ((monom P a n) \<oplus>\<^bsub>P\<^esub> q) = ltrm (monom P a n)"
	+ using assms ltrm_of_sum_diff_degree[of "(monom P a n)" q] 1 "0" by linarith
	+ then show ?thesis
	+ using UP_a_comm assms(1) assms(2) assms(5) ltrm_monom by auto
	+qed
	+
	+lemma(in UP_cring) ltrm_smult_cring:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "lcf p \<otimes> a \<noteq> \<zero>"
	+ shows "ltrm (a \<odot>\<^bsub>P\<^esub>p) = a\<odot>\<^bsub>P\<^esub>(ltrm p)"
	+ using assms
	+ by (smt lcf_monom(1) P_def R.m_closed R.m_comm cfs_closed cfs_smult coeff_simp
	+ cring_deg_mult deg_monom deg_ltrm monom_closed monom_mult_is_smult monom_mult_smult)
	+
	+lemma(in UP_cring) deg_zero_ltrm_smult_cring:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "degree p = 0"
	+ shows "ltrm (a \<odot>\<^bsub>P\<^esub>p) = a\<odot>\<^bsub>P\<^esub>(ltrm p)"
	+ by (metis ltrm_deg_0 assms(1) assms(2) assms(3) deg_smult_decr le_0_eq module.smult_closed module_axioms)
	+
	+lemma(in UP_domain) ltrm_smult:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "ltrm (a \<odot>\<^bsub>P\<^esub>p) = a\<odot>\<^bsub>P\<^esub>(ltrm p)"
	+ by (metis lcf_closed ltrm_closed ltrm_smult_cring P_def R.integral_iff UP_ring.deg_ltrm
	+ UP_ring_axioms UP_smult_zero assms(1) assms(2) cfs_zero deg_nzero_nzero deg_zero_ltrm_smult_cring monom_zero)
	+
	+lemma(in UP_cring) cring_ltrm_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "lcf p \<otimes> lcf q \<noteq> \<zero>"
	+ shows "ltrm (p \<otimes>\<^bsub>P\<^esub> q) = (ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)"
	+proof(cases "degree p = 0 \<or> degree q = 0")
	+ case True
	+ then show ?thesis
	+ by (smt ltrm_closed ltrm_deg_0 ltrm_smult_cring R.m_comm UP_m_comm assms(1) assms(2) assms(3) cfs_closed monom_mult_is_smult)
	+next
	+ case False
	+ obtain q0 where q0_def: "q0 = trunc q"
	+ by simp
	+ obtain p0 where p0_def: "p0 = trunc p"
	+ by simp
	+ have Pq: "degree q0 < degree q"
	+ using False P_def assms(2) q0_def trunc_degree by blast
	+ have Pp: "degree p0 < degree p"
	+ using False P_def assms(1) p0_def trunc_degree by blast
	+ have "p \<otimes>\<^bsub>P\<^esub> q = (p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>(q0 \<oplus>\<^bsub>P\<^esub> ltrm(q))"
	+ using assms(1) assms(2) p0_def q0_def trunc_simps(1) by auto
	+ then have P0: "p \<otimes>\<^bsub>P\<^esub> q = ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>q0) \<oplus>\<^bsub>P\<^esub> ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
	+ by (simp add: P.r_distr assms(1) assms(2) ltrm_closed p0_def q0_def trunc_closed)
	+ have P1: "degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>q0) < degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
	+ proof-
	+ have LHS: "degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>q0) \<le> degree p + degree q0 "
	+ proof(cases "q0 = \<zero>\<^bsub>P\<^esub>")
	+ case True
	+ then show ?thesis
	+ using assms(1) p0_def trunc_simps(1) by auto
	+ next
	+ case False
	+ then show ?thesis
	+ using assms(1) assms(2) deg_mult_ring p0_def
	+ q0_def trunc_simps(1) trunc_closed by auto
	+ qed
	+ have RHS: "degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = degree p + degree q"
	+ using assms(1) assms(2) deg_mult_ring ltrm_closed p0_def trunc_simps(1)
	+ by (smt P_def UP_cring.lcf_monom(1) UP_cring.cring_deg_mult UP_cring_axioms add.commute assms(3) cfs_closed deg_ltrm)
	+ then show ?thesis
	+ using RHS LHS Pq
	+ by linarith
	+ qed
	+ then have P2: "ltrm (p \<otimes>\<^bsub>P\<^esub> q) = ltrm ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
	+ using P0 P1
	+ by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm
	+ UP_mult_closed assms(1) assms(2) p0_def q0_def trunc_closed trunc_simps(1))
	+ have P3: " ltrm ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = ltrm p \<otimes>\<^bsub>P\<^esub> ltrm q"
	+ proof-
	+ have Q0: "((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = (p0 \<otimes>\<^bsub>P \<^esub>ltrm(q)) \<oplus>\<^bsub>P\<^esub> (ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)"
	+ by (simp add: P.l_distr assms(1) assms(2) ltrm_closed p0_def trunc_closed)
	+ have Q1: "degree ((p0 \<otimes>\<^bsub>P \<^esub>ltrm(q)) ) < degree ((ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
	+ proof(cases "p0 = \<zero>\<^bsub>P\<^esub>")
	+ case True
	+ then show ?thesis
	+ using P1 assms(1) assms(2) ltrm_closed by auto
	+ next
	+ case F: False
	+ then show ?thesis
	+ proof-
	+ have LHS: "degree ((p0 \<otimes>\<^bsub>P \<^esub>ltrm(q))) < degree p + degree q"
	+ using False F Pp assms(1) assms(2) deg_nzero_nzero
	+ deg_ltrm ltrm_closed p0_def trunc_closed
	+ by (smt add_le_cancel_right deg_mult_ring le_trans not_less)
	+ have RHS: "degree ((ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = degree p + degree q"
	+ using cring_deg_mult[of "ltrm p" "ltrm q"] assms
	+ by (simp add: ltrm_closed ltrm_cfs deg_ltrm)
	+ then show ?thesis using LHS RHS by auto
	+ qed
	+ qed
	+ have Q2: "ltrm ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = ltrm ((ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
	+ using Q0 Q1
	+ by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm
	+ UP_mult_closed assms(1) assms(2) p0_def trunc_closed)
	+ show ?thesis using ltrm_prod_ltrm Q0 Q1 Q2
	+ by (simp add: assms(1) assms(2))
	+ qed
	+ then show ?thesis
	+ by (simp add: P2)
	+qed
	+
	+lemma(in UP_domain) ltrm_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "ltrm (p \<otimes>\<^bsub>P\<^esub> q) = (ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)"
	+ using cring_ltrm_mult assms
	+ by (smt ltrm_closed ltrm_deg_0 cfs_closed deg_nzero_nzero deg_ltrm local.integral_iff monom_mult monom_zero)
	+
	+lemma lcf_deg_0:
	+ assumes "degree p = 0"
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "(p \<otimes>\<^bsub>P\<^esub> q) = (lcf p)\<odot>\<^bsub>P\<^esub>q"
	+ using P_def assms(1) assms(2) assms(3)
	+ by (metis ltrm_deg_0 cfs_closed monom_mult_is_smult)
	+
	+text\<open>leading term powers\<close>
	+
	+lemma (in domain) nonzero_pow_nonzero:
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq>\<zero>"
	+ shows "a[^](n::nat) \<noteq> \<zero>"
	+proof(induction n)
	+ case 0
	+ then show ?case
	+ by auto
	+next
	+ case (Suc n)
	+ fix n::nat
	+ assume IH: "a[^] n \<noteq> \<zero>"
	+ show "a[^] (Suc n) \<noteq> \<zero>"
	+ proof-
	+ have "a[^] (Suc n) = a[^] n \<otimes> a"
	+ by simp
	+ then show ?thesis using assms IH
	+ using IH assms(1) assms(2) local.integral by auto
	+ qed
	+qed
	+
	+lemma (in UP_cring) cring_monom_degree:
	+ assumes "a \<in> (carrier R)"
	+ assumes "p = monom P a m"
	+ assumes "a[^]n \<noteq> \<zero>"
	+ shows "degree (p[^]\<^bsub>P\<^esub> n) = n*m"
	+ by (simp add: assms(1) assms(2) assms(3) monom_pow)
	+
	+lemma (in UP_domain) monom_degree:
	+ assumes "a \<noteq>\<zero>"
	+ assumes "a \<in> (carrier R)"
	+ assumes "p = monom P a m"
	+ shows "degree (p[^]\<^bsub>P\<^esub> n) = n*m"
	+ by (simp add: R.domain_axioms assms(1) assms(2) assms(3) domain.nonzero_pow_nonzero monom_pow)
	+
	+lemma(in UP_cring) cring_pow_ltrm:
	+ assumes "p \<in> carrier P"
	+ assumes "lcf p [^]n \<noteq> \<zero>"
	+ shows "ltrm (p[^]\<^bsub>P\<^esub>(n::nat)) = (ltrm p)[^]\<^bsub>P\<^esub>n"
	+proof-
	+ have "lcf p [^]n \<noteq> \<zero> \<Longrightarrow> ltrm (p[^]\<^bsub>P\<^esub>(n::nat)) = (ltrm p)[^]\<^bsub>P\<^esub>n"
	+ proof(induction n)
	+ case 0
	+ then show ?case
	+ using P.ring_simprules(6) P.nat_pow_0 cfs_one deg_one monom_one by presburger
	+ next
	+ case (Suc n) fix n::nat
	+ assume IH : "(lcf p [^] n \<noteq> \<zero> \<Longrightarrow> ltrm (p [^]\<^bsub>P\<^esub> n) = ltrm p [^]\<^bsub>P\<^esub> n)"
	+ assume A: "lcf p [^] Suc n \<noteq> \<zero>"
	+ have a: "ltrm (p [^]\<^bsub>P\<^esub> n) = ltrm p [^]\<^bsub>P\<^esub> n"
	+ apply(cases "lcf p [^] n = \<zero>")
	+ using A lcf_closed assms(1) apply auto[1]
	+ by(rule IH)
	+ have 0: "lcf (ltrm (p [^]\<^bsub>P\<^esub> n)) = lcf p [^] n"
	+ unfolding a
	+ by (simp add: lcf_monom(1) assms(1) cfs_closed monom_pow)
	+ then have 1: "lcf (ltrm (p [^]\<^bsub>P\<^esub> n)) \<otimes> lcf p \<noteq> \<zero>"
	+ using assms A R.nat_pow_Suc IH by metis
	+ then show "ltrm (p [^]\<^bsub>P\<^esub> Suc n) = ltrm p [^]\<^bsub>P\<^esub> Suc n"
	+ using IH 0 assms(1) cring_ltrm_mult cfs_closed
	+ by (smt A lcf_monom(1) ltrm_closed P.nat_pow_Suc2 P.nat_pow_closed R.nat_pow_Suc2 a)
	+ qed
	+ then show ?thesis
	+ using assms(2) by blast
	+qed
	+
	+lemma(in UP_cring) cring_pow_deg:
	+ assumes "p \<in> carrier P"
	+ assumes "lcf p [^]n \<noteq> \<zero>"
	+ shows "degree (p[^]\<^bsub>P\<^esub>(n::nat)) = n*degree p"
	+proof-
	+ have "degree ( (ltrm p)[^]\<^bsub>P\<^esub>n) = n*degree p"
	+ using assms(1) assms(2) cring_monom_degree lcf_closed lcf_ltrm by auto
	+ then show ?thesis
	+ using assms cring_pow_ltrm
	+ by (metis P.nat_pow_closed P_def UP_ring.deg_ltrm UP_ring_axioms)
	+qed
	+
	+lemma(in UP_cring) cring_pow_deg_bound:
	+ assumes "p \<in> carrier P"
	+ shows "degree (p[^]\<^bsub>P\<^esub>(n::nat)) \<le> n*degree p"
	+ apply(induction n)
	+ apply (metis Group.nat_pow_0 deg_one le_zero_eq mult_is_0)
	+ using deg_mult_ring[of _ p]
	+ by (smt P.nat_pow_Suc2 P.nat_pow_closed ab_semigroup_add_class.add_ac(1) assms deg_mult_ring le_iff_add mult_Suc)
	+
	+lemma(in UP_cring) deg_smult:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "a \<otimes> lcf f \<noteq> \<zero>"
	+ shows "deg R (a \<odot>\<^bsub>UP R\<^esub> f) = deg R f"
	+ using assms P_def cfs_smult deg_eqI deg_smult_decr smult_closed
	+ by (metis deg_gtE le_neq_implies_less)
	+
	+lemma(in UP_cring) deg_smult':
	+ assumes "a \<in> Units R"
	+ assumes "f \<in> carrier (UP R)"
	+ shows "deg R (a \<odot>\<^bsub>UP R\<^esub> f) = deg R f"
	+ apply(cases "deg R f = 0")
	+ apply (metis P_def R.Units_closed assms(1) assms(2) deg_smult_decr le_zero_eq)
	+ apply(rule deg_smult)
	+ using assms apply blast
	+ using assms apply blast
	+proof
	+ assume A: "deg R f \<noteq> 0" "a \<otimes> f (deg R f) = \<zero>"
	+ have 0: "f (deg R f) = \<zero>"
	+ using A assms R.Units_not_right_zero_divisor[of a "f (deg R f)"] UP_car_memE(1) by blast
	+ then show False using assms A
	+ by (metis P_def deg_zero deg_ltrm monom_zero)
	+qed
	+
	+lemma(in UP_domain) pow_sum0:
	+"\<And> p q. p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n"
	+proof(induction n)
	+ case 0
	+ then show ?case
	+ by (metis Group.nat_pow_0 deg_one mult_is_0)
	+next
	+ case (Suc n)
	+ fix n
	+ assume IH: "\<And> p q. p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow>
	+ degree q < degree p \<Longrightarrow> degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n"
	+ then show "\<And> p q. p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow>
	+ degree q < degree p \<Longrightarrow> degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n)) = (degree p)*(Suc n)"
	+ proof-
	+ fix p q
	+ assume A0: "p \<in> carrier P" and
	+ A1: "q \<in> carrier P" and
	+ A2: "degree q < degree p"
	+ show "degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n)) = (degree p)*(Suc n)"
	+ proof(cases "q = \<zero>\<^bsub>P\<^esub>")
	+ case True
	+ then show ?thesis
	+ by (metis A0 A1 A2 IH P.nat_pow_Suc2 P.nat_pow_closed P.r_zero deg_mult
	+ domain.nonzero_pow_nonzero local.domain_axioms mult_Suc_right nat_neq_iff)
	+ next
	+ case False
	+ then show ?thesis
	+ proof-
	+ have P0: "degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n"
	+ using A0 A1 A2 IH by auto
	+ have P1: "(p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n) = ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q )"
	+ by simp
	+ then have P2: "(p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n) = (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> p) \<oplus>\<^bsub>P\<^esub> (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> q)"
	+ by (simp add: A0 A1 UP_r_distr)
	+ have P3: "degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> p) = (degree p)*n + (degree p)"
	+ using P0 A0 A1 A2 deg_nzero_nzero degree_of_sum_diff_degree local.nonzero_pow_nonzero by auto
	+ have P4: "degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> q) = (degree p)*n + (degree q)"
	+ using P0 A0 A1 A2 deg_nzero_nzero degree_of_sum_diff_degree local.nonzero_pow_nonzero False deg_mult
	+ by simp
	+ have P5: "degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> p) > degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> q)"
	+ using P3 P4 A2 by auto
	+ then show ?thesis using P5 P3 P2
	+ by (simp add: A0 A1 degree_of_sum_diff_degree)
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma(in UP_domain) pow_sum:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree q < degree p"
	+ shows "degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n"
	+ using assms(1) assms(2) assms(3) pow_sum0 by blast
	+
	+lemma(in UP_domain) deg_pow0:
	+ "\<And> p. p \<in> carrier P \<Longrightarrow> n \<ge> degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)"
	+proof(induction n)
	+ case 0
	+ show "p \<in> carrier P \<Longrightarrow> 0 \<ge> degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)"
	+ proof-
	+ assume B0:"p \<in> carrier P"
	+ assume B1: "0 \<ge> degree p"
	+ then obtain a where a_def: "a \<in> carrier R \<and> p = monom P a 0"
	+ using B0 deg_zero_impl_monom by fastforce
	+ show "degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)" using UP_cring.monom_pow
	+ by (metis P_def R.nat_pow_closed UP_cring_axioms a_def deg_const
	+ mult_0_right mult_zero_left)
	+ qed
	+next
	+ case (Suc n)
	+ fix n
	+ assume IH: "\<And>p. (p \<in> carrier P \<Longrightarrow> n \<ge>degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m * (degree p))"
	+ show "p \<in> carrier P \<Longrightarrow> Suc n \<ge> degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m * (degree p)"
	+ proof-
	+ assume A0: "p \<in> carrier P"
	+ assume A1: "Suc n \<ge> degree p"
	+ show "degree (p [^]\<^bsub>P\<^esub> m) = m * (degree p)"
	+ proof(cases "Suc n > degree p")
	+ case True
	+ then show ?thesis using IH A0 by simp
	+ next
	+ case False
	+ then show ?thesis
	+ proof-
	+ obtain q where q_def: "q = trunc p"
	+ by simp
	+ obtain k where k_def: "k = degree q"
	+ by simp
	+ have q_is_poly: "q \<in> carrier P"
	+ by (simp add: A0 q_def trunc_closed)
	+ have k_bound0: "k <degree p"
	+ using k_def q_def trunc_degree[of p] A0 False by auto
	+ have k_bound1: "k \<le> n"
	+ using k_bound0 A0 A1 by auto
	+ have P_q:"degree (q [^]\<^bsub>P\<^esub> m) = m * k"
	+ using IH[of "q"] k_bound1 k_def q_is_poly by auto
	+ have P_ltrm: "degree ((ltrm p) [^]\<^bsub>P\<^esub> m) = m*(degree p)"
	+ proof-
	+ have "degree p = degree (ltrm p)"
	+ by (simp add: A0 deg_ltrm)
	+ then show ?thesis using monom_degree
	+ by (metis A0 P.r_zero P_def cfs_closed coeff_simp equal_deg_sum k_bound0 k_def lcoeff_nonzero2 nat_neq_iff q_is_poly)
	+ qed
	+ have "p = q \<oplus>\<^bsub>P\<^esub> (ltrm p)"
	+ by (simp add: A0 q_def trunc_simps(1))
	+ then show ?thesis
	+ using P_q pow_sum[of "(ltrm p)" q m] A0 UP_a_comm
	+ deg_ltrm k_bound0 k_def ltrm_closed q_is_poly by auto
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma(in UP_domain) deg_pow:
	+ assumes "p \<in> carrier P"
	+ shows "degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)"
	+ using deg_pow0 assms by blast
	+
	+lemma(in UP_domain) ltrm_pow0:
	+"\<And>f. f \<in> carrier P \<Longrightarrow> ltrm (f [^]\<^bsub>P\<^esub> (n::nat)) = (ltrm f) [^]\<^bsub>P\<^esub> n"
	+proof(induction n)
	+ case 0
	+ then show ?case
	+ using ltrm_deg_0 P.nat_pow_0 P.ring_simprules(6) deg_one by presburger
	+next
	+ case (Suc n)
	+ fix n::nat
	+ assume IH: "\<And>f. f \<in> carrier P \<Longrightarrow> ltrm (f [^]\<^bsub>P\<^esub> n) = (ltrm f) [^]\<^bsub>P\<^esub> n"
	+ then show "\<And>f. f \<in> carrier P \<Longrightarrow> ltrm (f [^]\<^bsub>P\<^esub> (Suc n)) = (ltrm f) [^]\<^bsub>P\<^esub> (Suc n)"
	+ proof-
	+ fix f
	+ assume A: "f \<in> carrier P"
	+ show " ltrm (f [^]\<^bsub>P\<^esub> (Suc n)) = (ltrm f) [^]\<^bsub>P\<^esub> (Suc n)"
	+ proof-
	+ have 0: "ltrm (f [^]\<^bsub>P\<^esub> n) = (ltrm f) [^]\<^bsub>P\<^esub> n"
	+ using A IH by blast
	+ have 1: "ltrm (f [^]\<^bsub>P\<^esub> (Suc n)) = ltrm ((f [^]\<^bsub>P\<^esub> n)\<otimes>\<^bsub>P\<^esub> f)"
	+ by auto then
	+ show ?thesis using ltrm_mult 0 1
	+ by (simp add: A)
	+ qed
	+ qed
	+qed
	+
	+lemma(in UP_domain) ltrm_pow:
	+ assumes "f \<in> carrier P"
	+ shows " ltrm (f [^]\<^bsub>P\<^esub> (n::nat)) = (ltrm f) [^]\<^bsub>P\<^esub> n"
	+ using assms ltrm_pow0 by blast
	+
	+text\<open>lemma on the leading coefficient\<close>
	+
	+lemma lcf_eq:
	+ assumes "f \<in> carrier P"
	+ shows "lcf f = lcf (ltrm f)"
	+ using ltrm_deg_0
	+ by (simp add: ltrm_cfs assms deg_ltrm)
	+
	+lemma lcf_eq_deg_eq_imp_ltrm_eq:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree p > 0"
	+ assumes "degree p = degree q"
	+ assumes "lcf p = lcf q"
	+ shows "ltrm p = ltrm q"
	+ using assms(4) assms(5)
	+ by (simp add: leading_term_def)
	+
	+lemma ltrm_eq_imp_lcf_eq:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "ltrm p = ltrm q"
	+ shows "lcf p = lcf q"
	+ using assms
	+ by (metis lcf_eq)
	+
	+lemma ltrm_eq_imp_deg_drop:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "ltrm p = ltrm q"
	+ assumes "degree p >0"
	+ shows "degree (p \<ominus>\<^bsub>P\<^esub> q) < degree p"
	+proof-
	+ have P0: "degree p = degree q"
	+ by (metis assms(1) assms(2) assms(3) deg_ltrm)
	+ then have P1: "degree (p \<ominus>\<^bsub>P\<^esub> q) \<le> degree p"
	+ by (metis P.add.inv_solve_right P.minus_closed P.minus_eq assms(1)
	+ assms(2) degree_of_sum_diff_degree neqE order.strict_implies_order order_refl)
	+ have "degree (p \<ominus>\<^bsub>P\<^esub> q) \<noteq> degree p"
	+ proof
	+ assume A: "degree (p \<ominus>\<^bsub>P\<^esub> q) = degree p"
	+ have Q0: "p \<ominus>\<^bsub>P\<^esub> q = ((trunc p) \<oplus>\<^bsub>P\<^esub> (ltrm p)) \<ominus>\<^bsub>P\<^esub> ((trunc q) \<oplus>\<^bsub>P\<^esub> (ltrm p))"
	+ using assms(1) assms(2) assms(3) trunc_simps(1) by force
	+ have Q1: "p \<ominus>\<^bsub>P\<^esub> q = (trunc p) \<ominus>\<^bsub>P\<^esub> (trunc q)"
	+ proof-
	+ have "p \<ominus>\<^bsub>P\<^esub> q = ((trunc p) \<oplus>\<^bsub>P\<^esub> (ltrm p)) \<ominus>\<^bsub>P\<^esub> (trunc q) \<ominus> \<^bsub>P\<^esub> (ltrm p)"
	+ using Q0
	+ by (simp add: P.minus_add P.minus_eq UP_a_assoc assms(1) assms(2) ltrm_closed trunc_closed)
	+ then show ?thesis
	+ by (metis (no_types, lifting) ltrm_closed P.add.inv_mult_group P.minus_eq
	+ P.r_neg2 UP_a_assoc assms(1) assms(2) assms(3) carrier_is_submodule submoduleE(6) trunc_closed trunc_simps(1))
	+ qed
	+ have Q2: "degree (trunc p) < degree p"
	+ by (simp add: assms(1) assms(4) trunc_degree)
	+ have Q3: "degree (trunc q) < degree q"
	+ using P0 assms(2) assms(4) trunc_degree by auto
	+ then show False using A Q1 Q2 Q3 by (simp add: P.add.inv_solve_right
	+ P.minus_eq P0 assms(1) assms(2) degree_of_sum_diff_degree trunc_closed)
	+ qed
	+ then show ?thesis
	+ using P1 by auto
	+qed
	+
	+lemma(in UP_cring) cring_lcf_scalar_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "a \<otimes> (lcf p) \<noteq>\<zero>"
	+ shows "lcf (a \<odot>\<^bsub>P\<^esub> p) = a \<otimes> (lcf p)"
	+proof-
	+ have 0: "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (ltrm (a \<odot>\<^bsub>P\<^esub> p))"
	+ using assms lcf_eq smult_closed by blast
	+ have 1: "degree (a \<odot>\<^bsub>P\<^esub> p) = degree p"
	+ by (smt lcf_monom(1) P_def R.one_closed R.r_null UP_ring.coeff_smult UP_ring_axioms
	+ assms(1) assms(2) assms(3) coeff_simp cring_deg_mult deg_const monom_closed monom_mult_is_smult smult_one)
	+ then have "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (a \<odot>\<^bsub>P\<^esub> (ltrm p))"
	+ using lcf_eq[of "a \<odot>\<^bsub>P\<^esub> p"] smult_closed assms 0
	+ by (metis cfs_closed cfs_smult monom_mult_smult)
	+ then show ?thesis
	+ unfolding leading_term_def
	+ by (metis P_def R.m_closed UP_cring.lcf_monom UP_cring_axioms assms(1) assms(2) cfs_closed monom_mult_smult)
	+qed
	+
	+lemma(in UP_domain) lcf_scalar_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "lcf (a \<odot>\<^bsub>P\<^esub> p) = a \<otimes> (lcf p)"
	+proof-
	+ have "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (ltrm (a \<odot>\<^bsub>P\<^esub> p))"
	+ using lcf_eq UP_smult_closed assms(1) assms(2) by blast
	+ then have "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (a \<odot>\<^bsub>P\<^esub> (ltrm p))"
	+ using ltrm_smult assms(1) assms(2) by metis
	+ then show ?thesis
	+ by (metis (full_types) UP_smult_zero assms(1) assms(2) cfs_smult cfs_zero deg_smult)
	+qed
	+
	+lemma(in UP_cring) cring_lcf_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "(lcf p) \<otimes> (lcf q) \<noteq>\<zero>"
	+ shows "lcf (p \<otimes>\<^bsub>P\<^esub> q) = (lcf p) \<otimes> (lcf q)"
	+ using assms cring_ltrm_mult
	+ by (smt lcf_monom(1) P.m_closed R.m_closed cfs_closed monom_mult)
	+
	+lemma(in UP_domain) lcf_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "lcf (p \<otimes>\<^bsub>P\<^esub> q) = (lcf p) \<otimes> (lcf q)"
	+ by (smt ltrm_deg_0 R.integral_iff assms(1) assms(2) cfs_closed cring_lcf_mult deg_zero deg_ltrm local.integral_iff monom_zero)
	+
	+lemma(in UP_cring) cring_lcf_pow:
	+ assumes "p \<in> carrier P"
	+ assumes "(lcf p)[^]n \<noteq>\<zero>"
	+ shows "lcf (p[^]\<^bsub>P\<^esub>(n::nat)) = (lcf p)[^]n"
	+ by (smt P.nat_pow_closed R.nat_pow_closed assms(1) assms(2) cring_pow_ltrm lcf_closed lcf_ltrm lcf_monom monom_pow)
	+
	+lemma(in UP_domain) lcf_pow:
	+ assumes "p \<in> carrier P"
	+ shows "lcf (p[^]\<^bsub>P\<^esub>(n::nat)) = (lcf p)[^]n"
	+proof-
	+ show ?thesis
	+ proof(induction n)
	+ case 0
	+ then show ?case
	+ by (metis Group.nat_pow_0 P_def R.one_closed UP_cring.lcf_monom UP_cring_axioms monom_one)
	+ next
	+ case (Suc n)
	+ fix n
	+ assume IH: "lcf (p[^]\<^bsub>P\<^esub>(n::nat)) = (lcf p)[^]n"
	+ show "lcf (p[^]\<^bsub>P\<^esub>(Suc n)) = (lcf p)[^](Suc n)"
	+ proof-
	+ have "lcf (p[^]\<^bsub>P\<^esub>(Suc n)) = lcf ((p[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub>p)"
	+ by simp
	+ then have "lcf (p[^]\<^bsub>P\<^esub>(Suc n)) = (lcf p)[^]n \<otimes> (lcf p)"
	+ by (simp add: IH assms lcf_mult)
	+ then show ?thesis by auto
	+ qed
	+ qed
	+qed
	+end
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Constant Terms and Constant Coefficients\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+text\<open>Constant term and coefficient function\<close>
	+
	+definition zcf where
	+"zcf f = (f 0)"
	+
	+abbreviation(in UP_cring)(input) ctrm where
	+"ctrm f \<equiv> monom P (f 0) 0"
	+
	+context UP_cring
	+begin
	+
	+lemma ctrm_is_poly:
	+ assumes "p \<in> carrier P"
	+ shows "ctrm p \<in> carrier P"
	+ by (simp add: assms cfs_closed)
	+
	+lemma ctrm_degree:
	+ assumes "p \<in> carrier P"
	+ shows "degree (ctrm p) = 0"
	+ by (simp add: assms cfs_closed)
	+
	+lemma ctrm_zcf:
	+assumes "f \<in> carrier P"
	+assumes "zcf f = \<zero>"
	+shows "ctrm f = \<zero>\<^bsub>P\<^esub>"
	+ by (metis P_def UP_ring.monom_zero UP_ring_axioms zcf_def assms(2))
	+
	+lemma zcf_degree_zero:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = 0"
	+ shows "lcf f = zcf f"
	+ by (simp add: zcf_def assms(2))
	+
	+lemma zcf_zero_degree_zero:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = 0"
	+ assumes "zcf f = \<zero>"
	+ shows "f = \<zero>\<^bsub>P\<^esub>"
	+ using zcf_degree_zero[of f] assms ltrm_deg_0[of f]
	+ by simp
	+
	+lemma zcf_ctrm:
	+ assumes "p \<in> carrier P"
	+ shows "zcf (ctrm p) = zcf p"
	+ unfolding zcf_def
	+ using P_def UP_ring.cfs_monom UP_ring_axioms assms cfs_closed by fastforce
	+
	+lemma ctrm_trunc:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p >0"
	+ shows "zcf(trunc p) = zcf p"
	+ by (simp add: zcf_def assms(1) assms(2) trunc_cfs)
	+
	+text\<open>Constant coefficient function is a ring homomorphism\<close>
	+
	+
	+lemma zcf_add:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "zcf(p \<oplus>\<^bsub>P\<^esub> q) = (zcf p) \<oplus> (zcf q)"
	+ by (simp add: zcf_def assms(1) assms(2))
	+
	+lemma coeff_ltrm[simp]:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p > 0"
	+ shows "zcf(ltrm p) = \<zero>"
	+ by (metis ltrm_cfs_above_deg ltrm_cfs zcf_def assms(1) assms(2))
	+
	+lemma zcf_zero[simp]:
	+"zcf \<zero>\<^bsub>P\<^esub> = \<zero>"
	+ using zcf_degree_zero by auto
	+
	+lemma zcf_one[simp]:
	+"zcf \<one>\<^bsub>P\<^esub> = \<one>"
	+ by (simp add: zcf_def)
	+
	+lemma ctrm_smult:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "ctrm (a \<odot>\<^bsub>P\<^esub> f) = a \<odot>\<^bsub>P\<^esub>(ctrm f)"
	+ using P_def UP_ring.monom_mult_smult UP_ring_axioms assms(1) assms(2) cfs_smult coeff_simp
	+ by (simp add: UP_ring.monom_mult_smult cfs_closed)
	+
	+lemma ctrm_monom[simp]:
	+ assumes "a \<in> carrier R"
	+ shows "ctrm (monom P a (Suc k)) = \<zero>\<^bsub>P\<^esub>"
	+ by (simp add: assms cfs_monom)
	+end
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Polynomial Induction Rules\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+context UP_ring
	+begin
	+
	+text\<open>Rule for strong induction on polynomial degree\<close>
	+
	+lemma poly_induct:
	+ assumes "p \<in> carrier P"
	+ assumes Deg_0: "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> Q p"
	+ assumes IH: "\<And>p. (\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q) \<Longrightarrow> p \<in> carrier P \<Longrightarrow> degree p > 0 \<Longrightarrow> Q p"
	+ shows "Q p"
	+proof-
	+ have "\<And>n. \<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> Q p"
	+ proof-
	+ fix n
	+ show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> Q p"
	+ proof(induction n)
	+ case 0
	+ then show ?case
	+ using Deg_0 by simp
	+ next
	+ case (Suc n)
	+ fix n
	+ assume I: "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> Q p"
	+ show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> (Suc n) \<Longrightarrow> Q p"
	+ proof-
	+ fix p
	+ assume A0: " p \<in> carrier P "
	+ assume A1: "degree p \<le>Suc n"
	+ show "Q p"
	+ proof(cases "degree p < Suc n")
	+ case True
	+ then show ?thesis
	+ using I A0 by auto
	+ next
	+ case False
	+ then have D: "degree p = Suc n"
	+ by (simp add: A1 nat_less_le)
	+ then have "(\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q)"
	+ using I by simp
	+ then show "Q p"
	+ using IH D A0 A1 Deg_0 by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ then show ?thesis using assms by blast
	+qed
	+
	+text\<open>Variant on induction on degree\<close>
	+
	+lemma poly_induct2:
	+ assumes "p \<in> carrier P"
	+ assumes Deg_0: "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> Q p"
	+ assumes IH: "\<And>p. degree p > 0 \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q (trunc p) \<Longrightarrow> Q p"
	+ shows "Q p"
	+proof(rule poly_induct)
	+ show "p \<in> carrier P"
	+ by (simp add: assms(1))
	+ show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> Q p"
	+ by (simp add: Deg_0)
	+ show "\<And>p. (\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q) \<Longrightarrow> p \<in> carrier P \<Longrightarrow> 0 < degree p \<Longrightarrow> Q p"
	+ proof-
	+ fix p
	+ assume A0: "(\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q)"
	+ assume A1: " p \<in> carrier P"
	+ assume A2: "0 < degree p"
	+ show "Q p"
	+ proof-
	+ have "degree (trunc p) < degree p"
	+ by (simp add: A1 A2 trunc_degree)
	+ have "Q (trunc p)"
	+ by (simp add: A0 A1 \<open>degree (trunc p) < degree p\<close> trunc_closed)
	+ then show ?thesis
	+ by (simp add: A1 A2 IH)
	+ qed
	+ qed
	+qed
	+
	+text\<open>Additive properties which are true for all monomials are true for all polynomials \<close>
	+
	+lemma poly_induct3:
	+ assumes "p \<in> carrier P"
	+ assumes add: "\<And>p q. q \<in> carrier P \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q q \<Longrightarrow> Q (p \<oplus>\<^bsub>P\<^esub> q)"
	+ assumes monom: "\<And>a n. a \<in> carrier R \<Longrightarrow> Q (monom P a n)"
	+ shows "Q p"
	+ apply(rule poly_induct2)
	+ apply (simp add: assms(1))
	+ apply (metis lcf_closed P_def coeff_simp deg_zero_impl_monom monom)
	+ by (metis lcf_closed ltrm_closed add monom trunc_closed trunc_simps(1))
	+
	+lemma poly_induct4:
	+ assumes "p \<in> carrier P"
	+ assumes add: "\<And>p q. q \<in> carrier P \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q q \<Longrightarrow> Q (p \<oplus>\<^bsub>P\<^esub> q)"
	+ assumes monom_zero: "\<And>a. a \<in> carrier R \<Longrightarrow> Q (monom P a 0)"
	+ assumes monom_Suc: "\<And>a n. a \<in> carrier R \<Longrightarrow> Q (monom P a (Suc n))"
	+ shows "Q p"
	+ apply(rule poly_induct3)
	+ using assms(1) apply auto[1]
	+ using add apply blast
	+ using monom_zero monom_Suc
	+ by (metis P_def UP_ring.monom_zero UP_ring_axioms deg_monom deg_monom_le le_0_eq le_SucE zero_induct)
	+
	+lemma monic_monom_smult:
	+ assumes "a \<in> carrier R"
	+ shows "a \<odot>\<^bsub>P\<^esub> monom P \<one> n = monom P a n"
	+ using assms
	+ by (metis R.one_closed R.r_one monom_mult_smult)
	+
	+lemma poly_induct5:
	+ assumes "p \<in> carrier P"
	+ assumes add: "\<And>p q. q \<in> carrier P \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q q \<Longrightarrow> Q (p \<oplus>\<^bsub>P\<^esub> q)"
	+ assumes monic_monom: "\<And>n. Q (monom P \<one> n)"
	+ assumes smult: "\<And>p a . a \<in> carrier R \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q (a \<odot>\<^bsub>P\<^esub> p)"
	+ shows "Q p"
	+ apply(rule poly_induct3)
	+ apply (simp add: assms(1))
	+ using add apply blast
	+proof-
	+ fix a n assume A: "a \<in> carrier R" show "Q (monom P a n)"
	+ using monic_monom[of n] smult[of a "monom P \<one> n"] monom_mult_smult[of a \<one> n]
	+ by (simp add: A)
	+qed
	+
	+lemma poly_induct6:
	+ assumes "p \<in> carrier P"
	+ assumes monom: "\<And>a n. a \<in> carrier R \<Longrightarrow> Q (monom P a 0)"
	+ assumes plus_monom: "\<And>a n p. a \<in> carrier R \<Longrightarrow> a \<noteq> \<zero> \<Longrightarrow> p \<in> carrier P \<Longrightarrow> degree p < n \<Longrightarrow> Q p \<Longrightarrow>
	+ Q(p \<oplus>\<^bsub>P\<^esub> monom P a n)"
	+ shows "Q p"
	+ apply(rule poly_induct2)
	+ using assms(1) apply auto[1]
	+ apply (metis lcf_closed P_def coeff_simp deg_zero_impl_monom monom)
	+ using plus_monom
	+ by (metis lcf_closed P_def coeff_simp lcoeff_nonzero_deg nat_less_le trunc_closed trunc_degree trunc_simps(1))
	+
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Mapping a Polynomial to its Associated Ring Function\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+
	+text\<open>Turning a polynomial into a function on R:\<close>
	+definition to_function where
	+"to_function S f = (\<lambda>s \<in> carrier S. eval S S (\<lambda>x. x) s f)"
	+
	+context UP_cring
	+begin
	+
	+definition to_fun where
	+"to_fun f \<equiv> to_function R f"
	+
	+text\<open>Explicit formula for evaluating a polynomial function:\<close>
	+
	+lemma to_fun_eval:
	+ assumes "f \<in> carrier P"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun f x = eval R R (\<lambda>x. x) x f"
	+ using assms unfolding to_function_def to_fun_def
	+ by auto
	+
	+lemma to_fun_formula:
	+ assumes "f \<in> carrier P"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun f x = (\<Oplus>i \<in> {..degree f}. (f i) \<otimes> x [^] i)"
	+proof-
	+ have "f \<in> carrier (UP R)"
	+ using assms P_def by auto
	+ then have "eval R R (\<lambda>x. x) x f = (\<Oplus>\<^bsub>R\<^esub>i\<in>{..deg R f}. (\<lambda>x. x) (coeff (UP R) f i) \<otimes>\<^bsub>R\<^esub> x [^]\<^bsub>R\<^esub> i)"
	+ apply(simp add:UnivPoly.eval_def) done
	+ then have "to_fun f x = (\<Oplus>\<^bsub>R\<^esub>i\<in>{..deg R f}. (\<lambda>x. x) (coeff (UP R) f i) \<otimes>\<^bsub>R\<^esub> x [^]\<^bsub>R\<^esub> i)"
	+ using to_function_def assms unfolding to_fun_def
	+ by (simp add: to_function_def)
	+ then show ?thesis
	+ by(simp add: assms coeff_simp)
	+qed
	+
	+lemma eval_ring_hom:
	+ assumes "a \<in> carrier R"
	+ shows "eval R R (\<lambda>x. x) a \<in> ring_hom P R"
	+proof-
	+ have "(\<lambda>x. x) \<in> ring_hom R R"
	+ apply(rule ring_hom_memI)
	+ apply auto done
	+ then have "UP_pre_univ_prop R R (\<lambda>x. x)"
	+ using R_cring UP_pre_univ_propI by blast
	+ then show ?thesis
	+ by (simp add: P_def UP_pre_univ_prop.eval_ring_hom assms)
	+qed
	+
	+lemma to_fun_closed:
	+ assumes "f \<in> carrier P"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun f x \<in> carrier R"
	+ using assms to_fun_eval[of f x] eval_ring_hom[of x]
	+ ring_hom_closed
	+ by fastforce
	+
	+lemma to_fun_plus:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun (f \<oplus>\<^bsub>P\<^esub> g) x = (to_fun f x) \<oplus> (to_fun g x)"
	+ using assms to_fun_eval[of ] eval_ring_hom[of x]
	+ by (simp add: ring_hom_add)
	+
	+lemma to_fun_mult:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun (f \<otimes>\<^bsub>P\<^esub> g) x = (to_fun f x) \<otimes> (to_fun g x)"
	+ using assms to_fun_eval[of ] eval_ring_hom[of x]
	+ by (simp add: ring_hom_mult)
	+
	+lemma to_fun_ring_hom:
	+ assumes "a \<in> carrier R"
	+ shows "(\<lambda>p. to_fun p a) \<in> ring_hom P R"
	+ apply(rule ring_hom_memI)
	+ apply (simp add: assms to_fun_closed)
	+ apply (simp add: assms to_fun_mult)
	+ apply (simp add: assms to_fun_plus)
	+ using to_fun_eval[of "\<one>\<^bsub>P\<^esub>" a] eval_ring_hom[of a]
	+ ring_hom_closed
	+ by (simp add: assms ring_hom_one)
	+
	+lemma ring_hom_uminus:
	+ assumes "ring S"
	+ assumes "f \<in> (ring_hom S R)"
	+ assumes "a \<in> carrier S"
	+ shows "f (\<ominus>\<^bsub>S\<^esub> a) = \<ominus> (f a)"
	+proof-
	+ have "f (a \<ominus>\<^bsub>S\<^esub> a) = (f a) \<oplus> f (\<ominus>\<^bsub>S\<^esub> a)"
	+ unfolding a_minus_def
	+ by (simp add: assms(1) assms(2) assms(3) ring.ring_simprules(3) ring_hom_add)
	+ then have "(f a) \<oplus> f (\<ominus>\<^bsub>S\<^esub> a) = \<zero> "
	+ by (metis R.ring_axioms a_minus_def assms(1) assms(2) assms(3)
	+ ring.ring_simprules(16) ring_hom_zero)
	+ then show ?thesis
	+ by (metis (no_types, lifting) R.add.m_comm R.minus_equality assms(1)
	+ assms(2) assms(3) ring.ring_simprules(3) ring_hom_closed)
	+qed
	+
	+lemma to_fun_minus:
	+ assumes "f \<in> carrier P"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun (\<ominus>\<^bsub>P\<^esub>f) x = \<ominus> (to_fun f x)"
	+ unfolding to_function_def to_fun_def
	+ using eval_ring_hom[of x] assms
	+ by (simp add: UP_ring ring_hom_uminus)
	+
	+lemma id_is_hom:
	+"ring_hom_cring R R (\<lambda>x. x)"
	+proof(rule ring_hom_cringI)
	+ show "cring R"
	+ by (simp add: R_cring )
	+ show "cring R"
	+ by (simp add: R_cring )
	+ show "(\<lambda>x. x) \<in> ring_hom R R"
	+ unfolding ring_hom_def
	+ apply(auto)
	+ done
	+qed
	+
	+lemma UP_pre_univ_prop_fact:
	+"UP_pre_univ_prop R R (\<lambda>x. x)"
	+ unfolding UP_pre_univ_prop_def
	+ by (simp add: UP_cring_def R_cring id_is_hom)
	+
	+end
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>to-fun is a Ring Homomorphism from Polynomials to Functions\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+context UP_cring
	+begin
	+
	+lemma to_fun_is_Fun:
	+ assumes "x \<in> carrier P"
	+ shows "to_fun x \<in> carrier (Fun R)"
	+ apply(rule ring_functions.function_ring_car_memI)
	+ unfolding ring_functions_def apply(simp add: R.ring_axioms)
	+ using to_fun_closed assms apply auto[1]
	+ unfolding to_function_def to_fun_def by auto
	+
	+lemma to_fun_Fun_mult:
	+ assumes "x \<in> carrier P"
	+ assumes "y \<in> carrier P"
	+ shows "to_fun (x \<otimes>\<^bsub>P\<^esub> y) = to_fun x \<otimes>\<^bsub>function_ring (carrier R) R\<^esub> to_fun y"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
	+ apply (simp add: R.ring_axioms ring_functions_def)
	+ apply (simp add: assms(1) assms(2) to_fun_is_Fun)
	+ apply (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_mult_closed ring_functions.intro to_fun_is_Fun)
	+ by (simp add: R.ring_axioms assms(1) assms(2) ring_functions.function_mult_eval_car ring_functions.intro to_fun_is_Fun to_fun_mult)
	+
	+lemma to_fun_Fun_add:
	+ assumes "x \<in> carrier P"
	+ assumes "y \<in> carrier P"
	+ shows "to_fun (x \<oplus>\<^bsub>P\<^esub> y) = to_fun x \<oplus>\<^bsub>function_ring (carrier R) R\<^esub> to_fun y"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
	+ apply (simp add: R.ring_axioms ring_functions_def)
	+ apply (simp add: assms(1) assms(2) to_fun_is_Fun)
	+ apply (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_add_closed ring_functions.intro to_fun_is_Fun)
	+ by (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_add_eval_car ring_functions.intro to_fun_is_Fun to_fun_plus)
	+
	+lemma to_fun_Fun_one:
	+"to_fun \<one>\<^bsub>P\<^esub> = \<one>\<^bsub>Fun R\<^esub>"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
	+ apply (simp add: R.ring_axioms ring_functions_def)
	+ apply (simp add: to_fun_is_Fun)
	+ apply (simp add: R.ring_axioms ring_functions.function_one_closed ring_functions_def)
	+ using P_def R.ring_axioms UP_cring.eval_ring_hom UP_cring.to_fun_eval UP_cring_axioms UP_one_closed ring_functions.function_one_eval ring_functions.intro ring_hom_one
	+ by fastforce
	+
	+lemma to_fun_Fun_zero:
	+"to_fun \<zero>\<^bsub>P\<^esub> = \<zero>\<^bsub>Fun R\<^esub>"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
	+ apply (simp add: R.ring_axioms ring_functions_def)
	+ apply (simp add: to_fun_is_Fun)
	+ apply (simp add: R.ring_axioms ring_functions.function_zero_closed ring_functions_def)
	+ using P_def R.ring_axioms UP_cring.eval_ring_hom UP_cring.to_fun_eval UP_cring_axioms UP_zero_closed ring_functions.function_zero_eval ring_functions.intro ring_hom_zero
	+ by (metis UP_ring eval_ring_hom)
	+
	+lemma to_fun_function_ring_hom:
	+"to_fun \<in> ring_hom P (Fun R)"
	+ apply(rule ring_hom_memI)
	+ using to_fun_is_Fun apply auto[1]
	+ apply (simp add: to_fun_Fun_mult)
	+ apply (simp add: to_fun_Fun_add)
	+ by (simp add: to_fun_Fun_one)
	+
	+lemma(in UP_cring) to_fun_one:
	+ assumes "a \<in> carrier R"
	+ shows "to_fun \<one>\<^bsub>P\<^esub> a = \<one>"
	+ using assms to_fun_Fun_one
	+ by (metis P_def UP_cring.to_fun_eval UP_cring_axioms UP_one_closed eval_ring_hom ring_hom_one)
	+
	+lemma(in UP_cring) to_fun_zero:
	+ assumes "a \<in> carrier R"
	+ shows "to_fun \<zero>\<^bsub>P\<^esub> a = \<zero>"
	+ by (simp add: assms R.ring_axioms ring_functions.function_zero_eval ring_functions.intro to_fun_Fun_zero)
	+
	+lemma(in UP_cring) to_fun_nat_pow:
	+ assumes "h \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ shows "to_fun (h[^]\<^bsub>UP R\<^esub>(n::nat)) a = (to_fun h a)[^]n"
	+ apply(induction n)
	+ using assms to_fun_one
	+ apply (metis P.nat_pow_0 P_def R.nat_pow_0)
	+ using assms to_fun_mult P.nat_pow_closed P_def by auto
	+
	+lemma(in UP_cring) to_fun_finsum:
	+ assumes "finite (Y::'d set)"
	+ assumes "f \<in> UNIV \<rightarrow> carrier (UP R)"
	+ assumes "t \<in> carrier R"
	+ shows "to_fun (finsum (UP R) f Y) t = finsum R (\<lambda>i. (to_fun (f i) t)) Y"
	+proof(rule finite.induct[of Y])
	+ show "finite Y"
	+ using assms by blast
	+ show "to_fun (finsum (UP R) f {}) t = (\<Oplus>i\<in>{}. to_fun (f i) t)"
	+ using P.finsum_empty[of f] assms unfolding P_def R.finsum_empty
	+ using P_def to_fun_zero by presburger
	+ show "\<And>A a. finite A \<Longrightarrow>
	+ to_fun (finsum (UP R) f A) t = (\<Oplus>i\<in>A. to_fun (f i) t) \<Longrightarrow> to_fun (finsum (UP R) f (insert a A)) t = (\<Oplus>i\<in>insert a A. to_fun (f i) t)"
	+ proof-
	+ fix A :: "'d set" fix a
	+ assume A: "finite A" "to_fun (finsum (UP R) f A) t = (\<Oplus>i\<in>A. to_fun (f i) t)"
	+ show "to_fun (finsum (UP R) f (insert a A)) t = (\<Oplus>i\<in>insert a A. to_fun (f i) t)"
	+ proof(cases "a \<in> A")
	+ case True
	+ then show ?thesis using A
	+ by (metis insert_absorb)
	+ next
	+ case False
	+ have 0: "finsum (UP R) f (insert a A) = f a \<oplus>\<^bsub>UP R\<^esub> finsum (UP R) f A"
	+ using A False finsum_insert[of A a f] assms unfolding P_def by blast
	+ have 1: "to_fun (f a \<oplus>\<^bsub>P\<^esub>finsum (UP R) f A ) t = to_fun (f a) t \<oplus> to_fun (finsum (UP R) f A) t"
	+ apply(rule to_fun_plus[of "finsum (UP R) f A" "f a" t])
	+ using assms(2) finsum_closed[of f A] A unfolding P_def apply blast
	+ using P_def assms apply blast
	+ using assms by blast
	+ have 2: "to_fun (f a \<oplus>\<^bsub>P\<^esub>finsum (UP R) f A ) t = to_fun (f a) t \<oplus> (\<Oplus>i\<in>A. to_fun (f i) t)"
	+ unfolding 1 A by blast
	+ have 3: "(\<Oplus>i\<in>insert a A. to_fun (f i) t) = to_fun (f a) t \<oplus> (\<Oplus>i\<in>A. to_fun (f i) t)"
	+ apply(rule R.finsum_insert, rule A, rule False)
	+ using to_fun_closed assms unfolding P_def apply blast
	+ apply(rule to_fun_closed) using assms unfolding P_def apply blast using assms by blast
	+ show ?thesis
	+ unfolding 0 unfolding 3 using 2 unfolding P_def by blast
	+ qed
	+ qed
	+qed
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+subsection\<open>Inclusion of a Ring into its Polynomials Ring via Constants\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+definition to_polynomial where
	+"to_polynomial R = (\<lambda>a. monom (UP R) a 0)"
	+
	+context UP_cring
	+begin
	+
	+abbreviation(input) to_poly where
	+"to_poly \<equiv> to_polynomial R"
	+
	+lemma to_poly_mult_simp:
	+ assumes "b \<in> carrier R"
	+ assumes "f \<in> carrier (UP R)"
	+ shows "(to_polynomial R b) \<otimes>\<^bsub>UP R\<^esub> f = b \<odot>\<^bsub>UP R\<^esub> f"
	+ "f \<otimes>\<^bsub>UP R\<^esub> (to_polynomial R b) = b \<odot>\<^bsub>UP R\<^esub> f"
	+ unfolding to_polynomial_def
	+ using assms P_def monom_mult_is_smult apply auto[1]
	+ using UP_cring.UP_m_comm UP_cring_axioms UP_ring.monom_closed
	+ UP_ring.monom_mult_is_smult UP_ring_axioms assms(1) assms(2)
	+ by fastforce
	+
	+lemma to_fun_to_poly:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (to_poly a) b = a"
	+ unfolding to_function_def to_fun_def to_polynomial_def
	+ by (simp add: UP_pre_univ_prop.eval_const UP_pre_univ_prop_fact assms(1) assms(2))
	+
	+lemma to_poly_inverse:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = 0"
	+ shows "f = to_poly (f 0)"
	+ using P_def assms(1) assms(2)
	+ by (metis ltrm_deg_0 to_polynomial_def)
	+
	+lemma to_poly_closed:
	+ assumes "a \<in> carrier R"
	+ shows "to_poly a \<in> carrier P"
	+ by (metis P_def assms monom_closed to_polynomial_def)
	+
	+lemma degree_to_poly[simp]:
	+ assumes "a \<in> carrier R"
	+ shows "degree (to_poly a) = 0"
	+ by (metis P_def assms deg_const to_polynomial_def)
	+
	+lemma to_poly_is_ring_hom:
	+"to_poly \<in> ring_hom R P"
	+ unfolding to_polynomial_def
	+ unfolding P_def
	+ using UP_ring.const_ring_hom[of R]
	+ UP_ring_axioms by simp
	+
	+lemma to_poly_add:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_poly (a \<oplus> b) = to_poly a \<oplus>\<^bsub>P\<^esub> to_poly b"
	+ by (simp add: assms(1) assms(2) ring_hom_add to_poly_is_ring_hom)
	+
	+lemma to_poly_mult:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_poly (a \<otimes> b) = to_poly a \<otimes>\<^bsub>P\<^esub> to_poly b"
	+ by (simp add: assms(1) assms(2) ring_hom_mult to_poly_is_ring_hom)
	+
	+lemma to_poly_minus:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_poly (a \<ominus> b) = to_poly a \<ominus>\<^bsub>P\<^esub> to_poly b"
	+ by (metis P.minus_eq P_def R.add.inv_closed R.ring_axioms UP_ring.monom_add
	+ UP_ring_axioms assms(1) assms(2) monom_a_inv ring.ring_simprules(14) to_polynomial_def)
	+
	+lemma to_poly_a_inv:
	+ assumes "a \<in> carrier R"
	+ shows "to_poly (\<ominus> a) = \<ominus>\<^bsub>P\<^esub> to_poly a"
	+ by (metis P_def assms monom_a_inv to_polynomial_def)
	+
	+lemma to_poly_nat_pow:
	+ assumes "a \<in> carrier R"
	+ shows "(to_poly a) [^]\<^bsub>P\<^esub> (n::nat)= to_poly (a[^]n)"
	+ using assms UP_cring UP_cring_axioms UP_cring_def UnivPoly.ring_hom_cringI ring_hom_cring.hom_pow to_poly_is_ring_hom
	+ by fastforce
	+
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Polynomial Substitution\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+definition compose where
	+"compose R f g = eval R (UP R) (to_polynomial R) g f"
	+
	+abbreviation(in UP_cring)(input) sub (infixl "of" 70) where
	+"sub f g \<equiv> compose R f g"
	+
	+definition rev_compose where
	+"rev_compose R = eval R (UP R) (to_polynomial R)"
	+
	+abbreviation(in UP_cring)(input) rev_sub where
	+"rev_sub \<equiv> rev_compose R"
	+
	+context UP_cring
	+begin
	+
	+lemma sub_rev_sub:
	+"sub f g = rev_sub g f"
	+ unfolding compose_def rev_compose_def
	+ by simp
	+
	+lemma(in UP_cring) to_poly_UP_pre_univ_prop:
	+"UP_pre_univ_prop R P to_poly"
	+proof
	+ show "to_poly \<in> ring_hom R P"
	+ by (simp add: to_poly_is_ring_hom)
	+qed
	+
	+lemma rev_sub_is_hom:
	+ assumes "g \<in> carrier P"
	+ shows "rev_sub g \<in> ring_hom P P"
	+ unfolding rev_compose_def
	+ using to_poly_UP_pre_univ_prop assms(1) UP_pre_univ_prop.eval_ring_hom[of R P to_poly g]
	+ unfolding P_def apply auto
	+ done
	+
	+lemma rev_sub_closed:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "rev_sub q p \<in> carrier P"
	+ using rev_sub_is_hom[of q] assms ring_hom_closed[of "rev_sub q" P P p] by auto
	+
	+lemma sub_closed:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "sub q p \<in> carrier P"
	+ by (simp add: assms(1) assms(2) rev_sub_closed sub_rev_sub)
	+
	+lemma rev_sub_add:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "h \<in>carrier P"
	+ shows "rev_sub g (f \<oplus>\<^bsub>P\<^esub> h) = (rev_sub g f) \<oplus>\<^bsub>P\<^esub> (rev_sub g h)"
	+ using rev_sub_is_hom assms ring_hom_add by fastforce
	+
	+lemma sub_add:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "h \<in>carrier P"
	+ shows "((f \<oplus>\<^bsub>P\<^esub> h) of g) = ((f of g) \<oplus>\<^bsub>P\<^esub> (h of g))"
	+ by (simp add: assms(1) assms(2) assms(3) rev_sub_add sub_rev_sub)
	+
	+lemma rev_sub_mult:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "h \<in>carrier P"
	+ shows "rev_sub g (f \<otimes>\<^bsub>P\<^esub> h) = (rev_sub g f) \<otimes>\<^bsub>P\<^esub> (rev_sub g h)"
	+ using rev_sub_is_hom assms ring_hom_mult by fastforce
	+
	+lemma sub_mult:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "h \<in>carrier P"
	+ shows "((f \<otimes>\<^bsub>P\<^esub> h) of g) = ((f of g) \<otimes>\<^bsub>P\<^esub> (h of g))"
	+ by (simp add: assms(1) assms(2) assms(3) rev_sub_mult sub_rev_sub)
	+
	+lemma sub_monom:
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ shows "sub (monom (UP R) a n) g = to_poly a \<otimes>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub> (n::nat))"
	+ "sub (monom (UP R) a n) g = a \<odot>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub> (n::nat))"
	+ apply (simp add: UP_cring.to_poly_UP_pre_univ_prop UP_cring_axioms
	+ UP_pre_univ_prop.eval_monom assms(1) assms(2) Cring_Poly.compose_def)
	+ by (metis P_def UP_cring.to_poly_mult_simp(1) UP_cring_axioms UP_pre_univ_prop.eval_monom
	+ UP_ring assms(1) assms(2) Cring_Poly.compose_def monoid.nat_pow_closed ring_def to_poly_UP_pre_univ_prop)
	+
	+text\<open>Subbing into a constant does nothing\<close>
	+
	+lemma rev_sub_to_poly:
	+ assumes "g \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "rev_sub g (to_poly a) = to_poly a"
	+ unfolding to_polynomial_def rev_compose_def
	+ using to_poly_UP_pre_univ_prop
	+ unfolding to_polynomial_def
	+ using P_def UP_pre_univ_prop.eval_const assms(1) assms(2) by fastforce
	+
	+lemma sub_to_poly:
	+ assumes "g \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "(to_poly a) of g = to_poly a"
	+ by (simp add: assms(1) assms(2) rev_sub_to_poly sub_rev_sub)
	+
	+lemma sub_const:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = 0"
	+ shows "f of g = f"
	+ by (metis lcf_closed assms(1) assms(2) assms(3) sub_to_poly to_poly_inverse)
	+
	+text\<open>Substitution into a monomial\<close>
	+
	+lemma monom_sub:
	+ assumes "a \<in> carrier R"
	+ assumes "g \<in> carrier P"
	+ shows "(monom P a n) of g = a \<odot>\<^bsub>P\<^esub> g[^]\<^bsub>P\<^esub> n"
	+ unfolding compose_def
	+ using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g n] to_poly_UP_pre_univ_prop
	+ unfolding P_def
	+ using P.nat_pow_closed P_def to_poly_mult_simp(1)
	+ by (simp add: to_poly_mult_simp(1) UP_cring_axioms)
	+
	+lemma(in UP_cring) cring_sub_monom_bound:
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq>\<zero>"
	+ assumes "f = monom P a n"
	+ assumes "g \<in> carrier P"
	+ shows "degree (f of g) \<le> n*(degree g)"
	+proof-
	+ have "f of g = (to_poly a) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
	+ unfolding compose_def
	+ using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop
	+ unfolding P_def
	+ by blast
	+ then show ?thesis
	+ by (smt P.nat_pow_closed assms(1) assms(4) cring_pow_deg_bound deg_mult_ring
	+ degree_to_poly le_trans plus_nat.add_0 to_poly_closed)
	+qed
	+
	+lemma(in UP_cring) cring_sub_monom:
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq>\<zero>"
	+ assumes "f = monom P a n"
	+ assumes "g \<in> carrier P"
	+ assumes "a \<otimes> (lcf g [^] n) \<noteq> \<zero>"
	+ shows "degree (f of g) = n*(degree g)"
	+proof-
	+ have 0: "f of g = (to_poly a) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
	+ unfolding compose_def
	+ using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop
	+ unfolding P_def
	+ by blast
	+ have 1: "lcf (to_poly a) \<otimes> lcf (g [^]\<^bsub>P\<^esub> n) \<noteq> \<zero>"
	+ using assms
	+ by (smt P.nat_pow_closed P_def R.nat_pow_closed R.r_null cring_pow_ltrm lcf_closed lcf_ltrm lcf_monom monom_pow to_polynomial_def)
	+ then show ?thesis
	+ using 0 1 assms cring_pow_deg[of g n] cring_deg_mult[of "to_poly a" "g[^]\<^bsub>P\<^esub>n"]
	+ by (metis P.nat_pow_closed R.r_null add.right_neutral degree_to_poly to_poly_closed)
	+qed
	+
	+lemma(in UP_domain) sub_monom:
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq>\<zero>"
	+ assumes "f = monom P a n"
	+ assumes "g \<in> carrier P"
	+ shows "degree (f of g) = n*(degree g)"
	+proof-
	+ have "f of g = (to_poly a) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
	+ unfolding compose_def
	+ using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop
	+ unfolding P_def
	+ by blast
	+ then show ?thesis using deg_pow deg_mult
	+ by (metis P.nat_pow_closed P_def assms(1) assms(2)
	+ assms(4) deg_smult monom_mult_is_smult to_polynomial_def)
	+qed
	+
	+text\<open>Subbing a constant into a polynomial yields a constant\<close>
	+lemma sub_in_const:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree g = 0"
	+ shows "degree (f of g) = 0"
	+proof-
	+ have "\<And>n. (\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = 0)"
	+ proof-
	+ fix n
	+ show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = 0"
	+ proof(induction n)
	+ case 0
	+ then show ?case
	+ by (simp add: assms(1) sub_const)
	+ next
	+ case (Suc n)
	+ fix n
	+ assume IH: "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = 0"
	+ show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> (Suc n) \<Longrightarrow> degree (p of g) = 0"
	+ proof-
	+ fix p
	+ assume A0: "p \<in> carrier P"
	+ assume A1: "degree p \<le> (Suc n)"
	+ show "degree (p of g) = 0"
	+ proof(cases "degree p < Suc n")
	+ case True
	+ then show ?thesis using IH
	+ using A0 by auto
	+ next
	+ case False
	+ then have D: "degree p = Suc n"
	+ by (simp add: A1 nat_less_le)
	+ show ?thesis
	+ proof-
	+ have P0: "degree ((trunc p) of g) = 0" using IH
	+ by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
	+ have P1: "degree ((ltrm p) of g) = 0"
	+ proof-
	+ obtain a n where an_def: "ltrm p = monom P a n \<and> a \<in> carrier R"
	+ unfolding leading_term_def
	+ using A0 P_def cfs_closed by blast
	+ obtain b where b_def: "g = monom P b 0 \<and> b \<in> carrier R"
	+ using assms deg_zero_impl_monom coeff_closed
	+ by blast
	+ have 0: " monom P b 0 [^]\<^bsub>P\<^esub> n = monom P (b[^]n) 0"
	+ apply(induction n)
	+ apply fastforce[1]
	+ proof- fix n::nat assume IH: "monom P b 0 [^]\<^bsub>P\<^esub> n = monom P (b [^] n) 0"
	+ have "monom P b 0 [^]\<^bsub>P\<^esub> Suc n = (monom P (b[^]n) 0) \<otimes>\<^bsub>P\<^esub> monom P b 0"
	+ using IH by simp
	+ then have "monom P b 0 [^]\<^bsub>P\<^esub> Suc n = (monom P ((b[^]n)\<otimes>b) 0)"
	+ using b_def
	+ by (simp add: monom_mult_is_smult monom_mult_smult)
	+ then show "monom P b 0 [^]\<^bsub>P\<^esub> Suc n = monom P (b [^] Suc n) 0 "
	+ by simp
	+ qed
	+
	+ then have 0: "a \<odot>\<^bsub>P\<^esub> monom P b 0 [^]\<^bsub>P\<^esub> n = monom P (a \<otimes> b[^]n) 0"
	+ by (simp add: an_def b_def monom_mult_smult)
	+
	+
	+ then show ?thesis using monom_sub[of a "monom P b 0" n] assms an_def
	+ by (simp add: \<open>\<lbrakk>a \<in> carrier R; monom P b 0 \<in> carrier P\<rbrakk> \<Longrightarrow> monom P a n of monom P b 0 = a \<odot>\<^bsub>P\<^esub> monom P b 0 [^]\<^bsub>P\<^esub> n\<close> b_def)
	+ qed
	+ have P2: "p of g = (trunc p of g) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of g)"
	+ by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
	+ then show ?thesis
	+ using P0 P1 P2 deg_add[of "trunc p of g" "ltrm p of g"]
	+ by (metis A0 assms(1) le_0_eq ltrm_closed max_0R sub_closed trunc_closed)
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ using assms(2) by blast
	+qed
	+
	+lemma (in UP_cring) cring_sub_deg_bound:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ shows "degree (f of g) \<le> degree f * degree g"
	+proof-
	+ have "\<And>n. \<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) \<le> degree p * degree g"
	+ proof-
	+ fix n::nat
	+ show "\<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) \<le> degree p * degree g"
	+ proof(induction n)
	+ case 0
	+ then have B0: "degree p = 0" by auto
	+ then show ?case using sub_const[of g p]
	+ by (simp add: "0.prems"(1) assms(1))
	+ next
	+ case (Suc n)
	+ fix n
	+ assume IH: "(\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) \<le> degree p * degree g)"
	+ show " p \<in> carrier P \<Longrightarrow> degree p \<le> Suc n \<Longrightarrow> degree (p of g) \<le> degree p * degree g"
	+ proof-
	+ assume A0: "p \<in> carrier P"
	+ assume A1: "degree p \<le> Suc n"
	+ show ?thesis
	+ proof(cases "degree p < Suc n")
	+ case True
	+ then show ?thesis using IH
	+ by (simp add: A0)
	+ next
	+ case False
	+ then have D: "degree p = Suc n"
	+ using A1 by auto
	+ have P0: "(p of g) = ((trunc p) of g) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of g)"
	+ by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
	+ have P1: "degree ((trunc p) of g) \<le> (degree (trunc p))*(degree g)"
	+ using IH by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
	+ have P2: "degree ((ltrm p) of g) \<le> (degree p) * degree g"
	+ using A0 D P_def UP_cring_axioms assms(1)
	+ by (metis False cfs_closed coeff_simp cring_sub_monom_bound deg_zero lcoeff_nonzero2 less_Suc_eq_0_disj)
	+ then show ?thesis
	+ proof(cases "degree g = 0")
	+ case True
	+ then show ?thesis
	+ by (simp add: Suc(2) assms(1) sub_in_const)
	+ next
	+ case F: False
	+ then show ?thesis
	+ proof-
	+ have P3: "degree ((trunc p) of g) \<le> n*degree g"
	+ using A0 False D P1 P2 IH[of "trunc p"] trunc_degree[of p]
	+ proof -
	+ { assume "degree (trunc p) < degree p"
	+ then have "degree (trunc p) \<le> n"
	+ using D by auto
	+ then have ?thesis
	+ by (meson P1 le_trans mult_le_cancel2) }
	+ then show ?thesis
	+ by (metis (full_types) A0 D Suc_mult_le_cancel1 nat_mult_le_cancel_disj trunc_degree)
	+ qed
	+ then have P3': "degree ((trunc p) of g) < (degree p)*degree g"
	+ using F D by auto
	+ have P4: "degree (ltrm p of g) \<le> (degree p)*degree g"
	+ using cring_sub_monom_bound D P2
	+ by auto
	+ then show ?thesis
	+ using D P0 P1 P3 P4 A0 P3' assms(1) bound_deg_sum less_imp_le_nat
	+ ltrm_closed sub_closed trunc_closed
	+ by metis
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ using assms(2) by blast
	+qed
	+
	+lemma (in UP_cring) cring_sub_deg:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "lcf f \<otimes> (lcf g [^] (degree f)) \<noteq> \<zero>"
	+ shows "degree (f of g) = degree f * degree g"
	+proof-
	+ have 0: "f of g = (trunc f of g) \<oplus>\<^bsub>P\<^esub> ((ltrm f) of g)"
	+ by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
	+ have 1: "lcf f \<noteq> \<zero>"
	+ using assms cring.cring_simprules(26) lcf_closed
	+ by auto
	+ have 2: "degree ((ltrm f) of g) = degree f * degree g"
	+ using 0 1 assms cring_sub_monom[of "lcf f" "ltrm f" "degree f" g] lcf_closed lcf_ltrm
	+ by blast
	+ show ?thesis
	+ apply(cases "degree f = 0")
	+ apply (simp add: assms(1) assms(2))
	+ apply(cases "degree g = 0")
	+ apply (simp add: assms(1) assms(2) sub_in_const)
	+ using 0 1 assms cring_sub_deg_bound[of g "trunc f"] trunc_degree[of f]
	+ using sub_const apply auto[1]
	+ apply(cases "degree g = 0")
	+ using 0 1 assms cring_sub_deg_bound[of g "trunc f"] trunc_degree[of f]
	+ using sub_in_const apply fastforce
	+ unfolding 0 using 1 2
	+ by (smt "0" ltrm_closed \<open>\<lbrakk>f \<in> carrier P; 0 < deg R f\<rbrakk> \<Longrightarrow> deg R (Cring_Poly.truncate R f) < deg R f\<close>
	+ assms(1) assms(2) cring_sub_deg_bound degree_of_sum_diff_degree equal_deg_sum
	+ le_eq_less_or_eq mult_less_cancel2 nat_neq_iff neq0_conv sub_closed trunc_closed)
	+qed
	+
	+lemma (in UP_domain) sub_deg0:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "g \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ assumes "f \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ shows "degree (f of g) = degree f * degree g"
	+proof-
	+ have "\<And>n. \<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) = degree p * degree g"
	+ proof-
	+ fix n::nat
	+ show "\<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) = degree p * degree g"
	+ proof(induction n)
	+ case 0
	+ then have B0: "degree p = 0" by auto
	+ then show ?case using sub_const[of g p]
	+ by (simp add: "0.prems"(1) assms(1))
	+ next
	+ case (Suc n)
	+ fix n
	+ assume IH: "(\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = degree p * degree g)"
	+ show " p \<in> carrier P \<Longrightarrow> degree p \<le> Suc n \<Longrightarrow> degree (p of g) = degree p * degree g"
	+ proof-
	+ assume A0: "p \<in> carrier P"
	+ assume A1: "degree p \<le> Suc n"
	+ show ?thesis
	+ proof(cases "degree p < Suc n")
	+ case True
	+ then show ?thesis using IH
	+ by (simp add: A0)
	+ next
	+ case False
	+ then have D: "degree p = Suc n"
	+ using A1 by auto
	+ have P0: "(p of g) = ((trunc p) of g) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of g)"
	+ by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
	+ have P1: "degree ((trunc p) of g) = (degree (trunc p))*(degree g)"
	+ using IH by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
	+ have P2: "degree ((ltrm p) of g) = (degree p) * degree g"
	+ using A0 D P_def UP_domain.sub_monom UP_cring_axioms assms(1)
	+ by (metis False UP_domain_axioms UP_ring.coeff_simp UP_ring.lcoeff_nonzero2 UP_ring_axioms cfs_closed deg_nzero_nzero less_Suc_eq_0_disj)
	+
	+ then show ?thesis
	+ proof(cases "degree g = 0")
	+ case True
	+ then show ?thesis
	+ by (simp add: Suc(2) assms(1) sub_in_const)
	+ next
	+ case False
	+ then show ?thesis
	+ proof-
	+ have P3: "degree ((trunc p) of g) < degree ((ltrm p) of g)"
	+ using False D P1 P2
	+ by (metis (no_types, lifting) A0 mult.commute mult_right_cancel
	+ nat_less_le nat_mult_le_cancel_disj trunc_degree zero_less_Suc)
	+ then show ?thesis
	+ by (simp add: A0 ltrm_closed P0 P2 assms(1) equal_deg_sum sub_closed trunc_closed)
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ using assms(2) by blast
	+qed
	+
	+lemma(in UP_domain) sub_deg:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "g \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ shows "degree (f of g) = degree f * degree g"
	+proof(cases "f = \<zero>\<^bsub>P\<^esub>")
	+ case True
	+ then show ?thesis
	+ using assms(1) sub_const by auto
	+next
	+ case False
	+ then show ?thesis
	+ by (simp add: assms(1) assms(2) assms(3) sub_deg0)
	+qed
	+
	+lemma(in UP_cring) cring_ltrm_sub:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree g > 0"
	+ assumes "lcf f \<otimes> (lcf g [^] (degree f)) \<noteq> \<zero>"
	+ shows "ltrm (f of g) = ltrm ((ltrm f) of g)"
	+proof-
	+ have P0: "degree (f of g) = degree ((ltrm f) of g)"
	+ using assms(1) assms(2) assms(4) cring_sub_deg lcf_eq ltrm_closed deg_ltrm
	+ by auto
	+ have P1: "f of g = ((trunc f) of g) \<oplus>\<^bsub>P\<^esub>((ltrm f) of g)"
	+ by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
	+ then show ?thesis
	+ proof(cases "degree f = 0")
	+ case True
	+ then show ?thesis
	+ using ltrm_deg_0 assms(2) by auto
	+ next
	+ case False
	+ have P2: "degree (f of g) = degree f * degree g"
	+ by (simp add: assms(1) assms(2) assms(4) cring_sub_deg)
	+ then have P3: "degree ((trunc f) of g) < degree ((ltrm f) of g)"
	+ using False P0 P1 P_def UP_cring.sub_closed trunc_closed UP_cring_axioms
	+ UP_ring.degree_of_sum_diff_degree UP_ring.ltrm_closed UP_ring_axioms assms(1)
	+ assms(2) assms(4) cring_sub_deg_bound le_antisym less_imp_le_nat less_nat_zero_code
	+ mult_right_le_imp_le nat_neq_iff trunc_degree
	+ by (smt assms(3))
	+ then show ?thesis using P0 P1 P2
	+ by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm assms(1) assms(2) sub_closed trunc_closed)
	+ qed
	+qed
	+
	+lemma(in UP_domain) ltrm_sub:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree g > 0"
	+ shows "ltrm (f of g) = ltrm ((ltrm f) of g)"
	+proof-
	+ have P0: "degree (f of g) = degree ((ltrm f) of g)"
	+ using sub_deg
	+ by (metis ltrm_closed assms(1) assms(2) assms(3) deg_zero deg_ltrm nat_neq_iff)
	+ have P1: "f of g = ((trunc f) of g) \<oplus>\<^bsub>P\<^esub>((ltrm f) of g)"
	+ by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
	+ then show ?thesis
	+ proof(cases "degree f = 0")
	+ case True
	+ then show ?thesis
	+ using ltrm_deg_0 assms(2) by auto
	+ next
	+ case False
	+ then have P2: "degree ((trunc f) of g) < degree ((ltrm f) of g)"
	+ using sub_deg
	+ by (metis (no_types, lifting) ltrm_closed assms(1) assms(2) assms(3) deg_zero
	+ deg_ltrm mult_less_cancel2 neq0_conv trunc_closed trunc_degree)
	+ then show ?thesis
	+ using P0 P1 P2
	+ by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm assms(1) assms(2) sub_closed trunc_closed)
	+ qed
	+qed
	+
	+lemma(in UP_cring) cring_lcf_of_sub_in_ltrm:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = n"
	+ assumes "degree g > 0"
	+ assumes "(lcf f) \<otimes> ((lcf g)[^]n) \<noteq>\<zero>"
	+ shows "lcf ((ltrm f) of g) = (lcf f) \<otimes> ((lcf g)[^]n)"
	+ by (metis (no_types, lifting) P.nat_pow_closed P_def R.r_null UP_cring.monom_sub UP_cring_axioms
	+ assms(1) assms(2) assms(3) assms(5) cfs_closed cring_lcf_pow cring_lcf_scalar_mult)
	+
	+lemma(in UP_domain) lcf_of_sub_in_ltrm:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = n"
	+ assumes "degree g > 0"
	+ shows "lcf ((ltrm f) of g) = (lcf f) \<otimes> ((lcf g)[^]n)"
	+proof(cases "degree f = 0")
	+ case True
	+ then show ?thesis
	+ using ltrm_deg_0 assms(1) assms(2) assms(3) cfs_closed
	+ by (simp add: sub_const)
	+next
	+ case False
	+ then show ?thesis
	+ proof-
	+ have P0: "(ltrm f) of g = (to_poly (lcf f)) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
	+ unfolding compose_def
	+ using assms UP_pre_univ_prop.eval_monom[of R P to_poly "(lcf f)" g n] to_poly_UP_pre_univ_prop
	+ unfolding P_def
	+ using P_def cfs_closed by blast
	+ have P1: "(ltrm f) of g = (lcf f) \<odot>\<^bsub>P\<^esub>(g[^]\<^bsub>P\<^esub>n)"
	+ using P0 P.nat_pow_closed
	+ by (simp add: assms(1) assms(2) assms(3) cfs_closed monom_sub)
	+ have P2: "ltrm ((ltrm f) of g) = (ltrm (to_poly (lcf f))) \<otimes>\<^bsub>P\<^esub> (ltrm (g[^]\<^bsub>P\<^esub>n))"
	+ using P0 ltrm_mult P.nat_pow_closed P_def assms(1) assms(2)
	+ to_poly_closed
	+ by (simp add: cfs_closed)
	+ have P3: "ltrm ((ltrm f) of g) = (to_poly (lcf f)) \<otimes>\<^bsub>P\<^esub> (ltrm (g[^]\<^bsub>P\<^esub>n))"
	+ using P2 ltrm_deg_0 assms(2) to_poly_closed
	+ by (simp add: cfs_closed)
	+ have P4: "ltrm ((ltrm f) of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
	+ using P.nat_pow_closed P1 P_def assms(1) assms(2) ltrm_pow0 ltrm_smult
	+ by (simp add: cfs_closed)
	+ have P5: "lcf ((ltrm f) of g) = (lcf f) \<otimes> (lcf ((ltrm g)[^]\<^bsub>P\<^esub>n))"
	+ using lcf_scalar_mult P4 by (metis P.nat_pow_closed P1 cfs_closed
	+ UP_smult_closed assms(1) assms(2) assms(3) lcf_eq ltrm_closed sub_rev_sub)
	+ show ?thesis
	+ using P5 ltrm_pow lcf_pow assms(1) lcf_eq ltrm_closed by presburger
	+ qed
	+qed
	+
	+lemma(in UP_cring) cring_ltrm_of_sub_in_ltrm:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = n"
	+ assumes "degree g > 0"
	+ assumes "(lcf f) \<otimes> ((lcf g)[^]n) \<noteq>\<zero>"
	+ shows "ltrm ((ltrm f) of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
	+ by (smt lcf_eq ltrm_closed R.nat_pow_closed R.r_null assms(1) assms(2) assms(3)
	+ assms(4) assms(5) cfs_closed cring_lcf_of_sub_in_ltrm cring_lcf_pow cring_pow_ltrm
	+ cring_pow_deg cring_sub_deg deg_zero deg_ltrm monom_mult_smult neq0_conv)
	+
	+lemma(in UP_domain) ltrm_of_sub_in_ltrm:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = n"
	+ assumes "degree g > 0"
	+ shows "ltrm ((ltrm f) of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
	+ by (smt Group.nat_pow_0 lcf_of_sub_in_ltrm lcf_pow lcf_scalar_mult ltrm_closed
	+ ltrm_pow0 ltrm_smult P.nat_pow_closed P_def UP_ring.monom_one UP_ring_axioms assms(1)
	+ assms(2) assms(3) assms(4) cfs_closed coeff_simp deg_const deg_nzero_nzero deg_pow
	+ deg_smult deg_ltrm lcoeff_nonzero2 nat_less_le sub_deg)
	+
	+text\<open>formula for the leading term of a composition \<close>
	+
	+lemma(in UP_domain) cring_ltrm_of_sub:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = n"
	+ assumes "degree g > 0"
	+ assumes "(lcf f) \<otimes> ((lcf g)[^]n) \<noteq>\<zero>"
	+ shows "ltrm (f of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
	+ using ltrm_of_sub_in_ltrm ltrm_sub assms(1) assms(2) assms(3) assms(4) by presburger
	+
	+lemma(in UP_domain) ltrm_of_sub:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = n"
	+ assumes "degree g > 0"
	+ shows "ltrm (f of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
	+ using ltrm_of_sub_in_ltrm ltrm_sub assms(1) assms(2) assms(3) assms(4) by presburger
	+
	+text\<open>subtitution is associative\<close>
	+
	+lemma sub_assoc_monom:
	+ assumes "f \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "r \<in> carrier P"
	+ shows "(ltrm f) of (q of r) = ((ltrm f) of q) of r"
	+proof-
	+ obtain n where n_def: "n = degree f"
	+ by simp
	+ obtain a where a_def: "a \<in> carrier R \<and> (ltrm f) = monom P a n"
	+ using assms(1) cfs_closed n_def by blast
	+ have LHS: "(ltrm f) of (q of r) = a \<odot>\<^bsub>P\<^esub> (q of r)[^]\<^bsub>P\<^esub> n"
	+ by (metis P.nat_pow_closed P_def UP_pre_univ_prop.eval_monom a_def assms(2)
	+ assms(3) compose_def monom_mult_is_smult sub_closed to_poly_UP_pre_univ_prop to_polynomial_def)
	+ have RHS0: "((ltrm f) of q) of r = (a \<odot>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub> n)of r"
	+ by (metis P.nat_pow_closed P_def UP_pre_univ_prop.eval_monom a_def
	+ assms(2) compose_def monom_mult_is_smult to_poly_UP_pre_univ_prop to_polynomial_def)
	+ have RHS1: "((ltrm f) of q) of r = ((to_poly a) \<otimes>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub> n)of r"
	+ using RHS0 by (metis P.nat_pow_closed P_def a_def
	+ assms(2) monom_mult_is_smult to_polynomial_def)
	+ have RHS2: "((ltrm f) of q) of r = ((to_poly a) of r) \<otimes>\<^bsub>P\<^esub> (q[^]\<^bsub>P\<^esub> n of r)"
	+ using RHS1 a_def assms(2) assms(3) sub_mult to_poly_closed by auto
	+ have RHS3: "((ltrm f) of q) of r = (to_poly a) \<otimes>\<^bsub>P\<^esub> (q[^]\<^bsub>P\<^esub> n of r)"
	+ using RHS2 a_def assms(3) sub_to_poly by auto
	+ have RHS4: "((ltrm f) of q) of r = a \<odot>\<^bsub>P\<^esub> ((q[^]\<^bsub>P\<^esub> n)of r)"
	+ using RHS3
	+ by (metis P.nat_pow_closed P_def a_def assms(2) assms(3)
	+ monom_mult_is_smult sub_closed to_polynomial_def)
	+ have "(q of r)[^]\<^bsub>P\<^esub> n = ((q[^]\<^bsub>P\<^esub> n)of r)"
	+ apply(induction n)
	+ apply (metis Group.nat_pow_0 P.ring_simprules(6) assms(3) deg_one sub_const)
	+ by (simp add: assms(2) assms(3) sub_mult)
	+ then show ?thesis using RHS4 LHS by simp
	+qed
	+
	+lemma sub_assoc:
	+ assumes "f \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "r \<in> carrier P"
	+ shows "f of (q of r) = (f of q) of r"
	+proof-
	+ have "\<And> n. \<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> p of (q of r) = (p of q) of r"
	+ proof-
	+ fix n
	+ show "\<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> p of (q of r) = (p of q) of r"
	+ proof(induction n)
	+ case 0
	+ then have deg_p: "degree p = 0"
	+ by blast
	+ then have B0: "p of (q of r) = p"
	+ using sub_const[of "q of r" p] assms "0.prems"(1) sub_closed by blast
	+ have B1: "(p of q) of r = p"
	+ proof-
	+ have p0: "p of q = p"
	+ using deg_p 0 assms(2)
	+ by (simp add: P_def UP_cring.sub_const UP_cring_axioms)
	+ show ?thesis
	+ unfolding p0 using deg_p 0 assms(3)
	+ by (simp add: P_def UP_cring.sub_const UP_cring_axioms)
	+ qed
	+ then show "p of (q of r) = (p of q) of r" using B0 B1 by auto
	+ next
	+ case (Suc n)
	+ fix n
	+ assume IH: "\<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> p of (q of r) = (p of q) of r"
	+ then show "\<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> Suc n \<Longrightarrow> p of (q of r) = (p of q) of r"
	+ proof-
	+ fix p
	+ assume A0: " p \<in> carrier P "
	+ assume A1: "degree p \<le> Suc n"
	+ show "p of (q of r) = (p of q) of r"
	+ proof(cases "degree p < Suc n")
	+ case True
	+ then show ?thesis using A0 A1 IH by auto
	+ next
	+ case False
	+ then have "degree p = Suc n"
	+ using A1 by auto
	+ have I0: "p of (q of r) = ((trunc p) \<oplus>\<^bsub>P\<^esub> (ltrm p)) of (q of r)"
	+ using A0 trunc_simps(1) by auto
	+ have I1: "p of (q of r) = ((trunc p) of (q of r)) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of (q of r))"
	+ using I0 sub_add
	+ by (simp add: A0 assms(2) assms(3) ltrm_closed rev_sub_closed sub_rev_sub trunc_closed)
	+ have I2: "p of (q of r) = (((trunc p) of q) of r) \<oplus>\<^bsub>P\<^esub> (((ltrm p) of q) of r)"
	+ using IH[of "trunc p"] sub_assoc_monom[of p q r]
	+ by (metis A0 I1 \<open>degree p = Suc n\<close> assms(2) assms(3)
	+ less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
	+ have I3: "p of (q of r) = (((trunc p) of q) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of q)) of r"
	+ using sub_add trunc_simps(1) assms
	+ by (simp add: A0 I2 ltrm_closed sub_closed trunc_closed)
	+ have I4: "p of (q of r) = (((trunc p)\<oplus>\<^bsub>P\<^esub>(ltrm p)) of q) of r"
	+ using sub_add trunc_simps(1) assms
	+ by (simp add: trunc_simps(1) A0 I3 ltrm_closed trunc_closed)
	+ then show ?thesis
	+ using A0 trunc_simps(1) by auto
	+ qed
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ using assms(1) by blast
	+qed
	+
	+lemma sub_smult:
	+ assumes "f \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "(a\<odot>\<^bsub>P\<^esub>f ) of q = a\<odot>\<^bsub>P\<^esub>(f of q)"
	+proof-
	+ have "(a\<odot>\<^bsub>P\<^esub>f ) of q = ((to_poly a) \<otimes>\<^bsub>P\<^esub>f) of q"
	+ using assms by (metis P_def monom_mult_is_smult to_polynomial_def)
	+ then have "(a\<odot>\<^bsub>P\<^esub>f ) of q = ((to_poly a) of q) \<otimes>\<^bsub>P\<^esub>(f of q)"
	+ by (simp add: assms(1) assms(2) assms(3) sub_mult to_poly_closed)
	+ then have "(a\<odot>\<^bsub>P\<^esub>f ) of q = (to_poly a) \<otimes>\<^bsub>P\<^esub>(f of q)"
	+ by (simp add: assms(2) assms(3) sub_to_poly)
	+ then show ?thesis
	+ by (metis P_def assms(1) assms(2) assms(3)
	+ monom_mult_is_smult sub_closed to_polynomial_def)
	+qed
	+
	+lemma to_fun_sub_monom:
	+ assumes "is_UP_monom f"
	+ assumes "g \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "to_fun (f of g) a = to_fun f (to_fun g a)"
	+proof-
	+ obtain b n where b_def: "b \<in> carrier R \<and> f = monom P b n"
	+ using assms unfolding is_UP_monom_def
	+ using P_def cfs_closed by blast
	+ then have P0: "f of g = b \<odot>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
	+ using b_def assms(2) monom_sub by blast
	+ have P1: "UP_pre_univ_prop R R (\<lambda>x. x)"
	+ by (simp add: UP_pre_univ_prop_fact)
	+ then have P2: "to_fun f (to_fun g a) = b \<otimes>((to_fun g a)[^]n)"
	+ using P1 to_fun_eval[of f "to_fun g a"] P_def UP_pre_univ_prop.eval_monom assms(1)
	+ assms(2) assms(3) b_def is_UP_monomE(1) to_fun_closed
	+ by force
	+ have P3: "to_fun (monom P b n of g) a = b \<otimes>((to_fun g a)[^]n)"
	+ proof-
	+ have 0: "to_fun (monom P b n of g) a = eval R R (\<lambda>x. x) a (b \<odot>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n) )"
	+
	+ using UP_pre_univ_prop.eval_monom[of R "(UP R)" to_poly b g n]
	+ P_def assms(2) b_def to_poly_UP_pre_univ_prop to_fun_eval P0
	+ by (metis assms(3) monom_closed sub_closed)
	+ have 1: "to_fun (monom P b n of g) a = (eval R R (\<lambda>x. x) a (to_poly b)) \<otimes> ( eval R R (\<lambda>x. x) a ( g [^]\<^bsub>UP R\<^esub> n ))"
	+ using 0 eval_ring_hom
	+ by (metis P.nat_pow_closed P0 P_def assms(2) assms(3) b_def monom_mult_is_smult to_fun_eval to_fun_mult to_poly_closed to_polynomial_def)
	+ have 2: "to_fun (monom P b n of g) a = b \<otimes> ( eval R R (\<lambda>x. x) a ( g [^]\<^bsub>UP R\<^esub> n ))"
	+ using 1 assms(3) b_def to_fun_eval to_fun_to_poly to_poly_closed by auto
	+ then show ?thesis
	+ unfolding to_function_def to_fun_def
	+ using eval_ring_hom P_def UP_pre_univ_prop.ring_homD UP_pre_univ_prop_fact
	+ assms(2) assms(3) ring_hom_cring.hom_pow by fastforce
	+ qed
	+ then show ?thesis
	+ using b_def P2 by auto
	+qed
	+
	+lemma to_fun_sub:
	+ assumes "g \<in> carrier P"
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "to_fun (f of g) a = (to_fun f) (to_fun g a)"
	+proof(rule poly_induct2[of f])
	+ show "f \<in> carrier P"
	+ using assms by auto
	+ show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> to_fun (p of g) a = to_fun p (to_fun g a)"
	+ proof-
	+ fix p
	+ assume A0: "p \<in> carrier P"
	+ assume A1: "degree p = 0"
	+ then have P0: "degree (p of g) = 0"
	+ by (simp add: A0 assms(1) sub_const)
	+ then obtain b where b_def: "p of g = to_poly b \<and> b \<in> carrier R"
	+ using A0 A1 cfs_closed assms(1) to_poly_inverse
	+ by (meson sub_closed)
	+ then have "to_fun (p of g) a = b"
	+ by (simp add: assms(3) to_fun_to_poly)
	+ have "p of g = p"
	+ using A0 A1 P_def sub_const UP_cring_axioms assms(1) by blast
	+ then have P1: "p = to_poly b"
	+ using b_def by auto
	+ have "to_fun g a \<in> carrier R"
	+ using assms
	+ by (simp add: to_fun_closed)
	+ then show "to_fun (p of g) a = to_fun p (to_fun g a)"
	+ using P1 \<open>to_fun (p of g) a = b\<close> b_def
	+ by (simp add: to_fun_to_poly)
	+ qed
	+ show "\<And>p. 0 < degree p \<Longrightarrow> p \<in> carrier P \<Longrightarrow>
	+ to_fun (trunc p of g) a = to_fun (trunc p) (to_fun g a) \<Longrightarrow>
	+ to_fun (p of g) a = to_fun p (to_fun g a)"
	+ proof-
	+ fix p
	+ assume A0: "0 < degree p"
	+ assume A1: " p \<in> carrier P"
	+ assume A2: "to_fun (trunc p of g) a = to_fun (trunc p) (to_fun g a)"
	+ show "to_fun (p of g) a = to_fun p (to_fun g a)"
	+ proof-
	+ have "p of g = (trunc p) of g \<oplus>\<^bsub>P\<^esub> (ltrm p) of g"
	+ by (metis A1 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
	+ then have "to_fun (p of g) a = to_fun ((trunc p) of g) a \<oplus> (to_fun ((ltrm p) of g) a)"
	+ by (simp add: A1 assms(1) assms(3) to_fun_plus ltrm_closed sub_closed trunc_closed)
	+ then have 0: "to_fun (p of g) a = to_fun (trunc p) (to_fun g a) \<oplus> (to_fun ((ltrm p) of g) a)"
	+ by (simp add: A2)
	+ have "(to_fun ((ltrm p) of g) a) = to_fun (ltrm p) (to_fun g a)"
	+ using to_fun_sub_monom
	+ by (simp add: A1 assms(1) assms(3) ltrm_is_UP_monom)
	+ then have "to_fun (p of g) a = to_fun (trunc p) (to_fun g a) \<oplus> to_fun (ltrm p) (to_fun g a)"
	+ using 0 by auto
	+ then show ?thesis
	+ by (metis A1 assms(1) assms(3) to_fun_closed to_fun_plus ltrm_closed trunc_simps(1) trunc_closed)
	+ qed
	+ qed
	+qed
	+end
	+
	+
	+text\<open>More material on constant terms and constant coefficients\<close>
	+
	+context UP_cring
	+begin
	+
	+lemma to_fun_ctrm:
	+ assumes "f \<in> carrier P"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (ctrm f) b = (f 0)"
	+ using assms
	+ by (metis ctrm_degree ctrm_is_poly lcf_monom(2) P_def cfs_closed to_fun_to_poly to_poly_inverse)
	+
	+lemma to_fun_smult:
	+ assumes "f \<in> carrier P"
	+ assumes "b \<in> carrier R"
	+ assumes "c \<in> carrier R"
	+ shows "to_fun (c \<odot>\<^bsub>P\<^esub> f) b = c \<otimes>(to_fun f b)"
	+proof-
	+ have "(c \<odot>\<^bsub>P\<^esub> f) = (to_poly c) \<otimes>\<^bsub>P\<^esub> f"
	+ by (metis P_def assms(1) assms(3) monom_mult_is_smult to_polynomial_def)
	+ then have "to_fun (c \<odot>\<^bsub>P\<^esub> f) b = to_fun (to_poly c) b \<otimes> to_fun f b"
	+ by (simp add: assms(1) assms(2) assms(3) to_fun_mult to_poly_closed)
	+ then show ?thesis
	+ by (simp add: assms(2) assms(3) to_fun_to_poly)
	+qed
	+
	+lemma to_fun_monom:
	+ assumes "c \<in> carrier R"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun (monom P c n) x = c \<otimes> x [^] n"
	+ by (smt P_def R.m_comm R.nat_pow_closed UP_cring.to_poly_nat_pow UP_cring_axioms assms(1)
	+ assms(2) monom_is_UP_monom(1) sub_monom(1) to_fun_smult to_fun_sub_monom to_fun_to_poly
	+ to_poly_closed to_poly_mult_simp(2))
	+
	+lemma zcf_monom:
	+ assumes "a \<in> carrier R"
	+ shows "zcf (monom P a n) = to_fun (monom P a n) \<zero>"
	+ using to_fun_monom unfolding zcf_def
	+ by (simp add: R.nat_pow_zero assms cfs_monom)
	+
	+lemma zcf_to_fun:
	+ assumes "p \<in> carrier P"
	+ shows "zcf p = to_fun p \<zero>"
	+ apply(rule poly_induct3[of p])
	+ apply (simp add: assms)
	+ using R.zero_closed zcf_add to_fun_plus apply presburger
	+ using zcf_monom by blast
	+
	+lemma zcf_to_poly[simp]:
	+ assumes "a \<in> carrier R"
	+ shows "zcf (to_poly a) = a"
	+ by (metis assms cfs_closed degree_to_poly to_fun_to_poly to_poly_inverse to_poly_closed zcf_def)
	+
	+lemma zcf_ltrm_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree p > 0"
	+ shows "zcf((ltrm p) \<otimes>\<^bsub>P\<^esub> q) = \<zero>"
	+ using zcf_to_fun[of "ltrm p \<otimes>\<^bsub>P\<^esub> q" ]
	+ by (metis ltrm_closed P.l_null P.m_closed R.zero_closed UP_zero_closed zcf_to_fun
	+ zcf_zero assms(1) assms(2) assms(3) coeff_ltrm to_fun_mult)
	+
	+lemma zcf_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "zcf(p \<otimes>\<^bsub>P\<^esub> q) = (zcf p) \<otimes> (zcf q)"
	+ using zcf_to_fun[of " p \<otimes>\<^bsub>P\<^esub> q" ] zcf_to_fun[of "p" ] zcf_to_fun[of "q" ] to_fun_mult[of q p \<zero>]
	+ by (simp add: assms(1) assms(2))
	+
	+lemma zcf_is_ring_hom:
	+"zcf\<in> ring_hom P R"
	+ apply(rule ring_hom_memI)
	+ using zcf_mult zcf_add
	+ apply (simp add: P_def UP_ring.cfs_closed UP_ring_axioms zcf_def)
	+ apply (simp add: zcf_mult)
	+ using zcf_add apply auto[1]
	+ by simp
	+
	+lemma ctrm_is_ring_hom:
	+"ctrm \<in> ring_hom P P"
	+ apply(rule ring_hom_memI)
	+ apply (simp add: ctrm_is_poly)
	+ apply (metis zcf_def zcf_mult cfs_closed monom_mult zero_eq_add_iff_both_eq_0)
	+ using cfs_add[of _ _ 0]
	+ apply (simp add: cfs_closed)
	+ by auto
	+
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Describing the Image of (UP R) in the Ring of Functions from R to R\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+lemma to_fun_diff:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "to_fun (p \<ominus>\<^bsub>P\<^esub> q) a = to_fun p a \<ominus> to_fun q a"
	+ using to_fun_plus[of "\<ominus>\<^bsub>P\<^esub> q" p a]
	+ by (simp add: P.minus_eq R.minus_eq assms(1) assms(2) assms(3) to_fun_minus)
	+
	+lemma to_fun_const:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (monom P a 0) b = a"
	+ by (metis lcf_monom(2) P_def UP_cring.to_fun_ctrm UP_cring_axioms assms(1) assms(2) deg_const monom_closed)
	+
	+lemma to_fun_monic_monom:
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (monom P \<one> n) b = b[^]n"
	+ by (simp add: assms to_fun_monom)
	+
	+
	+text\<open>Constant polynomials map to constant polynomials\<close>
	+
	+lemma const_to_constant:
	+ assumes "a \<in> carrier R"
	+ shows "to_fun (monom P a 0) = constant_function (carrier R) a"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
	+ unfolding ring_functions_def apply(simp add: R.ring_axioms)
	+ apply (simp add: assms to_fun_is_Fun)
	+ using assms ring_functions.constant_function_closed[of R a "carrier R"]
	+ unfolding ring_functions_def apply (simp add: R.ring_axioms)
	+ using assms to_fun_const[of a ] unfolding constant_function_def
	+ by auto
	+
	+text\<open>Monomial polynomials map to monomial functions\<close>
	+
	+lemma monom_to_monomial:
	+ assumes "a \<in> carrier R"
	+ shows "to_fun (monom P a n) = monomial_function R a n"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
	+ unfolding ring_functions_def apply(simp add: R.ring_axioms)
	+ apply (simp add: assms to_fun_is_Fun)
	+ using assms U_function_ring.monomial_functions[of R a n] R.ring_axioms
	+ unfolding U_function_ring_def
	+ apply auto[1]
	+ unfolding monomial_function_def
	+ using assms to_fun_monom[of a _ n]
	+ by auto
	+end
	+
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Taylor Expansions\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+subsection\<open>Monic Linear Polynomials\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+text\<open>The polynomial representing the variable X\<close>
	+
	+definition X_poly where
	+"X_poly R = monom (UP R) \<one>\<^bsub>R\<^esub> 1"
	+
	+context UP_cring
	+begin
	+
	+abbreviation(input) X where
	+"X \<equiv> X_poly R"
	+
	+lemma X_closed:
	+"X \<in> carrier P"
	+ unfolding X_poly_def
	+ using P_def monom_closed by blast
	+
	+lemma degree_X[simp]:
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows"degree X = 1"
	+ unfolding X_poly_def
	+ using assms P_def deg_monom[of \<one> 1]
	+ by blast
	+
	+lemma X_not_zero:
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows"X \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ using degree_X assms by force
	+
	+lemma sub_X[simp]:
	+ assumes "p \<in> carrier P"
	+ shows "X of p = p"
	+ unfolding X_poly_def
	+ using P_def UP_pre_univ_prop.eval_monom1 assms compose_def to_poly_UP_pre_univ_prop
	+ by metis
	+
	+lemma sub_monom_deg_one:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "monom P a 1 of p = a \<odot>\<^bsub>P\<^esub> p"
	+ using assms sub_smult[of X p a] unfolding X_poly_def
	+ by (metis P_def R.one_closed R.r_one X_closed X_poly_def monom_mult_smult sub_X)
	+
	+lemma monom_rep_X_pow:
	+ assumes "a \<in> carrier R"
	+ shows "monom P a n = a\<odot>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)"
	+proof-
	+ have "monom P a n = a\<odot>\<^bsub>P\<^esub>monom P \<one> n"
	+ by (metis R.one_closed R.r_one assms monom_mult_smult)
	+ then show ?thesis
	+ unfolding X_poly_def
	+ using monom_pow
	+ by (simp add: P_def)
	+qed
	+
	+lemma X_sub[simp]:
	+ assumes "p \<in> carrier P"
	+ shows "p of X = p"
	+ apply(rule poly_induct3)
	+ apply (simp add: assms)
	+ using X_closed sub_add apply presburger
	+ using sub_monom[of X] P_def monom_rep_X_pow X_closed by auto
	+
	+text\<open>representation of monomials as scalar multiples of powers of X\<close>
	+
	+lemma ltrm_rep_X_pow:
	+ assumes "p \<in> carrier P"
	+ shows "ltrm p = (lcf p)\<odot>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(degree p))"
	+proof-
	+ have "ltrm p = monom P (lcf p) (degree p)"
	+ using assms unfolding leading_term_def by (simp add: P_def)
	+ then show ?thesis
	+ using monom_rep_X_pow P_def assms
	+ by (simp add: cfs_closed)
	+qed
	+
	+lemma to_fun_monom':
	+ assumes "c \<in> carrier R"
	+ assumes "c \<noteq>\<zero>"
	+ assumes "x \<in> carrier R"
	+ shows "to_fun (c \<odot>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) x = c \<otimes> x [^] n"
	+ using P_def to_fun_monom monom_rep_X_pow UP_cring_axioms assms(1) assms(2) assms(3) by fastforce
	+
	+lemma to_fun_X_pow:
	+ assumes "x \<in> carrier R"
	+ shows "to_fun (X[^]\<^bsub>P\<^esub>(n::nat)) x = x [^] n"
	+ using to_fun_monom'[of \<one> x n] assms
	+ by (metis P.nat_pow_closed R.l_one R.nat_pow_closed R.one_closed R.r_null R.r_one
	+ UP_one_closed X_closed to_fun_to_poly ring_hom_one smult_l_null smult_one to_poly_is_ring_hom)
	+end
	+
	+text\<open>Monic linear polynomials\<close>
	+
	+definition X_poly_plus where
	+"X_poly_plus R a = (X_poly R) \<oplus>\<^bsub>(UP R)\<^esub> to_polynomial R a"
	+
	+definition X_poly_minus where
	+"X_poly_minus R a = (X_poly R) \<ominus>\<^bsub>(UP R)\<^esub> to_polynomial R a"
	+
	+context UP_cring
	+begin
	+
	+abbreviation(input) X_plus where
	+"X_plus \<equiv> X_poly_plus R"
	+
	+abbreviation(input) X_minus where
	+"X_minus \<equiv> X_poly_minus R"
	+
	+lemma X_plus_closed:
	+ assumes "a \<in> carrier R"
	+ shows "(X_plus a) \<in> carrier P"
	+ unfolding X_poly_plus_def using X_closed to_poly_closed
	+ using P_def UP_a_closed assms by auto
	+
	+lemma X_minus_closed:
	+ assumes "a \<in> carrier R"
	+ shows "(X_minus a) \<in> carrier P"
	+ unfolding X_poly_minus_def using X_closed to_poly_closed
	+ by (simp add: P_def UP_cring.UP_cring UP_cring_axioms assms cring.cring_simprules(4))
	+
	+lemma X_minus_plus:
	+ assumes "a \<in> carrier R"
	+ shows "(X_minus a) = X_plus (\<ominus>a)"
	+ using P_def UP_ring.UP_ring UP_ring_axioms
	+ by (simp add: X_poly_minus_def X_poly_plus_def a_minus_def assms to_poly_a_inv)
	+
	+lemma degree_of_X_plus:
	+ assumes "a \<in> carrier R"
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows "degree (X_plus a) = 1"
	+proof-
	+ have 0:"degree (X_plus a) \<le> 1"
	+ using deg_add degree_X P_def unfolding X_poly_plus_def
	+ using UP_cring.to_poly_closed UP_cring_axioms X_closed assms(1) assms(2) by fastforce
	+ have 1:"degree (X_plus a) > 0"
	+ by (metis One_nat_def P_def R.one_closed R.r_zero X_poly_def
	+ X_closed X_poly_plus_def X_plus_closed assms coeff_add coeff_monom deg_aboveD
	+ gr0I lessI n_not_Suc_n to_polynomial_def to_poly_closed)
	+ then show ?thesis
	+ using "0" by linarith
	+qed
	+
	+lemma degree_of_X_minus:
	+ assumes "a \<in> carrier R"
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows "degree (X_minus a) = 1"
	+ using degree_of_X_plus[of "\<ominus>a"] X_minus_plus[simp] assms by auto
	+
	+lemma ltrm_of_X:
	+shows"ltrm X = X"
	+ unfolding leading_term_def
	+ by (metis P_def R.one_closed X_poly_def is_UP_monom_def is_UP_monomI leading_term_def)
	+
	+lemma ltrm_of_X_plus:
	+ assumes "a \<in> carrier R"
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows "ltrm (X_plus a) = X"
	+ unfolding X_poly_plus_def
	+ using X_closed assms ltrm_of_sum_diff_degree[of X "to_poly a"]
	+ degree_to_poly[of a] to_poly_closed[of a] degree_X ltrm_of_X
	+ by (simp add: P_def)
	+
	+lemma ltrm_of_X_minus:
	+ assumes "a \<in> carrier R"
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows "ltrm (X_minus a) = X"
	+ using X_minus_plus[of a] assms
	+ by (simp add: ltrm_of_X_plus)
	+
	+lemma lcf_of_X_minus:
	+ assumes "a \<in> carrier R"
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows "lcf (X_minus a) = \<one>"
	+ using ltrm_of_X_minus unfolding X_poly_def
	+ using P_def UP_cring.X_minus_closed UP_cring.lcf_eq UP_cring_axioms assms(1) assms(2) lcf_monom
	+ by (metis R.one_closed)
	+
	+lemma lcf_of_X_plus:
	+ assumes "a \<in> carrier R"
	+ assumes "\<one> \<noteq>\<zero>"
	+ shows "lcf (X_plus a) = \<one>"
	+ using ltrm_of_X_plus unfolding X_poly_def
	+ by (metis lcf_of_X_minus P_def UP_cring.lcf_eq UP_cring.X_plus_closed UP_cring_axioms X_minus_closed assms(1) assms(2) degree_of_X_minus)
	+
	+lemma to_fun_X[simp]:
	+ assumes "a \<in> carrier R"
	+ shows "to_fun X a = a"
	+ using X_closed assms to_fun_sub_monom ltrm_is_UP_monom ltrm_of_X to_poly_closed
	+ by (metis sub_X to_fun_to_poly)
	+
	+lemma to_fun_X_plus[simp]:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (X_plus a) b = b \<oplus> a"
	+ unfolding X_poly_plus_def
	+ using assms to_fun_X[of b] to_fun_plus[of "to_poly a" X b] to_fun_to_poly[of a b]
	+ using P_def X_closed to_poly_closed by auto
	+
	+lemma to_fun_X_minus[simp]:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (X_minus a) b = b \<ominus> a"
	+ using to_fun_X_plus[of "\<ominus> a" b] X_minus_plus[of a] assms
	+ by (simp add: R.minus_eq)
	+
	+lemma cfs_X_plus:
	+ assumes "a \<in> carrier R"
	+ shows "X_plus a n = (if n = 0 then a else (if n = 1 then \<one> else \<zero>))"
	+ using assms cfs_add monom_closed UP_ring_axioms cfs_monom
	+ unfolding X_poly_plus_def to_polynomial_def X_poly_def P_def
	+ by auto
	+
	+lemma cfs_X_minus:
	+ assumes "a \<in> carrier R"
	+ shows "X_minus a n = (if n = 0 then \<ominus> a else (if n = 1 then \<one> else \<zero>))"
	+ using cfs_X_plus[of "\<ominus> a"] assms
	+ unfolding X_poly_plus_def X_poly_minus_def
	+ by (simp add: P_def a_minus_def to_poly_a_inv)
	+
	+text\<open>Linear substituions\<close>
	+
	+lemma X_plus_sub_deg:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier P"
	+ shows "degree (f of (X_plus a)) = degree f"
	+ apply(cases "\<one> = \<zero>")
	+ apply (metis P_def UP_one_closed X_plus_closed X_poly_def sub_X assms(1) assms(2) deg_one monom_one monom_zero sub_const)
	+ using cring_sub_deg[of "X_plus a" f] assms X_plus_closed[of a] lcf_of_X_plus[of a]
	+ ltrm_of_X_plus degree_of_X_plus[of a] P_def
	+ by (metis lcf_eq R.nat_pow_one R.r_one UP_cring.cring_sub_deg UP_cring_axioms X_closed X_sub
	+ cfs_closed coeff_simp deg_nzero_nzero degree_X lcoeff_nonzero2 sub_const)
	+
	+lemma X_minus_sub_deg:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier P"
	+ shows "degree (f of (X_minus a)) = degree f"
	+ using X_plus_sub_deg[of "\<ominus>a"] assms X_minus_plus[of a]
	+ by simp
	+
	+lemma plus_minus_sub:
	+ assumes " a \<in> carrier R"
	+ shows "X_plus a of X_minus a = X"
	+ unfolding X_poly_plus_def
	+proof-
	+ have "(X \<oplus>\<^bsub>P\<^esub> to_poly a) of X_minus a = (X of X_minus a) \<oplus>\<^bsub>P\<^esub> (to_poly a) of X_minus a"
	+ using sub_add
	+ by (simp add: X_closed X_minus_closed assms to_poly_closed)
	+ then have "(X \<oplus>\<^bsub>P\<^esub> to_poly a) of X_minus a = (X_minus a) \<oplus>\<^bsub>P\<^esub> (to_poly a)"
	+ by (simp add: X_minus_closed assms sub_to_poly)
	+ then show "(X \<oplus>\<^bsub>UP R\<^esub> to_poly a) of X_minus a = X"
	+ unfolding to_polynomial_def X_poly_minus_def
	+ by (metis P.add.inv_solve_right P.minus_eq P_def
	+ X_closed X_poly_minus_def X_minus_closed assms monom_closed to_polynomial_def)
	+qed
	+
	+lemma minus_plus_sub:
	+ assumes " a \<in> carrier R"
	+ shows "X_minus a of X_plus a = X"
	+ using plus_minus_sub[of "\<ominus>a"]
	+ unfolding X_poly_minus_def
	+ unfolding X_poly_plus_def
	+ using assms apply simp
	+ by (metis P_def R.add.inv_closed R.minus_minus a_minus_def to_poly_a_inv)
	+
	+lemma ltrm_times_X:
	+ assumes "p \<in> carrier P"
	+ shows "ltrm (X \<otimes>\<^bsub>P\<^esub> p) = X \<otimes>\<^bsub>P\<^esub> (ltrm p)"
	+ using assms ltrm_of_X cring_ltrm_mult[of X p]
	+ by (metis ltrm_deg_0 P.r_null R.l_one R.one_closed UP_cring.lcf_monom(1)
	+ UP_cring_axioms X_closed X_poly_def cfs_closed deg_zero deg_ltrm monom_zero)
	+
	+lemma times_X_not_zero:
	+ assumes "p \<in> carrier P"
	+ assumes "p \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ shows "(X \<otimes>\<^bsub>P\<^esub> p) \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ by (metis (no_types, hide_lams) lcf_monom(1) lcf_of_X_minus ltrm_of_X_minus P.inv_unique
	+ P.r_null R.l_one R.one_closed UP_zero_closed X_closed zcf_def
	+ zcf_zero_degree_zero assms(1) assms(2) cfs_closed cfs_zero cring_lcf_mult
	+ deg_monom deg_nzero_nzero deg_ltrm degree_X degree_of_X_minus
	+ monom_one monom_zero)
	+
	+lemma degree_times_X:
	+ assumes "p \<in> carrier P"
	+ assumes "p \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ shows "degree (X \<otimes>\<^bsub>P\<^esub> p) = degree p + 1"
	+ using cring_deg_mult[of X p] assms times_X_not_zero[of p]
	+ by (metis (no_types, lifting) P.r_null P.r_one P_def R.l_one R.one_closed
	+ UP_cring.lcf_monom(1) UP_cring_axioms UP_zero_closed X_closed X_poly_def cfs_closed
	+ deg_zero deg_ltrm degree_X monom_one monom_zero to_poly_inverse)
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+subsection\<open>Basic Facts About Taylor Expansions\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+definition taylor_expansion where
	+"taylor_expansion R a p = compose R p (X_poly_plus R a)"
	+
	+definition(in UP_cring) taylor where
	+"taylor \<equiv> taylor_expansion R"
	+
	+context UP_cring
	+begin
	+
	+lemma taylor_expansion_ring_hom:
	+ assumes "c \<in> carrier R"
	+ shows "taylor_expansion R c \<in> ring_hom P P"
	+ unfolding taylor_expansion_def
	+ using rev_sub_is_hom[of "X_plus c"]
	+ unfolding rev_compose_def compose_def
	+ using X_plus_closed assms by auto
	+
	+notation taylor ("T\<^bsub>_\<^esub>")
	+
	+lemma(in UP_cring) taylor_closed:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "T\<^bsub>a\<^esub> f \<in> carrier P"
	+ unfolding taylor_def
	+ by (simp add: X_plus_closed assms(1) assms(2) sub_closed taylor_expansion_def)
	+
	+lemma taylor_deg:
	+ assumes "a \<in> carrier R"
	+ assumes "p \<in> carrier P"
	+ shows "degree (T\<^bsub>a\<^esub> p) = degree p"
	+ unfolding taylor_def taylor_expansion_def
	+ using X_plus_sub_deg[of a p] assms
	+ by (simp add: taylor_expansion_def)
	+
	+lemma taylor_id:
	+ assumes "a \<in> carrier R"
	+ assumes "p \<in> carrier P"
	+ shows "p = (T\<^bsub>a\<^esub> p) of (X_minus a)"
	+ unfolding taylor_expansion_def taylor_def
	+ using assms sub_assoc[of p "X_plus a" "X_minus a"] X_plus_closed[of a] X_minus_closed[of a]
	+ by (metis X_sub plus_minus_sub taylor_expansion_def)
	+
	+lemma taylor_eval:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier P"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (T\<^bsub>a\<^esub> f) b = to_fun f (b \<oplus> a)"
	+ unfolding taylor_expansion_def taylor_def
	+ using to_fun_sub[of "(X_plus a)" f b] to_fun_X_plus[of a b]
	+ assms X_plus_closed[of a] by auto
	+
	+lemma taylor_eval':
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier P"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun f (b) = to_fun (T\<^bsub>a\<^esub> f) (b \<ominus> a) "
	+ unfolding taylor_expansion_def taylor_def
	+ using to_fun_sub[of "(X_minus a)" "T\<^bsub>a\<^esub> f" b] to_fun_X_minus[of b a]
	+ assms X_minus_closed[of a]
	+ by (metis taylor_closed taylor_def taylor_id taylor_expansion_def to_fun_X_minus)
	+
	+lemma(in UP_cring) degree_monom:
	+ assumes "a \<in> carrier R"
	+ shows "degree (a \<odot>\<^bsub>UP R\<^esub> (X_poly R)[^]\<^bsub>UP R\<^esub>n) = (if a = \<zero> then 0 else n)"
	+ apply(cases "a = \<zero>")
	+ apply (metis (full_types) P.nat_pow_closed P_def R.one_closed UP_smult_zero X_poly_def deg_zero monom_closed)
	+ using P_def UP_cring.monom_rep_X_pow UP_cring_axioms assms deg_monom by fastforce
	+
	+lemma(in UP_cring) poly_comp_finsum:
	+ assumes "\<And>i::nat. i \<le> n \<Longrightarrow> g i \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. g i)"
	+ shows "p of q = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. (g i) of q)"
	+proof-
	+ have 0: "p of q = rev_sub q p"
	+ unfolding compose_def rev_compose_def by blast
	+ have 1: "p of q = finsum P (rev_compose R q \<circ> g) {..n}"
	+ unfolding 0 unfolding assms
	+ apply(rule ring_hom_finsum[of "rev_compose R q" P "{..n}" g ])
	+ using assms(2) rev_sub_is_hom apply blast
	+ apply (simp add: UP_ring)
	+ apply simp
	+ by (simp add: assms(1))
	+ show ?thesis unfolding 1
	+ unfolding comp_apply rev_compose_def compose_def
	+ by auto
	+qed
	+
	+lemma(in UP_cring) poly_comp_expansion:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "degree p \<le> n"
	+ shows "p of q = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. (p i) \<odot>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub>i)"
	+proof-
	+ obtain g where g_def: "g = (\<lambda>i. monom P (p i) i)"
	+ by blast
	+ have 0: "\<And>i. (g i) of q = (p i) \<odot>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub>i"
	+ proof- fix i show "g i of q = p i \<odot>\<^bsub>P\<^esub> q [^]\<^bsub>P\<^esub> i"
	+ using assms g_def P_def coeff_simp monom_sub
	+ by (simp add: cfs_closed)
	+ qed
	+ have 1: "(\<And>i. i \<le> n \<Longrightarrow> g i \<in> carrier P)"
	+ using g_def assms
	+ by (simp add: cfs_closed)
	+ have "(\<Oplus>\<^bsub>P\<^esub>i\<in>{..n}. monom P (p i) i) = p"
	+ using assms up_repr_le[of p n] coeff_simp[of p] unfolding P_def
	+ by auto
	+ then have "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. g i)"
	+ using g_def by auto
	+ then have "p of q = (\<Oplus>\<^bsub>P\<^esub>i\<in>{..n}. g i of q)"
	+ using 0 1 poly_comp_finsum[of n g q p]
	+ using assms(2)
	+ by blast
	+ then show ?thesis
	+ by(simp add: 0)
	+qed
	+
	+lemma(in UP_cring) taylor_sum:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p \<le> n"
	+ assumes "a \<in> carrier R"
	+ shows "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. T\<^bsub>a\<^esub> p i \<odot>\<^bsub>P\<^esub> (X_minus a)[^]\<^bsub>P\<^esub>i)"
	+proof-
	+ have 0: "(T\<^bsub>a\<^esub> p) of X_minus a = p"
	+ using P_def taylor_id assms(1) assms(3)
	+ by fastforce
	+ have 1: "degree (T\<^bsub>a\<^esub> p) \<le> n"
	+ using assms
	+ by (simp add: taylor_deg)
	+ have 2: "T\<^bsub>a\<^esub> p of X_minus a = (\<Oplus>\<^bsub>P\<^esub>i\<in>{..n}. T\<^bsub>a\<^esub> p i \<odot>\<^bsub>P\<^esub> X_minus a [^]\<^bsub>P\<^esub> i)"
	+ using 1 X_minus_closed[of a] poly_comp_expansion[of "T\<^bsub>a\<^esub> p" "X_minus a" n]
	+ assms taylor_closed
	+ by blast
	+ then show ?thesis
	+ using 0
	+ by simp
	+qed
	+
	+text\<open>The $i^{th}$ term in the taylor expansion\<close>
	+definition taylor_term where
	+"taylor_term c p i = (taylor_expansion R c p i) \<odot>\<^bsub>UP R\<^esub> (UP_cring.X_minus R c) [^]\<^bsub>UP R\<^esub>i"
	+
	+lemma (in UP_cring) taylor_term_closed:
	+assumes "p \<in> carrier P"
	+assumes "a \<in> carrier R"
	+shows "taylor_term a p i \<in> carrier (UP R)"
	+ unfolding taylor_term_def
	+ using P.nat_pow_closed P_def taylor_closed taylor_def X_minus_closed assms(1) assms(2) smult_closed
	+ by (simp add: cfs_closed)
	+
	+lemma(in UP_cring) taylor_term_sum:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p \<le> n"
	+ assumes "a \<in> carrier R"
	+ shows "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. taylor_term a p i)"
	+ unfolding taylor_term_def taylor_def
	+ using assms taylor_sum[of p n a] P_def
	+ using taylor_def by auto
	+
	+lemma (in UP_cring) taylor_expansion_add:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "c \<in> carrier R"
	+ shows "taylor_expansion R c (p \<oplus>\<^bsub>UP R\<^esub> q) = (taylor_expansion R c p) \<oplus>\<^bsub>UP R\<^esub> (taylor_expansion R c q)"
	+ unfolding taylor_expansion_def
	+ using assms X_plus_closed[of c] P_def sub_add
	+ by blast
	+
	+lemma (in UP_cring) taylor_term_add:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "taylor_term a (p \<oplus>\<^bsub>UP R\<^esub>q) i = taylor_term a p i \<oplus>\<^bsub>UP R\<^esub> taylor_term a q i"
	+ using assms taylor_expansion_add[of p q a]
	+ unfolding taylor_term_def
	+ using P.nat_pow_closed P_def taylor_closed X_minus_closed cfs_add smult_l_distr
	+ by (simp add: taylor_def cfs_closed)
	+
	+lemma (in UP_cring) to_fun_taylor_term:
	+assumes "p \<in> carrier P"
	+assumes "a \<in> carrier R"
	+assumes "c \<in> carrier R"
	+shows "to_fun (taylor_term c p i) a = (T\<^bsub>c\<^esub> p i) \<otimes> (a \<ominus> c)[^]i"
	+ using assms to_fun_smult[of "X_minus c [^]\<^bsub>UP R\<^esub> i" a "taylor_expansion R c p i"]
	+ to_fun_X_minus[of c a] to_fun_nat_pow[of "X_minus c" a i]
	+ unfolding taylor_term_def
	+ using P.nat_pow_closed P_def taylor_closed taylor_def X_minus_closed
	+ by (simp add: cfs_closed)
	+
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+subsection\<open>Defining the (Scalar-Valued) Derivative of a Polynomial Using the Taylor Expansion\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+definition derivative where
	+"derivative R f a = (taylor_expansion R a f) 1"
	+
	+context UP_cring
	+begin
	+
	+abbreviation(in UP_cring) deriv where
	+"deriv \<equiv> derivative R"
	+
	+lemma(in UP_cring) deriv_closed:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "(derivative R f a) \<in> carrier R"
	+ unfolding derivative_def
	+ using taylor_closed taylor_def assms(1) assms(2) cfs_closed by auto
	+
	+lemma(in UP_cring) deriv_add:
	+ assumes "f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "deriv (f \<oplus>\<^bsub>P\<^esub> g) a = deriv f a \<oplus> deriv g a"
	+ unfolding derivative_def taylor_expansion_def using assms
	+ by (simp add: X_plus_closed sub_add sub_closed)
	+
	+end
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>The Polynomial-Valued Derivative Operator\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+context UP_cring
	+begin
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Operator Which Shifts Coefficients\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+lemma cfs_times_X:
	+ assumes "g \<in> carrier P"
	+ shows "(X \<otimes>\<^bsub>P\<^esub> g) (Suc n) = g n"
	+ apply(rule poly_induct3[of g])
	+ apply (simp add: assms)
	+ apply (metis (no_types, lifting) P.m_closed P.r_distr X_closed cfs_add)
	+ by (metis (no_types, lifting) P_def R.l_one R.one_closed R.r_null Suc_eq_plus1 X_poly_def
	+ cfs_monom coeff_monom_mult coeff_simp monom_closed monom_mult)
	+
	+lemma times_X_pow_coeff:
	+ assumes "g \<in> carrier P"
	+ shows "(monom P \<one> k \<otimes>\<^bsub>P\<^esub> g) (n + k) = g n"
	+ using coeff_monom_mult P.m_closed P_def assms coeff_simp monom_closed
	+ by (simp add: cfs_closed)
	+
	+lemma zcf_eq_zero_unique:
	+ assumes "f \<in> carrier P"
	+ assumes "g \<in> carrier P \<and> (f = X \<otimes>\<^bsub>P\<^esub> g)"
	+ shows "\<And> h. h \<in> carrier P \<and> (f = X \<otimes>\<^bsub>P\<^esub> h) \<Longrightarrow> h = g"
	+proof-
	+ fix h
	+ assume A: "h \<in> carrier P \<and> (f = X \<otimes>\<^bsub>P\<^esub> h)"
	+ then have 0: " X \<otimes>\<^bsub>P\<^esub> g = X \<otimes>\<^bsub>P\<^esub> h"
	+ using assms(2) by auto
	+ show "h = g"
	+ using 0 A assms
	+ by (metis P_def coeff_simp cfs_times_X up_eqI)
	+qed
	+
	+lemma f_minus_ctrm:
	+ assumes "f \<in> carrier P"
	+ shows "zcf(f \<ominus>\<^bsub>P\<^esub> ctrm f) = \<zero>"
	+ using assms
	+ by (smt ctrm_is_poly P.add.inv_closed P.minus_closed P_def R.r_neg R.zero_closed zcf_to_fun
	+ to_fun_minus to_fun_plus UP_cring_axioms zcf_ctrm zcf_def a_minus_def cfs_closed)
	+
	+definition poly_shift where
	+"poly_shift f n = f (Suc n)"
	+
	+lemma poly_shift_closed:
	+ assumes "f \<in> carrier P"
	+ shows "poly_shift f \<in> carrier P"
	+ apply(rule UP_car_memI[of "deg R f"])
	+ unfolding poly_shift_def
	+proof -
	+ fix n :: nat
	+ assume "deg R f < n"
	+ then have "deg R f < Suc n"
	+ using Suc_lessD by blast
	+ then have "f (Suc n) = \<zero>\<^bsub>P\<^esub> (Suc n)"
	+ by (metis P.l_zero UP_zero_closed assms coeff_of_sum_diff_degree0)
	+ then show "f (Suc n) = \<zero>"
	+ by simp
	+next
	+ show " \<And>n. f (Suc n) \<in> carrier R"
	+ by(rule cfs_closed, rule assms)
	+qed
	+
	+lemma poly_shift_eq_0:
	+ assumes "f \<in> carrier P"
	+ shows "f n = (ctrm f \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub> poly_shift f) n"
	+ apply(cases "n = 0")
	+ apply (smt ctrm_degree ctrm_is_poly ltrm_of_X One_nat_def P.r_null P.r_zero P_def UP_cring.lcf_monom(1) UP_cring_axioms UP_mult_closed UP_r_one UP_zero_closed X_closed zcf_ltrm_mult zcf_def zcf_zero assms cfs_add cfs_closed deg_zero degree_X lessI monom_one poly_shift_closed to_poly_inverse)
	+proof- assume A: "n \<noteq> 0"
	+ then obtain k where k_def: " n = Suc k"
	+ by (meson lessI less_Suc_eq_0_disj)
	+ show ?thesis
	+ using cfs_times_X[of "poly_shift f" k] poly_shift_def[of f k] poly_shift_closed assms
	+ cfs_add[of "ctrm f" "X \<otimes>\<^bsub>P\<^esub> poly_shift f" n] unfolding k_def
	+ by (simp add: X_closed cfs_closed cfs_monom)
	+qed
	+
	+lemma poly_shift_eq:
	+ assumes "f \<in> carrier P"
	+ shows "f = (ctrm f \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub> poly_shift f)"
	+by(rule ext, rule poly_shift_eq_0, rule assms)
	+
	+lemma poly_shift_id:
	+ assumes "f \<in> carrier P"
	+ shows "f \<ominus>\<^bsub>P\<^esub> ctrm f = X \<otimes>\<^bsub>P\<^esub> poly_shift f"
	+ using assms poly_shift_eq[of f] poly_shift_closed unfolding a_minus_def
	+ by (metis ctrm_is_poly P.add.inv_solve_left P.m_closed UP_a_comm UP_a_inv_closed X_closed)
	+
	+lemma poly_shift_degree_zero:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p = 0"
	+ shows "poly_shift p = \<zero>\<^bsub>P\<^esub>"
	+ by (metis ltrm_deg_0 P.r_neg P.r_null UP_ring UP_zero_closed X_closed zcf_eq_zero_unique
	+ abelian_group.minus_eq assms(1) assms(2) poly_shift_closed poly_shift_id ring_def)
	+
	+lemma poly_shift_degree:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p > 0"
	+ shows "degree (poly_shift p) = degree p - 1 "
	+ using poly_shift_id[of p]
	+ by (metis ctrm_degree ctrm_is_poly P.r_null X_closed add_diff_cancel_right' assms(1) assms(2)
	+ deg_zero degree_of_difference_diff_degree degree_times_X nat_less_le poly_shift_closed)
	+
	+lemma poly_shift_monom:
	+ assumes "a \<in> carrier R"
	+ shows "poly_shift (monom P a (Suc k)) = (monom P a k)"
	+proof-
	+ have "(monom P a (Suc k)) = ctrm (monom P a (Suc k)) \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
	+ using poly_shift_eq[of "monom P a (Suc k)"] assms monom_closed
	+ by blast
	+ then have "(monom P a (Suc k)) = \<zero>\<^bsub>P\<^esub> \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
	+ using assms by simp
	+ then have "(monom P a (Suc k)) = X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
	+ using X_closed assms poly_shift_closed by auto
	+ then have "X \<otimes>\<^bsub>P\<^esub>(monom P a k) = X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
	+ by (metis P_def R.l_one R.one_closed X_poly_def assms monom_mult plus_1_eq_Suc)
	+ then show ?thesis
	+ using X_closed X_not_zero assms
	+ by (meson UP_mult_closed zcf_eq_zero_unique monom_closed poly_shift_closed)
	+qed
	+
	+lemma(in UP_cring) poly_shift_add:
	+ assumes "f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ shows "poly_shift (f \<oplus>\<^bsub>P\<^esub> g) = (poly_shift f) \<oplus>\<^bsub>P\<^esub> (poly_shift g)"
	+ apply(rule ext)
	+ using cfs_add[of "poly_shift f" "poly_shift g"] poly_shift_closed poly_shift_def
	+ by (simp add: poly_shift_def assms(1) assms(2))
	+
	+lemma(in UP_cring) poly_shift_s_mult:
	+ assumes "f \<in> carrier P"
	+ assumes "s \<in> carrier R"
	+ shows "poly_shift (s \<odot>\<^bsub>P\<^esub>f) = s \<odot>\<^bsub>P\<^esub> (poly_shift f)"
	+proof-
	+ have "(s \<odot>\<^bsub>P\<^esub>f) = (ctrm (s \<odot>\<^bsub>P\<^esub>f)) \<oplus>\<^bsub>P\<^esub>(X \<otimes>\<^bsub>P\<^esub> poly_shift (s \<odot>\<^bsub>P\<^esub>f))"
	+ using poly_shift_eq[of "(s \<odot>\<^bsub>P\<^esub>f)"] assms(1) assms(2)
	+ by blast
	+ then have 0: "(s \<odot>\<^bsub>P\<^esub>f) = (s \<odot>\<^bsub>P\<^esub>(ctrm f)) \<oplus>\<^bsub>P\<^esub>(X \<otimes>\<^bsub>P\<^esub> poly_shift (s \<odot>\<^bsub>P\<^esub>f))"
	+ using ctrm_smult assms(1) assms(2) by auto
	+ have 1: "(s \<odot>\<^bsub>P\<^esub>f) = s \<odot>\<^bsub>P\<^esub> ((ctrm f) \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> (poly_shift f)))"
	+ using assms(1) poly_shift_eq by auto
	+ have 2: "(s \<odot>\<^bsub>P\<^esub>f) = (s \<odot>\<^bsub>P\<^esub>(ctrm f)) \<oplus>\<^bsub>P\<^esub> (s \<odot>\<^bsub>P\<^esub>(X \<otimes>\<^bsub>P\<^esub> (poly_shift f)))"
	+ by (simp add: "1" X_closed assms(1) assms(2) ctrm_is_poly poly_shift_closed smult_r_distr)
	+ have 3: "(s \<odot>\<^bsub>P\<^esub>f) = (s \<odot>\<^bsub>P\<^esub>(ctrm f)) \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> (s \<odot>\<^bsub>P\<^esub>(poly_shift f)))"
	+ using "2" UP_m_comm X_closed assms(1) assms(2) smult_assoc2
	+ by (simp add: poly_shift_closed)
	+ have 4: "(X \<otimes>\<^bsub>P\<^esub> poly_shift (s \<odot>\<^bsub>P\<^esub>f)) = (X \<otimes>\<^bsub>P\<^esub> (s \<odot>\<^bsub>P\<^esub>(poly_shift f)))"
	+ using 3 0 X_closed assms(1) assms(2) ctrm_is_poly poly_shift_closed
	+ by auto
	+ then show ?thesis
	+ using X_closed X_not_zero assms(1) assms(2)
	+ by (metis UP_mult_closed UP_smult_closed zcf_eq_zero_unique poly_shift_closed)
	+qed
	+
	+lemma zcf_poly_shift:
	+ assumes "f \<in> carrier P"
	+ shows "zcf (poly_shift f) = f 1"
	+ apply(rule poly_induct3)
	+ apply (simp add: assms)
	+ using poly_shift_add zcf_add cfs_add poly_shift_closed apply metis
	+ unfolding zcf_def using poly_shift_monom poly_shift_degree_zero
	+ by (simp add: poly_shift_def)
	+
	+fun poly_shift_iter ("shift") where
	+Base:"poly_shift_iter 0 f = f"\|
	+Step:"poly_shift_iter (Suc n) f = poly_shift (poly_shift_iter n f)"
	+
	+lemma shift_closed:
	+ assumes "f \<in> carrier P"
	+ shows "shift n f \<in> carrier P"
	+ apply(induction n)
	+ using assms poly_shift_closed by auto
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Operator Which Multiplies Coefficients by Their Degree\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+
	+definition n_mult where
	+"n_mult f = (\<lambda>n. [n]\<cdot>\<^bsub>R\<^esub>(f n))"
	+
	+lemma(in UP_cring) n_mult_closed:
	+ assumes "f \<in> carrier P"
	+ shows "n_mult f \<in> carrier P"
	+ apply(rule UP_car_memI[of "deg R f"])
	+ unfolding n_mult_def
	+ apply (metis P.l_zero R.add.nat_pow_one UP_zero_closed assms cfs_zero coeff_of_sum_diff_degree0)
	+ using assms cfs_closed by auto
	+
	+text\<open>Facts about the shift function\<close>
	+
	+lemma shift_one:
	+"shift (Suc 0) = poly_shift"
	+ by auto
	+
	+lemma shift_factor0:
	+ assumes "f \<in> carrier P"
	+ shows "degree f \<ge> (Suc k) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc k) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc k)))) < (Suc k)"
	+proof(induction k)
	+ case 0
	+ have 0: " f \<ominus>\<^bsub>P\<^esub> (ctrm f) = (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X"
	+ by (metis UP_m_comm X_closed assms poly_shift_id shift_closed shift_one)
	+ then have " f \<ominus>\<^bsub>P\<^esub>(shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X = (ctrm f) "
	+ proof-
	+ have " f \<ominus>\<^bsub>P\<^esub> (ctrm f) \<ominus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X= (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X \<ominus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X"
	+ using 0 by simp
	+ then have " f \<ominus>\<^bsub>P\<^esub> (ctrm f) \<ominus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X = \<zero>\<^bsub>P\<^esub>"
	+ using UP_cring.UP_cring[of R] assms
	+ by (metis "0" P.ring_simprules(4) P_def UP_ring.UP_ring UP_ring_axioms
	+ a_minus_def abelian_group.r_neg ctrm_is_poly ring_def)
	+ then have " f \<ominus>\<^bsub>P\<^esub> ((ctrm f) \<oplus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X) = \<zero>\<^bsub>P\<^esub>"
	+ using assms P.ring_simprules
	+ by (metis "0" poly_shift_id poly_shift_eq)
	+ then have " f \<ominus>\<^bsub>P\<^esub> ((shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X \<oplus>\<^bsub>P\<^esub> (ctrm f) ) = \<zero>\<^bsub>P\<^esub>"
	+ using P.m_closed UP_a_comm X_closed assms ctrm_is_poly shift_closed
	+ by presburger
	+ then have "f \<ominus>\<^bsub>P\<^esub> ((shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X) \<ominus>\<^bsub>P\<^esub> (ctrm f)= \<zero>\<^bsub>P\<^esub>"
	+ using P.add.m_assoc P.ring_simprules(14) P.ring_simprules(19) assms "0"
	+ P.add.inv_closed P.r_neg P.r_zero ctrm_is_poly
	+ by smt
	+ then show ?thesis
	+ by (metis "0" P.add.m_comm P.m_closed P.ring_simprules(14) P.ring_simprules(18)
	+ P.ring_simprules(3) X_closed assms ctrm_is_poly poly_shift_id poly_shift_eq
	+ shift_closed)
	+ qed
	+ then have " f \<ominus>\<^bsub>P\<^esub>(shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc 0)) = (ctrm f) "
	+ proof-
	+ have "X = X[^]\<^bsub>P\<^esub>(Suc 0)"
	+ by (simp add: X_closed)
	+ then show ?thesis
	+ using 0 \<open>f \<ominus>\<^bsub>P\<^esub> shift (Suc 0) f \<otimes>\<^bsub>P\<^esub> X = ctrm f\<close>
	+ by auto
	+ qed
	+ then have " degree (f \<ominus>\<^bsub>P\<^esub>(shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc 0))) < 1"
	+ using ctrm_degree[of f] assms by simp
	+ then show ?case
	+ by blast
	+next
	+ case (Suc n)
	+ fix k
	+ assume IH: "degree f \<ge> (Suc k) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc k) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc k)))) < (Suc k)"
	+ show "degree f \<ge> (Suc (Suc k)) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc (Suc k)) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc (Suc k))))) < (Suc (Suc k))"
	+ proof-
	+ obtain n where n_def: "n = Suc k"
	+ by simp
	+ have IH': "degree f \<ge> n \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift n f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))) < n"
	+ using n_def IH by auto
	+ have P: "degree f \<ge> (Suc n) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc n) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc n)))) < (Suc n)"
	+ proof-
	+ obtain g where g_def: "g = (f \<ominus>\<^bsub>P\<^esub> ((shift n f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)))"
	+ by simp
	+ obtain s where s_def: "s = shift n f"
	+ by simp
	+ obtain s' where s'_def: "s' = shift (Suc n) f"
	+ by simp
	+ have P: "g \<in> carrier P" "s \<in> carrier P" "s' \<in> carrier P" "(X[^]\<^bsub>P\<^esub>n) \<in> carrier P"
	+ using s_def s'_def g_def assms shift_closed[of f n]
	+ apply (simp add: X_closed)
	+ apply (simp add: \<open>f \<in> carrier P \<Longrightarrow> shift n f \<in> carrier P\<close> assms s_def)
	+ using P_def UP_cring.shift_closed UP_cring_axioms assms s'_def apply blast
	+ using X_closed by blast
	+ have g_def': "g = (f \<ominus>\<^bsub>P\<^esub> (s \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)))"
	+ using g_def s_def by auto
	+ assume "degree f \<ge> (Suc n)"
	+ then have " degree (f \<ominus>\<^bsub>P\<^esub> (s \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))) < n"
	+ using IH' Suc_leD s_def by blast
	+ then have d_g: "degree g < n" using g_def' by auto
	+ have P0: "f \<ominus>\<^bsub>P\<^esub> (s' \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc n))) = ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g"
	+ proof-
	+ have "s = (ctrm s) \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> s')"
	+ using s_def s'_def P_def poly_shift_eq UP_cring_axioms assms shift_closed
	+ by (simp add: UP_cring.poly_shift_eq)
	+ then have 0: "g = f \<ominus>\<^bsub>P\<^esub> ((ctrm s) \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> s')) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)"
	+ using g_def' by auto
	+ then have "g = f \<ominus>\<^bsub>P\<^esub> ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<ominus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
	+ using P cring X_closed P.l_distr P.ring_simprules(19) UP_a_assoc a_minus_def assms
	+ by (simp add: a_minus_def ctrm_is_poly)
	+ then have "g \<oplus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) = f \<ominus>\<^bsub>P\<^esub> ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
	+ using P cring X_closed P.l_distr P.ring_simprules UP_a_assoc a_minus_def assms
	+ by (simp add: P.r_neg2 ctrm_is_poly)
	+ then have " ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) = f \<ominus>\<^bsub>P\<^esub> (g \<oplus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)))"
	+ using P cring X_closed P.ring_simprules UP_a_assoc a_minus_def assms
	+ by (simp add: P.ring_simprules(17) ctrm_is_poly)
	+ then have " ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) = f \<ominus>\<^bsub>P\<^esub> (((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g)"
	+ by (simp add: P(1) P(3) UP_a_comm X_closed)
	+ then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) = f \<ominus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<ominus>\<^bsub>P\<^esub> g"
	+ using P(1) P(3) P.ring_simprules(19) UP_a_assoc a_minus_def assms
	+ by (simp add: a_minus_def X_closed)
	+ then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g= f \<ominus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
	+ by (metis P(1) P(3) P(4) P.add.inv_solve_right P.m_closed P.ring_simprules(14)
	+ P.ring_simprules(4) P_def UP_cring.X_closed UP_cring_axioms assms)
	+ then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g= f \<ominus>\<^bsub>P\<^esub> ((s' \<otimes>\<^bsub>P\<^esub> X) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
	+ by (simp add: P(3) UP_m_comm X_closed)
	+ then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g= f \<ominus>\<^bsub>P\<^esub> (s' \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc n)))"
	+ using P(3) P.nat_pow_Suc2 UP_m_assoc X_closed by auto
	+ then show ?thesis
	+ by auto
	+ qed
	+ have P1: "degree (((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g) \<le> n"
	+ proof-
	+ have Q0: "degree ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<le> n"
	+ proof(cases "ctrm s = \<zero>\<^bsub>P\<^esub>")
	+ case True
	+ then show ?thesis
	+ by (simp add: P(4))
	+ next
	+ case False
	+ then have F0: "degree ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<le> degree (ctrm s) + degree (X[^]\<^bsub>P\<^esub>n) "
	+ by (meson ctrm_is_poly P(2) P(4) deg_mult_ring)
	+ have F1: "\<one>\<noteq>\<zero>\<Longrightarrow> degree (X[^]\<^bsub>P\<^esub>n) = n"
	+ unfolding X_poly_def
	+ using P_def cring_monom_degree by auto
	+ show ?thesis
	+ by (metis (no_types, hide_lams) F0 F1 ltrm_deg_0 P(2) P.r_null P_def R.l_null R.l_one
	+ R.nat_pow_closed R.zero_closed X_poly_def assms cfs_closed
	+ add_0 deg_const deg_zero deg_ltrm
	+ monom_pow monom_zero zero_le)
	+ qed
	+ then show ?thesis
	+ using d_g
	+ by (simp add: P(1) P(2) P(4) bound_deg_sum ctrm_is_poly)
	+ qed
	+ then show ?thesis
	+ using s'_def P0 by auto
	+ qed
	+ assume "degree f \<ge> (Suc (Suc k)) "
	+ then show "degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc (Suc k)) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc (Suc k))))) < (Suc (Suc k))"
	+ using P by(simp add: n_def)
	+ qed
	+qed
	+
	+lemma(in UP_cring) shift_degree0:
	+ assumes "f \<in> carrier P"
	+ shows "degree f >n \<Longrightarrow> Suc (degree (shift (Suc n) f)) = degree (shift n f)"
	+proof(induction n)
	+ case 0
	+ assume B: "0< degree f"
	+ have 0: "degree (shift 0 f) = degree f"
	+ by simp
	+ have 1: "degree f = degree (f \<ominus>\<^bsub>P\<^esub> (ctrm f))"
	+ using assms(1) B ctrm_degree degree_of_difference_diff_degree
	+ by (simp add: ctrm_is_poly)
	+ have "(f \<ominus>\<^bsub>P\<^esub> (ctrm f)) = X \<otimes>\<^bsub>P\<^esub>(shift 1 f)"
	+ using P_def poly_shift_id UP_cring_axioms assms(1) by auto
	+ then have "degree (f \<ominus>\<^bsub>P\<^esub> (ctrm f)) = 1 + (degree (shift 1 f))"
	+ by (metis "1" B P.r_null X_closed add.commute assms deg_nzero_nzero degree_times_X not_gr_zero shift_closed)
	+ then have "degree (shift 0 f) = 1 + (degree (shift 1 f))"
	+ using 0 1 by auto
	+ then show ?case
	+ by simp
	+next
	+ case (Suc n)
	+ fix n
	+ assume IH: "(n < degree f \<Longrightarrow> Suc (degree (shift (Suc n) f)) = degree (shift n f))"
	+ show "Suc n < degree f \<Longrightarrow> Suc (degree (shift (Suc (Suc n)) f)) = degree (shift (Suc n) f)"
	+ proof-
	+ assume A: " Suc n < degree f"
	+ then have 0: "(shift (Suc n) f) = ctrm ((shift (Suc n) f)) \<oplus>\<^bsub>P\<^esub> (shift (Suc (Suc n)) f)\<otimes>\<^bsub>P\<^esub>X"
	+ by (metis UP_m_comm X_closed assms local.Step poly_shift_eq shift_closed)
	+ have N: "(shift (Suc (Suc n)) f) \<noteq> \<zero>\<^bsub>P\<^esub>"
	+ proof
	+ assume C: "shift (Suc (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
	+ obtain g where g_def: "g = f \<ominus>\<^bsub>P\<^esub> (shift (Suc (Suc n)) f)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc (Suc n)))"
	+ by simp
	+ have C0: "degree g < degree f"
	+ using g_def assms A
	+ by (meson Suc_leI Suc_less_SucD Suc_mono less_trans_Suc shift_factor0)
	+ have C1: "g = f"
	+ using C
	+ by (simp add: P.minus_eq X_closed assms g_def)
	+ then show False
	+ using C0 by auto
	+ qed
	+ have 1: "degree (shift (Suc n) f) = degree ((shift (Suc n) f) \<ominus>\<^bsub>P\<^esub> ctrm ((shift (Suc n) f)))"
	+ proof(cases "degree (shift (Suc n) f) = 0")
	+ case True
	+ then show ?thesis
	+ using N assms poly_shift_degree_zero poly_shift_closed shift_closed by auto
	+ next
	+ case False
	+ then have "degree (shift (Suc n) f) > degree (ctrm ((shift (Suc n) f)))"
	+ proof -
	+ have "shift (Suc n) f \<in> carrier P"
	+ using assms shift_closed by blast
	+ then show ?thesis
	+ using False ctrm_degree by auto
	+ qed
	+ then show ?thesis
	+ proof -
	+ show ?thesis
	+ using \<open>degree (ctrm (shift (Suc n) f)) < degree (shift (Suc n) f)\<close>
	+ assms ctrm_is_poly degree_of_difference_diff_degree shift_closed by presburger
	+ qed
	+ qed
	+ have 2: "(shift (Suc n) f) \<ominus>\<^bsub>P\<^esub> ctrm ((shift (Suc n) f)) = (shift (Suc (Suc n)) f)\<otimes>\<^bsub>P\<^esub>X"
	+ using 0
	+ by (metis Cring_Poly.INTEG.Step P.m_comm X_closed assms poly_shift_id shift_closed)
	+ have 3: "degree ((shift (Suc n) f) \<ominus>\<^bsub>P\<^esub> ctrm ((shift (Suc n) f))) = degree (shift (Suc (Suc n)) f) + 1"
	+ using 2 N X_closed X_not_zero assms degree_X shift_closed
	+ by (metis UP_m_comm degree_times_X)
	+ then show ?thesis using 1
	+ by linarith
	+ qed
	+qed
	+
	+lemma(in UP_cring) shift_degree:
	+ assumes "f \<in> carrier P"
	+ shows "degree f \<ge> n \<Longrightarrow> degree (shift n f) + n = degree f"
	+proof(induction n)
	+ case 0
	+ then show ?case
	+ by auto
	+next
	+ case (Suc n)
	+ fix n
	+ assume IH: "(n \<le> degree f \<Longrightarrow> degree (shift n f) + n = degree f)"
	+ show "Suc n \<le> degree f \<Longrightarrow> degree (shift (Suc n) f) + Suc n = degree f"
	+ proof-
	+ assume A: "Suc n \<le> degree f "
	+ have 0: "degree (shift n f) + n = degree f"
	+ using IH A by auto
	+ have 1: "degree (shift n f) = Suc (degree (shift (Suc n) f))"
	+ using A assms shift_degree0 by auto
	+ show "degree (shift (Suc n) f) + Suc n = degree f"
	+ using 0 1 by simp
	+ qed
	+qed
	+
	+lemma(in UP_cring) shift_degree':
	+ assumes "f \<in> carrier P"
	+ shows "degree (shift (degree f) f) = 0"
	+ using shift_degree assms
	+ by fastforce
	+
	+lemma(in UP_cring) shift_above_degree:
	+ assumes "f \<in> carrier P"
	+ assumes "k > degree f"
	+ shows "(shift k f) = \<zero>\<^bsub>P\<^esub>"
	+proof-
	+ have "\<And>n. shift ((degree f)+ (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
	+ proof-
	+ fix n
	+ show "shift ((degree f)+ (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
	+ proof(induction n)
	+ case 0
	+ have B0:"shift (degree f) f = ctrm(shift (degree f) f) \<oplus>\<^bsub>P\<^esub> (shift (degree f + Suc 0) f)\<otimes>\<^bsub>P\<^esub>X"
	+ proof -
	+ have f1: "\<forall>f n. f \<notin> carrier P \<or> shift n f \<in> carrier P"
	+ by (meson shift_closed)
	+ then have "shift (degree f + Suc 0) f \<in> carrier P"
	+ using assms(1) by blast
	+ then show ?thesis
	+ using f1 by (simp add: P.m_comm X_closed assms(1) poly_shift_eq)
	+ qed
	+ have B1:"shift (degree f) f = ctrm(shift (degree f) f)"
	+ proof -
	+ have "shift (degree f) f \<in> carrier P"
	+ using assms(1) shift_closed by blast
	+ then show ?thesis
	+ using ltrm_deg_0 assms(1) shift_degree' by auto
	+ qed
	+ have B2: "(shift (degree f + Suc 0) f)\<otimes>\<^bsub>P\<^esub>X = \<zero>\<^bsub>P\<^esub>"
	+ using B0 B1 X_closed assms(1)
	+ proof -
	+ have "\<forall>f n. f \<notin> carrier P \<or> shift n f \<in> carrier P"
	+ using shift_closed by blast
	+ then show ?thesis
	+ by (metis (no_types) B0 B1 P.add.l_cancel_one UP_mult_closed X_closed assms(1))
	+ qed
	+ then show ?case
	+ by (metis P.r_null UP_m_comm UP_zero_closed X_closed assms(1) zcf_eq_zero_unique shift_closed)
	+ next
	+ case (Suc n)
	+ fix n
	+ assume "shift (degree f + Suc n) f = \<zero>\<^bsub>P\<^esub>"
	+ then show "shift (degree f + Suc (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
	+ by (simp add: poly_shift_degree_zero)
	+ qed
	+ qed
	+ then show ?thesis
	+ using assms(2) less_iff_Suc_add by auto
	+qed
	+
	+lemma(in UP_domain) shift_cfs0:
	+ assumes "f \<in> carrier P"
	+ shows "zcf(shift 1 f) = f 1"
	+ using assms
	+ by (simp add: zcf_poly_shift)
	+
	+lemma(in UP_cring) X_mult_cf:
	+ assumes "p \<in> carrier P"
	+ shows "(p \<otimes>\<^bsub>P\<^esub> X) (k+1) = p k"
	+ unfolding X_poly_def
	+ using assms
	+ by (metis UP_m_comm X_closed X_poly_def add.commute plus_1_eq_Suc cfs_times_X)
	+
	+lemma(in UP_cring) X_pow_cf:
	+ assumes "p \<in> carrier P"
	+ shows "(p \<otimes>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) (n + k) = p k"
	+proof-
	+ have P: "\<And>f. f \<in> carrier P \<Longrightarrow> (f \<otimes>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) (n + k) = f k"
	+ proof(induction n)
	+ show "\<And>f. f \<in> carrier P \<Longrightarrow> (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> (0::nat)) (0 + k) = f k"
	+ proof-
	+ fix f
	+ assume B0: "f \<in> carrier P"
	+ show "(f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> (0::nat)) (0 + k) = f k"
	+ by (simp add: B0)
	+ qed
	+ fix n
	+ fix f
	+ assume IH: "(\<And>f. f \<in> carrier P \<Longrightarrow> (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n) (n + k) = f k)"
	+ assume A0: " f \<in> carrier P"
	+ show "(f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> Suc n) (Suc n + k) = f k"
	+ proof-
	+ have 0: "(f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)(n + k) = f k"
	+ using A0 IH by simp
	+ have 1: "((f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)\<otimes>\<^bsub>P\<^esub>X) (Suc n + k) = (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)(n + k)"
	+ using X_mult_cf A0 P.m_closed P.nat_pow_closed
	+ Suc_eq_plus1 X_closed add_Suc by presburger
	+ have 2: "(f \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> n \<otimes>\<^bsub>P\<^esub>X)) (Suc n + k) = (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)(n + k)"
	+ using 1
	+ by (simp add: A0 UP_m_assoc X_closed)
	+ then show ?thesis
	+ by (simp add: "0")
	+ qed
	+ qed
	+ show ?thesis using assms P[of p] by auto
	+qed
	+
	+lemma poly_shift_cfs:
	+ assumes "f \<in> carrier P"
	+ shows "poly_shift f n = f (Suc n)"
	+proof-
	+ have "(f \<ominus>\<^bsub>P\<^esub> ctrm f) (Suc n) = (X \<otimes>\<^bsub>P\<^esub> (poly_shift f)) (Suc n)"
	+ using assms poly_shift_id by auto
	+ then show ?thesis unfolding X_poly_def using poly_shift_closed assms
	+ by (metis (no_types, lifting) ctrm_degree ctrm_is_poly
	+ P.add.m_comm P.minus_closed coeff_of_sum_diff_degree0 poly_shift_id poly_shift_eq cfs_times_X zero_less_Suc)
	+qed
	+
	+lemma(in UP_cring) shift_cfs:
	+ assumes "p \<in> carrier P"
	+ shows "(shift k p) n = p (k + n)"
	+ apply(induction k arbitrary: n)
	+ by (auto simp: assms poly_shift_cfs shift_closed)
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>The Derivative Operator\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+definition pderiv where
	+"pderiv p = poly_shift (n_mult p)"
	+
	+lemma pderiv_closed:
	+ assumes "p \<in> carrier P"
	+ shows "pderiv p \<in> carrier P"
	+ unfolding pderiv_def
	+ using assms n_mult_closed[of p] poly_shift_closed[of "n_mult p"]
	+ by blast
	+
	+text\<open>Function which obtains the first n+1 terms of f, in ascending order of degree:\<close>
	+
	+definition trms_of_deg_leq where
	+"trms_of_deg_leq n f \<equiv> f \<ominus>\<^bsub>(UP R)\<^esub> ((shift (Suc n) f) \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc n))"
	+
	+lemma trms_of_deg_leq_closed:
	+ assumes "f \<in> carrier P"
	+ shows "trms_of_deg_leq n f \<in> carrier P"
	+ unfolding trms_of_deg_leq_def using assms
	+ by (metis P.m_closed P.minus_closed P_def R.one_closed monom_closed shift_closed)
	+
	+lemma trms_of_deg_leq_id:
	+ assumes "f \<in> carrier P"
	+ shows "f \<ominus>\<^bsub>P\<^esub> (trms_of_deg_leq k f) = shift (Suc k) f \<otimes>\<^bsub>P\<^esub> monom P \<one> (Suc k)"
	+ unfolding trms_of_deg_leq_def
	+ using assms
	+ by (smt P.add.inv_closed P.l_zero P.m_closed P.minus_add P.minus_minus P.r_neg
	+ P_def R.one_closed UP_a_assoc a_minus_def monom_closed shift_closed)
	+
	+lemma trms_of_deg_leq_id':
	+ assumes "f \<in> carrier P"
	+ shows "f = (trms_of_deg_leq k f) \<oplus>\<^bsub>P\<^esub> shift (Suc k) f \<otimes>\<^bsub>P\<^esub> monom P \<one> (Suc k)"
	+ using trms_of_deg_leq_id assms trms_of_deg_leq_closed[of f]
	+ by (smt P.add.inv_closed P.l_zero P.m_closed P.minus_add P.minus_minus P.r_neg R.one_closed UP_a_assoc a_minus_def monom_closed shift_closed)
	+
	+lemma deg_leqI:
	+ assumes "p \<in> carrier P"
	+ assumes "\<And>n. n > k \<Longrightarrow> p n = \<zero>"
	+ shows "degree p \<le> k"
	+ by (metis assms(1) assms(2) deg_zero deg_ltrm le0 le_less_linear monom_zero)
	+
	+lemma deg_leE:
	+ assumes "p \<in> carrier P"
	+ assumes "degree p < k"
	+ shows "p k = \<zero>"
	+ using assms coeff_of_sum_diff_degree0 P_def coeff_simp deg_aboveD
	+ by auto
	+
	+lemma trms_of_deg_leq_deg:
	+ assumes "f \<in> carrier P"
	+ shows "degree (trms_of_deg_leq k f) \<le> k"
	+proof-
	+ have "\<And>n. (trms_of_deg_leq k f) (Suc k + n) = \<zero>"
	+ proof-
	+ fix n
	+ have 0: "(shift (Suc k) f \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc k)) (Suc k + n) = shift (Suc k) f n"
	+ using assms shift_closed cfs_monom_mult_l
	+ by (metis P.m_comm P_def R.one_closed add.commute monom_closed times_X_pow_coeff)
	+ then show "trms_of_deg_leq k f (Suc k + n) = \<zero>"
	+ unfolding trms_of_deg_leq_def
	+ using shift_cfs[of f "Suc k" n]
	+ cfs_minus[of f "shift (Suc k) f \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc k)" "Suc k + n"]
	+ by (metis P.m_closed P.r_neg P_def R.one_closed a_minus_def assms
	+ cfs_minus cfs_zero monom_closed shift_closed)
	+ qed
	+ then show ?thesis using deg_leqI
	+ by (metis (no_types, lifting) assms le_iff_add less_Suc_eq_0_disj less_Suc_eq_le trms_of_deg_leq_closed)
	+qed
	+
	+lemma trms_of_deg_leq_zero_is_ctrm:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f > 0"
	+ shows "trms_of_deg_leq 0 f = ctrm f"
	+proof-
	+ have "f = ctrm f \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> (shift (Suc 0) f))"
	+ using assms poly_shift_eq
	+ by simp
	+ then have "f = ctrm f \<oplus>\<^bsub>P\<^esub> (X [^]\<^bsub>UP R\<^esub> Suc 0 \<otimes>\<^bsub>P\<^esub> (shift (Suc 0) f))"
	+ using P.nat_pow_eone P_def X_closed by auto
	+ then show ?thesis
	+ unfolding trms_of_deg_leq_def
	+ by (metis (no_types, lifting) ctrm_is_poly One_nat_def P.add.right_cancel P.m_closed
	+ P.minus_closed P.nat_pow_eone P_def UP_m_comm X_closed X_poly_def assms(1) shift_closed
	+ trms_of_deg_leq_def trms_of_deg_leq_id')
	+qed
	+
	+lemma cfs_monom_mult:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "k < n"
	+ shows "(p \<otimes>\<^bsub>P\<^esub> (monom P a n)) k = \<zero>"
	+ apply(rule poly_induct3[of p])
	+ apply (simp add: assms(1))
	+ apply (metis (no_types, lifting) P.l_distr P.m_closed R.r_zero R.zero_closed assms(2) cfs_add monom_closed)
	+ using assms monom_mult[of _ a _ n]
	+ by (metis R.m_closed R.m_comm add.commute cfs_monom not_add_less1)
	+
	+lemma(in UP_cring) cfs_monom_mult_2:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "m < n"
	+ shows "((monom P a n) \<otimes>\<^bsub>P\<^esub> f) m = \<zero>"
	+ using cfs_monom_mult
	+ by (simp add: P.m_comm assms(1) assms(2) assms(3))
	+
	+lemma trms_of_deg_leq_cfs:
	+ assumes "f \<in> carrier P"
	+ shows "trms_of_deg_leq n f k = (if k \<le> n then (f k) else \<zero>)"
	+ unfolding trms_of_deg_leq_def
	+ apply(cases "k \<le> n")
	+ using cfs_minus[of f "shift (Suc n) f \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc n)"]
	+ cfs_monom_mult[of _ \<one> k "Suc n"]
	+ apply (metis (no_types, lifting) P.m_closed P.minus_closed P_def R.one_closed R.r_zero assms
	+ cfs_add cfs_closed le_refl monom_closed nat_less_le nat_neq_iff not_less_eq_eq shift_closed
	+ trms_of_deg_leq_def trms_of_deg_leq_id')
	+ using trms_of_deg_leq_deg[of f n] deg_leE
	+ unfolding trms_of_deg_leq_def
	+ using assms trms_of_deg_leq_closed trms_of_deg_leq_def by auto
	+
	+lemma trms_of_deg_leq_iter:
	+ assumes "f \<in> carrier P"
	+ shows "trms_of_deg_leq (Suc k) f = (trms_of_deg_leq k f) \<oplus>\<^bsub>P\<^esub> monom P (f (Suc k)) (Suc k)"
	+proof fix x
	+ show "trms_of_deg_leq (Suc k) f x = (trms_of_deg_leq k f \<oplus>\<^bsub>P\<^esub> monom P (f (Suc k)) (Suc k)) x"
	+ apply(cases "x \<le> k")
	+ using trms_of_deg_leq_cfs trms_of_deg_leq_closed cfs_closed[of f "Suc k"]
	+ cfs_add[of "trms_of_deg_leq k f" "monom P (f (Suc k)) (Suc k)" x]
	+ apply (simp add: assms)
	+ using deg_leE assms cfs_closed cfs_monom apply auto[1]
	+ by (simp add: assms cfs_closed cfs_monom trms_of_deg_leq_cfs trms_of_deg_leq_closed)
	+qed
	+
	+lemma trms_of_deg_leq_0:
	+ assumes "f \<in> carrier P"
	+ shows "trms_of_deg_leq 0 f = ctrm f"
	+ by (metis One_nat_def P.r_null P_def UP_m_comm UP_zero_closed X_closed X_poly_def assms not_gr_zero
	+ poly_shift_degree_zero shift_one trms_of_deg_leq_def trms_of_deg_leq_zero_is_ctrm trunc_simps(2) trunc_zero)
	+
	+lemma trms_of_deg_leq_degree_f:
	+ assumes "f \<in> carrier P"
	+ shows "trms_of_deg_leq (degree f) f = f"
	+proof fix x
	+ show "trms_of_deg_leq (deg R f) f x = f x"
	+ using assms trms_of_deg_leq_cfs deg_leE[of f x]
	+ by simp
	+qed
	+
	+definition(in UP_cring) lin_part where
	+"lin_part f = trms_of_deg_leq 1 f"
	+
	+lemma(in UP_cring) lin_part_id:
	+ assumes "f \<in> carrier P"
	+ shows "lin_part f = (ctrm f) \<oplus>\<^bsub>P\<^esub> monom P (f 1) 1"
	+ unfolding lin_part_def
	+ by (simp add: assms trms_of_deg_leq_0 trms_of_deg_leq_iter)
	+
	+lemma(in UP_cring) lin_part_eq:
	+ assumes "f \<in> carrier P"
	+ shows "f = lin_part f \<oplus>\<^bsub>P\<^esub> (shift 2 f) \<otimes>\<^bsub>P\<^esub> monom P \<one> 2"
	+ unfolding lin_part_def
	+ by (metis Suc_1 assms trms_of_deg_leq_id')
	+
	+text\<open>Constant term of a substitution:\<close>
	+
	+lemma zcf_eval:
	+ assumes "f \<in> carrier P"
	+ shows "zcf f = to_fun f \<zero>"
	+ using assms zcf_to_fun by blast
	+
	+lemma ctrm_of_sub:
	+ assumes "f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ shows "zcf(f of g) = to_fun f (zcf g)"
	+ apply(rule poly_induct3[of f])
	+ apply (simp add: assms(1))
	+ using P_def UP_cring.to_fun_closed UP_cring_axioms zcf_add zcf_to_fun assms(2) to_fun_plus sub_add sub_closed apply fastforce
	+ using R.zero_closed zcf_to_fun assms(2) to_fun_sub monom_closed sub_closed by presburger
	+
	+text\<open>Evaluation of linear part:\<close>
	+
	+lemma to_fun_lin_part:
	+ assumes "f \<in> carrier P"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (lin_part f) b = (f 0) \<oplus> (f 1) \<otimes> b"
	+ using assms lin_part_id[of f] to_fun_ctrm to_fun_monom monom_closed
	+ by (simp add: cfs_closed to_fun_plus)
	+
	+text\<open>Constant term of taylor expansion:\<close>
	+
	+lemma taylor_zcf:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "zcf(T\<^bsub>a\<^esub> f) = to_fun f a"
	+ unfolding taylor_expansion_def
	+ using ctrm_of_sub assms P_def zcf_eval X_plus_closed taylor_closed taylor_eval by auto
	+
	+lemma(in UP_cring) taylor_eq_1:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "(T\<^bsub>a\<^esub> f) \<ominus>\<^bsub>P\<^esub> (trms_of_deg_leq 1 (T\<^bsub>a\<^esub> f)) = (shift (2::nat) (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub> (X[^]\<^bsub>P\<^esub>(2::nat))"
	+ by (metis P.nat_pow_eone P.nat_pow_mult P_def Suc_1 taylor_closed X_closed X_poly_def assms(1)
	+ assms(2) monom_one_Suc2 one_add_one trms_of_deg_leq_id)
	+
	+lemma(in UP_cring) taylor_deg_1:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "f of (X_plus a) = (lin_part (T\<^bsub>a\<^esub> f)) \<oplus>\<^bsub>P\<^esub> (shift (2::nat) (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub> (X[^]\<^bsub>P\<^esub>(2::nat))"
	+ using taylor_eq_1[of f a]
	+ unfolding taylor_expansion_def lin_part_def
	+ using One_nat_def X_plus_closed assms(1)
	+ assms(2) trms_of_deg_leq_id' numeral_2_eq_2 sub_closed
	+ by (metis P.nat_pow_Suc2 P.nat_pow_eone P_def taylor_def X_closed X_poly_def monom_one_Suc taylor_expansion_def)
	+
	+lemma(in UP_cring) taylor_deg_1_eval:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) b"
	+ assumes "fa = to_fun f a"
	+ assumes "f'a = deriv f a"
	+ shows "to_fun f (b \<oplus> a) = fa \<oplus> (f'a \<otimes> b) \<oplus> (c \<otimes> b[^](2::nat))"
	+ using assms taylor_deg_1 unfolding derivative_def
	+proof-
	+ have 0: "to_fun f (b \<oplus> a) = to_fun (f of (X_plus a)) b"
	+ using to_fun_sub assms X_plus_closed by auto
	+ have 1: "to_fun (lin_part (T\<^bsub>a\<^esub> f)) b = fa \<oplus> (f'a \<otimes> b) "
	+ using assms to_fun_lin_part[of "(T\<^bsub>a\<^esub> f)" b]
	+ by (metis P_def taylor_def UP_cring.taylor_zcf UP_cring.taylor_closed UP_cring_axioms zcf_def derivative_def)
	+ have 2: "(T\<^bsub>a\<^esub> f) = (lin_part (T\<^bsub>a\<^esub> f)) \<oplus>\<^bsub>P\<^esub> ((shift 2 (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub>X[^]\<^bsub>P\<^esub>(2::nat))"
	+ using lin_part_eq[of "(T\<^bsub>a\<^esub>f)"] assms(1) assms(2) taylor_closed
	+ by (metis taylor_def taylor_deg_1 taylor_expansion_def)
	+ then have "to_fun (T\<^bsub>a\<^esub>f) b = fa \<oplus> (f'a \<otimes> b) \<oplus> to_fun ((shift 2 (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub>X[^]\<^bsub>P\<^esub>(2::nat)) b"
	+ using 1 2
	+ by (metis P.nat_pow_closed taylor_closed UP_mult_closed X_closed assms(1) assms(2) assms(3)
	+ to_fun_plus lin_part_def shift_closed trms_of_deg_leq_closed)
	+ then have "to_fun (T\<^bsub>a\<^esub>f) b = fa \<oplus> (f'a \<otimes> b) \<oplus> c \<otimes> to_fun (X[^]\<^bsub>P\<^esub>(2::nat)) b"
	+ by (simp add: taylor_closed X_closed assms(1) assms(2) assms(3) assms(4) to_fun_mult shift_closed)
	+ then have 3: "to_fun f (b \<oplus> a)= fa \<oplus> (f'a \<otimes> b) \<oplus> c \<otimes> to_fun (X[^]\<^bsub>P\<^esub>(2::nat)) b"
	+ using taylor_eval assms(1) assms(2) assms(3) by auto
	+ have "to_fun (X[^]\<^bsub>P\<^esub>(2::nat)) b = b[^](2::nat)"
	+ by (metis P.nat_pow_Suc2 P.nat_pow_eone R.nat_pow_Suc2
	+ R.nat_pow_eone Suc_1 to_fun_X
	+ X_closed assms(3) to_fun_mult)
	+ then show ?thesis
	+ using 3 by auto
	+qed
	+
	+lemma(in UP_cring) taylor_deg_1_eval':
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) b"
	+ assumes "fa = to_fun f a"
	+ assumes "f'a = deriv f a"
	+ shows "to_fun f (a \<oplus> b) = fa \<oplus> (f'a \<otimes> b) \<oplus> (c \<otimes> b[^](2::nat))"
	+ using R.add.m_comm taylor_deg_1_eval assms(1) assms(2) assms(3) assms(4) assms(5) assms(6)
	+ by auto
	+
	+lemma(in UP_cring) taylor_deg_1_eval'':
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) (\<ominus>b)"
	+ shows "to_fun f (a \<ominus> b) = (to_fun f a) \<ominus> (deriv f a \<otimes> b) \<oplus> (c \<otimes> b[^](2::nat))"
	+proof-
	+ have "\<ominus>b \<in> carrier R"
	+ using assms
	+ by blast
	+ then have 0: "to_fun f (a \<ominus> b) = (to_fun f a)\<oplus> (deriv f a \<otimes> (\<ominus>b)) \<oplus> (c \<otimes> (\<ominus>b)[^](2::nat))"
	+ unfolding a_minus_def
	+ using taylor_deg_1_eval'[of f a "\<ominus>b" c "(to_fun f a)" "deriv f a"] assms
	+ by auto
	+ have 1: "\<ominus> (deriv f a \<otimes> b) = (deriv f a \<otimes> (\<ominus>b))"
	+ using assms
	+ by (simp add: R.r_minus deriv_closed)
	+ have 2: "(c \<otimes> b[^](2::nat)) = (c \<otimes> (\<ominus>b)[^](2::nat))"
	+ using assms
	+ by (metis R.add.inv_closed R.add.inv_solve_right R.l_zero R.nat_pow_Suc2
	+ R.nat_pow_eone R.zero_closed Suc_1 UP_ring_axioms UP_ring_def
	+ ring.ring_simprules(26) ring.ring_simprules(27))
	+ show ?thesis
	+ using 0 1 2
	+ unfolding a_minus_def
	+ by simp
	+qed
	+
	+lemma(in UP_cring) taylor_deg_1_expansion:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) (b \<ominus> a)"
	+ assumes "fa = to_fun f a"
	+ assumes "f'a = deriv f a"
	+ shows "to_fun f (b) = fa \<oplus> f'a \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
	+proof-
	+ obtain b' where b'_def: "b'= b \<ominus> a "
	+ by simp
	+ then have b'_def': "b = b' \<oplus> a"
	+ using assms
	+ by (metis R.add.inv_solve_right R.minus_closed R.minus_eq)
	+ have "to_fun f (b' \<oplus> a) = fa \<oplus> (f'a \<otimes> b') \<oplus> (c \<otimes> b'[^](2::nat))"
	+ using assms taylor_deg_1_eval[of f a b' c fa f'a] b'_def
	+ by blast
	+ then have "to_fun f (b) = fa \<oplus> (f'a \<otimes> b') \<oplus> (c \<otimes> b'[^](2::nat))"
	+ using b'_def'
	+ by auto
	+ then show "to_fun f (b) = fa \<oplus> f'a \<otimes> (b \<ominus> a) \<oplus> c \<otimes> (b \<ominus> a) [^] (2::nat)"
	+ using b'_def
	+ by auto
	+qed
	+
	+lemma(in UP_cring) Taylor_deg_1_expansion':
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "\<exists>c \<in> carrier R. to_fun f (b) = (to_fun f a) \<oplus> (deriv f a) \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
	+ using taylor_deg_1_expansion[of f a b] assms unfolding P_def
	+ by (metis P_def R.minus_closed taylor_closed shift_closed to_fun_closed)
	+
	+
	+text\<open>Basic Properties of deriv and pderiv:\<close>
	+
	+lemma n_mult_degree_bound:
	+ assumes "f \<in> carrier P"
	+ shows "degree (n_mult f) \<le> degree f"
	+ apply(rule deg_leqI)
	+ apply (simp add: assms n_mult_closed)
	+ by (simp add: assms deg_leE n_mult_def)
	+
	+lemma pderiv_deg_0[simp]:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = 0"
	+ shows "pderiv f = \<zero>\<^bsub>P\<^esub>"
	+proof-
	+ have "degree (n_mult f) = 0"
	+ using P_def n_mult_degree_bound assms(1) assms(2) by fastforce
	+ then show ?thesis
	+ unfolding pderiv_def
	+ by (simp add: assms(1) n_mult_closed poly_shift_degree_zero)
	+qed
	+
	+lemma deriv_deg_0:
	+ assumes "f \<in> carrier P"
	+ assumes "degree f = 0"
	+ assumes "a \<in> carrier R"
	+ shows "deriv f a = \<zero>"
	+ unfolding derivative_def taylor_expansion_def
	+ using X_plus_closed assms(1) assms(2) assms(3) deg_leE sub_const by force
	+
	+lemma poly_shift_monom':
	+ assumes "a \<in> carrier R"
	+ shows "poly_shift (a \<odot>\<^bsub>P\<^esub> (X[^]\<^bsub>P\<^esub>(Suc n))) = a\<odot>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)"
	+ using assms monom_rep_X_pow poly_shift_monom by auto
	+
	+lemma monom_coeff:
	+ assumes "a \<in> carrier R"
	+ shows "(a \<odot>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> (n::nat)) k = (if (k = n) then a else \<zero>)"
	+ using assms cfs_monom monom_rep_X_pow by auto
	+
	+lemma cfs_n_mult:
	+ assumes "p \<in> carrier P"
	+ shows "n_mult p n = [n]\<cdot>(p n)"
	+ by (simp add: n_mult_def)
	+
	+lemma cfs_add_nat_pow:
	+ assumes "p \<in> carrier P"
	+ shows "([(n::nat)]\<cdot>\<^bsub>P\<^esub>p) k = [n]\<cdot>(p k)"
	+ apply(induction n) by (auto simp: assms)
	+
	+lemma cfs_add_int_pow:
	+ assumes "p \<in> carrier P"
	+ shows "([(n::int)]\<cdot>\<^bsub>P\<^esub>p) k = [n]\<cdot>(p k)"
	+ apply(induction n)
	+ by(auto simp: add_pow_int_ge assms cfs_add_nat_pow add_pow_int_lt)
	+
	+lemma add_nat_pow_monom:
	+ assumes "a \<in> carrier R"
	+ shows "[(n::nat)]\<cdot>\<^bsub>P\<^esub>monom P a k = monom P ([n]\<cdot>a) k"
	+ apply(rule ext)
	+ by (simp add: assms cfs_add_nat_pow cfs_monom)
	+
	+lemma add_int_pow_monom:
	+ assumes "a \<in> carrier R"
	+ shows "[(n::int)]\<cdot>\<^bsub>P\<^esub>monom P a k = monom P ([n]\<cdot>a) k"
	+ apply(rule ext)
	+ by (simp add: assms cfs_add_int_pow cfs_monom)
	+
	+lemma n_mult_monom:
	+ assumes "a \<in> carrier R"
	+ shows "n_mult (monom P a (Suc n)) = monom P ([Suc n]\<cdot>a) (Suc n)"
	+ apply(rule ext)
	+ unfolding n_mult_def
	+ using assms cfs_monom by auto
	+
	+lemma pderiv_monom:
	+ assumes "a \<in> carrier R"
	+ shows "pderiv (monom P a n) = monom P ([n]\<cdot>a) (n-1)"
	+ apply(cases "n = 0")
	+ apply (simp add: assms)
	+ unfolding pderiv_def
	+ using assms Suc_diff_1[of n] n_mult_monom[of a "n-1"] poly_shift_monom[of "[Suc (n-1)]\<cdot>a" "Suc (n-1)"]
	+ by (metis R.add.nat_pow_closed neq0_conv poly_shift_monom)
	+
	+lemma pderiv_monom':
	+ assumes "a \<in> carrier R"
	+ shows "pderiv (a \<odot>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) = ([n]\<cdot>a)\<odot>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n-1)"
	+ using assms pderiv_monom[of a n ]
	+ by (simp add: P_def UP_cring.monom_rep_X_pow UP_cring_axioms)
	+
	+lemma n_mult_add:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "n_mult (p \<oplus>\<^bsub>P\<^esub> q) = n_mult p \<oplus>\<^bsub>P\<^esub> n_mult q"
	+proof(rule ext) fix x show "n_mult (p \<oplus>\<^bsub>P\<^esub> q) x = (n_mult p \<oplus>\<^bsub>P\<^esub> n_mult q) x"
	+ using assms R.add.nat_pow_distrib[of "p x" "q x" x] cfs_add[of p q x]
	+ cfs_add[of "n_mult p" "n_mult q" x] n_mult_closed
	+ unfolding n_mult_def
	+ by (simp add: cfs_closed)
	+qed
	+
	+lemma pderiv_add:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "pderiv (p \<oplus>\<^bsub>P\<^esub> q) = pderiv p \<oplus>\<^bsub>P\<^esub> pderiv q"
	+ unfolding pderiv_def
	+ using assms poly_shift_add n_mult_add
	+ by (simp add: n_mult_closed)
	+
	+lemma zcf_monom_sub:
	+ assumes "p \<in> carrier P"
	+ shows "zcf ((monom P \<one> (Suc n)) of p) = zcf p [^] (Suc n)"
	+ apply(induction n)
	+ using One_nat_def P.nat_pow_eone R.nat_pow_eone R.one_closed R.zero_closed zcf_to_fun assms to_fun_closed monom_sub smult_one apply presburger
	+ using P_def UP_cring.ctrm_of_sub UP_cring_axioms zcf_to_fun assms to_fun_closed to_fun_monom monom_closed
	+ by fastforce
	+
	+lemma zcf_monom_sub':
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "zcf ((monom P a (Suc n)) of p) = a \<otimes> zcf p [^] (Suc n)"
	+ using zcf_monom_sub assms P_def R.zero_closed UP_cring.ctrm_of_sub UP_cring.to_fun_monom UP_cring_axioms
	+ zcf_to_fun to_fun_closed monom_closed by fastforce
	+
	+lemma deriv_monom:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "deriv (monom P a n) b = ([n]\<cdot>a)\<otimes>(b[^](n-1))"
	+proof(induction n)
	+ case 0
	+ have 0: "b [^] ((0::nat) - 1) \<in> carrier R"
	+ using assms
	+ by simp
	+ then show ?case unfolding derivative_def using assms
	+ by (smt One_nat_def P_def R.add.nat_pow_0 R.nat_pow_Suc2 R.nat_pow_eone R.zero_closed
	+ taylor_def taylor_deg UP_cring.taylor_closed UP_cring.zcf_monom UP_cring.shift_one
	+ UP_cring_axioms zcf_degree_zero zcf_zero_degree_zero degree_monom monom_closed
	+ monom_rep_X_pow plus_1_eq_Suc poly_shift_degree_zero shift_cfs to_fun_monom to_fun_zero zero_diff)
	+next
	+ case (Suc n)
	+ show ?case
	+ proof(cases "n = 0")
	+ case True
	+ have T0: "[Suc n] \<cdot> a \<otimes> b [^] (Suc n - 1) = a"
	+ by (simp add: True assms(1))
	+ have T1: "(X_poly R \<oplus>\<^bsub>UP R\<^esub> to_polynomial R b) [^]\<^bsub>UP R\<^esub> Suc n = X_poly R \<oplus>\<^bsub>UP R\<^esub> to_polynomial R b "
	+ using P.nat_pow_eone P_def True UP_a_closed X_closed assms(2) to_poly_closed by auto
	+ then show ?thesis
	+ unfolding derivative_def taylor_expansion_def
	+ using T0 T1 True sub_monom(2)[of "X_plus b" a "Suc n"] cfs_add assms
	+ unfolding P_def X_poly_plus_def to_polynomial_def X_poly_def
	+ by (smt Group.nat_pow_0 lcf_eq lcf_monom(2) ltrm_of_X_plus One_nat_def P_def R.one_closed
	+ R.r_one R.r_zero UP_cring.zcf_monom UP_cring.degree_of_X_plus
	+ UP_cring.poly_shift_degree_zero UP_cring_axioms X_closed X_plus_closed X_poly_def
	+ X_poly_plus_def zcf_zero_degree_zero cfs_monom_mult_l degree_to_poly to_fun_X_pow
	+ plus_1_eq_Suc poly_shift_cfs poly_shift_monom to_poly_closed to_poly_mult_simp(2)
	+ to_poly_nat_pow to_polynomial_def)
	+ next
	+ case False
	+ have "deriv (monom P a (Suc n)) b = ((monom P a (Suc n)) of (X_plus b)) 1"
	+ unfolding derivative_def taylor_expansion_def
	+ by auto
	+ then have "deriv (monom P a (Suc n)) b = (((monom P a n) of (X_plus b)) \<otimes>\<^bsub>P\<^esub> (X_plus b)) 1"
	+ using monom_mult[of a \<one> n 1] sub_mult[of "X_plus b" "monom P a n" "monom P \<one> 1" ] X_plus_closed[of b] assms
	+ by (metis lcf_monom(1) P.l_one P.nat_pow_eone P_def R.one_closed R.r_one Suc_eq_plus1
	+ deg_one monom_closed monom_one sub_monom(1) to_poly_inverse)
	+ then have "deriv (monom P a (Suc n)) b = (((monom P a n) of (X_plus b)) \<otimes>\<^bsub>P\<^esub> (monom P \<one> 1) \<oplus>\<^bsub>P\<^esub>
	+ (((monom P a n) of (X_plus b)) \<otimes>\<^bsub>P\<^esub> to_poly b)) 1"
	+ unfolding X_poly_plus_def
	+ by (metis P.r_distr P_def X_closed X_plus_closed X_poly_def X_poly_plus_def assms(1) assms(2) monom_closed sub_closed to_poly_closed)
	+ then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> b \<otimes> ((monom P a n) of (X_plus b)) 1"
	+ unfolding X_poly_plus_def
	+ by (smt One_nat_def P.m_closed P_def UP_m_comm X_closed X_plus_closed X_poly_def X_poly_plus_def
	+ assms(1) assms(2) cfs_add cfs_monom_mult_l monom_closed plus_1_eq_Suc sub_closed cfs_times_X to_polynomial_def)
	+ then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> b \<otimes> (deriv (monom P a n) b)"
	+ by (simp add: derivative_def taylor_expansion_def)
	+ then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> b \<otimes> ( ([n]\<cdot>a)\<otimes>(b[^](n-1)))"
	+ by (simp add: Suc)
	+ then have 0: "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> ([n]\<cdot>a)\<otimes>(b[^]n)"
	+ using assms R.m_comm[of b] R.nat_pow_mult[of b "n-1" 1] False
	+ by (metis (no_types, lifting) R.add.nat_pow_closed R.m_lcomm R.nat_pow_closed R.nat_pow_eone add.commute add_eq_if plus_1_eq_Suc)
	+ have 1: "((monom P a n) of (X_plus b)) 0 = a \<otimes> b[^]n"
	+ unfolding X_poly_plus_def using zcf_monom_sub'
	+ by (smt ctrm_of_sub One_nat_def P_def R.l_zero R.one_closed UP_cring.zcf_to_poly
	+ UP_cring.f_minus_ctrm UP_cring_axioms X_plus_closed X_poly_def X_poly_plus_def zcf_add
	+ zcf_def assms(1) assms(2) to_fun_monom monom_closed monom_one_Suc2 poly_shift_id poly_shift_monom to_poly_closed)
	+ show ?thesis
	+ using 0 1 R.add.nat_pow_Suc2 R.add.nat_pow_closed R.l_distr R.nat_pow_closed assms(1) assms(2) diff_Suc_1 by presburger
	+ qed
	+qed
	+
	+lemma deriv_smult:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "g \<in> carrier P"
	+ shows "deriv (a \<odot>\<^bsub>P\<^esub> g) b = a \<otimes> (deriv g b)"
	+ unfolding derivative_def taylor_expansion_def
	+ using assms sub_smult X_plus_closed cfs_smult
	+ by (simp add: sub_closed)
	+
	+lemma deriv_const:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "deriv (monom P a 0) b = \<zero>"
	+ unfolding derivative_def
	+ using assms taylor_closed taylor_def taylor_deg deg_leE by auto
	+
	+lemma deriv_monom_deg_one:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "deriv (monom P a 1) b = a"
	+ unfolding derivative_def taylor_expansion_def
	+ using assms cfs_X_plus[of b 1] sub_monom_deg_one X_plus_closed[of b]
	+ by simp
	+
	+lemma monom_Suc:
	+ assumes "a \<in> carrier R"
	+ shows "monom P a (Suc n) = monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> monom P a n"
	+ "monom P a (Suc n) = monom P a n \<otimes>\<^bsub>P\<^esub> monom P \<one> 1"
	+ apply (metis R.l_one R.one_closed Suc_eq_plus1_left assms monom_mult)
	+ by (metis R.one_closed R.r_one Suc_eq_plus1 assms monom_mult)
	+
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+subsection\<open>The Product Rule\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+lemma(in UP_cring) times_x_product_rule:
	+ assumes "f \<in> carrier P"
	+ shows "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+proof(rule poly_induct3[of f])
	+ show "f \<in> carrier P"
	+ using assms by blast
	+ show "\<And>p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ pderiv (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<Longrightarrow>
	+ pderiv (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = q \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<Longrightarrow>
	+ pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+ proof- fix p q assume A: "q \<in> carrier P"
	+ "p \<in> carrier P"
	+ "pderiv (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+ "pderiv (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = q \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+ have 0: "(p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 = (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<oplus>\<^bsub>P\<^esub> (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
	+ using A assms by (meson R.one_closed UP_l_distr is_UP_monomE(1) is_UP_monomI)
	+ have 1: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = pderiv (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<oplus>\<^bsub>P\<^esub> pderiv (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
	+ unfolding 0 apply(rule pderiv_add)
	+ using A is_UP_monomE(1) monom_is_UP_monom(1) apply blast
	+ using A is_UP_monomE(1) monom_is_UP_monom(1) by blast
	+ have 2: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<oplus>\<^bsub>P\<^esub> (q \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
	+ unfolding 1 A by blast
	+ have 3: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> (pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
	+ unfolding 2
	+ using A P.add.m_lcomm R.one_closed UP_a_assoc UP_a_closed UP_mult_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed by presburger
	+ have 4: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> ((pderiv p \<oplus>\<^bsub>P\<^esub> pderiv q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
	+ unfolding 3 using A P.l_distr R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed by presburger
	+ show 5: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+ unfolding 4 using pderiv_add A by presburger
	+ qed
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow>
	+ pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = up_ring.monom P a n \<oplus>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+ proof- fix a n assume A: "a \<in> carrier R"
	+ have 0: "up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 = up_ring.monom P a (Suc n)"
	+ using A monom_Suc(2) by presburger
	+ have 1: "pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = [(Suc n)] \<cdot>\<^bsub>P\<^esub> (up_ring.monom P a n)"
	+ unfolding 0 using A add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom
	+ by (simp add: P_def)
	+ have 2: "pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> [n] \<cdot>\<^bsub>P\<^esub> (up_ring.monom P a n)"
	+ unfolding 1 using A P.add.nat_pow_Suc2 is_UP_monomE(1) monom_is_UP_monom(1) by blast
	+ have 3: "pderiv (up_ring.monom P a n) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 = [n] \<cdot>\<^bsub>P\<^esub> (up_ring.monom P a n)"
	+ apply(cases "n = 0")
	+ using A add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom pderiv_deg_0 apply auto[1]
	+ using monom_Suc(2)[of a "n-1"] A add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom
	+ by (metis R.add.nat_pow_closed Suc_eq_plus1 add_eq_if monom_Suc(2) pderiv_monom)
	+ show "pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = up_ring.monom P a n \<oplus>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+ unfolding 2 3 by blast
	+ qed
	+qed
	+
	+lemma(in UP_cring) deg_one_eval:
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "deg R g = 1"
	+ shows "\<And>t. t \<in> carrier R \<Longrightarrow> to_fun g t = g 0 \<oplus> (g 1)\<otimes>t"
	+proof-
	+ obtain h where h_def: "h = ltrm g"
	+ by blast
	+ have 0: "deg R (g \<ominus>\<^bsub>UP R\<^esub> h) = 0"
	+ using assms unfolding h_def
	+ by (metis ltrm_closed ltrm_eq_imp_deg_drop ltrm_monom P_def UP_car_memE(1) less_one)
	+ have 1: "g \<ominus>\<^bsub>UP R\<^esub> h = to_poly (g 0)"
	+ proof(rule ext) fix x show "(g \<ominus>\<^bsub>UP R\<^esub> h) x = to_polynomial R (g 0) x"
	+ proof(cases "x = 0")
	+ case True
	+ have T0: "h 0 = \<zero>"
	+ unfolding h_def using assms UP_car_memE(1) cfs_monom by presburger
	+ have T1: "(g \<ominus>\<^bsub>UP R\<^esub> h) 0 = g 0 \<ominus> h 0"
	+ using ltrm_closed P_def assms(1) cfs_minus h_def by blast
	+ then show ?thesis using T0 assms
	+ by (smt "0" ltrm_closed ltrm_deg_0 P.minus_closed P_def UP_car_memE(1) UP_zero_closed zcf_def zcf_zero deg_zero degree_to_poly h_def to_poly_closed to_poly_inverse to_poly_minus trunc_simps(2) trunc_zero)
	+ next
	+ case False
	+ then have "x > 0"
	+ by presburger
	+ then show ?thesis
	+ by (metis "0" ltrm_closed P.minus_closed P_def UP_car_memE(1) UP_cring.degree_to_poly UP_cring_axioms assms(1) deg_leE h_def to_poly_closed)
	+ qed
	+ qed
	+ have 2: "g = (g \<ominus>\<^bsub>UP R\<^esub> h) \<oplus>\<^bsub>UP R\<^esub> h"
	+ unfolding h_def using assms
	+ by (metis "1" P_def h_def lin_part_def lin_part_id to_polynomial_def trms_of_deg_leq_degree_f)
	+ fix t assume A: "t \<in> carrier R"
	+ have 3: " to_fun g t = to_fun (g \<ominus>\<^bsub>UP R\<^esub> h) t \<oplus> to_fun h t"
	+ using 2
	+ by (metis "1" A P_def UP_car_memE(1) assms(1) h_def monom_closed to_fun_plus to_polynomial_def)
	+ then show "to_fun g t = g 0 \<oplus> g 1 \<otimes> t "
	+ unfolding 1 h_def
	+ using A P_def UP_cring.lin_part_def UP_cring_axioms assms(1) assms(2) to_fun_lin_part trms_of_deg_leq_degree_f by fastforce
	+qed
	+
	+lemma nmult_smult:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier P"
	+ shows "n_mult (a \<odot>\<^bsub>P\<^esub> f) = a \<odot>\<^bsub>P\<^esub> (n_mult f)"
	+ apply(rule poly_induct4[of f])
	+ apply (simp add: assms(2))
	+ using assms(1) n_mult_add n_mult_closed smult_closed smult_r_distr apply presburger
	+ using assms apply(intro ext, metis (no_types, lifting) ctrm_smult ltrm_deg_0 P_def R.add.nat_pow_0 UP_cring.ctrm_degree UP_cring.n_mult_closed UP_cring.n_mult_def UP_cring_axioms UP_smult_closed UP_zero_closed zcf_degree_zero zcf_zero deg_const deg_zero le_0_eq monom_closed n_mult_degree_bound smult_r_null)
	+ using monom_mult_smult n_mult_monom assms
	+ by (smt lcf_monom(1) P_def R.add.nat_pow_closed R.add_pow_rdistr R.zero_closed UP_cring.to_poly_mult_simp(1) UP_cring_axioms UP_smult_closed cfs_closed cring_lcf_mult monom_closed to_polynomial_def)
	+
	+lemma pderiv_smult:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier P"
	+ shows "pderiv (a \<odot>\<^bsub>P\<^esub> f) = a \<odot>\<^bsub>P\<^esub> (pderiv f)"
	+ unfolding pderiv_def
	+ using assms
	+ by (simp add: n_mult_closed nmult_smult poly_shift_s_mult)
	+
	+lemma(in UP_cring) pderiv_minus:
	+ assumes "a \<in> carrier P"
	+ assumes "b \<in> carrier P"
	+ shows "pderiv (a \<ominus>\<^bsub>P\<^esub> b) = pderiv a \<ominus>\<^bsub>P\<^esub> pderiv b"
	+proof-
	+ have "\<ominus>\<^bsub>P\<^esub> b = (\<ominus>\<one>)\<odot>\<^bsub>P\<^esub>b"
	+ using R.one_closed UP_smult_one assms(2) smult_l_minus by presburger
	+ thus ?thesis unfolding a_minus_def using pderiv_add assms pderiv_smult
	+ by (metis P.add.inv_closed R.add.inv_closed R.one_closed UP_smult_one pderiv_closed smult_l_minus)
	+qed
	+
	+lemma(in UP_cring) pderiv_const:
	+ assumes "b \<in> carrier R"
	+ shows "pderiv (up_ring.monom P b 0) = \<zero>\<^bsub>P\<^esub>"
	+ using assms pderiv_monom[of b 0] deg_const is_UP_monomE(1) monom_is_UP_monom(1) pderiv_deg_0
	+ by blast
	+
	+lemma(in UP_cring) pderiv_minus_const:
	+ assumes "a \<in> carrier P"
	+ assumes "b \<in> carrier R"
	+ shows "pderiv (a \<ominus>\<^bsub>P\<^esub> up_ring.monom P b 0) = pderiv a"
	+ using pderiv_minus[of a "up_ring.monom P b 0" ] assms pderiv_const[of b]
	+ by (smt P.l_zero P.minus_closed P_def UP_cring.pderiv_const UP_cring.pderiv_minus UP_cring.poly_shift_eq UP_cring_axioms cfs_closed monom_closed pderiv_add pderiv_closed poly_shift_id)
	+
	+lemma(in UP_cring) monom_product_rule:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
	+proof-
	+ have "\<forall>f. f \<in> carrier P \<longrightarrow> pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
	+ proof(induction n)
	+ case 0
	+ show ?case
	+ proof fix f show "f \<in> carrier P \<longrightarrow> pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a 0) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0 "
	+ proof assume A: "f \<in> carrier P"
	+ have 0: "f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0 = a \<odot>\<^bsub>P\<^esub>f"
	+ using assms A UP_m_comm is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult by presburger
	+ have 1: "f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a 0) = \<zero>\<^bsub>P\<^esub>"
	+ using A assms P.r_null pderiv_const by presburger
	+ have 2: "pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0 = a \<odot>\<^bsub>P\<^esub> pderiv f"
	+ using assms A UP_m_comm is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed by presburger
	+ show "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a 0) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0"
	+ unfolding 0 1 2 using A UP_l_zero UP_smult_closed assms(2) pderiv_closed pderiv_smult by presburger
	+ qed
	+ qed
	+ next
	+ case (Suc n)
	+ show "\<forall>f. f \<in> carrier P \<longrightarrow>
	+ pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
	+ proof fix f
	+ show "f \<in> carrier P \<longrightarrow>
	+ pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
	+ proof
	+ assume A: "f \<in> carrier P"
	+ show " pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
	+ proof(cases "n = 0")
	+ case True
	+ have 0: "(f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = a \<odot>\<^bsub>P\<^esub> f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
	+ proof -
	+ have "\<forall>n. up_ring.monom P a n \<in> carrier P"
	+ using assms(2) is_UP_monomE(1) monom_is_UP_monom(1) by presburger
	+ then show ?thesis
	+ by (metis A P.m_assoc P.m_comm R.one_closed True assms(2) is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_mult_is_smult)
	+ qed
	+ have 1: "f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) = a \<odot>\<^bsub>P\<^esub> f"
	+ using assms True
	+ by (metis A One_nat_def P.m_comm R.add.nat_pow_eone diff_Suc_1 is_UP_monomE(1) is_UP_monomI monom_mult_is_smult pderiv_monom)
	+ have 2: "pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n) = a \<odot>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
	+ using A assms unfolding True
	+ by (metis P.m_lcomm R.one_closed UP_mult_closed is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed)
	+ have 3: "a \<odot>\<^bsub>P\<^esub> f \<oplus>\<^bsub>P\<^esub> a \<odot>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = a \<odot>\<^bsub>P\<^esub> (f \<oplus>\<^bsub>P\<^esub>(pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1))"
	+ using assms A P.m_closed R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed smult_r_distr by presburger
	+ show ?thesis
	+ unfolding 0 1 2 3
	+ using A times_x_product_rule P.m_closed R.one_closed UP_smult_assoc2 assms(2) is_UP_monomE(1) monom_is_UP_monom(1) pderiv_smult by presburger
	+ next
	+ case False
	+ have IH: "pderiv ((f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) = (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
	+ using Suc A P.m_closed R.one_closed is_UP_monomE(1) is_UP_monomI by presburger
	+ have 0: "f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n) = (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
	+ using A R.one_closed UP_m_assoc assms(2) is_UP_monomE(1) monom_Suc(1) monom_is_UP_monom(1) by presburger
	+ have 1: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n =
	+ (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n "
	+ using A times_x_product_rule by presburger
	+ have 2: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) =(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P ([n]\<cdot>a) n)"
	+ proof-
	+ have 20: "up_ring.monom P ([n] \<cdot> a) (n) = up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P ([n] \<cdot> a) (n - 1)"
	+ using A assms False monom_mult[of \<one> "[n]\<cdot>a" 1 "n-1"]
	+ by (metis R.add.nat_pow_closed R.l_one R.one_closed Suc_eq_plus1 add.commute add_eq_if )
	+ show ?thesis unfolding 20 using assms A False pderiv_monom[of a n]
	+ using P.m_assoc R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) by simp
	+ qed
	+ have 3: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P ([n]\<cdot>a) n) = [n]\<cdot>\<^bsub>P\<^esub>(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P a n)"
	+ using A assms by (metis P.add_pow_rdistr add_nat_pow_monom is_UP_monomE(1) monom_is_UP_monom(1))
	+ have 4: "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
	+ using times_x_product_rule A by blast
	+ have 5: " (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n =
	+ (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n ) \<oplus>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n )"
	+ using A assms by (meson P.l_distr P.m_closed R.one_closed is_UP_monomE(1) is_UP_monomI pderiv_closed)
	+ have 6: " (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n =
	+ (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n ) \<oplus>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n )"
	+ using A assms False 5 by blast
	+ have 7: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n =
	+ [(Suc n)] \<cdot>\<^bsub>P\<^esub> (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
	+ unfolding 2 3 5 6 using assms A P.a_assoc
	+ by (smt "1" "2" "3" "6" P.add.nat_pow_Suc P.m_closed R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed)
	+ have 8: "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = pderiv ((f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n)"
	+ using A assms 0 by presburger
	+ show " pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
	+ unfolding 8 IH 0 1 2 3 4 5 6
	+ by (smt "2" "4" "6" "7" A P.add_pow_rdistr R.one_closed UP_m_assoc add_nat_pow_monom assms(2) diff_Suc_1 is_UP_monomE(1) is_UP_monomI monom_Suc(1) pderiv_closed pderiv_monom)
	+ qed
	+ qed
	+ qed
	+ qed
	+ thus ?thesis using assms by blast
	+qed
	+
	+lemma(in UP_cring) product_rule:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "g \<in> carrier (UP R)"
	+ shows "pderiv (f \<otimes>\<^bsub>UP R\<^esub>g) = (pderiv f \<otimes>\<^bsub>UP R\<^esub> g) \<oplus>\<^bsub>UP R\<^esub> (f \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
	+proof(rule poly_induct3[of f])
	+ show "f \<in> carrier P"
	+ using assms unfolding P_def by blast
	+ show "\<And>p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ pderiv (p \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
	+ pderiv (q \<otimes>\<^bsub>UP R\<^esub> g) = pderiv q \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
	+ pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ proof- fix p q
	+ assume A: "q \<in> carrier P" "p \<in> carrier P"
	+ "pderiv (p \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ "pderiv (q \<otimes>\<^bsub>UP R\<^esub> g) = pderiv q \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ have 0: "(p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g = p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> g"
	+ using A assms unfolding P_def using P_def UP_l_distr by blast
	+ have 1: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (p \<otimes>\<^bsub>UP R\<^esub> g) \<oplus>\<^bsub>UP R\<^esub> pderiv (q \<otimes>\<^bsub>UP R\<^esub> g)"
	+ unfolding 0 using pderiv_add[of "p \<otimes>\<^bsub>P\<^esub> g" "q \<otimes>\<^bsub>P\<^esub> g"] unfolding P_def
	+ using A(1) A(2) P_def UP_mult_closed assms(2) by blast
	+ have 2: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g \<oplus>\<^bsub>UP R\<^esub> (pderiv q \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
	+ unfolding 1 A by blast
	+ have 3: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> pderiv q \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ using A assms
	+ by (smt "2" P.add.m_lcomm P.m_closed P_def UP_a_assoc pderiv_closed)
	+ have 4: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = (pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> pderiv q \<otimes>\<^bsub>UP R\<^esub> g) \<oplus>\<^bsub>UP R\<^esub> (p \<otimes>\<^bsub>UP R\<^esub> pderiv g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
	+ unfolding 3 using A assms P_def UP_a_assoc UP_a_closed UP_mult_closed pderiv_closed by auto
	+ have 5: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = ((pderiv p \<oplus>\<^bsub>UP R\<^esub> pderiv q) \<otimes>\<^bsub>UP R\<^esub> g) \<oplus>\<^bsub>UP R\<^esub> ((p \<oplus>\<^bsub>UP R\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
	+ unfolding 4 using A assms by (metis P.l_distr P_def pderiv_closed)
	+ have 6: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = ((pderiv (p \<oplus>\<^bsub>P\<^esub> q)) \<otimes>\<^bsub>UP R\<^esub> g) \<oplus>\<^bsub>UP R\<^esub> ((p \<oplus>\<^bsub>UP R\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
	+ unfolding 5 using A assms
	+ by (metis P_def pderiv_add)
	+ show "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ unfolding 6 using A assms P_def by blast
	+ qed
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow>
	+ pderiv (up_ring.monom P a n \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (up_ring.monom P a n) \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> up_ring.monom P a n \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ using P_def UP_m_comm assms(2) is_UP_monomE(1) monom_is_UP_monom(1) monom_product_rule pderiv_closed by presburger
	+qed
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+subsection\<open>The Chain Rule\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+lemma(in UP_cring) chain_rule:
	+ assumes "f \<in> carrier P"
	+ assumes "g \<in> carrier P"
	+ shows "pderiv (compose R f g) = compose R (pderiv f) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+proof(rule poly_induct3[of f])
	+ show "f \<in> carrier P"
	+ using assms by blast
	+ show "\<And>p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ pderiv (Cring_Poly.compose R p g) = Cring_Poly.compose R (pderiv p) g \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
	+ pderiv (Cring_Poly.compose R q g) = Cring_Poly.compose R (pderiv q) g \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
	+ pderiv (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> q) g) = Cring_Poly.compose R (pderiv (p \<oplus>\<^bsub>P\<^esub> q)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ using pderiv_add sub_add
	+ by (smt P_def UP_a_closed UP_m_comm UP_r_distr assms(2) pderiv_closed sub_closed)
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow>
	+ pderiv (compose R (up_ring.monom P a n) g) = compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ proof-
	+ fix a n assume A: "a \<in> carrier R"
	+ show "pderiv (compose R (up_ring.monom P a n) g) = compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ proof(induction n)
	+ case 0
	+ have 00: "(compose R (up_ring.monom P a 0) g) = (up_ring.monom P a 0)"
	+ using A P_def assms(2) deg_const is_UP_monom_def monom_is_UP_monom(1) sub_const by presburger
	+ have 01: "pderiv (up_ring.monom P a 0) = \<zero>\<^bsub>P\<^esub>"
	+ using A pderiv_const by blast
	+ show ?case unfolding 00 01
	+ by (metis P.l_null P_def UP_zero_closed assms(2) deg_zero pderiv_closed sub_const)
	+ next
	+ case (Suc n)
	+ show "pderiv (Cring_Poly.compose R (up_ring.monom P a (Suc n)) g) = Cring_Poly.compose R (pderiv (up_ring.monom P a (Suc n))) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
	+ proof(cases "n = 0")
	+ case True
	+ have 0: "compose R (up_ring.monom P a (Suc n)) g = a \<odot>\<^bsub>P\<^esub> g"
	+ using A assms sub_monom_deg_one[of g a] unfolding True using One_nat_def
	+ by presburger
	+ have 1: "(pderiv (up_ring.monom P a (Suc n))) = up_ring.monom P a 0"
	+ unfolding True
	+ proof -
	+ have "pderiv (up_ring.monom P a 0) = \<zero>\<^bsub>P\<^esub>"
	+ using A pderiv_const by blast
	+ then show "pderiv (up_ring.monom P a (Suc 0)) = up_ring.monom P a 0"
	+ using A lcf_monom(1) P_def X_closed deg_const deg_nzero_nzero is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_rep_X_pow pderiv_monom poly_shift_degree_zero poly_shift_eq sub_monom(2) sub_monom_deg_one to_poly_inverse to_poly_mult_simp(2)
	+ by (metis (no_types, lifting) P.l_null P.r_zero X_poly_def times_x_product_rule)
	+ qed
	+ then show ?thesis unfolding 0 1
	+ using A P_def assms(2) deg_const is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed pderiv_smult sub_const
	+ by presburger
	+ next
	+ case False
	+ have 0: "compose R (up_ring.monom P a (Suc n)) g = (compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> (compose R (up_ring.monom P \<one> 1) g)"
	+ using assms A by (metis R.one_closed monom_Suc(2) monom_closed sub_mult)
	+ have 1: "compose R (up_ring.monom P a (Suc n)) g = (compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> g"
	+ unfolding 0 using A assms
	+ by (metis P_def R.one_closed UP_cring.lcf_monom(1) UP_cring.to_poly_inverse UP_cring_axioms UP_l_one UP_one_closed deg_one monom_one sub_monom_deg_one to_poly_mult_simp(1))
	+ have 2: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
	+ ((pderiv (compose R (up_ring.monom P a n) g)) \<otimes>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> ((compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> pderiv g)"
	+ unfolding 1 unfolding P_def apply(rule product_rule)
	+ using A assms unfolding P_def using P_def is_UP_monomE(1) is_UP_monomI rev_sub_closed sub_rev_sub apply presburger
	+ using assms unfolding P_def by blast
	+ have 3: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
	+ (compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g \<otimes>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> ((compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> pderiv g)"
	+ unfolding 2 Suc by blast
	+ have 4: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
	+ ((compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>UP R\<^esub> pderiv g) \<oplus>\<^bsub>P\<^esub> ((compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> pderiv g)"
	+ unfolding 3 using A assms m_assoc m_comm
	+ by (smt P_def monom_closed monom_rep_X_pow pderiv_closed sub_closed)
	+ have 5: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
	+ ((compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> (compose R (up_ring.monom P a n) g)) \<otimes>\<^bsub>P\<^esub> pderiv g"
	+ unfolding 4 using A assms
	+ by (metis P.l_distr P.m_closed P_def UP_cring.pderiv_closed UP_cring_axioms monom_closed sub_closed)
	+ have 6: "compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>P\<^esub> g = [n]\<cdot>\<^bsub>P\<^esub>compose R ((up_ring.monom P a n)) g"
	+ proof-
	+ have 60: "(pderiv (up_ring.monom P a n)) = (up_ring.monom P ([n]\<cdot>a) (n-1))"
	+ using A assms pderiv_monom by blast
	+ have 61: "compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>P\<^esub> g = compose R ((up_ring.monom P ([n]\<cdot>a) (n-1))) g \<otimes>\<^bsub>P\<^esub> (compose R (up_ring.monom P \<one> 1) g)"
	+ unfolding 60 using A assms sub_monom_deg_one[of g \<one> ] R.one_closed smult_one by presburger
	+ have 62: "compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>P\<^esub> g = compose R (up_ring.monom P ([n]\<cdot>a) n) g"
	+ unfolding 61 using False A assms sub_mult[of g "up_ring.monom P ([n] \<cdot> a) (n - 1)" "up_ring.monom P \<one> 1" ] monom_mult[of "[n]\<cdot>a" \<one> "n-1" 1]
	+ by (metis Nat.add_0_right R.add.nat_pow_closed R.one_closed R.r_one Suc_eq_plus1 add_eq_if monom_closed)
	+ have 63: "\<And>k::nat. Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
	+ proof- fix k::nat show "Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
	+ apply(induction k)
	+ using UP_zero_closed assms(2) deg_zero monom_zero sub_const
	+ apply (metis A P.add.nat_pow_0 add_nat_pow_monom)
	+ proof-
	+ fix k::nat
	+ assume a: "Cring_Poly.compose R (monom P ([k] \<cdot> a) n) g =
	+ [k] \<cdot>\<^bsub>P\<^esub> Cring_Poly.compose R (monom P a n) g"
	+ have 0: "(monom P ([Suc k] \<cdot> a) n) = [Suc k] \<cdot> a \<odot>\<^bsub>P\<^esub>(monom P \<one> n)"
	+ by (simp add: A monic_monom_smult)
	+ have 1: "(monom P ([Suc k] \<cdot> a) n) = [k] \<cdot> a \<odot>\<^bsub>P\<^esub>(monom P \<one> n) \<oplus>\<^bsub>P\<^esub>a \<odot>\<^bsub>P\<^esub>(monom P \<one> n) "
	+ unfolding 0
	+ by (simp add: A UP_smult_l_distr)
	+ show "Cring_Poly.compose R (monom P ([Suc k] \<cdot> a) n) g =
	+ [Suc k] \<cdot>\<^bsub>P\<^esub> (Cring_Poly.compose R (monom P a n) g) "
	+ unfolding 1
	+ by (simp add: A a assms(2) monic_monom_smult sub_add)
	+ qed
	+ qed
	+ have 64: "Cring_Poly.compose R (up_ring.monom P ([n] \<cdot> a) n) g = [n] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
	+ using 63 by blast
	+ show ?thesis unfolding 62 64 by blast
	+ qed
	+ have 63: "\<And>k::nat. Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
	+ proof- fix k::nat show "Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
	+ apply(induction k)
	+ using UP_zero_closed assms(2) deg_zero monom_zero sub_const
	+ apply (metis A P.add.nat_pow_0 add_nat_pow_monom)
	+ using A P.add.nat_pow_Suc add_nat_pow_monom assms(2) is_UP_monomE(1) monom_is_UP_monom(1) rev_sub_add sub_rev_sub
	+ by (metis P.add.nat_pow_closed)
	+ qed
	+ have 7: "([n] \<cdot>\<^bsub>P\<^esub> Cring_Poly.compose R (up_ring.monom P a n) g \<oplus>\<^bsub>P\<^esub> Cring_Poly.compose R (up_ring.monom P a n) g) =
	+ [Suc n] \<cdot>\<^bsub>P\<^esub> (Cring_Poly.compose R (up_ring.monom P a n) g)"
	+ using A assms P.add.nat_pow_Suc by presburger
	+ have 8: "[Suc n] \<cdot>\<^bsub>P\<^esub> Cring_Poly.compose R (up_ring.monom P a n) g \<otimes>\<^bsub>P\<^esub> pderiv g = Cring_Poly.compose R (up_ring.monom P ([Suc n] \<cdot> a) n) g \<otimes>\<^bsub>P\<^esub> pderiv g"
	+ unfolding 63[of "Suc n"] by blast
	+ show ?thesis unfolding 5 6 7 8 using A assms pderiv_monom[of "a" "Suc n"]
	+ using P_def diff_Suc_1 by metis
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma deriv_prod_rule_times_monom:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "q \<in> carrier P"
	+ shows "deriv ((monom P a n) \<otimes>\<^bsub>P\<^esub> q) b = (deriv (monom P a n) b) \<otimes> (to_fun q b) \<oplus> (to_fun (monom P a n) b) \<otimes> deriv q b"
	+proof(rule poly_induct3[of q])
	+ show "q \<in> carrier P"
	+ using assms by simp
	+ show " \<And>p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ deriv (monom P a n \<otimes>\<^bsub>P\<^esub> p) b = deriv (monom P a n) b \<otimes> to_fun p b \<oplus> to_fun (monom P a n) b \<otimes> deriv p b \<Longrightarrow>
	+ deriv (monom P a n \<otimes>\<^bsub>P\<^esub> q) b = deriv (monom P a n) b \<otimes> to_fun q b \<oplus> to_fun (monom P a n) b \<otimes> deriv q b \<Longrightarrow>
	+ deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b = deriv (monom P a n) b \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (p \<oplus>\<^bsub>P\<^esub> q) b"
	+ proof- fix p q assume A: "q \<in> carrier P" " p \<in> carrier P"
	+ "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> p) b = deriv (monom P a n) b \<otimes> to_fun p b \<oplus> to_fun (monom P a n) b \<otimes> deriv p b"
	+ "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> q) b = deriv (monom P a n) b \<otimes> to_fun q b \<oplus> to_fun (monom P a n) b \<otimes> deriv q b"
	+ have "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b = deriv (monom P a n) b \<otimes> to_fun p b \<oplus> to_fun (monom P a n) b \<otimes> deriv p b
	+ \<oplus>deriv (monom P a n) b \<otimes> to_fun q b \<oplus> to_fun (monom P a n) b \<otimes> deriv q b"
	+ using A assms
	+ by (simp add: P.r_distr R.add.m_assoc deriv_add deriv_closed to_fun_closed)
	+ hence "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b = deriv (monom P a n) b \<otimes> to_fun p b \<oplus>deriv (monom P a n) b \<otimes> to_fun q b
	+ \<oplus> to_fun (monom P a n) b \<otimes> deriv p b \<oplus> to_fun (monom P a n) b \<otimes> deriv q b"
	+ using A(1) A(2) R.add.m_assoc R.add.m_comm assms(1) assms(2) deriv_closed to_fun_closed by auto
	+ hence "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b = deriv (monom P a n) b \<otimes> (to_fun p b \<oplus> to_fun q b)
	+ \<oplus> to_fun (monom P a n) b \<otimes> (deriv p b \<oplus> deriv q b)"
	+ by (simp add: A(1) A(2) R.add.m_assoc R.r_distr assms(1) assms(2) deriv_closed to_fun_closed)
	+ thus "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b = deriv (monom P a n) b \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (p \<oplus>\<^bsub>P\<^esub> q) b"
	+ by (simp add: A(1) A(2) assms(2) deriv_add to_fun_plus)
	+ qed
	+ show "\<And>c m. c \<in> carrier R \<Longrightarrow> deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b =
	+ deriv (monom P a n) b \<otimes> to_fun (monom P c m) b
	+ \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b"
	+ proof- fix c m assume A: "c \<in> carrier R"
	+ show "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b"
	+ proof(cases "n = 0")
	+ case True
	+ have LHS: "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = deriv (monom P (a \<otimes> c) m) b"
	+ by (metis A True add.left_neutral assms(1) monom_mult)
	+ have RHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
	+ = a \<otimes> deriv (monom P c m) b "
	+ using deriv_const to_fun_monom A True assms(1) assms(2) deriv_closed by auto
	+ show ?thesis using A assms LHS RHS deriv_monom
	+ by (smt R.add.nat_pow_closed R.add_pow_rdistr R.m_assoc R.m_closed R.nat_pow_closed)
	+ next
	+ case False
	+ show ?thesis
	+ proof(cases "m = 0")
	+ case True
	+ have LHS: "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = deriv (monom P (a \<otimes> c) n) b"
	+ by (metis A True add.comm_neutral assms(1) monom_mult)
	+ have RHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
	+ = c \<otimes> deriv (monom P a n) b "
	+ by (metis (no_types, lifting) A lcf_monom(1) P_def R.m_closed R.m_comm R.r_null
	+ R.r_zero True UP_cring.to_fun_ctrm UP_cring_axioms assms(1) assms(2) deg_const
	+ deriv_closed deriv_const to_fun_closed monom_closed)
	+ show ?thesis using LHS RHS deriv_monom A assms
	+ by (smt R.add.nat_pow_closed R.add_pow_ldistr R.m_assoc R.m_closed R.m_comm R.nat_pow_closed)
	+ next
	+ case F: False
	+ have pos: "n > 0" "m >0"
	+ using F False by auto
	+ have RHS: "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = [(n + m)] \<cdot> (a \<otimes> c) \<otimes> b [^] (n + m - 1)"
	+ using deriv_monom[of "a \<otimes> c" b "n + m"] monom_mult[of a c n m]
	+ by (simp add: A assms(1) assms(2))
	+ have LHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
	+ = [n]\<cdot>a \<otimes>(b[^](n-1)) \<otimes> c \<otimes> b[^]m \<oplus> a \<otimes> b[^]n \<otimes> [m]\<cdot>c \<otimes>(b[^](m-1))"
	+ using deriv_monom[of a b n] to_fun_monom[of a b n]
	+ deriv_monom[of c b m] to_fun_monom[of c b m] A assms
	+ by (simp add: R.m_assoc)
	+ have 0: "[n]\<cdot>a \<otimes> (b[^](n-1)) \<otimes> c \<otimes> b[^]m = [n]\<cdot>a \<otimes> c \<otimes> b[^](n + m -1) "
	+ proof-
	+ have "[n]\<cdot>a \<otimes> (b[^](n-1)) \<otimes> c \<otimes> b[^]m = [n]\<cdot>a \<otimes> c \<otimes> (b[^](n-1)) \<otimes> b[^]m"
	+ by (simp add: A R.m_lcomm R.semiring_axioms assms(1) assms(2) semiring.semiring_simprules(8))
	+ hence "[n]\<cdot>a \<otimes> (b[^](n-1)) \<otimes> c \<otimes> b[^]m = [n]\<cdot>a \<otimes> c \<otimes> ((b[^](n-1)) \<otimes> b[^]m)"
	+ by (simp add: A R.m_assoc assms(1) assms(2))
	+ thus ?thesis
	+ by (simp add: False R.nat_pow_mult add_eq_if assms(2))
	+ qed
	+ have 1: "a \<otimes> b[^]n \<otimes> [m]\<cdot>c \<otimes>(b[^](m-1)) = a \<otimes> [m]\<cdot>c \<otimes> b[^](n + m -1)"
	+ proof-
	+ have "a \<otimes> b[^]n \<otimes> [m]\<cdot>c \<otimes>(b[^](m-1)) = a \<otimes> [m]\<cdot>c \<otimes> b[^]n \<otimes>(b[^](m-1))"
	+ using A R.m_comm R.m_lcomm assms(1) assms(2) by auto
	+ hence "a \<otimes> b[^]n \<otimes> [m]\<cdot>c \<otimes>(b[^](m-1)) = a \<otimes> [m]\<cdot>c \<otimes> (b[^]n \<otimes>(b[^](m-1)))"
	+ by (simp add: A R.m_assoc assms(1) assms(2))
	+ thus ?thesis
	+ by (simp add: F R.nat_pow_mult add.commute add_eq_if assms(2))
	+ qed
	+ have LHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
	+ = [n]\<cdot>a \<otimes> c \<otimes> b[^](n + m -1) \<oplus> a \<otimes> [m]\<cdot>c \<otimes> b[^](n + m -1)"
	+ using LHS 0 1
	+ by simp
	+ hence LHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
	+ = [n]\<cdot> (a \<otimes> c \<otimes> b[^](n + m -1)) \<oplus> [m]\<cdot> (a \<otimes> c \<otimes> b[^](n + m -1))"
	+ by (simp add: A R.add_pow_ldistr R.add_pow_rdistr assms(1) assms(2))
	+ show ?thesis using LHS RHS
	+ by (simp add: A R.add.nat_pow_mult R.add_pow_ldistr assms(1) assms(2))
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma deriv_prod_rule:
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "deriv (p \<otimes>\<^bsub>P\<^esub> q) a = deriv p a \<otimes> (to_fun q a) \<oplus> (to_fun p a) \<otimes> deriv q a"
	+proof(rule poly_induct3[of p])
	+ show "p \<in> carrier P"
	+ using assms(1) by simp
	+ show " \<And>p qa.
	+ qa \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ deriv (p \<otimes>\<^bsub>P\<^esub> q) a = deriv p a \<otimes> to_fun q a \<oplus> to_fun p a \<otimes> deriv q a \<Longrightarrow>
	+ deriv (qa \<otimes>\<^bsub>P\<^esub> q) a = deriv qa a \<otimes> to_fun q a \<oplus> to_fun qa a \<otimes> deriv q a \<Longrightarrow>
	+ deriv ((p \<oplus>\<^bsub>P\<^esub> qa) \<otimes>\<^bsub>P\<^esub> q) a = deriv (p \<oplus>\<^bsub>P\<^esub> qa) a \<otimes> to_fun q a \<oplus> to_fun (p \<oplus>\<^bsub>P\<^esub> qa) a \<otimes> deriv q a"
	+ proof- fix f g assume A: "f \<in> carrier P" "g \<in> carrier P"
	+ "deriv (f \<otimes>\<^bsub>P\<^esub> q) a = deriv f a \<otimes> to_fun q a \<oplus> to_fun f a \<otimes> deriv q a"
	+ "deriv (g \<otimes>\<^bsub>P\<^esub> q) a = deriv g a \<otimes> to_fun q a \<oplus> to_fun g a \<otimes> deriv q a"
	+ have "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = deriv f a \<otimes> to_fun q a \<oplus> to_fun f a \<otimes> deriv q a \<oplus>
	+ deriv g a \<otimes> to_fun q a \<oplus> to_fun g a \<otimes> deriv q a"
	+ using A deriv_add
	+ by (simp add: P.l_distr R.add.m_assoc assms(2) assms(3) deriv_closed to_fun_closed)
	+ hence "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = deriv f a \<otimes> to_fun q a \<oplus> deriv g a \<otimes> to_fun q a \<oplus>
	+ to_fun f a \<otimes> deriv q a \<oplus> to_fun g a \<otimes> deriv q a"
	+ using R.a_comm R.a_assoc deriv_closed to_fun_closed assms
	+ by (simp add: A(1) A(2))
	+ hence "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = (deriv f a \<otimes> to_fun q a \<oplus> deriv g a \<otimes> to_fun q a) \<oplus>
	+ (to_fun f a \<otimes> deriv q a \<oplus> to_fun g a \<otimes> deriv q a)"
	+ by (simp add: A(1) A(2) R.add.m_assoc assms(2) assms(3) deriv_closed to_fun_closed)
	+ thus "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = deriv (f \<oplus>\<^bsub>P\<^esub> g) a \<otimes> to_fun q a \<oplus> to_fun (f \<oplus>\<^bsub>P\<^esub> g) a \<otimes> deriv q a"
	+ by (simp add: A(1) A(2) R.l_distr assms(2) assms(3) deriv_add deriv_closed to_fun_closed to_fun_plus)
	+ qed
	+ show "\<And>aa n. aa \<in> carrier R \<Longrightarrow> deriv (monom P aa n \<otimes>\<^bsub>P\<^esub> q) a = deriv (monom P aa n) a \<otimes> to_fun q a \<oplus> to_fun (monom P aa n) a \<otimes> deriv q a"
	+ using deriv_prod_rule_times_monom
	+ by (simp add: assms(2) assms(3))
	+qed
	+
	+lemma pderiv_eval_deriv_monom:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "to_fun (pderiv (monom P a n)) b = deriv (monom P a n) b"
	+ using deriv_monom assms pderiv_monom
	+ by (simp add: P_def UP_cring.to_fun_monom UP_cring_axioms)
	+
	+lemma pderiv_eval_deriv:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "deriv f a = to_fun (pderiv f) a"
	+ apply(rule poly_induct3[of f])
	+ apply (simp add: assms(1))
	+ using assms(2) deriv_add to_fun_plus pderiv_add pderiv_closed apply presburger
	+ using assms(2) pderiv_eval_deriv_monom
	+ by presburger
	+
	+text\<open>Taking taylor expansions commutes with taking derivatives:\<close>
	+
	+lemma(in UP_cring) taylor_expansion_pderiv_comm:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "c \<in> carrier R"
	+ shows "pderiv (taylor_expansion R c f) = taylor_expansion R c (pderiv f)"
	+ apply(rule poly_induct3[of f])
	+ using assms unfolding P_def apply blast
	+proof-
	+ fix p q assume A: " q \<in> carrier (UP R)" "p \<in> carrier (UP R)"
	+ "pderiv (taylor_expansion R c p) = taylor_expansion R c (pderiv p)"
	+ "pderiv (taylor_expansion R c q) = taylor_expansion R c (pderiv q)"
	+ have 0: " pderiv (taylor_expansion R c (p \<oplus>\<^bsub>UP R\<^esub> q)) = pderiv (taylor_expansion R c p \<oplus>\<^bsub>UP R\<^esub> taylor_expansion R c q)"
	+ using A P_def taylor_expansion_add assms(2) by presburger
	+ show "pderiv (taylor_expansion R c (p \<oplus>\<^bsub>UP R\<^esub> q)) = taylor_expansion R c (pderiv (p \<oplus>\<^bsub>UP R\<^esub> q))"
	+ unfolding 0
	+ using A(1) A(2) A(3) A(4) taylor_def UP_cring.taylor_closed UP_cring.taylor_expansion_add UP_cring.pderiv_add UP_cring.pderiv_closed UP_cring_axioms assms(2) by fastforce
	+next
	+ fix a n assume A: "a \<in> carrier R"
	+ show "pderiv (taylor_expansion R c (up_ring.monom (UP R) a n)) = taylor_expansion R c (pderiv (up_ring.monom (UP R) a n))"
	+ proof(cases "n = 0")
	+ case True
	+ have 0: "deg R (taylor_expansion R c (up_ring.monom (UP R) a n)) = 0"
	+ unfolding True
	+ using P_def A assms taylor_def taylor_deg deg_const is_UP_monomE(1) monom_is_UP_monom(2) by presburger
	+ have 1: "(pderiv (up_ring.monom (UP R) a n)) = \<zero>\<^bsub>P\<^esub>"
	+ unfolding True using P_def A assms pderiv_const by blast
	+ show ?thesis unfolding 1 using 0 A assms P_def
	+ by (metis P.add.right_cancel taylor_closed taylor_def taylor_expansion_add UP_l_zero UP_zero_closed monom_closed pderiv_deg_0)
	+ next
	+ case False
	+ have 0: "pderiv (up_ring.monom (UP R) a n) = (up_ring.monom (UP R) ([n]\<cdot>a) (n-1))"
	+ using A
	+ by (simp add: UP_cring.pderiv_monom UP_cring_axioms)
	+ have 1: "pderiv (taylor_expansion R c (up_ring.monom (UP R) a n)) = (Cring_Poly.compose R (up_ring.monom (UP R) ([n]\<cdot>a) (n-1)) (X_plus c)) \<otimes>\<^bsub>P\<^esub> pderiv (X_plus c)"
	+ using chain_rule[of "up_ring.monom (UP R) a n" "X_plus c"] unfolding 0 taylor_expansion_def
	+ using A P_def X_plus_closed assms(2) is_UP_monom_def monom_is_UP_monom(1) by presburger
	+ have 2: "pderiv (X_plus c) = \<one>\<^bsub>P\<^esub>"
	+ using pderiv_add[of "X_poly R" "to_poly c"] P.l_null P.l_one P.r_zero P_def R.one_closed X_closed
	+ X_poly_def X_poly_plus_def assms(2) monom_one pderiv_const to_poly_closed to_polynomial_def
	+ by (metis times_x_product_rule)
	+ show ?thesis unfolding 1 0 2 taylor_expansion_def
	+ by (metis "1" "2" A P.l_one P_def R.add.nat_pow_closed UP_m_comm UP_one_closed X_plus_closed assms(2) monom_closed sub_closed taylor_expansion_def)
	+ qed
	+qed
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Linear Substitutions\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+lemma(in UP_ring) lcoeff_Lcf:
	+ assumes "f \<in> carrier P"
	+ shows "lcoeff f = lcf f"
	+ unfolding P_def
	+ using assms coeff_simp[of f] by metis
	+
	+lemma(in UP_cring) linear_sub_cfs:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "d \<in> carrier R"
	+ assumes "g = compose R f (up_ring.monom (UP R) d 1)"
	+ shows "g i = d[^]i \<otimes> f i"
	+proof-
	+ have 0: "(up_ring.monom (UP R) d 1) \<in> carrier (UP R)"
	+ using assms by (meson R.ring_axioms UP_ring.intro UP_ring.monom_closed)
	+ have 1: "(\<forall>i. compose R f (up_ring.monom (UP R) d 1) i = d[^]i \<otimes> f i)"
	+ apply(rule poly_induct3[of f])
	+ using assms unfolding P_def apply blast
	+ proof-
	+ show "\<And>p q. q \<in> carrier (UP R) \<Longrightarrow>
	+ p \<in> carrier (UP R) \<Longrightarrow>
	+ \<forall>i. Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> p i \<Longrightarrow>
	+ \<forall>i. Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> q i \<Longrightarrow>
	+ \<forall>i. Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> (p \<oplus>\<^bsub>UP R\<^esub> q) i"
	+ proof
	+ fix p q i
	+ assume A: "q \<in> carrier (UP R)"
	+ "p \<in> carrier (UP R)"
	+ "\<forall>i. Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> p i"
	+ "\<forall>i. Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> q i"
	+ show "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> (p \<oplus>\<^bsub>UP R\<^esub> q) i"
	+ proof-
	+ have 1: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) =
	+ Cring_Poly.compose R p (up_ring.monom (UP R) d 1) \<oplus>\<^bsub>UP R\<^esub> Cring_Poly.compose R q (up_ring.monom (UP R) d 1)"
	+ using A(1) A(2) sub_add[of "up_ring.monom (UP R) d 1" q p] unfolding P_def
	+ using "0" P_def sub_add by blast
	+ have 2: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i =
	+ Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i \<oplus> Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i"
	+ using 1 by (metis (no_types, lifting) "0" A(1) A(2) P_def cfs_add sub_closed)
	+ have 3: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> p i \<oplus> d [^] i \<otimes> q i"
	+ unfolding 2 using A by presburger
	+ have 4: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> (p i \<oplus> q i)"
	+ using "3" A(1) A(2) R.nat_pow_closed R.r_distr UP_car_memE(1) assms(2) by presburger
	+ thus "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> (p \<oplus>\<^bsub>UP R\<^esub> q) i"
	+ unfolding 4 using A(1) A(2) P_def cfs_add by presburger
	+ qed
	+ qed
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow>
	+ \<forall>i. Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> up_ring.monom (UP R) a n i"
	+ proof fix a n i assume A: "a \<in> carrier R"
	+ have 0: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) =
	+ a \<odot>\<^bsub>UP R\<^esub>(up_ring.monom (UP R) d 1)[^]\<^bsub>UP R\<^esub>n"
	+ using assms A 0 P_def monom_sub by blast
	+ have 1: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) =
	+ a \<odot>\<^bsub>UP R\<^esub> (d[^]n \<odot>\<^bsub>UP R\<^esub>(up_ring.monom (UP R) \<one> n))"
	+ unfolding 0 using A assms
	+ by (metis P_def R.nat_pow_closed monic_monom_smult monom_pow mult.left_neutral)
	+ have 2: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) =
	+ (a \<otimes>d[^]n)\<odot>\<^bsub>UP R\<^esub>(up_ring.monom (UP R) \<one> n)"
	+ unfolding 1 using A assms
	+ by (metis R.nat_pow_closed R.one_closed R.ring_axioms UP_ring.UP_smult_assoc1 UP_ring.intro UP_ring.monom_closed)
	+ show "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> up_ring.monom (UP R) a n i"
	+ apply(cases "i = n")
	+ unfolding 2 using A P_def R.m_closed R.m_comm R.nat_pow_closed assms(2) cfs_monom monic_monom_smult apply presburger
	+ using A P_def R.m_closed R.nat_pow_closed R.r_null assms(2) cfs_monom monic_monom_smult by presburger
	+ qed
	+ qed
	+ show ?thesis using 1 unfolding assms
	+ by blast
	+qed
	+
	+lemma(in UP_cring) linear_sub_deriv:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "d \<in> carrier R"
	+ assumes "g = compose R f (up_ring.monom (UP R) d 1)"
	+ assumes "c \<in> carrier R"
	+ shows "pderiv g = d \<odot>\<^bsub>UP R\<^esub> compose R (pderiv f) (up_ring.monom (UP R) d 1)"
	+ unfolding assms
	+proof(rule poly_induct3[of f])
	+ show "f \<in> carrier P"
	+ using assms unfolding P_def by blast
	+ show "\<And> p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ pderiv (Cring_Poly.compose R p (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv p) (up_ring.monom (UP R) d 1) \<Longrightarrow>
	+ pderiv (Cring_Poly.compose R q (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv q) (up_ring.monom (UP R) d 1) \<Longrightarrow>
	+ pderiv (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> q) (up_ring.monom (UP R) d 1)) =
	+ d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (p \<oplus>\<^bsub>P\<^esub> q)) (up_ring.monom (UP R) d 1)"
	+ proof- fix p q assume A: "q \<in> carrier P" "p \<in> carrier P"
	+ "pderiv (Cring_Poly.compose R p (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv p) (up_ring.monom (UP R) d 1)"
	+ "pderiv (Cring_Poly.compose R q (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv q) (up_ring.monom (UP R) d 1)"
	+ show " pderiv (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> q) (up_ring.monom (UP R) d 1)) =
	+ d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (p \<oplus>\<^bsub>P\<^esub> q)) (up_ring.monom (UP R) d 1)"
	+ using A assms
	+ by (smt P_def UP_a_closed UP_r_distr monom_closed monom_mult_is_smult pderiv_add pderiv_closed rev_sub_add sub_closed sub_rev_sub)
	+ qed
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow>
	+ pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) =
	+ d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)"
	+ proof- fix a n assume A: "a \<in> carrier R"
	+ have "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = a \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P d 1)[^]\<^bsub>UP R\<^esub> n"
	+ using A assms sub_monom(2) P_def is_UP_monomE(1) monom_is_UP_monom(1) by blast
	+ hence 0: "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = a \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P (d[^]n) n)"
	+ using A assms P_def monom_pow nat_mult_1 by metis
	+ show "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) =
	+ d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)"
	+ proof(cases "n = 0")
	+ case True
	+ have T0: "pderiv (up_ring.monom P a n) = \<zero>\<^bsub> UP R\<^esub>" unfolding True
	+ using A P_def pderiv_const by blast
	+ have T1: "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = up_ring.monom P a n"
	+ unfolding True
	+ using A assms P_def deg_const is_UP_monomE(1) monom_is_UP_monom(1) sub_const by presburger
	+ thus ?thesis unfolding T0 T1
	+ by (metis P.nat_pow_eone P_def UP_smult_closed UP_zero_closed X_closed assms(2) deg_zero monom_rep_X_pow smult_r_null sub_const)
	+ next
	+ case False
	+ have F0: "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = (a \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P ([n]\<cdot>\<^bsub>R\<^esub>(d[^]n))(n-1)))"
	+ using A assms pderiv_monom unfolding 0
	+ using P_def R.nat_pow_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_smult by metis
	+ have F1: "(pderiv (up_ring.monom P a n)) = up_ring.monom P ([n] \<cdot> a) (n - 1)"
	+ using A assms pderiv_monom[of a n] by blast
	+ hence F2: "(pderiv (up_ring.monom P a n)) = ([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub>up_ring.monom P \<one> (n - 1)"
	+ using A P_def monic_monom_smult by auto
	+ have F3: "Cring_Poly.compose R ((([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P \<one> (n - 1)))) (up_ring.monom (UP R) d 1) =
	+ ([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> ((up_ring.monom (UP R) d 1)[^]\<^bsub>UP R\<^esub>(n-1))"
	+ using A F1 F2 P_def assms(2) monom_closed sub_monom(2) by fastforce
	+ have F4: "Cring_Poly.compose R ((([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P \<one> (n - 1)))) (up_ring.monom (UP R) d 1) =
	+ ([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> ((up_ring.monom (UP R) (d[^](n-1)) (n-1)))"
	+ by (metis F3 P_def assms(2) monom_pow nat_mult_1)
	+ have F5: "d \<odot>\<^bsub>UP R\<^esub> (Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)) =
	+ (d \<otimes>([n] \<cdot> a)) \<odot>\<^bsub>UP R\<^esub> up_ring.monom (UP R) (d [^] (n - 1)) (n - 1)"
	+ unfolding F4 F2
	+ using A P_def assms(2) monom_closed smult_assoc1 by auto
	+ have F6: "d \<odot>\<^bsub>UP R\<^esub> (Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)) =
	+ (d \<otimes> d[^](n-1) \<otimes>[n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> ((up_ring.monom (UP R) \<one> (n-1)))"
	+ unfolding F5 using False A assms P_def R.m_assoc R.m_closed R.m_comm R.nat_pow_closed monic_monom_smult monom_mult_smult
	+ by (smt R.add.nat_pow_closed)
	+ have F7: "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = (a \<otimes> ([n]\<cdot>\<^bsub>R\<^esub>(d[^]n)) \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P \<one> (n-1)))"
	+ unfolding F0 using A assms P_def R.m_closed R.nat_pow_closed monic_monom_smult monom_mult_smult
	+ by simp
	+ have F8: "a \<otimes> [n] \<cdot> (d [^] n) = d \<otimes> d [^] (n - 1) \<otimes> [n] \<cdot> a"
	+ proof-
	+ have F80: "d \<otimes> d [^] (n - 1) \<otimes> [n] \<cdot> a = d [^] n \<otimes> [n] \<cdot> a"
	+ using A assms False by (metis R.nat_pow_Suc2 add.right_neutral add_eq_if)
	+ show ?thesis unfolding F80
	+ using A R.add_pow_rdistr R.m_comm R.nat_pow_closed assms(2) by presburger
	+ qed
	+ show ?thesis unfolding F6 F7 unfolding F8 P_def by blast
	+ qed
	+ qed
	+qed
	+
	+lemma(in UP_cring) linear_sub_deriv':
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "d \<in> carrier R"
	+ assumes "g = compose R f (up_ring.monom (UP R) d 1)"
	+ assumes "c \<in> carrier R"
	+ shows "pderiv g = compose R (d \<odot>\<^bsub>UP R\<^esub> pderiv f) (up_ring.monom (UP R) d 1)"
	+ using assms linear_sub_deriv[of f d g c] P_def is_UP_monomE(1) is_UP_monomI pderiv_closed sub_smult by metis
	+
	+lemma(in UP_cring) linear_sub_inv:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "d \<in> Units R"
	+ assumes "g = compose R f (up_ring.monom (UP R) d 1)"
	+ shows "compose R g (up_ring.monom (UP R) (inv d) 1) = f"
	+ unfolding assms
	+proof fix x
	+ have 0: "Cring_Poly.compose R (Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) (up_ring.monom (UP R) (inv d) 1) x =
	+ (inv d)[^]x \<otimes> ((Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) x)"
	+ apply(rule linear_sub_cfs)
	+ using P_def R.Units_closed assms(1) assms(2) monom_closed sub_closed apply auto[1]
	+ apply (simp add: assms(2))
	+ by blast
	+ show "Cring_Poly.compose R (Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) (up_ring.monom (UP R) (inv d) 1) x = f x "
	+ unfolding 0 using linear_sub_cfs[of f d "Cring_Poly.compose R f (up_ring.monom (UP R) d 1)" x]
	+ assms
	+ by (smt R.Units_closed R.Units_inv_closed R.Units_l_inv R.m_assoc R.m_comm R.nat_pow_closed R.nat_pow_distrib R.nat_pow_one R.r_one UP_car_memE(1))
	+qed
	+
	+lemma(in UP_cring) linear_sub_deg:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "d \<in> Units R"
	+ assumes "g = compose R f (up_ring.monom (UP R) d 1)"
	+ shows "deg R g = deg R f"
	+proof(cases "deg R f = 0")
	+ case True
	+ show ?thesis using assms
	+ unfolding True assms using P_def True monom_closed
	+ by (simp add: R.Units_closed sub_const)
	+next
	+ case False
	+ have 0: "monom (UP R) d 1 (deg R (monom (UP R) d 1)) = d"
	+ using assms lcf_monom(2) by blast
	+ have 1: "d[^](deg R f) \<in> Units R"
	+ using assms(2)
	+ by (metis Group.comm_monoid.axioms(1) R.units_comm_group R.units_of_pow comm_group_def monoid.nat_pow_closed units_of_carrier)
	+ have 2: "f (deg R f) \<noteq> \<zero>"
	+ using assms False P_def UP_cring.ltrm_rep_X_pow UP_cring_axioms deg_ltrm degree_monom by fastforce
	+ have "deg R g = deg R f * deg R (up_ring.monom (UP R) d 1)"
	+ unfolding assms
	+ apply(rule cring_sub_deg[of "up_ring.monom (UP R) d 1" f] )
	+ using assms P_def monom_closed apply blast
	+ unfolding P_def apply(rule assms)
	+ unfolding 0 using 2 1
	+ by (metis R.Units_closed R.Units_l_cancel R.m_comm R.r_null R.zero_closed UP_car_memE(1) assms(1))
	+ thus ?thesis using assms unfolding assms
	+ by (metis (no_types, lifting) P_def R.Units_closed deg_monom deg_zero is_UP_monomE(1) linear_sub_inv monom_is_UP_monom(2) monom_zero mult.right_neutral mult_0_right sub_closed sub_const)
	+qed
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Lemmas About Polynomial Division\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+context UP_cring
	+begin
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Division by Linear Terms\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+definition UP_root_div where
	+"UP_root_div f a = (poly_shift (T\<^bsub>a\<^esub> f)) of (X_minus a)"
	+
	+definition UP_root_rem where
	+"UP_root_rem f a = ctrm (T\<^bsub>a\<^esub> f)"
	+
	+lemma UP_root_div_closed:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "UP_root_div f a \<in> carrier P"
	+ using assms
	+ unfolding UP_root_div_def
	+ by (simp add: taylor_closed X_minus_closed poly_shift_closed sub_closed)
	+
	+lemma rem_closed:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "UP_root_rem f a \<in> carrier P"
	+ using assms
	+ unfolding UP_root_rem_def
	+ by (simp add: taylor_closed ctrm_is_poly)
	+
	+lemma rem_deg:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "degree (UP_root_rem f a) = 0"
	+ by (simp add: taylor_closed assms(1) assms(2) ctrm_degree UP_root_rem_def)
	+
	+lemma remainder_theorem:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "g = UP_root_div f a"
	+ assumes "r = UP_root_rem f a"
	+ shows "f = r \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> g"
	+proof-
	+ have "T\<^bsub>a\<^esub>f = (ctrm (T\<^bsub>a\<^esub>f)) \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub> poly_shift (T\<^bsub>a\<^esub>f)"
	+ using poly_shift_eq[of "T\<^bsub>a\<^esub>f"] assms taylor_closed
	+ by blast
	+ hence 1: "T\<^bsub>a\<^esub>f of (X_minus a) = (ctrm (T\<^bsub>a\<^esub>f)) \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> (poly_shift (T\<^bsub>a\<^esub>f) of (X_minus a))"
	+ using assms taylor_closed[of f a] X_minus_closed[of a] X_closed
	+ sub_add[of "X_minus a" "ctrm (T\<^bsub>a\<^esub>f)" "X \<otimes>\<^bsub>P\<^esub> poly_shift (T\<^bsub>a\<^esub>f)"]
	+ sub_const[of "X_minus a"] sub_mult[of "X_minus a" X "poly_shift (T\<^bsub>a\<^esub>f)"]
	+ ctrm_degree ctrm_is_poly P.m_closed poly_shift_closed sub_X
	+ by presburger
	+ have 2: "f = (ctrm (T\<^bsub>a\<^esub>f)) \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> (poly_shift (T\<^bsub>a\<^esub>f) of (X_minus a))"
	+ using 1 taylor_id[of a f] assms
	+ by simp
	+ then show ?thesis
	+ using assms
	+ unfolding UP_root_div_def UP_root_rem_def
	+ by auto
	+qed
	+
	+lemma remainder_theorem':
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "f = UP_root_rem f a \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> UP_root_div f a"
	+ using assms remainder_theorem by auto
	+
	+lemma factor_theorem:
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "g = UP_root_div f a"
	+ assumes "to_fun f a = \<zero>"
	+ shows "f = (X_minus a) \<otimes>\<^bsub>P\<^esub> g"
	+ using remainder_theorem[of f a g _] assms
	+ unfolding UP_root_rem_def
	+ by (simp add: ctrm_zcf taylor_zcf taylor_closed UP_root_div_closed X_minus_closed)
	+
	+lemma factor_theorem':
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "to_fun f a = \<zero>"
	+ shows "f = (X_minus a) \<otimes>\<^bsub>P\<^esub> UP_root_div f a"
	+ by (simp add: assms(1) assms(2) assms(3) factor_theorem)
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Geometric Sums\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+lemma geom_quot:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "p = monom P \<one> (Suc n) \<ominus>\<^bsub>P\<^esub> monom P (b[^](Suc n)) 0 "
	+ assumes "g = UP_root_div p b"
	+ shows "a[^](Suc n) \<ominus> b[^] (Suc n) = (a \<ominus> b) \<otimes> (to_fun g a)"
	+proof-
	+ have root: "to_fun p b = \<zero>"
	+ using assms to_fun_const[of "b[^](Suc n)" b] to_fun_monic_monom[of b "Suc n"] R.nat_pow_closed[of b "Suc n"]
	+ to_fun_diff[of "monom P \<one> (Suc n)" "monom P (b[^](Suc n)) 0" b] monom_closed
	+ by (metis P.minus_closed P_def R.one_closed R.zero_closed UP_cring.f_minus_ctrm
	+ UP_cring.to_fun_diff UP_cring_axioms zcf_to_fun cfs_monom to_fun_const)
	+ have LHS: "to_fun p a = a[^](Suc n) \<ominus> b[^] (Suc n)"
	+ using assms to_fun_const to_fun_monic_monom to_fun_diff
	+ by auto
	+ have RHS: "to_fun ((X_minus b) \<otimes>\<^bsub>P\<^esub> g) a = (a \<ominus> b) \<otimes> (to_fun g a)"
	+ using to_fun_mult[of g "X_minus b"] assms X_minus_closed
	+ by (metis P.minus_closed P_def R.nat_pow_closed R.one_closed UP_cring.UP_root_div_closed UP_cring_axioms to_fun_X_minus monom_closed)
	+ show ?thesis
	+ using RHS LHS root factor_theorem' assms(2) assms(3) assms(4)
	+ by auto
	+qed
	+
	+end
	+
	+context UP_cring
	+begin
	+
	+definition geometric_series where
	+"geometric_series n a b = to_fun (UP_root_div (monom P \<one> (Suc n) \<ominus>\<^bsub>UP R\<^esub> (monom P (b[^](Suc n)) 0)) b) a"
	+
	+lemma geometric_series_id:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "a[^](Suc n) \<ominus>b[^] (Suc n) = (a \<ominus> b) \<otimes> (geometric_series n a b)"
	+ using assms geom_quot
	+ by (simp add: P_def geometric_series_def)
	+
	+lemma geometric_series_closed:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "(geometric_series n a b) \<in> carrier R"
	+ unfolding geometric_series_def
	+ using assms P.minus_closed P_def UP_root_div_closed to_fun_closed monom_closed
	+ by auto
	+
	+text\<open>Shows that $a^n - b^n$ has $a - b$ as a factor:\<close>
	+lemma to_fun_monic_monom_diff:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "\<exists>c. c \<in> carrier R \<and> to_fun (monom P \<one> n) a \<ominus> to_fun (monom P \<one> n) b = (a \<ominus> b) \<otimes> c"
	+proof(cases "n = 0")
	+ case True
	+ have "to_fun (monom P \<one> 0) a \<ominus> to_fun (monom P \<one> 0) b = (a \<ominus> b) \<otimes> \<zero>"
	+ unfolding a_minus_def using to_fun_const[of \<one>] assms
	+ by (simp add: R.r_neg)
	+ then show ?thesis
	+ using True by blast
	+next
	+ case False
	+ then show ?thesis
	+ using Suc_diff_1[of n] geometric_series_id[of a b "n-1"] geometric_series_closed[of a b "n-1"]
	+ assms(1) assms(2) to_fun_monic_monom
	+ by auto
	+qed
	+
	+lemma to_fun_diff_factor:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "f \<in> carrier P"
	+ shows "\<exists>c. c \<in> carrier R \<and>(to_fun f a) \<ominus> (to_fun f b) = (a \<ominus> b)\<otimes>c"
	+proof(rule poly_induct5[of f])
	+ show "f \<in> carrier P" using assms by simp
	+ show "\<And>p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ \<exists>c. c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c \<Longrightarrow>
	+ \<exists>c. c \<in> carrier R \<and> to_fun q a \<ominus> to_fun q b = (a \<ominus> b) \<otimes> c \<Longrightarrow>
	+ \<exists>c. c \<in> carrier R \<and> to_fun (p \<oplus>\<^bsub>P\<^esub> q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = (a \<ominus> b) \<otimes> c"
	+ proof- fix p q assume A: "q \<in> carrier P" "p \<in> carrier P"
	+ "\<exists>c. c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c"
	+ "\<exists>c. c \<in> carrier R \<and> to_fun q a \<ominus> to_fun q b = (a \<ominus> b) \<otimes> c"
	+ obtain c where c_def: "c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c"
	+ using A by blast
	+ obtain c' where c'_def: "c' \<in> carrier R \<and> to_fun q a \<ominus> to_fun q b = (a \<ominus> b) \<otimes> c'"
	+ using A by blast
	+ have 0: "(a \<ominus> b) \<otimes> c \<oplus> (a \<ominus> b) \<otimes> c' = (a \<ominus> b)\<otimes>(c \<oplus> c')"
	+ using assms c_def c'_def unfolding a_minus_def
	+ by (simp add: R.r_distr R.r_minus)
	+ have 1: "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = to_fun p a \<oplus> to_fun q a \<ominus> to_fun p b \<ominus> to_fun q b"
	+ using A to_fun_plus[of p q a] to_fun_plus[of p q b] assms to_fun_closed
	+ R.ring_simprules(19)[of "to_fun p b" "to_fun q b"]
	+ by (simp add: R.add.m_assoc R.minus_eq to_fun_plus)
	+ hence "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = to_fun p a \<ominus> to_fun p b \<oplus> to_fun q a \<ominus> to_fun q b"
	+ using 0 A assms R.ring_simprules to_fun_closed a_assoc a_comm
	+ unfolding a_minus_def
	+ by smt
	+ hence "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = to_fun p a \<ominus> to_fun p b \<oplus> (to_fun q a \<ominus> to_fun q b)"
	+ using 0 A assms R.ring_simprules to_fun_closed
	+ unfolding a_minus_def
	+ by metis
	+ hence "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = (a \<ominus> b)\<otimes>(c \<oplus> c')"
	+ using 0 A c_def c'_def
	+ by simp
	+ thus "\<exists>c. c \<in> carrier R \<and> to_fun (p \<oplus>\<^bsub>P\<^esub> q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = (a \<ominus> b) \<otimes> c"
	+ using R.add.m_closed c'_def c_def by blast
	+ qed
	+ show "\<And>n. \<exists>c. c \<in> carrier R \<and> to_fun (monom P \<one> n) a \<ominus> to_fun (monom P \<one> n) b = (a \<ominus> b) \<otimes> c"
	+ by (simp add: assms(1) assms(2) to_fun_monic_monom_diff)
	+ show "\<And>p aa.
	+ aa \<in> carrier R \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow> \<exists>c. c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c \<Longrightarrow> \<exists>c. c \<in> carrier R \<and> to_fun (aa \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (aa \<odot>\<^bsub>P\<^esub> p) b = (a \<ominus> b) \<otimes> c"
	+ proof- fix p c assume A: "c \<in> carrier R" " p \<in> carrier P"
	+ "\<exists>e. e \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> e"
	+ then obtain d where d_def: "d \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> d"
	+ by blast
	+ have "to_fun (c \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (c \<odot>\<^bsub>P\<^esub> p) b = c \<otimes> (to_fun p a \<ominus> to_fun p b)"
	+ using A d_def assms to_fun_smult[of p a c] to_fun_smult[of p b c]
	+ to_fun_closed[of p a] to_fun_closed[of p b] R.ring_simprules
	+ by smt
	+ hence "c\<otimes>d \<in> carrier R \<and> to_fun (c \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (c \<odot>\<^bsub>P\<^esub> p) b = (a \<ominus> b) \<otimes> (c \<otimes>d)"
	+ by (simp add: A(1) R.m_lcomm assms(1) assms(2) d_def)
	+ thus "\<exists>e. e \<in> carrier R \<and> to_fun (c \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (c \<odot>\<^bsub>P\<^esub> p) b = (a \<ominus> b) \<otimes> e"
	+ by blast
	+ qed
	+qed
	+
	+text\<open>Any finite set over a domain is the zero set of a polynomial:\<close>
	+lemma(in UP_domain) fin_set_poly_roots:
	+ assumes "F \<subseteq> carrier R"
	+ assumes "finite F"
	+ shows "\<exists> P \<in> carrier (UP R). \<forall> x \<in> carrier R. to_fun P x = \<zero> \<longleftrightarrow> x \<in> F"
	+ apply(rule finite.induct)
	+ apply (simp add: assms(2))
	+proof-
	+ show "\<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> {})"
	+ proof-
	+ have "\<forall>x\<in>carrier R. (to_fun (\<one>\<^bsub>UP R\<^esub>) x = \<zero>) = (x \<in> {})"
	+ proof
	+ fix x
	+ assume A: "x \<in> carrier R"
	+ then have "(to_fun (\<one>\<^bsub>UP R\<^esub>)) x = \<one>"
	+ by (metis P_def R.one_closed UP_cring.to_fun_to_poly UP_cring_axioms ring_hom_one to_poly_is_ring_hom)
	+ then show "(to_fun \<one>\<^bsub>UP R\<^esub> x = \<zero>) = (x \<in> {})"
	+ by simp
	+ qed
	+ then show ?thesis
	+ using P_def UP_one_closed
	+ by blast
	+ qed
	+ show "\<And>A a. finite A \<Longrightarrow>
	+ \<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> A) \<Longrightarrow> \<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> insert a A)"
	+ proof-
	+ fix A :: "'a set" fix a
	+ assume fin_A: "finite A"
	+ assume IH: "\<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> A)"
	+ then obtain p where p_def: "p \<in>carrier (UP R) \<and> (\<forall>x\<in>carrier R. (to_fun p x = \<zero>) = (x \<in> A))"
	+ by blast
	+ show "\<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> insert a A)"
	+ proof(cases "a \<in> carrier R")
	+ case True
	+ obtain Q where Q_def: "Q = p \<otimes>\<^bsub>UP R\<^esub> (X \<ominus>\<^bsub>UP R\<^esub> to_poly a)"
	+ by blast
	+ have "\<forall>x\<in>carrier R. (to_fun Q x = \<zero>) = (x \<in> insert a A)"
	+ proof fix x
	+ assume P: "x \<in> carrier R"
	+ have P0: "to_fun (X \<ominus>\<^bsub>UP R\<^esub> to_poly a) x = x \<ominus> a"
	+ using to_fun_plus[of X "\<ominus>\<^bsub>UP R\<^esub> to_poly a" x] True P
	+ unfolding a_minus_def
	+ by (metis X_poly_minus_def a_minus_def to_fun_X_minus)
	+ then have "to_fun Q x = (to_fun p x) \<otimes> (x \<ominus> a)"
	+ proof-
	+ have 0: " p \<in> carrier P"
	+ by (simp add: P_def p_def)
	+ have 1: " X \<ominus>\<^bsub>UP R\<^esub> to_poly a \<in> carrier P"
	+ using P.minus_closed P_def True X_closed to_poly_closed by auto
	+ have 2: "x \<in> carrier R"
	+ by (simp add: P)
	+ then show ?thesis
	+ using to_fun_mult[of p "(X \<ominus>\<^bsub>UP R\<^esub> to_poly a)" x] P0 0 1 2 Q_def True P_def to_fun_mult
	+ by auto
	+ qed
	+ then show "(to_fun Q x = \<zero>) = (x \<in> insert a A)"
	+ using p_def
	+ by (metis P R.add.inv_closed R.integral_iff R.l_neg R.minus_closed R.minus_unique True UP_cring.to_fun_closed UP_cring_axioms a_minus_def insert_iff)
	+ qed
	+ then have "Q \<in> carrier (UP R) \<and> (\<forall>x\<in>carrier R. (to_fun Q x = \<zero>) = (x \<in> insert a A))"
	+ using P.minus_closed P_def Q_def True UP_mult_closed X_closed p_def to_poly_closed by auto
	+ then show ?thesis
	+ by blast
	+ next
	+ case False
	+ then show ?thesis
	+ using IH subsetD by auto
	+ qed
	+ qed
	+qed
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Polynomial Evaluation at Multiplicative Inverses\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+text\<open>For every polynomial $p(x)$ of degree $n$, there is a unique polynomial $q(x)$ which satisfies the equation $q(x) = x^n p(1/x)$. This section defines this polynomial and proves this identity.\<close>
	+definition(in UP_cring) one_over_poly where
	+"one_over_poly p = (\<lambda> n. if n \<le> degree p then p ((degree p) - n) else \<zero>)"
	+
	+lemma(in UP_cring) one_over_poly_closed:
	+ assumes "p \<in> carrier P"
	+ shows "one_over_poly p \<in> carrier P"
	+ apply(rule UP_car_memI[of "degree p" ])
	+ unfolding one_over_poly_def using assms apply simp
	+ by (simp add: assms cfs_closed)
	+
	+lemma(in UP_cring) one_over_poly_monom:
	+ assumes "a \<in> carrier R"
	+ shows "one_over_poly (monom P a n) = monom P a 0"
	+ apply(rule ext)
	+ unfolding one_over_poly_def using assms
	+ by (metis cfs_monom deg_monom diff_diff_cancel diff_is_0_eq diff_self_eq_0 zero_diff)
	+
	+lemma(in UP_cring) one_over_poly_monom_add:
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq> \<zero>"
	+ assumes "p \<in> carrier P"
	+ assumes "degree p < n"
	+ shows "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) = monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p"
	+proof-
	+ have 0: "degree (p \<oplus>\<^bsub>P\<^esub> monom P a n) = n"
	+ by (simp add: assms(1) assms(2) assms(3) assms(4) equal_deg_sum)
	+ show ?thesis
	+ proof(rule ext) fix x show "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) x =
	+ (monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - deg R p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x"
	+ proof(cases "x = 0")
	+ case T: True
	+ have T0: "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) 0 = a"
	+ unfolding one_over_poly_def
	+ by (metis lcf_eq lcf_monom(1) ltrm_of_sum_diff_deg P.add.m_closed assms(1) assms(2) assms(3) assms(4) diff_zero le0 monom_closed)
	+ have T1: "(monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) 0 = a"
	+ using one_over_poly_closed
	+ by (metis (no_types, lifting) lcf_monom(1) R.one_closed R.r_zero UP_m_comm UP_mult_closed assms(1) assms(3) assms(4) cfs_add cfs_monom_mult deg_const monom_closed zero_less_diff)
	+ show ?thesis using T0 T1 T by auto
	+ next
	+ case F: False
	+ show ?thesis
	+ proof(cases "x < n - degree p")
	+ case True
	+ then have T0: "degree p < n - x \<and> n - x < n"
	+ using F by auto
	+ then have T1: "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) x = \<zero>"
	+ using True F 0 unfolding one_over_poly_def
	+ using assms(1) assms(3) coeff_of_sum_diff_degree0
	+ by (metis ltrm_cfs ltrm_of_sum_diff_deg P.add.m_closed P.add.m_comm assms(2) assms(4) monom_closed nat_neq_iff)
	+ have "(monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x = \<zero>"
	+ using True F 0 one_over_poly_def one_over_poly_closed
	+ by (metis (no_types, lifting) P.add.m_comm P.m_closed R.one_closed UP_m_comm assms(1)
	+ assms(3) cfs_monom_mult coeff_of_sum_diff_degree0 deg_const monom_closed neq0_conv)
	+ then show ?thesis using T1 by auto
	+ next
	+ case False
	+ then have "n - degree p \<le> x"
	+ by auto
	+ then obtain k where k_def: "k + (n - degree p) = x"
	+ using le_Suc_ex diff_add
	+ by blast
	+ have F0: "(monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - deg R p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x
	+ = one_over_poly p k"
	+ using k_def one_over_poly_closed assms
	+ times_X_pow_coeff[of "one_over_poly p" "n - deg R p" k]
	+ P.m_closed
	+ by (metis (no_types, lifting) P.add.m_comm R.one_closed add_gr_0 coeff_of_sum_diff_degree0 deg_const monom_closed zero_less_diff)
	+ show ?thesis
	+ proof(cases "x \<le> n")
	+ case True
	+ have T0: "n - x = degree p - k"
	+ using assms(4) k_def by linarith
	+ have T1: "n - x < n"
	+ using True F
	+ by linarith
	+ then have F1: "(p \<oplus>\<^bsub>P\<^esub> monom P a n) (n - x) = p (degree p - k)"
	+ using True False F0 0 k_def cfs_add
	+ by (simp add: F0 T0 assms(1) assms(3) cfs_closed cfs_monom)
	+ then show ?thesis
	+ using "0" F0 assms(1) assms(2) assms(3) degree_of_sum_diff_degree k_def one_over_poly_def
	+ by auto
	+ next
	+ case False
	+ then show ?thesis
	+ using "0" F0 assms(1) assms(2) assms(3) degree_of_sum_diff_degree k_def one_over_poly_def
	+ by auto
	+ qed
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma( in UP_cring) one_over_poly_eval:
	+ assumes "p \<in> carrier P"
	+ assumes "x \<in> carrier R"
	+ assumes "x \<in> Units R"
	+ shows "to_fun (one_over_poly p) x = (x[^](degree p)) \<otimes> (to_fun p (inv\<^bsub>R\<^esub> x))"
	+proof(rule poly_induct6[of p])
	+ show " p \<in> carrier P"
	+ using assms by simp
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow>
	+ to_fun (one_over_poly (monom P a 0)) x = x [^] deg R (monom P a 0) \<otimes> to_fun (monom P a 0) (inv x)"
	+ using assms to_fun_const one_over_poly_monom by auto
	+ show "\<And>a n p.
	+ a \<in> carrier R \<Longrightarrow>
	+ a \<noteq> \<zero> \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ deg R p < n \<Longrightarrow>
	+ to_fun (one_over_poly p) x = x [^] deg R p \<otimes> to_fun p (inv x) \<Longrightarrow>
	+ to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = x [^] deg R (p \<oplus>\<^bsub>P\<^esub> monom P a n) \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> monom P a n) (inv x)"
	+ proof- fix a n p assume A: "a \<in> carrier R" "a \<noteq> \<zero>" "p \<in> carrier P" "deg R p < n"
	+ "to_fun (one_over_poly p) x = x [^] deg R p \<otimes> to_fun p (inv x)"
	+ have "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) = monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p"
	+ using A by (simp add: one_over_poly_monom_add)
	+ hence "to_fun ( one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x =
	+ a \<oplus> to_fun ( monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x"
	+ using A to_fun_plus one_over_poly_closed cfs_add
	+ by (simp add: assms(2) to_fun_const)
	+ hence "to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = a \<oplus> x[^](n - degree p) \<otimes> x [^] degree p \<otimes> to_fun p (inv x)"
	+ by (simp add: A(3) A(5) R.m_assoc assms(2) assms(3) to_fun_closed to_fun_monic_monom to_fun_mult one_over_poly_closed)
	+ hence 0:"to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = a \<oplus> x[^]n \<otimes> to_fun p (inv x)"
	+ using A R.nat_pow_mult assms(2)
	+ by auto
	+ have 1: "to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = x[^]n \<otimes> (a \<otimes> inv x [^]n \<oplus> to_fun p (inv x))"
	+ proof-
	+ have "x[^]n \<otimes> a \<otimes> inv x [^]n = a"
	+ by (metis (no_types, hide_lams) A(1) R.Units_inv_closed R.Units_r_inv R.m_assoc
	+ R.m_comm R.nat_pow_closed R.nat_pow_distrib R.nat_pow_one R.r_one assms(2) assms(3))
	+ thus ?thesis
	+ using A R.ring_simprules(23)[of _ _ "x[^]n"] 0 R.m_assoc assms(2) assms(3) to_fun_closed
	+ by auto
	+ qed
	+ have 2: "degree (p \<oplus>\<^bsub>P\<^esub> monom P a n) = n"
	+ by (simp add: A(1) A(2) A(3) A(4) equal_deg_sum)
	+ show " to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = x [^] deg R (p \<oplus>\<^bsub>P\<^esub> monom P a n) \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> monom P a n) (inv x)"
	+ using 1 2
	+ by (metis (no_types, lifting) A(1) A(3) P_def R.Units_inv_closed R.add.m_comm
	+ UP_cring.to_fun_monom UP_cring_axioms assms(3) to_fun_closed to_fun_plus monom_closed)
	+ qed
	+qed
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Lifting Homomorphisms of Rings to Polynomial Rings by Application to Coefficients\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+definition poly_lift_hom where
	+"poly_lift_hom R S \<phi> = eval R (UP S) (to_polynomial S \<circ> \<phi>) (X_poly S)"
	+
	+context UP_ring
	+begin
	+
	+lemma(in UP_cring) pre_poly_lift_hom_is_hom:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ shows "ring_hom_ring R (UP S) (to_polynomial S \<circ> \<phi>)"
	+ apply(rule ring_hom_ringI)
	+ apply (simp add: R.ring_axioms)
	+ apply (simp add: UP_ring.UP_ring UP_ring.intro assms(1) cring.axioms(1))
	+ using UP_cring.intro UP_cring.to_poly_closed assms(1) assms(2) ring_hom_closed apply fastforce
	+ using assms UP_cring.to_poly_closed[of S] ring_hom_closed[of \<phi> R S] comp_apply[of "to_polynomial S" \<phi>]
	+ unfolding UP_cring_def
	+ apply (metis UP_cring.to_poly_mult UP_cring_def ring_hom_mult)
	+ using assms UP_cring.to_poly_closed[of S] ring_hom_closed[of \<phi> R S] comp_apply[of "to_polynomial S" \<phi>]
	+ unfolding UP_cring_def
	+ apply (metis UP_cring.to_poly_add UP_cring_def ring_hom_add)
	+ using assms UP_cring.to_poly_closed[of S] ring_hom_one[of \<phi> R S] comp_apply[of "to_polynomial S" \<phi>]
	+ unfolding UP_cring_def
	+ by (simp add: \<open>\<phi> \<in> ring_hom R S \<Longrightarrow> \<phi> \<one> = \<one>\<^bsub>S\<^esub>\<close> UP_cring.intro UP_cring.to_poly_is_ring_hom ring_hom_one)
	+
	+lemma(in UP_cring) poly_lift_hom_is_hom:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ shows "poly_lift_hom R S \<phi> \<in> ring_hom (UP R) (UP S)"
	+ unfolding poly_lift_hom_def
	+ apply( rule UP_pre_univ_prop.eval_ring_hom[of R "UP S" ])
	+ unfolding UP_pre_univ_prop_def
	+ apply (simp add: R_cring RingHom.ring_hom_cringI UP_cring.UP_cring UP_cring_def assms(1) assms(2) pre_poly_lift_hom_is_hom)
	+ by (simp add: UP_cring.X_closed UP_cring.intro assms(1))
	+
	+lemma(in UP_cring) poly_lift_hom_closed:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier (UP R)"
	+ shows "poly_lift_hom R S \<phi> p \<in> carrier (UP S)"
	+ by (metis assms(1) assms(2) assms(3) poly_lift_hom_is_hom ring_hom_closed)
	+
	+lemma(in UP_cring) poly_lift_hom_add:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier (UP R)"
	+ assumes "q \<in> carrier (UP R)"
	+ shows "poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>UP R\<^esub> q) = poly_lift_hom R S \<phi> p \<oplus>\<^bsub>UP S\<^esub> poly_lift_hom R S \<phi> q"
	+ using assms poly_lift_hom_is_hom[of S \<phi>] ring_hom_add[of "poly_lift_hom R S \<phi>" "UP R" "UP S" p q]
	+ by blast
	+
	+lemma(in UP_cring) poly_lift_hom_mult:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier (UP R)"
	+ assumes "q \<in> carrier (UP R)"
	+ shows "poly_lift_hom R S \<phi> (p \<otimes>\<^bsub>UP R\<^esub> q) = poly_lift_hom R S \<phi> p \<otimes>\<^bsub>UP S\<^esub> poly_lift_hom R S \<phi> q"
	+ using assms poly_lift_hom_is_hom[of S \<phi>] ring_hom_mult[of "poly_lift_hom R S \<phi>" "UP R" "UP S" p q]
	+ by blast
	+
	+lemma(in UP_cring) poly_lift_hom_extends_hom:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "r \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (to_polynomial R r) = to_polynomial S (\<phi> r)"
	+ using UP_pre_univ_prop.eval_const[of R "UP S" "to_polynomial S \<circ> \<phi>" "X_poly S" r ] assms
	+ comp_apply[of "\<lambda>a. monom (UP S) a 0" \<phi> r] pre_poly_lift_hom_is_hom[of S \<phi>]
	+ unfolding poly_lift_hom_def to_polynomial_def UP_pre_univ_prop_def
	+ by (simp add: R_cring RingHom.ring_hom_cringI UP_cring.UP_cring UP_cring.X_closed UP_cring.intro)
	+
	+lemma(in UP_cring) poly_lift_hom_extends_hom':
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "r \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (monom P r 0) = monom (UP S) (\<phi> r) 0"
	+ using poly_lift_hom_extends_hom[of S \<phi> r] assms
	+ unfolding to_polynomial_def P_def
	+ by blast
	+
	+lemma(in UP_cring) poly_lift_hom_smult:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (a \<odot>\<^bsub>UP R\<^esub> p) = \<phi> a \<odot>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> p)"
	+ using assms poly_lift_hom_is_hom[of S \<phi>] poly_lift_hom_extends_hom'[of S \<phi> a]
	+ poly_lift_hom_mult[of S \<phi> "monom P a 0" p] ring_hom_closed[of \<phi> R S a]
	+ UP_ring.monom_mult_is_smult[of S "\<phi> a" "poly_lift_hom R S \<phi> p"]
	+ monom_mult_is_smult[of a p] monom_closed[of a 0] poly_lift_hom_closed[of S \<phi> p]
	+ unfolding to_polynomial_def UP_ring_def P_def cring_def
	+ by simp
	+
	+lemma(in UP_cring) poly_lift_hom_monom:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "r \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (monom (UP R) r n) = (monom (UP S) (\<phi> r) n)"
	+proof-
	+ have "eval R (UP S) (to_polynomial S \<circ> \<phi>) (X_poly S) (monom (UP R) r n) = (to_polynomial S \<circ> \<phi>) r \<otimes>\<^bsub>UP S\<^esub> X_poly S [^]\<^bsub>UP S\<^esub> n"
	+ using assms UP_pre_univ_prop.eval_monom[of R "UP S" "to_polynomial S \<circ> \<phi>" r "X_poly S" n]
	+ unfolding UP_pre_univ_prop_def UP_cring_def ring_hom_cring_def
	+ by (meson UP_cring.UP_cring UP_cring.X_closed UP_cring.pre_poly_lift_hom_is_hom UP_cring_axioms
	+ UP_cring_def ring_hom_cring_axioms.intro ring_hom_ring.homh)
	+ then have "eval R (UP S) (to_polynomial S \<circ> \<phi>) (X_poly S) (monom (UP R) r n) = (to_polynomial S (\<phi> r)) \<otimes>\<^bsub>UP S\<^esub> X_poly S [^]\<^bsub>UP S\<^esub> n"
	+ by simp
	+ then show ?thesis
	+ unfolding poly_lift_hom_def
	+ using assms UP_cring.monom_rep_X_pow[of S "\<phi> r" n] ring_hom_closed[of \<phi> R S r]
	+ by (metis UP_cring.X_closed UP_cring.intro UP_cring.monom_sub UP_cring.sub_monom(1))
	+qed
	+
	+lemma(in UP_cring) poly_lift_hom_X_var:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ shows "poly_lift_hom R S \<phi> (monom (UP R) \<one>\<^bsub>R\<^esub> 1) = (monom (UP S) \<one>\<^bsub>S\<^esub> 1)"
	+ using assms(1) assms(2) poly_lift_hom_monom ring_hom_one by fastforce
	+
	+lemma(in UP_cring) poly_lift_hom_X_var':
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ shows "poly_lift_hom R S \<phi> (X_poly R) = (X_poly S)"
	+ unfolding X_poly_def
	+ using assms(1) assms(2) poly_lift_hom_X_var by blast
	+
	+lemma(in UP_cring) poly_lift_hom_X_var'':
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ shows "poly_lift_hom R S \<phi> (monom (UP R) \<one>\<^bsub>R\<^esub> n) = (monom (UP S) \<one>\<^bsub>S\<^esub> n)"
	+ using assms(1) assms(2) poly_lift_hom_monom ring_hom_one by fastforce
	+
	+lemma(in UP_cring) poly_lift_hom_X_var''':
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ shows "poly_lift_hom R S \<phi> (X_poly R [^]\<^bsub>UP R\<^esub> (n::nat)) = (X_poly S) [^]\<^bsub>UP S\<^esub> (n::nat)"
	+ using assms
	+ by (smt ltrm_of_X P.nat_pow_closed P_def R.ring_axioms UP_cring.to_fun_closed UP_cring.intro
	+ UP_cring.monom_pow UP_cring.poly_lift_hom_monom UP_cring_axioms X_closed cfs_closed
	+ cring.axioms(1) to_fun_X_pow poly_lift_hom_X_var' ring_hom_closed ring_hom_nat_pow)
	+
	+lemma(in UP_cring) poly_lift_hom_X_plus:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (X_poly_plus R a) = X_poly_plus S (\<phi> a)"
	+ using ring_hom_add
	+ unfolding X_poly_plus_def
	+ using P_def X_closed assms(1) assms(2) assms(3) poly_lift_hom_X_var' poly_lift_hom_add poly_lift_hom_extends_hom to_poly_closed by fastforce
	+
	+lemma(in UP_cring) poly_lift_hom_X_plus_nat_pow:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (X_poly_plus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = X_poly_plus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
	+ using assms poly_lift_hom_X_plus[of S \<phi> a]
	+ ring_hom_nat_pow[of "UP R" "UP S" "poly_lift_hom R S \<phi>" "X_poly_plus R a" n]
	+ poly_lift_hom_is_hom[of S \<phi>] X_plus_closed[of a] UP_ring.UP_ring[of S]
	+ unfolding P_def cring_def UP_cring_def
	+ using P_def UP_ring UP_ring.intro
	+ by (simp add: UP_ring.intro)
	+
	+lemma(in UP_cring) X_poly_plus_nat_pow_closed:
	+ assumes "a \<in> carrier R"
	+ shows " X_poly_plus R a [^]\<^bsub>UP R\<^esub> (n::nat) \<in> carrier (UP R)"
	+ using assms P.nat_pow_closed P_def X_plus_closed by auto
	+
	+lemma(in UP_cring) poly_lift_hom_X_plus_nat_pow_smult:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (b \<odot>\<^bsub>UP R\<^esub> X_poly_plus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = \<phi> b \<odot>\<^bsub>UP S \<^esub>X_poly_plus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
	+ by (simp add: X_poly_plus_nat_pow_closed assms(1) assms(2) assms(3) assms(4) poly_lift_hom_X_plus_nat_pow poly_lift_hom_smult)
	+
	+lemma(in UP_cring) poly_lift_hom_X_minus:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (X_poly_minus R a) = X_poly_minus S (\<phi> a)"
	+ using poly_lift_hom_X_plus[of S \<phi> "\<ominus> a"] X_minus_plus[of a] UP_cring.X_minus_plus[of S "\<phi> a"]
	+ R.ring_hom_a_inv[of S \<phi> a]
	+ unfolding UP_cring_def P_def
	+ by (metis R.add.inv_closed assms(1) assms(2) assms(3) cring.axioms(1) ring_hom_closed)
	+
	+lemma(in UP_cring) poly_lift_hom_X_minus_nat_pow:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (X_poly_minus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = X_poly_minus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
	+ using assms poly_lift_hom_X_minus ring_hom_nat_pow X_minus_plus UP_cring.X_minus_plus
	+ poly_lift_hom_X_plus poly_lift_hom_X_plus_nat_pow by fastforce
	+
	+lemma(in UP_cring) X_poly_minus_nat_pow_closed:
	+ assumes "a \<in> carrier R"
	+ shows "X_poly_minus R a [^]\<^bsub>UP R\<^esub> (n::nat) \<in> carrier (UP R)"
	+ using assms monoid.nat_pow_closed[of "UP R" "X_poly_minus R a" n]
	+ P.nat_pow_closed P_def X_minus_closed by auto
	+
	+lemma(in UP_cring) poly_lift_hom_X_minus_nat_pow_smult:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (b \<odot>\<^bsub>UP R\<^esub> X_poly_minus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = \<phi> b \<odot>\<^bsub>UP S \<^esub>X_poly_minus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
	+ by (simp add: X_poly_minus_nat_pow_closed assms(1) assms(2) assms(3) assms(4) poly_lift_hom_X_minus_nat_pow poly_lift_hom_smult)
	+
	+lemma(in UP_cring) poly_lift_hom_cf:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier P"
	+ shows "poly_lift_hom R S \<phi> p k = \<phi> (p k)"
	+ apply(rule poly_induct3[of p])
	+ apply (simp add: assms(3))
	+proof-
	+ show "\<And>p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ poly_lift_hom R S \<phi> p k = \<phi> (p k) \<Longrightarrow> poly_lift_hom R S \<phi> q k = \<phi> (q k) \<Longrightarrow> poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q) k = \<phi> ((p \<oplus>\<^bsub>P\<^esub> q) k)"
	+ proof- fix p q assume A: "p \<in> carrier P" "q \<in> carrier P"
	+ "poly_lift_hom R S \<phi> p k = \<phi> (p k)" "poly_lift_hom R S \<phi> q k = \<phi> (q k)"
	+ show "poly_lift_hom R S \<phi> q k = \<phi> (q k) \<Longrightarrow> poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q) k = \<phi> ((p \<oplus>\<^bsub>P\<^esub> q) k)"
	+ using A assms poly_lift_hom_add[of S \<phi> p q]
	+ poly_lift_hom_closed[of S \<phi> p] poly_lift_hom_closed[of S \<phi> q]
	+ UP_ring.cfs_closed[of S "poly_lift_hom R S \<phi> q " k] UP_ring.cfs_closed[of S "poly_lift_hom R S \<phi> p" k]
	+ UP_ring.cfs_add[of S "poly_lift_hom R S \<phi> p" "poly_lift_hom R S \<phi> q" k]
	+ unfolding P_def UP_ring_def
	+ by (metis (full_types) P_def cfs_add cfs_closed cring.axioms(1) ring_hom_add)
	+ qed
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow> poly_lift_hom R S \<phi> (monom P a n) k = \<phi> (monom P a n k)"
	+ proof- fix a m assume A: "a \<in> carrier R"
	+ show "poly_lift_hom R S \<phi> (monom P a m) k = \<phi> (monom P a m k)"
	+ apply(cases "m = k")
	+ using cfs_monom[of a m k] assms poly_lift_hom_monom[of S \<phi> a m] UP_ring.cfs_monom[of S "\<phi> a" m k]
	+ unfolding P_def UP_ring_def
	+ apply (simp add: A cring.axioms(1) ring_hom_closed)
	+ using cfs_monom[of a m k] assms poly_lift_hom_monom[of S \<phi> a m] UP_ring.cfs_monom[of S "\<phi> a" m k]
	+ unfolding P_def UP_ring_def
	+ by (metis A P_def R.ring_axioms cring.axioms(1) ring_hom_closed ring_hom_zero)
	+ qed
	+qed
	+
	+lemma(in ring) ring_hom_monom_term:
	+ assumes "a \<in> carrier R"
	+ assumes "c \<in> carrier R"
	+ assumes "ring S"
	+ assumes "h \<in> ring_hom R S"
	+ shows "h (a \<otimes> c[^](n::nat)) = h a \<otimes>\<^bsub>S\<^esub> (h c)[^]\<^bsub>S\<^esub>n"
	+ apply(induction n)
	+ using assms ringE(2) ring_hom_closed apply fastforce
	+ by (metis assms(1) assms(2) assms(3) assms(4) local.ring_axioms nat_pow_closed ring_hom_mult ring_hom_nat_pow)
	+
	+lemma(in UP_cring) poly_lift_hom_eval:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "UP_cring.to_fun S (poly_lift_hom R S \<phi> p) (\<phi> a) = \<phi> (to_fun p a) "
	+ apply(rule poly_induct3[of p])
	+ apply (simp add: assms(3))
	+proof-
	+ show "\<And>p q. q \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ UP_cring.to_fun S (poly_lift_hom R S \<phi> p) (\<phi> a) = \<phi> (to_fun p a) \<Longrightarrow>
	+ UP_cring.to_fun S (poly_lift_hom R S \<phi> q) (\<phi> a) = \<phi> (to_fun q a) \<Longrightarrow>
	+ UP_cring.to_fun S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) (\<phi> a) = \<phi> (to_fun (p \<oplus>\<^bsub>P\<^esub> q) a)"
	+ proof- fix p q assume A: "q \<in> carrier P" "p \<in> carrier P"
	+ "UP_cring.to_fun S (poly_lift_hom R S \<phi> p) (\<phi> a) = \<phi> (to_fun p a)"
	+ "UP_cring.to_fun S (poly_lift_hom R S \<phi> q) (\<phi> a) = \<phi> (to_fun q a)"
	+ have "(poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) = poly_lift_hom R S \<phi> p \<oplus>\<^bsub>UP S\<^esub> poly_lift_hom R S \<phi> q"
	+ using A(1) A(2) P_def assms(1) assms(2) poly_lift_hom_add by auto
	+ hence "UP_cring.to_fun S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) (\<phi> a) =
	+ UP_cring.to_fun S (poly_lift_hom R S \<phi> p) (\<phi> a) \<oplus>\<^bsub>S\<^esub> UP_cring.to_fun S (poly_lift_hom R S \<phi> q) (\<phi> a)"
	+ using UP_cring.to_fun_plus[of S] assms
	+ unfolding UP_cring_def
	+ by (metis (no_types, lifting) A(1) A(2) P_def poly_lift_hom_closed ring_hom_closed)
	+ thus "UP_cring.to_fun S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) (\<phi> a) = \<phi> (to_fun (p \<oplus>\<^bsub>P\<^esub> q) a)"
	+ using A to_fun_plus assms ring_hom_add[of \<phi> R S]
	+ poly_lift_hom_closed[of S \<phi>] UP_cring.to_fun_def[of S] to_fun_def
	+ unfolding P_def UP_cring_def
	+ using UP_cring.to_fun_closed UP_cring_axioms
	+ by metis
	+ qed
	+ show "\<And>c n. c \<in> carrier R \<Longrightarrow> UP_cring.to_fun S (poly_lift_hom R S \<phi> (monom P c n)) (\<phi> a) = \<phi> (to_fun (monom P c n) a)"
	+ unfolding P_def
	+ proof - fix c n assume A: "c \<in> carrier R"
	+ have 0: "\<phi> (a [^]\<^bsub>R\<^esub> (n::nat)) = \<phi> a [^]\<^bsub>S\<^esub> n"
	+ using assms ring_hom_nat_pow[of R S \<phi> a n]
	+ unfolding cring_def
	+ using R.ring_axioms by blast
	+ have 1: "\<phi> (c \<otimes>\<^bsub>R\<^esub> a [^]\<^bsub>R\<^esub> n) = \<phi> c \<otimes>\<^bsub>S\<^esub> \<phi> a [^]\<^bsub>S\<^esub> n"
	+ using ring_hom_mult[of \<phi> R S c "a [^]\<^bsub>R\<^esub> n" ] 0 assms A monoid.nat_pow_closed [of R a n]
	+ by (simp add: cring.axioms(1) ringE(2))
	+ show "UP_cring.to_fun S (poly_lift_hom R S \<phi> (monom (UP R) c n)) (\<phi> a) = \<phi> (to_fun(monom (UP R) c n) a)"
	+ using assms A poly_lift_hom_monom[of S \<phi> c n] UP_cring.to_fun_monom[of S "\<phi> c" "\<phi> a" n]
	+ to_fun_monom[of c a n] 0 1 ring_hom_closed[of \<phi> R S] unfolding UP_cring_def
	+ by (simp add: P_def to_fun_def)
	+ qed
	+qed
	+
	+lemma(in UP_cring) poly_lift_hom_sub:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier P"
	+ assumes "q \<in> carrier P"
	+ shows "poly_lift_hom R S \<phi> (compose R p q) = compose S (poly_lift_hom R S \<phi> p) (poly_lift_hom R S \<phi> q)"
	+ apply(rule poly_induct3[of p])
	+ apply (simp add: assms(3))
	+proof-
	+ show " \<And>p qa.
	+ qa \<in> carrier P \<Longrightarrow>
	+ p \<in> carrier P \<Longrightarrow>
	+ poly_lift_hom R S \<phi> (Cring_Poly.compose R p q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> p) (poly_lift_hom R S \<phi> q) \<Longrightarrow>
	+ poly_lift_hom R S \<phi> (Cring_Poly.compose R qa q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> qa) (poly_lift_hom R S \<phi> q) \<Longrightarrow>
	+ poly_lift_hom R S \<phi> (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> qa) q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> qa)) (poly_lift_hom R S \<phi> q)"
	+ proof- fix a b assume A: "a \<in> carrier P"
	+ "b \<in> carrier P"
	+ "poly_lift_hom R S \<phi> (Cring_Poly.compose R a q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> a) (poly_lift_hom R S \<phi> q)"
	+ "poly_lift_hom R S \<phi> (Cring_Poly.compose R b q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> b) (poly_lift_hom R S \<phi> q)"
	+ show "poly_lift_hom R S \<phi> (Cring_Poly.compose R (a \<oplus>\<^bsub>P\<^esub> b) q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> (a \<oplus>\<^bsub>P\<^esub> b)) (poly_lift_hom R S \<phi> q)"
	+ using assms UP_cring.sub_add[of R q a b ] UP_cring.sub_add[of S ]
	+ unfolding UP_cring_def
	+ by (metis A(1) A(2) A(3) A(4) P_def R_cring UP_cring.sub_closed UP_cring_axioms poly_lift_hom_add poly_lift_hom_closed)
	+ qed
	+ show "\<And>a n. a \<in> carrier R \<Longrightarrow>
	+ poly_lift_hom R S \<phi> (Cring_Poly.compose R (monom P a n) q) =
	+ Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom P a n)) (poly_lift_hom R S \<phi> q)"
	+ proof-
	+ fix a n assume A: "a \<in> carrier R"
	+ have 0: "(poly_lift_hom R S \<phi> (monom (UP R) a n)) = monom (UP S) (\<phi> a) n"
	+ by (simp add: A assms(1) assms(2) assms(3) assms(4) poly_lift_hom_monom)
	+ have 1: " q [^]\<^bsub>UP R\<^esub> n \<in> carrier (UP R)"
	+ using monoid.nat_pow_closed[of "UP R" q n] UP_ring.UP_ring UP_ring.intro assms(1) assms
	+ P.monoid_axioms P_def by blast
	+ have 2: "poly_lift_hom R S \<phi> (to_polynomial R a \<otimes>\<^bsub>UP R\<^esub> q [^]\<^bsub>UP R\<^esub> n) =
	+ to_polynomial S (\<phi> a) \<otimes>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> q) [^]\<^bsub>UP S\<^esub> n"
	+ using poly_lift_hom_mult[of S \<phi> "to_polynomial R a" "q [^]\<^bsub>UP R\<^esub> n"] poly_lift_hom_is_hom[of S \<phi>]
	+ ring_hom_nat_pow[of P "UP S" "poly_lift_hom R S \<phi>" q n] UP_cring.UP_cring[of S]
	+ UP_cring poly_lift_hom_monom[of S \<phi> a 0] ring_hom_closed[of \<phi> R S a]
	+ monom_closed[of a 0] nat_pow_closed[of q n] assms A
	+ unfolding to_polynomial_def P_def UP_cring_def cring_def
	+ by auto
	+ have 3: "poly_lift_hom R S \<phi> (Cring_Poly.compose R (monom (UP R) a n) q) = to_polynomial S (\<phi> a) \<otimes>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> q) [^]\<^bsub>UP S\<^esub> n"
	+ using "2" A P_def assms(4) sub_monom(1) by auto
	+ have 4: "Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom (UP R) a n)) (poly_lift_hom R S \<phi> q)
	+ = Cring_Poly.compose S (monom (UP S) (\<phi> a) n) (poly_lift_hom R S \<phi> q)"
	+ by (simp add: "0")
	+ have "poly_lift_hom R S \<phi> q \<in> carrier (UP S)"
	+ using P_def UP_cring.poly_lift_hom_closed UP_cring_axioms assms(1) assms(2) assms(4) by blast
	+ then have 5: "Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom (UP R) a n)) (poly_lift_hom R S \<phi> q)
	+ = to_polynomial S (\<phi> a) \<otimes>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> q) [^]\<^bsub>UP S\<^esub> n"
	+ using 4 UP_cring.sub_monom[of S "poly_lift_hom R S \<phi> q" "\<phi> a" n] assms
	+ unfolding UP_cring_def
	+ by (simp add: A ring_hom_closed)
	+ thus "poly_lift_hom R S \<phi> (Cring_Poly.compose R (monom P a n) q) =
	+ Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom P a n)) (poly_lift_hom R S \<phi> q)"
	+ using 0 1 2 3 4 assms A
	+ by (simp add: P_def)
	+ qed
	+qed
	+
	+lemma(in UP_cring) poly_lift_hom_comm_taylor_expansion:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (taylor_expansion R a p) = taylor_expansion S (\<phi> a) (poly_lift_hom R S \<phi> p)"
	+ unfolding taylor_expansion_def
	+ using poly_lift_hom_sub[of S \<phi> p "(X_poly_plus R a)"] poly_lift_hom_X_plus[of S \<phi> a] assms
	+ by (simp add: P_def UP_cring.X_plus_closed UP_cring_axioms)
	+
	+lemma(in UP_cring) poly_lift_hom_comm_taylor_expansion_cf:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ shows "\<phi> (taylor_expansion R a p i) = taylor_expansion S (\<phi> a) (poly_lift_hom R S \<phi> p) i"
	+ using poly_lift_hom_cf assms poly_lift_hom_comm_taylor_expansion P_def
	+ taylor_def UP_cring.taylor_closed UP_cring_axioms by fastforce
	+
	+lemma(in UP_cring) taylor_expansion_cf_closed:
	+ assumes "p \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ shows "taylor_expansion R a p i \<in> carrier R"
	+ using assms taylor_closed
	+ by (simp add: taylor_def cfs_closed)
	+
	+lemma(in UP_cring) poly_lift_hom_comm_taylor_term:
	+ assumes "cring S"
	+ assumes "\<phi> \<in> ring_hom R S"
	+ assumes "p \<in> carrier (UP R)"
	+ assumes "a \<in> carrier R"
	+ shows "poly_lift_hom R S \<phi> (taylor_term a p i) = UP_cring.taylor_term S (\<phi> a) (poly_lift_hom R S \<phi> p) i"
	+ using poly_lift_hom_X_minus_nat_pow_smult[of S \<phi> a "taylor_expansion R a p i" i]
	+ poly_lift_hom_comm_taylor_expansion[of S \<phi> p a]
	+ poly_lift_hom_comm_taylor_expansion_cf[of S \<phi> p a i]
	+ assms UP_cring.taylor_term_def[of S]
	+ unfolding taylor_term_def UP_cring_def P_def
	+ by (simp add: UP_cring.taylor_expansion_cf_closed UP_cring_axioms)
	+
	+lemma(in UP_cring) poly_lift_hom_degree_bound:
	+ assumes "cring S"
	+ assumes "h \<in> ring_hom R S"
	+ assumes "f \<in> carrier (UP R)"
	+ shows "deg S (poly_lift_hom R S h f) \<le> deg R f"
	+ using poly_lift_hom_closed[of S h f] UP_cring.deg_leqI[of S "poly_lift_hom R S h f" "deg R f"] assms ring_hom_zero[of h R S] deg_aboveD[of f] coeff_simp[of f]
	+ unfolding P_def UP_cring_def
	+ by (simp add: P_def R.ring_axioms cring.axioms(1) poly_lift_hom_cf)
	+
	+lemma(in UP_cring) deg_eqI:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "deg R f \<le> n"
	+ assumes "f n \<noteq> \<zero>"
	+ shows "deg R f = n"
	+ using assms coeff_simp[of f] P_def deg_leE le_neq_implies_less by blast
	+
	+lemma(in UP_cring) poly_lift_hom_degree_eq:
	+ assumes "cring S"
	+ assumes "h \<in> ring_hom R S"
	+ assumes "h (lcf f) \<noteq> \<zero>\<^bsub>S\<^esub>"
	+ assumes "f \<in> carrier (UP R)"
	+ shows "deg S (poly_lift_hom R S h f) = deg R f"
	+ apply(rule UP_cring.deg_eqI)
	+ using assms unfolding UP_cring_def apply blast
	+ using poly_lift_hom_closed[of S h f] assms apply blast
	+ using poly_lift_hom_degree_bound[of S h f] assms apply blast
	+ using assms poly_lift_hom_cf[of S h f]
	+ by (metis P_def)
	+
	+lemma(in UP_cring) poly_lift_hom_lcoeff:
	+ assumes "cring S"
	+ assumes "h \<in> ring_hom R S"
	+ assumes "h (lcf f) \<noteq> \<zero>\<^bsub>S\<^esub>"
	+ assumes "f \<in> carrier (UP R)"
	+ shows "UP_ring.lcf S (poly_lift_hom R S h f) = h (lcf f)"
	+ using poly_lift_hom_degree_eq[of S h f] assms
	+ by (simp add: P_def poly_lift_hom_cf)
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Coefficient List Constructor for Polynomials\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+definition list_to_poly where
	+"list_to_poly R as n = (if n < length as then as!n else \<zero>\<^bsub>R\<^esub>)"
	+
	+context UP_ring
	+begin
	+
	+lemma(in UP_ring) list_to_poly_closed:
	+ assumes "set as \<subseteq> carrier R"
	+ shows "list_to_poly R as \<in> carrier P"
	+ apply(rule UP_car_memI[of "length as"])
	+ apply (simp add: list_to_poly_def)
	+ by (metis R.zero_closed assms in_mono list_to_poly_def nth_mem)
	+
	+lemma(in UP_ring) list_to_poly_zero[simp]:
	+"list_to_poly R [] = \<zero>\<^bsub>UP R\<^esub>"
	+ unfolding list_to_poly_def
	+ apply auto
	+ by(simp add: UP_def)
	+
	+lemma(in UP_domain) list_to_poly_singleton:
	+ assumes "a \<in> carrier R"
	+ shows "list_to_poly R [a] = monom P a 0"
	+ apply(rule ext)
	+ unfolding list_to_poly_def using assms
	+ by (simp add: cfs_monom)
	+end
	+
	+definition cf_list where
	+"cf_list R p = map p [(0::nat)..< Suc (deg R p)]"
	+
	+lemma cf_list_length:
	+"length (cf_list R p) = Suc (deg R p)"
	+ unfolding cf_list_def
	+ by simp
	+
	+lemma cf_list_entries:
	+ assumes "i \<le> deg R p"
	+ shows "(cf_list R p)!i = p i"
	+ unfolding cf_list_def
	+ by (metis add.left_neutral assms diff_zero less_Suc_eq_le map_eq_map_tailrec nth_map_upt)
	+
	+lemma(in UP_ring) list_to_poly_cf_list_inv:
	+ assumes "p \<in> carrier (UP R)"
	+ shows "list_to_poly R (cf_list R p) = p"
	+proof
	+ fix x
	+ show "list_to_poly R (cf_list R p) x = p x"
	+ apply(cases "x < degree p")
	+ unfolding list_to_poly_def
	+ using assms cf_list_length[of R p] cf_list_entries[of _ R p]
	+ apply simp
	+ by (metis P_def UP_ring.coeff_simp UP_ring_axioms \<open>\<And>i. i \<le> deg R p \<Longrightarrow> cf_list R p ! i = p i\<close> \<open>length (cf_list R p) = Suc (deg R p)\<close> assms deg_belowI less_Suc_eq_le)
	+qed
	+
	+section\<open>Polynomial Rings over a Subring\<close>
	+
	+subsection\<open>Characterizing the Carrier of a Polynomial Ring over a Subring\<close>
	+lemma(in ring) carrier_update:
	+"carrier (R\<lparr>carrier := S\<rparr>) = S"
	+"\<zero>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub> = \<zero>"
	+"\<one>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub> = \<one>"
	+"(\<oplus>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub>) = (\<oplus>)"
	+"(\<otimes>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub>) = (\<otimes>)"
	+by auto
	+
	+
	+lemma(in UP_cring) poly_cfs_subring:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "\<And>n. g n \<in> S"
	+ shows "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ apply(rule UP_cring.UP_car_memI')
	+ using R.subcringI' R.subcring_iff UP_cring.intro assms(1) subringE(1) apply blast
	+proof-
	+ have "carrier (R\<lparr>carrier := S\<rparr>) = S"
	+ using ring.carrier_update by simp
	+ then show 0: "\<And>x. g x \<in> carrier (R\<lparr>carrier := S\<rparr>)"
	+ using assms by blast
	+ have 0: "\<zero>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> = \<zero>"
	+ using R.carrier_update(2) by blast
	+ then show "\<And>x. (deg R g) < x \<Longrightarrow> g x = \<zero>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub>"
	+ using UP_car_memE assms(2) by presburger
	+qed
	+
	+lemma(in UP_cring) UP_ring_subring:
	+ assumes "subring S R"
	+ shows "UP_cring (R \<lparr> carrier := S \<rparr>)" "UP_ring (R \<lparr> carrier := S \<rparr>)"
	+ using assms unfolding UP_cring_def
	+ using R.subcringI' R.subcring_iff subringE(1) apply blast
	+ using assms unfolding UP_ring_def
	+ using R.subcringI' R.subcring_iff subringE(1)
	+ by (simp add: R.subring_is_ring)
	+
	+lemma(in UP_cring) UP_ring_subring_is_ring:
	+ assumes "subring S R"
	+ shows "cring (UP (R \<lparr> carrier := S \<rparr>))"
	+ using assms UP_ring_subring[of S] UP_cring.UP_cring[of "R\<lparr>carrier := S\<rparr>"]
	+ by blast
	+
	+lemma(in UP_cring) UP_ring_subring_add_closed:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "f \<oplus>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using assms UP_ring_subring_is_ring[of S]
	+ by (meson cring.cring_simprules(1))
	+
	+lemma(in UP_cring) UP_ring_subring_mult_closed:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "f \<otimes>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using assms UP_ring_subring_is_ring[of S]
	+ by (meson cring.carrier_is_subcring subcringE(6))
	+
	+lemma(in UP_cring) UP_ring_subring_car:
	+ assumes "subring S R"
	+ shows "carrier (UP (R \<lparr> carrier := S \<rparr>)) = {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
	+proof
	+ show "carrier (UP (R\<lparr>carrier := S\<rparr>)) \<subseteq> {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
	+ proof
	+ fix h assume A: "h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ have "h \<in> carrier P"
	+ apply(rule UP_car_memI[of "deg (R\<lparr>carrier := S\<rparr>) h"]) unfolding P_def
	+ using UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h] R.carrier_update[of S]
	+ assms UP_ring_subring A apply presburger
	+ using UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h] assms
	+ by (metis A R.ring_axioms UP_cring_def \<open>carrier (R\<lparr>carrier := S\<rparr>) = S\<close> cring.subcringI' is_UP_cring ring.subcring_iff subringE(1) subsetD)
	+ then show "h \<in> {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
	+ unfolding P_def
	+ using assms A UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h] R.carrier_update[of S]
	+ UP_ring_subring by blast
	+ qed
	+ show "{h \<in> carrier (UP R). \<forall>n. h n \<in> S} \<subseteq> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ proof fix h assume A: "h \<in> {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
	+ have 0: "h \<in> carrier (UP R)"
	+ using A by blast
	+ have 1: "\<And>n. h n \<in> S"
	+ using A by blast
	+ show "h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ apply(rule UP_ring.UP_car_memI[of _ "deg R h"])
	+ using assms UP_ring_subring[of S] UP_cring.axioms UP_ring.intro cring.axioms(1) apply blast
	+ using UP_car_memE[of h] carrier_update 0 R.carrier_update(2) apply presburger
	+ using assms 1 R.carrier_update(1) by blast
	+ qed
	+qed
	+
	+lemma(in UP_cring) UP_ring_subring_car_subset:
	+ assumes "subring S R"
	+ shows "carrier (UP (R \<lparr> carrier := S \<rparr>)) \<subseteq> carrier (UP R)"
	+proof fix h assume "h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ then show "h \<in> carrier (UP R)"
	+ using assms UP_ring_subring_car[of S] by blast
	+qed
	+
	+lemma(in UP_cring) UP_ring_subring_car_subset':
	+ assumes "subring S R"
	+ assumes "h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "h \<in> carrier (UP R)"
	+ using assms UP_ring_subring_car_subset[of S] by blast
	+
	+lemma(in UP_cring) UP_ring_subring_add:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "g \<oplus>\<^bsub>UP R\<^esub> f = g \<oplus>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>f"
	+proof(rule ext) fix x show "(g \<oplus>\<^bsub>UP R\<^esub> f) x = (g \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> f) x"
	+ proof-
	+ have 0: " (g \<oplus>\<^bsub>P\<^esub> f) x = g x \<oplus> f x"
	+ using assms cfs_add[of g f x] unfolding P_def
	+ using UP_ring_subring_car_subset' by blast
	+ have 1: "(g \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> f) x = g x \<oplus>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> f x"
	+ using UP_ring.cfs_add[of "R \<lparr> carrier := S \<rparr>" g f x] UP_ring_subring[of S] assms
	+ unfolding UP_ring_def UP_cring_def
	+ using R.subring_is_ring by blast
	+ show ?thesis using 0 1 R.carrier_update(4)[of S]
	+ by (simp add: P_def)
	+ qed
	+qed
	+
	+lemma(in UP_cring) UP_ring_subring_deg:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "deg R g = deg (R \<lparr> carrier := S \<rparr>) g"
	+proof-
	+ have 0: "g \<in> carrier (UP R)"
	+ using assms UP_ring_subring_car[of S] by blast
	+ have 1: "deg R g \<le> deg (R \<lparr> carrier := S \<rparr>) g"
	+ using 0 assms UP_cring.UP_car_memE[of "R \<lparr> carrier := S \<rparr>" g]
	+ UP_car_memE[of g] P_def R.carrier_update(2) UP_ring_subring deg_leqI by presburger
	+ have 2: "deg (R \<lparr> carrier := S \<rparr>) g \<le> deg R g"
	+ using 0 assms UP_cring.UP_car_memE[of "R \<lparr> carrier := S \<rparr>" g]
	+ UP_car_memE[of g] P_def R.carrier_update(2) UP_ring_subring UP_cring.deg_leqI
	+ by metis
	+
	+ show ?thesis using 1 2 by presburger
	+qed
	+
	+
	+lemma(in UP_cring) UP_subring_monom:
	+ assumes "subring S R"
	+ assumes "a \<in> S"
	+ shows "up_ring.monom (UP R) a n = up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) a n"
	+proof fix x
	+ have 0: "a \<in> carrier R"
	+ using assms subringE(1) by blast
	+ have 1: "a \<in> carrier (R\<lparr>carrier := S\<rparr>)"
	+ using assms by (simp add: assms(2))
	+ have 2: " up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) a n x = (if n = x then a else \<zero>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub>)"
	+ using 1 assms UP_ring_subring[of S] UP_ring.cfs_monom[of "R\<lparr>carrier := S\<rparr>" a n x] UP_cring.axioms UP_ring.intro cring.axioms(1)
	+ by blast
	+ show "up_ring.monom (UP R) a n x = up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) a n x"
	+ using 0 1 2 cfs_monom[of a n x] R.carrier_update(2)[of S] unfolding P_def by presburger
	+qed
	+
	+lemma(in UP_cring) UP_ring_subring_mult:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "g \<otimes>\<^bsub>UP R\<^esub> f = g \<otimes>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>f"
	+proof(rule UP_ring.poly_induct3[of "R \<lparr> carrier := S \<rparr>" f])
	+ show "UP_ring (R\<lparr>carrier := S\<rparr>)"
	+ by (simp add: UP_ring_subring(2) assms(1))
	+ show " f \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ by (simp add: assms(3))
	+ show " \<And>p q. q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
	+ p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
	+ g \<otimes>\<^bsub>UP R\<^esub> p = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> p \<Longrightarrow>
	+ g \<otimes>\<^bsub>UP R\<^esub> q = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q \<Longrightarrow> g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q)"
	+ proof- fix p q
	+ assume A: " q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ "p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ "g \<otimes>\<^bsub>UP R\<^esub> p = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> p"
	+ "g \<otimes>\<^bsub>UP R\<^esub> q = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q"
	+ have 0: "p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q = p \<oplus>\<^bsub>UP R\<^esub> q"
	+ using A UP_ring_subring_add[of S p q]
	+ by (simp add: assms(1))
	+ have 1: "g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP R\<^esub> q) = g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP R\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
	+ using 0 A assms P.r_distr P_def UP_ring_subring_car_subset' by auto
	+ hence 2:"g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) = g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP R\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
	+ using 0 by simp
	+ have 3: "g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) =
	+ g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q"
	+ using 0 A assms semiring.r_distr[of "UP (R\<lparr>carrier := S\<rparr>)"] UP_ring_subring_car_subset'
	+ using UP_ring.UP_r_distr \<open>UP_ring (R\<lparr>carrier := S\<rparr>)\<close> by blast
	+ hence 4: "g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) =
	+ g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
	+ using A by simp
	+ hence 5: "g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) =
	+ g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP R\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
	+ using UP_ring_subring_add[of S]
	+ by (simp add: A(1) A(2) A(3) A(4) UP_ring.UP_mult_closed \<open>UP_ring (R\<lparr>carrier := S\<rparr>)\<close> assms(1) assms(2))
	+ show "g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q)"
	+ by (simp add: "2" "5")
	+ qed
	+ show "\<And>a n. a \<in> carrier (R\<lparr>carrier := S\<rparr>) \<Longrightarrow> g \<otimes>\<^bsub>UP R\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n"
	+ proof fix a n x assume A: "a \<in> carrier (R\<lparr>carrier := S\<rparr>)"
	+ have 0: "monom (UP (R\<lparr>carrier := S\<rparr>)) a n = monom (UP R) a n"
	+ using A UP_subring_monom assms(1) by auto
	+ have 1: "g \<in> carrier (UP R)"
	+ using assms UP_ring_subring_car_subset' by blast
	+ have 2: "a \<in> carrier R"
	+ using A assms subringE(1)[of S R] R.carrier_update[of S] by blast
	+ show "(g \<otimes>\<^bsub>UP R\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n) x = (g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n) x"
	+ proof(cases "x < n")
	+ case True
	+ have T0: "(g \<otimes>\<^bsub>UP R\<^esub> monom (UP R) a n) x = \<zero>"
	+ using 1 2 True cfs_monom_mult[of g a x n] A assms unfolding P_def by blast
	+ then show ?thesis using UP_cring.cfs_monom_mult[of "R\<lparr>carrier := S\<rparr>" g a x n] 0 A True
	+ UP_ring_subring(1) assms(1) assms(2) by auto
	+ next
	+ case False
	+ have F0: "(g \<otimes>\<^bsub>UP R\<^esub> monom (UP R) a n) x = a \<otimes> (g (x - n))"
	+ using 1 2 False cfs_monom_mult_l[of g a n "x - n"] A assms unfolding P_def by simp
	+ have F1: "(g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n) (x - n + n) = a \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> g (x - n)"
	+ using 1 2 False UP_cring.cfs_monom_mult_l[of "R\<lparr>carrier := S\<rparr>" g a n "x - n"] A assms
	+ UP_ring_subring(1) by blast
	+ hence F2: "(g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP R) a n) (x - n + n) = a \<otimes> g (x - n)"
	+ using UP_subring_monom[of S a n] R.carrier_update[of S] assms 0 by metis
	+ show ?thesis using F0 F1 1 2 assms
	+ by (simp add: "0" False add.commute add_diff_inverse_nat)
	+ qed
	+ qed
	+qed
	+
	+lemma(in UP_cring) UP_ring_subring_one:
	+ assumes "subring S R"
	+ shows "\<one>\<^bsub>UP R\<^esub> = \<one>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>"
	+ using UP_subring_monom[of S \<one> 0] assms P_def R.subcringI' UP_ring.monom_one UP_ring_subring(2) monom_one subcringE(3) by force
	+
	+lemma(in UP_cring) UP_ring_subring_zero:
	+ assumes "subring S R"
	+ shows "\<zero>\<^bsub>UP R\<^esub> = \<zero>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>"
	+ using UP_subring_monom[of S \<zero> 0] UP_ring.monom_zero[of "R \<lparr> carrier := S \<rparr>" 0] assms monom_zero[of 0]
	+ UP_ring_subring[of S] subringE(2)[of S R]
	+ unfolding P_def
	+ by (simp add: P_def R.carrier_update(2))
	+
	+lemma(in UP_cring) UP_ring_subring_nat_pow:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "g[^]\<^bsub>UP R\<^esub>n = g[^]\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>(n::nat)"
	+ apply(induction n)
	+ using assms apply (simp add: UP_ring_subring_one)
	+proof-
	+ fix n::nat
	+ assume A: "g [^]\<^bsub>UP R\<^esub> n = g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n"
	+ have "Group.monoid (UP (R\<lparr>carrier := S\<rparr>)) "
	+ using assms UP_ring_subring[of S] UP_ring.UP_ring[of "R\<lparr>carrier := S\<rparr>"] ring.is_monoid by blast
	+ hence 0 : " g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ using monoid.nat_pow_closed[of "UP (R \<lparr> carrier := S \<rparr>)" g n] assms UP_ring_subring
	+ unfolding UP_ring_def ring_def by blast
	+ have 1: "g [^]\<^bsub>UP R\<^esub> n \<in> carrier (UP R)"
	+ using 0 assms UP_ring_subring_car_subset'[of S] by (simp add: A)
	+ then have 2: "g [^]\<^bsub>UP R\<^esub> n \<otimes>\<^bsub>UP R\<^esub> g = g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g"
	+ using assms UP_ring_subring_mult[of S "g [^]\<^bsub>UP R\<^esub> n" g]
	+ by (simp add: "0" A)
	+ then show "g [^]\<^bsub>UP R\<^esub> Suc n = g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> Suc n"
	+ by simp
	+qed
	+
	+lemma(in UP_cring) UP_subring_compose_monom:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ shows "compose R (up_ring.monom (UP R) a n) g = compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) a n) g"
	+proof-
	+ have g_closed: "g \<in> carrier (UP R)"
	+ using assms UP_ring_subring_car by blast
	+ have 0: "a \<in> carrier R"
	+ using assms subringE(1) by blast
	+ have 1: "compose R (up_ring.monom (UP R) a n) g = a \<odot>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub>n)"
	+ using monom_sub[of a g n] unfolding P_def
	+ using "0" assms(2) g_closed by blast
	+ have 2: "compose (R\<lparr>carrier := S\<rparr>) (up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) a n) g = a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n"
	+ using assms UP_cring.monom_sub[of "R \<lparr> carrier := S \<rparr>" a g n] UP_ring_subring[of S] R.carrier_update[of S]
	+ by blast
	+ have 3: " g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n = g[^]\<^bsub>UP R\<^esub>n"
	+ using UP_ring_subring_nat_pow[of S g n]
	+ by (simp add: assms(1) assms(2))
	+ have 4: "a \<odot>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub>n) = a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n"
	+ proof fix x
	+ show "(a \<odot>\<^bsub>UP R\<^esub> g [^]\<^bsub>UP R\<^esub> n) x = (a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n) x"
	+ proof-
	+ have LHS: "(a \<odot>\<^bsub>UP R\<^esub> g [^]\<^bsub>UP R\<^esub> n) x = a \<otimes> ((g [^]\<^bsub>UP R\<^esub> n) x)"
	+ using "0" P.nat_pow_closed P_def cfs_smult g_closed by auto
	+ have RHS: "(a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n) x = a \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> ((g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n) x)"
	+ proof-
	+ have "Group.monoid (UP (R\<lparr>carrier := S\<rparr>)) "
	+ using assms UP_ring_subring[of S] UP_ring.UP_ring[of "R\<lparr>carrier := S\<rparr>"] ring.is_monoid by blast
	+ hence 0 : " g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ using monoid.nat_pow_closed[of "UP (R \<lparr> carrier := S \<rparr>)" g n] assms UP_ring_subring
	+ unfolding UP_ring_def ring_def by blast
	+ have 1: "g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ using assms UP_ring_subring[of S] R.carrier_update[of S] 0 by blast
	+ then show ?thesis using UP_ring.cfs_smult UP_ring_subring assms
	+ by (simp add: UP_ring.cfs_smult)
	+ qed
	+ show ?thesis using R.carrier_update RHS LHS 3 assms
	+ by simp
	+ qed
	+ qed
	+ show ?thesis using 0 1 2 3 4
	+ by simp
	+qed
	+
	+lemma(in UP_cring) UP_subring_compose:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "\<And>n. g n \<in> S"
	+ assumes "\<And>n. f n \<in> S"
	+ shows "compose R f g = compose (R \<lparr> carrier := S \<rparr>) f g"
	+proof-
	+ have g_closed: "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using assms poly_cfs_subring by blast
	+ have 0: "\<And>n. (\<forall> h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>)) \<longrightarrow> compose R h g = compose (R \<lparr> carrier := S \<rparr>) h g)"
	+ proof- fix n show "(\<forall> h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>)) \<longrightarrow> compose R h g = compose (R \<lparr> carrier := S \<rparr>) h g)"
	+ proof(induction n)
	+ show "\<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> 0 \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow> Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
	+ proof fix h
	+ show "h \<in> carrier (UP R) \<and> deg R h \<le> 0 \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow> Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
	+ proof
	+ assume A: "h \<in> carrier (UP R) \<and> deg R h \<le> 0 \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ then have 0: "deg R h = 0"
	+ by linarith
	+ then have 1: "deg (R \<lparr> carrier := S \<rparr>) h = 0"
	+ using A assms UP_ring_subring_deg[of S h]
	+ by linarith
	+ show "Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
	+ using 0 1 g_closed assms sub_const[of g h] UP_cring.sub_const[of "R\<lparr>carrier := S\<rparr>" g h] A P_def UP_ring_subring
	+ by presburger
	+ qed
	+ qed
	+ show "\<And>n. \<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
	+ Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g \<Longrightarrow>
	+ \<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
	+ Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
	+ proof fix n h
	+ assume IH: "\<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
	+ Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
	+ show "h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
	+ Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
	+ proof assume A: "h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ show "Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
	+ proof(cases "deg R h \<le> n")
	+ case True
	+ then show ?thesis using A IH by blast
	+ next
	+ case False
	+ then have F0: "deg R h = Suc n"
	+ using A by (simp add: A le_Suc_eq)
	+ then have F1: "deg (R\<lparr>carrier := S\<rparr>) h = Suc n"
	+ using UP_ring_subring_deg[of S h] A
	+ by (simp add: \<open>h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))\<close> assms(1))
	+ obtain j where j_def: "j \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<and>
	+ h = j \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h) \<and>
	+ deg (R\<lparr>carrier := S\<rparr>) j < deg (R\<lparr>carrier := S\<rparr>) h"
	+ using A UP_ring.ltrm_decomp[of "R\<lparr>carrier := S\<rparr>" h] assms UP_ring_subring[of S]
	+ F1 by (metis (mono_tags, lifting) F0 False zero_less_Suc)
	+ have j_closed: "j \<in> carrier (UP R)"
	+ using j_def assms UP_ring_subring_car_subset by blast
	+ have F2: "deg R j < deg R h"
	+ using j_def assms
	+ by (metis (no_types, lifting) F0 F1 UP_ring_subring_deg)
	+ have F3: "(deg (R\<lparr>carrier := S\<rparr>) h) = deg R h"
	+ by (simp add: F0 F1)
	+ have F30: "h (deg (R\<lparr>carrier := S\<rparr>) h) \<in> S "
	+ using A UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h "deg (R\<lparr>carrier := S\<rparr>) h"]
	+ by (metis R.carrier_update(1) UP_ring_subring(1) assms(1))
	+ hence F4: "up_ring.monom P (h (deg R h)) (deg R h) =
	+ up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h)"
	+ using F3 g_closed j_def UP_subring_monom[of S "h (deg (R\<lparr>carrier := S\<rparr>) h)"] assms
	+ unfolding P_def by metis
	+ have F5: "compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g =
	+ compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h)) g"
	+ using F0 F1 F2 F3 F4 UP_subring_compose_monom[of S] assms P_def \<open>h (deg (R\<lparr>carrier := S\<rparr>) h) \<in> S\<close>
	+ by (metis g_closed)
	+ have F5: "compose R j g = compose (R \<lparr> carrier := S \<rparr>) j g"
	+ using F0 F2 IH UP_ring_subring_car_subset' assms(1) j_def by auto
	+ have F6: "h = j \<oplus>\<^bsub>UP R\<^esub> monom (UP R) (h (deg R h)) (deg R h)"
	+ using j_def F4 UP_ring_subring_add[of S j "up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h)"]
	+ UP_ring.monom_closed[of "R\<lparr>carrier := S\<rparr>" "h (deg (R\<lparr>carrier := S\<rparr>) h)" "deg (R\<lparr>carrier := S\<rparr>) h"]
	+ using P_def UP_ring_subring(2) \<open>h (deg (R\<lparr>carrier := S\<rparr>) h) \<in> S\<close> assms(1) by auto
	+ have F7: "compose R h g =compose R j g \<oplus>\<^bsub>UP R\<^esub>
	+ compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g"
	+ proof-
	+ show ?thesis
	+ using assms(2) j_closed F5 sub_add[of g j "up_ring.monom P (h (deg R h)) (deg R h)" ]
	+ F4 F3 F2 F1 g_closed unfolding P_def
	+ by (metis A F6 ltrm_closed P_def)
	+ qed
	+ have F8: "compose (R \<lparr> carrier := S \<rparr>) h g = compose (R \<lparr> carrier := S \<rparr>) j g \<oplus>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>
	+ compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) (h (deg (R \<lparr> carrier := S \<rparr>) h)) (deg (R \<lparr> carrier := S \<rparr>) h)) g"
	+ proof-
	+ have 0: " UP_cring (R\<lparr>carrier := S\<rparr>)"
	+ by (simp add: UP_ring_subring(1) assms(1))
	+ have 1: "monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg R h)) (deg R h) \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ using assms 0 F30 UP_ring.monom_closed[of "R\<lparr>carrier := S\<rparr>" "h (deg R h)" "deg R h"] R.carrier_update[of S]
	+ unfolding UP_ring_def UP_cring_def
	+ by (simp add: F3 cring.axioms(1))
	+ show ?thesis
	+ using 0 1 g_closed j_def UP_cring.sub_add[of "R \<lparr> carrier := S \<rparr>" g j "monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg R h)) (deg R h)" ]
	+ using F3 by auto
	+ qed
	+ have F9: "compose R j g \<in> carrier (UP R)"
	+ by (simp add: UP_cring.sub_closed assms(2) is_UP_cring j_closed)
	+ have F10: "compose (R \<lparr> carrier := S \<rparr>) j g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using assms j_def UP_cring.sub_closed[of "R \<lparr> carrier := S \<rparr>"] UP_ring_subring(1) g_closed by blast
	+ have F11: " compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g \<in> carrier (UP R)"
	+ using assms j_def UP_cring.sub_closed[of "R \<lparr> carrier := S \<rparr>"]
	+ UP_ring.monom_closed[of "R \<lparr> carrier := S \<rparr>"]
	+ by (simp add: A UP_car_memE(1) UP_cring.rev_sub_closed UP_ring.monom_closed is_UP_cring is_UP_ring sub_rev_sub)
	+ have F12: " compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) (h (deg (R \<lparr> carrier := S \<rparr>) h)) (deg (R \<lparr> carrier := S \<rparr>) h)) g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using assms j_def UP_cring.sub_closed[of "R \<lparr> carrier := S \<rparr>"]
	+ UP_ring.monom_closed[of "R \<lparr> carrier := S \<rparr>"] UP_ring_subring[of S]
	+ using A UP_ring.ltrm_closed g_closed by fastforce
	+ show ?thesis using F9 F10 F11 F12 F7 F8 F5 UP_ring_subring_add[of S "compose R j g" "compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g"]
	+ assms
	+ using F3 F30 UP_subring_compose_monom g_closed by auto
	+ qed
	+ qed
	+ qed
	+ qed
	+ qed
	+ show ?thesis using 0[of "deg R f"]
	+ by (simp add: assms(1) assms(3) assms(5) poly_cfs_subring)
	+qed
	+
	+
	+subsection\<open>Evaluation over a Subring\<close>
	+
	+lemma(in UP_cring) UP_subring_eval:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ shows "to_function R g a = to_function (R \<lparr> carrier := S \<rparr>) g a"
	+ apply(rule UP_ring.poly_induct3[of "R \<lparr> carrier := S \<rparr>" g] )
	+ apply (simp add: UP_ring_subring(2) assms(1))
	+ apply (simp add: assms(2))
	+proof-
	+ show "\<And>p q. q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
	+ p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
	+ to_function R p a = to_function (R\<lparr>carrier := S\<rparr>) p a \<Longrightarrow>
	+ to_function R q a = to_function (R\<lparr>carrier := S\<rparr>) q a \<Longrightarrow>
	+ to_function R (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a = to_function (R\<lparr>carrier := S\<rparr>) (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a"
	+ proof- fix p q assume A: "q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ "p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ " to_function R p a = to_function (R\<lparr>carrier := S\<rparr>) p a"
	+ " to_function R q a = to_function (R\<lparr>carrier := S\<rparr>) q a"
	+ have a_closed: "a \<in> carrier R"
	+ using assms R.carrier_update[of S] subringE(1) by blast
	+ have 0: "UP_cring (R\<lparr>carrier := S\<rparr>)"
	+ using assms by (simp add: UP_ring_subring(1))
	+ have 1: "to_function (R\<lparr>carrier := S\<rparr>) p a \<in> S"
	+ using A 0 UP_cring.to_fun_closed[of "R\<lparr>carrier := S\<rparr>"]
	+ by (simp add: UP_cring.to_fun_def assms(3))
	+ have 2: "to_function (R\<lparr>carrier := S\<rparr>) q a \<in> S"
	+ using A 0 UP_cring.to_fun_closed[of "R\<lparr>carrier := S\<rparr>"]
	+ by (simp add: UP_cring.to_fun_def assms(3))
	+ have 3: "p \<in> carrier (UP R)"
	+ using A assms 0 UP_ring_subring_car_subset' by blast
	+ have 4: "q \<in> carrier (UP R)"
	+ using A assms 0 UP_ring_subring_car_subset' by blast
	+ have 5: "to_fun p a \<oplus> to_fun q a = UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) p a \<oplus>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) q a"
	+ using 1 2 A R.carrier_update[of S] assms by (simp add: "0" UP_cring.to_fun_def to_fun_def)
	+ have 6: "UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a =
	+ UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) p a \<oplus>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) q a"
	+ using UP_cring.to_fun_plus[of "R \<lparr> carrier := S \<rparr>" q p a]
	+ by (simp add: "0" A(1) A(2) assms(3))
	+ have 7: "to_fun (p \<oplus>\<^bsub>P\<^esub> q) a = to_fun p a \<oplus> to_fun q a"
	+ using to_fun_plus[of q p a] 3 4 a_closed by (simp add: P_def)
	+ have 8: "p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q = p \<oplus>\<^bsub>P\<^esub> q"
	+ unfolding P_def using assms A R.carrier_update[of S] UP_ring_subring_add[of S p q] by simp
	+ show "to_function R (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a = to_function (R\<lparr>carrier := S\<rparr>) (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a"
	+ using UP_ring_subring_car_subset'[of S ] 0 1 2 3 4 5 6 7 8 A R.carrier_update[of S]
	+ unfolding P_def by (simp add: UP_cring.to_fun_def to_fun_def)
	+ qed
	+ show "\<And>b n.
	+ b \<in> carrier (R\<lparr>carrier := S\<rparr>) \<Longrightarrow>
	+ to_function R (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = to_function (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a"
	+ proof- fix b n assume A: "b \<in> carrier (R\<lparr>carrier := S\<rparr>)"
	+ have 0: "UP_cring (R\<lparr>carrier := S\<rparr>)"
	+ by (simp add: UP_ring_subring(1) assms(1))
	+ have a_closed: "a \<in> carrier R"
	+ using assms subringE by blast
	+ have 1: "UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = b \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a [^]\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> n"
	+ using assms A UP_cring.to_fun_monom[of "R\<lparr>carrier := S\<rparr>" b a n]
	+ by (simp add: "0")
	+ have 2: "UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) \<equiv> to_function (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n)"
	+ using UP_cring.to_fun_def[of "R\<lparr>carrier := S\<rparr>" "monom (UP (R\<lparr>carrier := S\<rparr>)) b n"] 0 by linarith
	+ have 3: "(monom (UP (R\<lparr>carrier := S\<rparr>)) b n) = monom P b n"
	+ using A assms unfolding P_def using UP_subring_monom by auto
	+ have 4: " b \<otimes> a [^] n = b \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a [^]\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> n"
	+ apply(induction n) using R.carrier_update[of S] apply simp
	+ using R.carrier_update[of S] R.nat_pow_consistent by auto
	+ hence 5: "to_function R (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = b \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a[^]\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub>n"
	+ using 0 1 2 3 assms A UP_cring.to_fun_monom[of "R\<lparr>carrier := S\<rparr>" b a n] UP_cring.to_fun_def[of "R\<lparr>carrier := S\<rparr>" "monom (UP (R\<lparr>carrier := S\<rparr>)) b n"]
	+ R.carrier_update[of S] subringE[of S R] a_closed UP_ring.monom_closed[of "R\<lparr>carrier := S\<rparr>" a n]
	+ to_fun_monom[of b a n]
	+ unfolding P_def UP_cring.to_fun_def to_fun_def by (metis subsetD)
	+ thus " to_function R (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = to_function (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a"
	+ using "1" "2" by auto
	+ qed
	+qed
	+
	+lemma(in UP_cring) UP_subring_eval':
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ shows "to_fun g a = to_function (R \<lparr> carrier := S \<rparr>) g a"
	+ unfolding to_fun_def using assms
	+ by (simp add: UP_subring_eval)
	+
	+lemma(in UP_cring) UP_subring_eval_closed:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ shows "to_fun g a \<in> S"
	+ using assms UP_subring_eval'[of S g a] UP_cring.to_fun_closed UP_cring.to_fun_def R.carrier_update(1) UP_ring_subring(1) by fastforce
	+
	+subsection\<open>Derivatives and Taylor Expansions over a Subring\<close>
	+
	+
	+lemma(in UP_cring) UP_subring_taylor:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "\<And>n. g n \<in> S"
	+ assumes "a \<in> S"
	+ shows "taylor_expansion R a g = taylor_expansion (R \<lparr> carrier := S \<rparr>) a g"
	+proof-
	+ have a_closed: "a \<in> carrier R"
	+ using assms subringE by blast
	+ have 0: "X_plus a \<in> carrier (UP R)"
	+ using assms X_plus_closed unfolding P_def
	+ using local.a_closed by auto
	+ have 1: "\<And>n. X_plus a n \<in> S"
	+ proof- fix n
	+ have "X_plus a n = (if n = 0 then a else
	+ (if n = 1 then \<one> else \<zero>))"
	+ using a_closed
	+ by (simp add: cfs_X_plus)
	+ then show "X_plus a n \<in> S" using subringE assms
	+ by (simp add: subringE(2) subringE(3))
	+ qed
	+ have 2: "(X_poly_plus (R\<lparr>carrier := S\<rparr>) a) = X_plus a"
	+ proof-
	+ have 20: "(X_poly_plus (R\<lparr>carrier := S\<rparr>) a) = (\<lambda>k. if k = (0::nat) then a else
	+ (if k = 1 then \<one> else \<zero>))"
	+ using a_closed assms UP_cring.cfs_X_plus[of "R\<lparr>carrier := S\<rparr>" a] R.carrier_update
	+ UP_ring_subring(1) by auto
	+ have 21: "X_plus a = (\<lambda>k. if k = (0::nat) then a else
	+ (if k = 1 then \<one> else \<zero>))"
	+ using cfs_X_plus[of a] a_closed
	+ by blast
	+ show ?thesis apply(rule ext) using 20 21
	+ by auto
	+ qed
	+ show ?thesis
	+ unfolding taylor_expansion_def using 0 1 2 assms UP_subring_compose[of S g "X_plus a"]
	+ by (simp add: UP_subring_compose)
	+qed
	+
	+lemma(in UP_cring) UP_subring_taylor_closed:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "\<And>n. g n \<in> S"
	+ assumes "a \<in> S"
	+ shows "taylor_expansion R a g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+proof-
	+ have "g \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ by (metis P_def R.carrier_update(1) R.carrier_update(2) UP_cring.UP_car_memI' UP_ring_subring(1) assms(1) assms(2) assms(3) deg_leE)
	+ then show ?thesis
	+ using assms UP_cring.taylor_def[of "R\<lparr>carrier := S\<rparr>"] UP_subring_taylor[of S g a]
	+ UP_cring.taylor_closed[of "R \<lparr> carrier := S \<rparr>" g a] UP_ring_subring(1)[of S] by simp
	+qed
	+
	+lemma(in UP_cring) UP_subring_taylor_closed':
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ shows "taylor_expansion R a g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using UP_subring_taylor_closed assms UP_cring.UP_car_memE[of "R \<lparr> carrier := S \<rparr>" g] R.carrier_update[of S]
	+ UP_ring_subring(1) UP_ring_subring_car_subset' by auto
	+
	+lemma(in UP_cring) UP_subring_taylor':
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "\<And>n. g n \<in> S"
	+ assumes "a \<in> S"
	+ shows "taylor_expansion R a g n \<in> S"
	+ using assms UP_subring_taylor R.carrier_update[of S] UP_cring.taylor_closed[of "R \<lparr> carrier := S \<rparr>"]
	+ using UP_cring.taylor_expansion_cf_closed UP_ring_subring(1) poly_cfs_subring by metis
	+
	+
	+lemma(in UP_cring) UP_subring_deriv:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ shows "deriv g a= UP_cring.deriv (R \<lparr> carrier := S \<rparr>) g a"
	+proof-
	+ have 0: "(\<And>n. g n \<in> S)"
	+ using assms UP_ring_subring_car by blast
	+ thus ?thesis
	+ unfolding derivative_def using 0 UP_ring_subring_car_subset[of S] assms UP_subring_taylor[of S g a]
	+ by (simp add: subset_iff)
	+qed
	+
	+lemma(in UP_cring) UP_subring_deriv_closed:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ shows "deriv g a \<in> S"
	+ using assms UP_cring.deriv_closed[of "R \<lparr> carrier := S \<rparr>" g a] UP_subring_deriv[of S g a]
	+ UP_ring_subring_car_subset[of S] UP_ring_subring[of S]
	+ by simp
	+
	+lemma(in UP_cring) poly_shift_subring_closed:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "poly_shift g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using UP_cring.poly_shift_closed[of "R \<lparr> carrier := S \<rparr>" g] assms UP_ring_subring[of S]
	+ by simp
	+
	+lemma(in UP_cring) UP_subring_taylor_appr:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ assumes "b \<in> S"
	+ shows "\<exists>c \<in> S. to_fun g a= to_fun g b \<oplus> (deriv g b)\<otimes> (a \<ominus> b) \<oplus> (c \<otimes> (a \<ominus> b)[^](2::nat))"
	+proof-
	+ have a_closed: "a \<in> carrier R"
	+ using assms subringE by blast
	+ have b_closed: "b \<in> carrier R"
	+ using assms subringE by blast
	+ have g_closed: " g \<in> carrier (UP R)"
	+ using UP_ring_subring_car_subset[of S] assms by blast
	+ have 0: "to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b) = to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b)"
	+ by simp
	+ have 1: "to_fun g b = to_fun g b"
	+ by simp
	+ have 2: "deriv g b = deriv g b"
	+ by simp
	+ have 3: "to_fun g a = to_fun g b \<oplus> deriv g b \<otimes> (a \<ominus> b) \<oplus> to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b) \<otimes> (a \<ominus> b) [^] (2::nat)"
	+ using taylor_deg_1_expansion[of g b a "to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b)" "to_fun g b" "deriv g b"]
	+ assms a_closed b_closed g_closed 0 1 2 unfolding P_def by blast
	+ have 4: "to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b) \<in> S"
	+ proof-
	+ have 0: "(2::nat) = Suc (Suc 0)"
	+ by simp
	+ have 1: "a \<ominus> b \<in> S"
	+ using assms unfolding a_minus_def
	+ by (simp add: subringE(5) subringE(7))
	+ have 2: "poly_shift (T\<^bsub>b\<^esub> g) \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ using poly_shift_subring_closed[of S "taylor_expansion R b g"] UP_ring_subring[of S]
	+ UP_subring_taylor_closed'[of S g b] assms unfolding taylor_def
	+ by blast
	+ hence 3: "poly_shift (poly_shift (T\<^bsub>b\<^esub> g)) \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
	+ using UP_cring.poly_shift_closed[of "R\<lparr>carrier := S\<rparr>" "(poly_shift (T\<^bsub>b\<^esub> g))"]
	+ unfolding taylor_def
	+ using assms(1) poly_shift_subring_closed by blast
	+ have 4: "to_fun (poly_shift (poly_shift (T\<^bsub>b\<^esub> g))) (a \<ominus> b) \<in> S"
	+ using 1 2 3 0 UP_subring_eval_closed[of S "poly_shift (poly_shift (T\<^bsub>b\<^esub> g))" "a \<ominus> b"]
	+ UP_cring.poly_shift_closed[of "R\<lparr>carrier := S\<rparr>"] assms
	+ by blast
	+ then show ?thesis
	+ by (simp add: numeral_2_eq_2)
	+ qed
	+ obtain c where c_def: "c = to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b)"
	+ by blast
	+ have 5: "c \<in> S \<and> to_fun g a = to_fun g b \<oplus> deriv g b \<otimes> (a \<ominus> b) \<oplus> c \<otimes> (a \<ominus> b) [^] (2::nat)"
	+ unfolding c_def using 3 4 by blast
	+ thus ?thesis using c_def 4 by blast
	+qed
	+
	+lemma(in UP_cring) UP_subring_taylor_appr':
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ assumes "a \<in> S"
	+ assumes "b \<in> S"
	+ shows "\<exists>c c' c''. c \<in> S \<and> c' \<in> S \<and> c'' \<in> S \<and> to_fun g a= c \<oplus> c'\<otimes> (a \<ominus> b) \<oplus> (c'' \<otimes> (a \<ominus> b)[^](2::nat))"
	+ using UP_subring_taylor_appr[of S g a b] assms UP_subring_deriv_closed[of S g b] UP_subring_eval_closed[of S g b]
	+ by blast
	+
	+lemma (in UP_cring) pderiv_cfs:
	+ assumes"g \<in> carrier (UP R)"
	+ shows "pderiv g n = [Suc n]\<cdot>(g (Suc n))"
	+ unfolding pderiv_def
	+ using n_mult_closed[of g] assms poly_shift_cfs[of "n_mult g" n]
	+ unfolding P_def n_mult_def by blast
	+
	+lemma(in ring) subring_add_pow:
	+ assumes "subring S R"
	+ assumes "a \<in> S"
	+ shows "[(n::nat)] \<cdot>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a = [(n::nat)] \<cdot>a"
	+proof-
	+ have 0: "a \<in> carrier R"
	+ using assms(1) assms(2) subringE(1) by blast
	+ have 1: "a \<in> carrier (R\<lparr>carrier := S\<rparr>)"
	+ by (simp add: assms(2))
	+ show ?thesis
	+ apply(induction n)
	+ using assms 0 1 carrier_update[of S]
	+ apply (simp add: add_pow_def)
	+ using assms 0 1 carrier_update[of S]
	+ by (simp add: add_pow_def)
	+qed
	+
	+lemma(in UP_cring) UP_subring_pderiv_equal:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "pderiv g = UP_cring.pderiv (R\<lparr>carrier := S\<rparr>) g"
	+proof fix n
	+ show "pderiv g n = UP_cring.pderiv (R\<lparr>carrier := S\<rparr>) g n"
	+ using UP_cring.pderiv_cfs[of "R \<lparr> carrier := S \<rparr>" g n] pderiv_cfs[of g n]
	+ assms R.subring_add_pow[of S "g (Suc n)" "Suc n"]
	+ by (simp add: UP_ring_subring(1) UP_ring_subring_car)
	+qed
	+
	+lemma(in UP_cring) UP_subring_pderiv_closed:
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ shows "pderiv g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
	+ using assms UP_cring.pderiv_closed[of "R \<lparr> carrier := S \<rparr>" g] R.carrier_update(1) UP_ring_subring(1)
	+UP_subring_pderiv_equal by auto
	+
	+lemma(in UP_cring) UP_subring_pderiv_closed':
	+ assumes "subring S R"
	+ assumes "g \<in> carrier (UP R)"
	+ assumes "\<And>n. g n \<in> S"
	+ shows "\<And>n. pderiv g n \<in> S"
	+ using assms UP_subring_pderiv_closed[of S g] poly_cfs_subring[of S g] UP_ring_subring_car
	+ by blast
	+
	+lemma(in UP_cring) taylor_deg_one_expansion_subring:
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "subring S R"
	+ assumes "\<And>i. f i \<in> S"
	+ assumes "a \<in> S"
	+ assumes "b \<in> S"
	+ shows "\<exists>c \<in> S. to_fun f b = (to_fun f a) \<oplus> (deriv f a) \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
	+ apply(rule UP_subring_taylor_appr, rule assms)
	+ using assms poly_cfs_subring apply blast
	+ by(rule assms, rule assms)
	+
	+lemma(in UP_cring) taylor_deg_one_expansion_subring':
	+ assumes "f \<in> carrier (UP R)"
	+ assumes "subring S R"
	+ assumes "\<And>i. f i \<in> S"
	+ assumes "a \<in> S"
	+ assumes "b \<in> S"
	+ shows "\<exists>c \<in> S. to_fun f b = (to_fun f a) \<oplus> (to_fun (pderiv f) a) \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
	+proof-
	+ have "S \<subseteq> carrier R"
	+ using assms subringE(1) by blast
	+ hence 0: "deriv f a = to_fun (pderiv f) a"
	+ using assms pderiv_eval_deriv[of f a] unfolding P_def by blast
	+ show ?thesis
	+ using assms taylor_deg_one_expansion_subring[of f S a b]
	+ unfolding 0 by blast
	+qed
	+
	+end
	diff --git a/thys/Padic_Ints/Extended_Int.thy b/thys/Padic_Ints/Extended_Int.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Extended_Int.thy
	@@ -0,0 +1,931 @@
	+
	+section \<open>Extended integers (i.e. with infinity)\<close>
	+
	+text\<open>
	+ This section formalizes the extended integers, which serve as the codomain for the $p$-adic
	+ valuation. The element $\infty$ is added to the integers to serve as a maximxal element in the
	+ order, which is the valuation of $0$.
	+\<close>
	+
	+theory Extended_Int
	+imports Main "HOL-Library.Countable" "HOL-Library.Order_Continuity" "HOL-Library.Extended_Nat"
	+begin
	+
	+text\<open>
	+ The following is based very closely on the theory \<^theory>\<open>HOL-Library.Extended_Nat\<close> from the
	+ standard Isabelle distribution, with adaptations made to formalize the integers extended with
	+ an element for infinity. This is the standard range for the valuation function on a discretely
	+ valued ring such as the field of $p$-adic numbers, such as in \cite{engler2005valued}.
	+\<close>
	+
	+context
	+ fixes f :: "nat \<Rightarrow> 'a::{canonically_ordered_monoid_add, linorder_topology, complete_linorder}"
	+begin
	+
	+lemma sums_SUP[simp, intro]: "f sums (SUP n. \<Sum>i<n. f i)"
	+ unfolding sums_def by (intro LIMSEQ_SUP monoI sum_mono2 zero_le) auto
	+
	+lemma suminf_eq_SUP: "suminf f = (SUP n. \<Sum>i<n. f i)"
	+ using sums_SUP by (rule sums_unique[symmetric])
	+
	+end
	+
	+subsection \<open>Type definition\<close>
	+
	+text \<open>
	+ We extend the standard natural numbers by a special value indicating
	+ infinity.
	+\<close>
	+
	+typedef eint = "UNIV :: int option set" ..
	+
	+
	+definition eint :: "int \<Rightarrow> eint" where
	+ "eint n = Abs_eint (Some n)"
	+
	+instantiation eint :: infinity
	+begin
	+
	+definition "\<infinity> = Abs_eint None"
	+instance ..
	+
	+end
	+
	+fun int_option_enumeration :: "int option \<Rightarrow> nat" where
	+"int_option_enumeration (Some n) = (if n \<ge> 0 then nat (2(n + 1)) else nat (2(-n) + 1))"\|
	+"int_option_enumeration None = (0::nat)"
	+
	+lemma int_option_enumeration_inj:
	+"inj int_option_enumeration"
	+proof
	+ have pos_even: "\<And>n::int. n \<ge> 0 \<Longrightarrow> even (int_option_enumeration (Some n)) \<and> (int_option_enumeration (Some n))> 0"
	+ proof-
	+ fix n::int assume "n \<ge>0" then have "(int_option_enumeration (Some n)) = nat (2*(n + 1))"
	+ by simp
	+ then show "even (int_option_enumeration (Some n)) \<and> 0 < int_option_enumeration (Some n)"
	+ by (smt \<open>0 \<le> n\<close> even_of_nat int_nat_eq oddE zero_less_nat_eq)
	+ qed
	+ have neg_odd: "\<And>n::int. n < 0 \<Longrightarrow> odd (int_option_enumeration (Some n))"
	+ by (smt evenE even_of_nat int_nat_eq int_option_enumeration.simps(1))
	+ fix x y assume A: "x \<in> UNIV" "y \<in> UNIV" "int_option_enumeration x = int_option_enumeration y"
	+ show "x = y"
	+ apply(cases "x = None")
	+ using A pos_even neg_odd
	+ apply (metis dvd_0_right int_option_enumeration.elims int_option_enumeration.simps(2) not_gr0 not_le)
	+ proof-
	+ assume "x \<noteq>None"
	+ then obtain n where n_def: "x = Some n"
	+ by auto
	+ then have y_not_None: "y \<noteq> None"
	+ using A
	+ by (metis \<open>\<And>thesis. (\<And>n. x = Some n \<Longrightarrow> thesis) \<Longrightarrow> thesis\<close>
	+ add_cancel_right_right even_add int_option_enumeration.simps(2)
	+ linorder_not_less neg_odd neq0_conv pos_even)
	+ then obtain m where m_def: "y = Some m"
	+ by blast
	+ show ?thesis
	+ proof(cases "n \<ge>0")
	+ case True
	+ then show ?thesis
	+ using n_def A neg_odd pos_even m_def int_option_enumeration.simps(1)
	+ by (smt int_nat_eq)
	+ next
	+ case False
	+ then show ?thesis
	+ using n_def A neg_odd pos_even m_def int_option_enumeration.simps(1)
	+ by (smt int_nat_eq)
	+ qed
	+ qed
	+qed
	+
	+definition eint_enumeration where
	+"eint_enumeration = int_option_enumeration \<circ> Rep_eint"
	+
	+lemma eint_enumeration_inj:
	+"inj eint_enumeration"
	+ unfolding eint_enumeration_def
	+ using int_option_enumeration_inj Rep_eint_inject
	+ by (metis (mono_tags, lifting) comp_apply injD inj_on_def)
	+
	+instance eint :: countable
	+proof
	+ show "\<exists>to_int::eint \<Rightarrow> nat. inj to_int"
	+ using eint_enumeration_inj by blast
	+qed
	+
	+old_rep_datatype eint "\<infinity> :: eint"
	+proof -
	+ fix P i assume "\<And>j. P (eint j)" "P \<infinity>"
	+ then show "P i"
	+ proof induct
	+ case (Abs_eint y) then show ?case
	+ by (cases y rule: option.exhaust)
	+ (auto simp: eint_def infinity_eint_def)
	+ qed
	+qed (auto simp add: eint_def infinity_eint_def Abs_eint_inject)
	+
	+declare [[coercion "eint::int\<Rightarrow>eint"]]
	+
	+lemmas eint2_cases = eint.exhaust[case_product eint.exhaust]
	+lemmas eint3_cases = eint.exhaust[case_product eint.exhaust eint.exhaust]
	+
	+lemma not_infinity_eq [iff]: "(x \<noteq> \<infinity>) = (\<exists>i. x = eint i)"
	+ by (cases x) auto
	+
	+lemma not_eint_eq [iff]: "(\<forall>y. x \<noteq> eint y) = (x = \<infinity>)"
	+ by (cases x) auto
	+
	+lemma eint_ex_split: "(\<exists>c::eint. P c) \<longleftrightarrow> P \<infinity> \<or> (\<exists>c::int. P c)"
	+ by (metis eint.exhaust)
	+
	+primrec the_eint :: "eint \<Rightarrow> int"
	+ where "the_eint (eint n) = n"
	+
	+
	+subsection \<open>Constructors and numbers\<close>
	+
	+instantiation eint :: zero_neq_one
	+begin
	+
	+definition
	+ "0 = eint 0"
	+
	+definition
	+ "1 = eint 1"
	+
	+instance
	+ proof qed (simp add: zero_eint_def one_eint_def)
	+
	+end
	+
	+
	+lemma eint_0 [code_post]: "eint 0 = 0"
	+ by (simp add: zero_eint_def)
	+
	+lemma eint_1 [code_post]: "eint 1 = 1"
	+ by (simp add: one_eint_def)
	+
	+lemma eint_0_iff: "eint x = 0 \<longleftrightarrow> x = 0" "0 = eint x \<longleftrightarrow> x = 0"
	+ by (auto simp add: zero_eint_def)
	+
	+lemma eint_1_iff: "eint x = 1 \<longleftrightarrow> x = 1" "1 = eint x \<longleftrightarrow> x = 1"
	+ by (auto simp add: one_eint_def)
	+
	+lemma infinity_ne_i0 [simp]: "(\<infinity>::eint) \<noteq> 0"
	+ by (simp add: zero_eint_def)
	+
	+lemma i0_ne_infinity [simp]: "0 \<noteq> (\<infinity>::eint)"
	+ by (simp add: zero_eint_def)
	+
	+lemma zero_one_eint_neq:
	+ "\<not> 0 = (1::eint)"
	+ "\<not> 1 = (0::eint)"
	+ unfolding zero_eint_def one_eint_def by simp_all
	+
	+lemma infinity_ne_i1 [simp]: "(\<infinity>::eint) \<noteq> 1"
	+ by (simp add: one_eint_def)
	+
	+lemma i1_ne_infinity [simp]: "1 \<noteq> (\<infinity>::eint)"
	+ by (simp add: one_eint_def)
	+
	+subsection \<open>Addition\<close>
	+
	+instantiation eint :: comm_monoid_add
	+begin
	+
	+definition [nitpick_simp]:
	+ "m + n = (case m of \<infinity> \<Rightarrow> \<infinity> \| eint m \<Rightarrow> (case n of \<infinity> \<Rightarrow> \<infinity> \| eint n \<Rightarrow> eint (m + n)))"
	+
	+lemma plus_eint_simps [simp, code]:
	+ fixes q :: eint
	+ shows "eint m + eint n = eint (m + n)"
	+ and "\<infinity> + q = \<infinity>"
	+ and "q + \<infinity> = \<infinity>"
	+ by (simp_all add: plus_eint_def split: eint.splits)
	+
	+instance
	+proof
	+ fix n m q :: eint
	+ show "n + m + q = n + (m + q)"
	+ by (cases n m q rule: eint3_cases) auto
	+ show "n + m = m + n"
	+ by (cases n m rule: eint2_cases) auto
	+ show "0 + n = n"
	+ by (cases n) (simp_all add: zero_eint_def)
	+qed
	+
	+end
	+
	+lemma eSuc_eint: "(eint n) + 1 = eint (n + 1)"
	+ by (simp add: one_eint_def)
	+
	+lemma eSuc_infinity [simp]: " \<infinity> + (1::eint) = \<infinity>"
	+ unfolding plus_eint_def
	+ by auto
	+
	+lemma eSuc_inject [simp]: " m + (1::eint)= n + 1 \<longleftrightarrow> m = n"
	+ unfolding plus_eint_def
	+ apply(cases "m = \<infinity>")
	+ apply (metis (no_types, lifting) eSuc_eint
	+ eint.distinct(2) eint.exhaust eint.simps(4) eint.simps(5) plus_eint_def)
	+ apply(cases "n = \<infinity>")
	+ using eSuc_eint plus_eint_def apply auto[1]
	+ unfolding one_eint_def
	+ using add.commute eSuc_eint
	+ by auto
	+
	+lemma eSuc_eint_iff: "x + 1 = eint y \<longleftrightarrow> (\<exists>n. y = n + 1 \<and> x = eint n)"
	+ apply(cases "x = \<infinity>")
	+ apply simp
	+ unfolding plus_eint_def one_eint_def
	+ using eSuc_eint
	+ by auto
	+
	+lemma enat_eSuc_iff: "eint y = x + 1 \<longleftrightarrow> (\<exists>n. y = n + 1 \<and> eint n = x)"
	+ using eSuc_eint_iff
	+ by metis
	+
	+lemma iadd_Suc: "((m::eint) + 1) + n = (m + n) + 1"
	+ by (metis ab_semigroup_add_class.add_ac(1) add.assoc add.commute)
	+
	+
	+lemma iadd_Suc_right: "(m::eint) + (n + 1) = (m + n) + 1"
	+ using add.assoc[of m n 1] by auto
	+
	+subsection \<open>Multiplication\<close>
	+
	+instantiation eint :: "{comm_semiring}"
	+begin
	+
	+definition times_eint_def [nitpick_simp]:
	+ "m * n = (case m of \<infinity> \<Rightarrow> \<infinity> \| eint m \<Rightarrow>
	+ (case n of \<infinity> \<Rightarrow> \<infinity> \| eint n \<Rightarrow> eint (m * n)))"
	+
	+lemma times_eint_simps [simp, code]:
	+ "eint m * eint n = eint (m * n)"
	+ "\<infinity> * \<infinity> = (\<infinity>::eint)"
	+ "\<infinity> * eint n = \<infinity>"
	+ "eint m * \<infinity> = \<infinity>"
	+ unfolding times_eint_def zero_eint_def
	+ by (simp_all split: eint.split)
	+
	+lemma sum_infinity_imp_summand_infinity:
	+ assumes "a + b = (\<infinity>::eint)"
	+ shows "a = \<infinity> \<or> b = \<infinity>"
	+ using assms
	+ by (metis not_eint_eq plus_eint_simps(1))
	+
	+lemma sum_finite_imp_summands_finite:
	+ assumes "a + b \<noteq> (\<infinity>::eint)"
	+ shows "a \<noteq> \<infinity>" "b \<noteq> \<infinity>"
	+ using assms eint.simps(5) apply fastforce
	+ using assms eint.simps(5) by fastforce
	+
	+
	+instance
	+proof
	+ fix a b c :: eint
	+ show "(a * b) * c = a * (b * c)"
	+ unfolding times_eint_def zero_eint_def
	+ by (simp split: eint.split)
	+ show comm: "a * b = b * a"
	+ unfolding times_eint_def zero_eint_def
	+ by (simp split: eint.split)
	+ show distr: "(a + b) * c = a * c + b * c"
	+ unfolding times_eint_def plus_eint_def
	+ apply(cases "a + b = \<infinity>")
	+ apply(cases "a = \<infinity>")
	+ apply simp
	+ using sum_infinity_imp_summand_infinity[of a b]
	+ apply (metis eint.simps(5) plus_eint_def plus_eint_simps(3))
	+ apply(cases "c = \<infinity>")
	+ apply (metis eint.exhaust plus_eint_def plus_eint_simps(3) times_eint_def times_eint_simps(4))
	+ using sum_finite_imp_summands_finite[of a b]
	+ apply auto
	+ by (simp add: semiring_normalization_rules(1))
	+qed
	+
	+
	+end
	+
	+lemma mult_one_right[simp]:
	+"(n::eint)*1 = n"
	+ apply(cases "n = \<infinity>")
	+ apply (simp add: one_eint_def)
	+ by (metis eint2_cases mult_cancel_left2 one_eint_def times_eint_simps(1))
	+
	+lemma mult_one_left[simp]:
	+"1*(n::eint) = n"
	+ by (metis mult.commute mult_one_right)
	+
	+lemma mult_eSuc: "((m::eint) + 1) * n = m * n + n"
	+ by (simp add: distrib_right)
	+
	+lemma mult_eSuc': "((m::eint) + 1) * n = n + m * n"
	+ using mult_eSuc add.commute by simp
	+
	+lemma mult_eSuc_right: "(m::eint) * (n + 1) = m * n + m "
	+ by(simp add: distrib_left)
	+
	+lemma mult_eSuc_right': "(m::eint) * (n + 1) = m + m * n "
	+ using mult_eSuc_right add.commute by simp
	+
	+
	+subsection \<open>Numerals\<close>
	+
	+lemma numeral_eq_eint:
	+ "numeral k = eint (numeral k)"
	+ by simp
	+
	+lemma eint_numeral [code_abbrev]:
	+ "eint (numeral k) = numeral k"
	+ using numeral_eq_eint ..
	+
	+lemma infinity_ne_numeral [simp]: "(\<infinity>::eint) \<noteq> numeral k"
	+ by auto
	+
	+lemma numeral_ne_infinity [simp]: "numeral k \<noteq> (\<infinity>::eint)"
	+ by simp
	+
	+subsection \<open>Subtraction\<close>
	+
	+instantiation eint :: minus
	+begin
	+
	+definition diff_eint_def:
	+"a - b = (case a of (eint x) \<Rightarrow> (case b of (eint y) \<Rightarrow> eint (x - y) \| \<infinity> \<Rightarrow> \<infinity>)
	+ \| \<infinity> \<Rightarrow> \<infinity>)"
	+
	+instance ..
	+
	+end
	+
	+
	+
	+
	+lemma idiff_eint_eint [simp, code]: "eint a - eint b = eint (a - b)"
	+ by (simp add: diff_eint_def)
	+
	+lemma idiff_infinity [simp, code]: "\<infinity> - n = (\<infinity>::eint)"
	+ by (simp add: diff_eint_def)
	+
	+lemma idiff_infinity_right [simp, code]: "eint a - \<infinity> = \<infinity>"
	+ by (simp add: diff_eint_def)
	+
	+lemma idiff_0 [simp]: "(0::eint) - n = -n"
	+ by (cases n, simp_all add: zero_eint_def)
	+
	+lemmas idiff_eint_0 [simp] = idiff_0 [unfolded zero_eint_def]
	+
	+lemma idiff_0_right [simp]: "(n::eint) - 0 = n"
	+ by (cases n) (simp_all add: zero_eint_def)
	+
	+lemmas idiff_eint_0_right [simp] = idiff_0_right [unfolded zero_eint_def]
	+
	+lemma idiff_self [simp]: "n \<noteq> \<infinity> \<Longrightarrow> (n::eint) - n = 0"
	+ by (auto simp: zero_eint_def)
	+
	+
	+lemma eSuc_minus_eSuc [simp]: "((n::eint) + 1) - (m + 1) = n - m"
	+ apply(cases "n = \<infinity>")
	+ apply simp
	+ apply(cases "m = \<infinity>")
	+ apply (metis eSuc_infinity eint.exhaust idiff_infinity_right infinity_ne_i1 sum_infinity_imp_summand_infinity)
	+proof-
	+ assume A: "n \<noteq>\<infinity>" "m \<noteq> \<infinity>"
	+ obtain a where a_def: "n = eint a"
	+ using A
	+ by auto
	+ obtain b where b_def: "m = eint b"
	+ using A
	+ by auto
	+ show ?thesis
	+ using idiff_eint_eint[of "a + 1" "b + 1"]
	+ idiff_eint_eint[of a b]
	+ by (simp add: a_def b_def eSuc_eint)
	+qed
	+
	+lemma eSuc_minus_1 [simp]: "((n::eint)+ 1) - 1 = n"
	+ using eSuc_minus_eSuc[of n 0]
	+ by auto
	+
	+
	+(lemmas idiff_self_eq_0_eint = idiff_self_eq_0[unfolded zero_eint_def])
	+
	+subsection \<open>Ordering\<close>
	+
	+instantiation eint :: linordered_ab_semigroup_add
	+begin
	+
	+definition [nitpick_simp]:
	+ "m \<le> n = (case n of eint n1 \<Rightarrow> (case m of eint m1 \<Rightarrow> m1 \<le> n1 \| \<infinity> \<Rightarrow> False)
	+ \| \<infinity> \<Rightarrow> True)"
	+
	+definition [nitpick_simp]:
	+ "m < n = (case m of eint m1 \<Rightarrow> (case n of eint n1 \<Rightarrow> m1 < n1 \| \<infinity> \<Rightarrow> True)
	+ \| \<infinity> \<Rightarrow> False)"
	+
	+lemma eint_ord_simps [simp]:
	+ "eint m \<le> eint n \<longleftrightarrow> m \<le> n"
	+ "eint m < eint n \<longleftrightarrow> m < n"
	+ "q \<le> (\<infinity>::eint)"
	+ "q < (\<infinity>::eint) \<longleftrightarrow> q \<noteq> \<infinity>"
	+ "(\<infinity>::eint) \<le> q \<longleftrightarrow> q = \<infinity>"
	+ "(\<infinity>::eint) < q \<longleftrightarrow> False"
	+ by (simp_all add: less_eq_eint_def less_eint_def split: eint.splits)
	+
	+lemma numeral_le_eint_iff[simp]:
	+ shows "numeral m \<le> eint n \<longleftrightarrow> numeral m \<le> n"
	+ by auto
	+
	+lemma numeral_less_eint_iff[simp]:
	+ shows "numeral m < eint n \<longleftrightarrow> numeral m < n"
	+ by simp
	+
	+lemma eint_ord_code [code]:
	+ "eint m \<le> eint n \<longleftrightarrow> m \<le> n"
	+ "eint m < eint n \<longleftrightarrow> m < n"
	+ "q \<le> (\<infinity>::eint) \<longleftrightarrow> True"
	+ "eint m < \<infinity> \<longleftrightarrow> True"
	+ "\<infinity> \<le> eint n \<longleftrightarrow> False"
	+ "(\<infinity>::eint) < q \<longleftrightarrow> False"
	+ by simp_all
	+
	+lemma eint_ord_plus_one[simp]:
	+ assumes "eint n \<le> x"
	+ assumes "x < y"
	+ shows "eint (n + 1) \<le> y"
	+proof-
	+ obtain m where "x = eint m"
	+ using assms(2)
	+ by fastforce
	+ show ?thesis apply(cases "y = \<infinity>")
	+ apply simp
	+ using \<open>x = eint m\<close> assms(1) assms(2)
	+ by force
	+qed
	+
	+instance
	+ by standard (auto simp add: less_eq_eint_def less_eint_def plus_eint_def split: eint.splits)
	+
	+end
	+
	+instance eint :: "{strict_ordered_comm_monoid_add}"
	+proof
	+ show "a < b \<Longrightarrow> c < d \<Longrightarrow> a + c < b + d" for a b c d :: eint
	+ by (cases a b c d rule: eint2_cases[case_product eint2_cases]) auto
	+qed
	+
	+(* BH: These equations are already proven generally for any type in
	+class linordered_semidom. However, eint is not in that class because
	+it does not have the cancellation property. Would it be worthwhile to
	+a generalize linordered_semidom to a new class that includes eint? *)
	+
	+lemma add_diff_assoc_eint: "z \<le> y \<Longrightarrow> x + (y - z) = x + y - (z::eint)"
	+by(cases x)(auto simp add: diff_eint_def split: eint.split)
	+
	+lemma eint_ord_number [simp]:
	+ "(numeral m :: eint) \<le> numeral n \<longleftrightarrow> (numeral m :: nat) \<le> numeral n"
	+ "(numeral m :: eint) < numeral n \<longleftrightarrow> (numeral m :: nat) < numeral n"
	+ apply simp
	+ by simp
	+
	+lemma infinity_ileE [elim!]: "\<infinity> \<le> eint m \<Longrightarrow> R"
	+ by simp
	+
	+lemma infinity_ilessE [elim!]: "\<infinity> < eint m \<Longrightarrow> R"
	+ by simp
	+
	+lemma imult_infinity: "(0::eint) < n \<Longrightarrow> \<infinity> * n = \<infinity>"
	+ by (simp add: zero_eint_def less_eint_def split: eint.splits)
	+
	+lemma imult_infinity_right: "(0::eint) < n \<Longrightarrow> n * \<infinity> = \<infinity>"
	+ by (simp add: zero_eint_def less_eint_def split: eint.splits)
	+
	+lemma min_eint_simps [simp]:
	+ "min (eint m) (eint n) = eint (min m n)"
	+ "min q (\<infinity>::eint) = q"
	+ "min (\<infinity>::eint) q = q"
	+ by (auto simp add: min_def)
	+
	+lemma max_eint_simps [simp]:
	+ "max (eint m) (eint n) = eint (max m n)"
	+ "max q \<infinity> = (\<infinity>::eint)"
	+ "max \<infinity> q = (\<infinity>::eint)"
	+ by (simp_all add: max_def)
	+
	+lemma eint_ile: "n \<le> eint m \<Longrightarrow> \<exists>k. n = eint k"
	+ by (cases n) simp_all
	+
	+lemma eint_iless: "n < eint m \<Longrightarrow> \<exists>k. n = eint k"
	+ by (cases n) simp_all
	+
	+lemma iadd_le_eint_iff:
	+ "x + y \<le> eint n \<longleftrightarrow> (\<exists>y' x'. x = eint x' \<and> y = eint y' \<and> x' + y' \<le> n)"
	+by(cases x y rule: eint.exhaust[case_product eint.exhaust]) simp_all
	+
	+lemma chain_incr: "\<forall>i. \<exists>j. Y i < Y j \<Longrightarrow> \<exists>j. eint k < Y j"
	+proof-
	+ assume A: "\<forall>i. \<exists>j. Y i < Y j"
	+ then have "\<forall>i. \<exists>n::int. Y i = eint n"
	+ by (metis eint.exhaust eint_ord_simps(6))
	+ then obtain i n where in_def: "Y (i::'a) = eint n"
	+ by blast
	+ show "\<exists>j. eint k < Y j"
	+ proof(rule ccontr)
	+ assume C: "\<not>(\<exists>j. eint k < Y j)"
	+ then have C':"\<forall>j. Y j \<le> eint k"
	+ using le_less_linear
	+ by blast
	+ then have "Y (i::'a) \<le> eint k"
	+ by simp
	+ have "\<And>m::nat. \<exists>j::'a. Y j \<ge> eint (n + int m)"
	+ proof- fix m
	+ show "\<exists>j::'a. Y j \<ge> eint (n + int m)"
	+ apply(induction m)
	+ apply (metis in_def int_ops(1) order_refl plus_int_code(1))
	+ proof- fix m
	+ assume "\<exists>j. eint (n + int m) \<le> Y j"
	+ then obtain j where j_def: "eint (n + int m) \<le> Y j"
	+ by blast
	+ obtain j' where j'_def: "Y j < Y j'"
	+ using A by blast
	+ have "eint (n + int (Suc m)) = eint (n + m + 1)"
	+ by auto
	+ then have "eint (n + int (Suc m)) \<le> Y j'"
	+ using j_def j'_def eint_ord_plus_one[of "n + m" "Y j" "Y j'"]
	+ by presburger
	+ then show "\<exists>j. eint (n + int (Suc m)) \<le> Y j"
	+ by blast
	+ qed
	+ qed
	+ then show False
	+ by (metis A C \<open>Y i \<le> eint k\<close> eint_ord_simps(1) in_def
	+ order.not_eq_order_implies_strict zle_iff_zadd)
	+ qed
	+qed
	+
	+lemma eint_ord_Suc:
	+ assumes "(x::eint) < y"
	+ shows "x + 1 < y + 1"
	+ apply(cases "y = \<infinity>")
	+ using assms i1_ne_infinity sum_infinity_imp_summand_infinity
	+ apply fastforce
	+ by (metis add_mono_thms_linordered_semiring(3) assms eSuc_inject order_less_le)
	+
	+lemma eSuc_ile_mono [simp]: "(n::eint) + 1 \<le> m+ 1 \<longleftrightarrow> n \<le> m"
	+ by (meson add_mono_thms_linordered_semiring(3) eint_ord_Suc linorder_not_le)
	+
	+lemma eSuc_mono [simp]: "(n::eint) + 1 < m+ 1 \<longleftrightarrow> n < m"
	+ by (meson add_mono_thms_linordered_semiring(3) eint_ord_Suc linorder_not_le)
	+
	+lemma ile_eSuc [simp]: "(n::eint) \<le> n + 1"
	+ by (metis add.right_neutral add_left_mono eint_1_iff(2) eint_ord_code(1) linear not_one_le_zero zero_eint_def)
	+
	+lemma ileI1: "(m::eint) < n \<Longrightarrow> m + 1 \<le> n"
	+ by (metis eSuc_eint eint.exhaust eint_ex_split eint_iless eint_ord_Suc eint_ord_code(6)
	+ eint_ord_plus_one eint_ord_simps(3) less_le_trans linear )
	+
	+lemma Suc_ile_eq: "eint (m +1) \<le> n \<longleftrightarrow> eint m < n"
	+ by (cases n) auto
	+
	+lemma iless_Suc_eq [simp]: "eint m < n + 1 \<longleftrightarrow> eint m \<le> n"
	+ by (metis Suc_ile_eq eSuc_eint eSuc_ile_mono)
	+
	+lemma eSuc_max: "(max (x::eint) y) + 1 = max (x+1) (y+1)"
	+ by (simp add: max_def)
	+
	+lemma eSuc_Max:
	+ assumes "finite A" "A \<noteq> ({}::eint set)"
	+ shows " (Max A) + 1 = Max ((+)1 ` A)"
	+using assms proof induction
	+ case (insert x A)
	+ thus ?case
	+ using Max_insert[of A x] Max_singleton[of x] add.commute[of 1] eSuc_max finite_imageI
	+ image_insert image_is_empty
	+ by (simp add: add.commute hom_Max_commute)
	+qed simp
	+
	+instantiation eint :: "{order_top}"
	+begin
	+
	+definition top_eint :: eint where "top_eint = \<infinity>"
	+
	+instance
	+ by standard (simp add: top_eint_def)
	+
	+end
	+
	+lemma finite_eint_bounded:
	+ assumes le_fin: "\<And>y. y \<in> A \<Longrightarrow> eint m \<le> y \<and> y \<le> eint n"
	+ shows "finite A"
	+proof (rule finite_subset)
	+ show "finite (eint ` {m..n})" by blast
	+ have "A \<subseteq> {eint m..eint n}" using le_fin by fastforce
	+ also have "\<dots> \<subseteq> eint ` {m..n}"
	+ apply (rule subsetI)
	+ subgoal for x by (cases x) auto
	+ done
	+ finally show "A \<subseteq> eint ` {m..n}" .
	+qed
	+
	+
	+subsection \<open>Cancellation simprocs\<close>
	+
	+lemma add_diff_cancel_eint[simp]: "x \<noteq> \<infinity> \<Longrightarrow> x + y - x = (y::eint)"
	+by (metis add.commute add.right_neutral add_diff_assoc_eint idiff_self order_refl)
	+
	+lemma eint_add_left_cancel: "a + b = a + c \<longleftrightarrow> a = (\<infinity>::eint) \<or> b = c"
	+ unfolding plus_eint_def by (simp split: eint.split)
	+
	+lemma eint_add_left_cancel_le: "a + b \<le> a + c \<longleftrightarrow> a = (\<infinity>::eint) \<or> b \<le> c"
	+ unfolding plus_eint_def by (simp split: eint.split)
	+
	+lemma eint_add_left_cancel_less: "a + b < a + c \<longleftrightarrow> a \<noteq> (\<infinity>::eint) \<and> b < c"
	+ unfolding plus_eint_def by (simp split: eint.split)
	+
	+lemma plus_eq_infty_iff_eint: "(m::eint) + n = \<infinity> \<longleftrightarrow> m=\<infinity> \<or> n=\<infinity>"
	+using eint_add_left_cancel by fastforce
	+
	+ML \<open>
	+structure Cancel_Enat_Common =
	+struct
	+ (* copied from src/HOL/Tools/nat_numeral_simprocs.ML *)
	+ fun find_first_t _ _ [] = raise TERM("find_first_t", [])
	+ \| find_first_t past u (t::terms) =
	+ if u aconv t then (rev past @ terms)
	+ else find_first_t (t::past) u terms
	+
	+ fun dest_summing (Const (\<^const_name>\<open>Groups.plus\<close>, _) $ t $ u, ts) =
	+ dest_summing (t, dest_summing (u, ts))
	+ \| dest_summing (t, ts) = t :: ts
	+
	+ val mk_sum = Arith_Data.long_mk_sum
	+ fun dest_sum t = dest_summing (t, [])
	+ val find_first = find_first_t []
	+ val trans_tac = Numeral_Simprocs.trans_tac
	+ val norm_ss =
	+ simpset_of (put_simpset HOL_basic_ss \<^context>
	+ addsimps @{thms ac_simps add_0_left add_0_right})
	+ fun norm_tac ctxt = ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
	+ fun simplify_meta_eq ctxt cancel_th th =
	+ Arith_Data.simplify_meta_eq [] ctxt
	+ ([th, cancel_th] MRS trans)
	+ fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
	+end
	+
	+structure Eq_Enat_Cancel = ExtractCommonTermFun
	+(open Cancel_Enat_Common
	+ val mk_bal = HOLogic.mk_eq
	+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> \<^typ>\<open>eint\<close>
	+ fun simp_conv _ _ = SOME @{thm eint_add_left_cancel}
	+)
	+
	+structure Le_Enat_Cancel = ExtractCommonTermFun
	+(open Cancel_Enat_Common
	+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
	+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> \<^typ>\<open>eint\<close>
	+ fun simp_conv _ _ = SOME @{thm eint_add_left_cancel_le}
	+)
	+
	+structure Less_Enat_Cancel = ExtractCommonTermFun
	+(open Cancel_Enat_Common
	+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
	+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> \<^typ>\<open>eint\<close>
	+ fun simp_conv _ _ = SOME @{thm eint_add_left_cancel_less}
	+)
	+\<close>
	+
	+simproc_setup eint_eq_cancel
	+ ("(l::eint) + m = n" \| "(l::eint) = m + n") =
	+ \<open>fn phi => fn ctxt => fn ct => Eq_Enat_Cancel.proc ctxt (Thm.term_of ct)\<close>
	+
	+simproc_setup eint_le_cancel
	+ ("(l::eint) + m \<le> n" \| "(l::eint) \<le> m + n") =
	+ \<open>fn phi => fn ctxt => fn ct => Le_Enat_Cancel.proc ctxt (Thm.term_of ct)\<close>
	+
	+simproc_setup eint_less_cancel
	+ ("(l::eint) + m < n" \| "(l::eint) < m + n") =
	+ \<open>fn phi => fn ctxt => fn ct => Less_Enat_Cancel.proc ctxt (Thm.term_of ct)\<close>
	+
	+text \<open>TODO: add regression tests for these simprocs\<close>
	+
	+text \<open>TODO: add simprocs for combining and cancelling numerals\<close>
	+
	+subsection \<open>Well-ordering\<close>
	+
	+lemma less_eintE:
	+ "[\| n < eint m; !!k. n = eint k ==> k < m ==> P \|] ==> P"
	+by (induct n) auto
	+
	+lemma less_infinityE:
	+ "[\| n < \<infinity>; !!k. n = eint k ==> P \|] ==> P"
	+by (induct n) auto
	+
	+
	+subsection \<open>Traditional theorem names\<close>
	+
	+lemmas eint_defs = zero_eint_def one_eint_def
	+ plus_eint_def less_eq_eint_def less_eint_def
	+
	+instantiation eint :: uminus
	+begin
	+
	+definition
	+"- b = (case b of \<infinity> \<Rightarrow> \<infinity> \| eint m \<Rightarrow> eint (-m))"
	+
	+lemma eint_uminus_eq:
	+"(a::eint) + (-a) = a - a"
	+ apply(induction a)
	+ apply (simp add: uminus_eint_def)
	+ by simp
	+
	+
	+
	+
	+instance..
	+end
	+
	+section\<open>Additional Lemmas (Useful for the Proof of Hensel's Lemma)\<close>
	+
	+lemma eint_mult_mono:
	+ assumes "(c::eint) > 0 \<and> c \<noteq> \<infinity>"
	+ assumes "k > n"
	+ shows "kc > nc"
	+ using assms apply(induction k, induction n, induction c)
	+ by(auto simp add: zero_eint_def)
	+
	+lemma eint_mult_mono':
	+ assumes "(c::eint) \<ge> 0 \<and> c \<noteq> \<infinity>"
	+ assumes "k > n"
	+ shows "kc \<ge> nc"
	+ apply(cases "c = 0")
	+ apply (metis add.right_neutral assms(2) eint_add_left_cancel eint_ord_code(3)
	+ eint_ord_simps(4) eq_iff less_le_trans mult.commute mult_eSuc_right'
	+ mult_one_right not_less times_eint_simps(4) zero_eint_def)
	+ using assms eint_mult_mono
	+ by (simp add: le_less)
	+
	+lemma eint_minus_le:
	+ assumes "(b::eint) < c"
	+ shows "c - b > 0"
	+ using assms apply(induction b, induction c)
	+ by (auto simp add: zero_eint_def)
	+
	+lemma eint_nat_times:
	+ assumes "(c::eint) > 0"
	+ shows "(Suc n)*(c::eint) > 0"
	+ using assms apply(induction c)
	+ apply (simp add: zero_eint_def)
	+ by simp
	+
	+lemma eint_pos_times_is_pos:
	+ assumes "(c::eint) > 0"
	+ assumes "b > 0"
	+ shows "b*c > 0"
	+ using assms apply(induction c, induction b)
	+ by(auto simp add: zero_eint_def imult_infinity_right)
	+
	+lemma eint_nat_is_pos:
	+"eint (Suc n) > 0"
	+ by (simp add: zero_eint_def)
	+
	+lemma eint_pow_int_is_pos:
	+ assumes "n > 0"
	+ shows "eint n > 0"
	+ using assms by (simp add: zero_eint_def)
	+
	+lemma eint_nat_times':
	+ assumes "(c::eint) \<ge> 0"
	+ shows "(Suc n)*c \<ge> 0"
	+ using assms zero_eint_def by fastforce
	+
	+lemma eint_pos_int_times_ge:
	+ assumes "(c::eint) \<ge> 0"
	+ assumes "n > 0"
	+ shows "eint n * c \<ge> c"
	+ using assms apply(induction c)
	+ apply (smt eSuc_eint eint.distinct(2) eint_mult_mono' eint_pow_int_is_pos eq_iff ileI1 less_le mult.commute mult_one_right one_eint_def zero_eint_def)
	+ by simp
	+
	+lemma eint_pos_int_times_gt:
	+ assumes "(c::eint) > 0"
	+ assumes "c \<noteq>\<infinity>"
	+ assumes "n > 1"
	+ shows "eint n * c > c"
	+ using assms eint_mult_mono[of c 1 "eint n"]
	+ by (metis eint_ord_simps(2) mult_one_left one_eint_def)
	+
	+lemma eint_add_cancel_fact[simp]:
	+ assumes "(c::eint) \<noteq> \<infinity>"
	+ shows "c + (b - c) = b"
	+ using assms apply(induction c, induction b)
	+ by auto
	+
	+lemma nat_mult_not_infty[simp]:
	+ assumes "c \<noteq> \<infinity>"
	+ shows "(eint n) * c \<noteq> \<infinity>"
	+ using assms by auto
	+
	+lemma eint_minus_distl:
	+ assumes "(b::eint) \<noteq> d"
	+ shows "bc - dc = (b-d)*c"
	+ using assms apply(induction c, induction b, induction d)
	+ apply (metis add_diff_cancel_eint distrib_right eint.distinct(2) eint_add_cancel_fact nat_mult_not_infty)
	+ apply simp
	+ apply simp
	+ by (simp add: mult.commute times_eint_def)
	+
	+lemma eint_minus_distr:
	+ assumes "(b::eint) \<noteq> d"
	+ shows "c(b - d) = cb - c*d"
	+ by (metis assms eint_minus_distl mult.commute)
	+
	+lemma eint_int_minus_distr:
	+"(eint n)c - (eint m)c = eint (n - m) * c"
	+ by (metis add.right_neutral distrib_right eint_add_left_cancel eint_minus_distl idiff_eint_eint
	+ idiff_infinity idiff_self infinity_ne_i0 nat_mult_not_infty not_eint_eq times_eint_simps(4))
	+
	+lemma eint_2_minus_1_mult[simp]:
	+"2*(b::eint) - b = b"
	+proof -
	+ have "\<forall>e. (\<infinity>::eint) * e = \<infinity>"
	+ by (simp add: times_eint_def)
	+ then show ?thesis
	+ by (metis add_diff_cancel_eint idiff_infinity mult.commute mult_eSuc_right' mult_one_right one_add_one one_eint_def plus_eint_simps(1))
	+qed
	+
	+lemma eint_minus_comm:
	+"(d::eint) + b - c = d - c + b"
	+apply(induction c )
	+ apply (metis add.assoc add_diff_cancel_eint eint.distinct(2) eint_add_cancel_fact)
	+ apply(induction d)
	+ apply (metis distrib_left eint2_cases eint_minus_distl i1_ne_infinity idiff_infinity_right
	+ mult_one_left plus_eq_infty_iff_eint sum_infinity_imp_summand_infinity times_eint_simps(3))
	+ apply(induction b)
	+ apply simp
	+ by simp
	+
	+lemma ge_plus_pos_imp_gt:
	+ assumes "(c::eint) \<noteq>\<infinity>"
	+ assumes "(b::eint) > 0"
	+ assumes "d \<ge> c + b"
	+ shows "d > c"
	+ using assms apply(induction d, induction c)
	+ apply (metis add.comm_neutral assms(2) eint_add_left_cancel_less less_le_trans)
	+ apply blast
	+ by simp
	+
	+lemma eint_minus_ineq:
	+ assumes "(c::eint) \<noteq>\<infinity>"
	+ assumes "b \<ge> d"
	+ shows "b - c \<ge> d - c"
	+ by (metis add_left_mono antisym assms(1) assms(2) eint_add_cancel_fact linear)
	+
	+lemma eint_minus_ineq':
	+ assumes "(c::eint) \<noteq>\<infinity>"
	+ assumes "b \<ge> d"
	+ assumes "(e::eint) > 0"
	+ assumes "e \<noteq> \<infinity>"
	+ shows "e(b - c) \<ge> e(d - c)"
	+ using assms eint_minus_ineq
	+ by (metis eint_mult_mono' eq_iff less_le mult.commute)
	+
	+lemma eint_minus_ineq'':
	+ assumes "(c::eint) \<noteq>\<infinity>"
	+ assumes "b \<ge> d"
	+ assumes "(e::eint) > 0"
	+ assumes "e \<noteq> \<infinity>"
	+ shows "e(b - c) \<ge> ed - e*c"
	+ using assms eint_minus_ineq'
	+ proof -
	+ have "\<forall>e. (0::eint) + e = e"
	+ by simp
	+ then have f1: "e * 0 = 0"
	+ by (metis add_diff_cancel_eint assms(4) idiff_self mult_eSuc_right' mult_one_right)
	+ have "\<infinity> \<noteq> c * e"
	+ using assms(1) assms(4) eint_pos_times_is_pos by auto
	+ then show ?thesis
	+ using f1 by (metis assms(1) assms(2) assms(3) assms(4) eint_minus_distl eint_minus_ineq' idiff_self mult.commute)
	+ qed
	+
	+lemma eint_min_ineq:
	+ assumes "(b::eint) \<ge> min c d"
	+ assumes "c > e"
	+ assumes "d > e"
	+ shows "b > e"
	+ by (meson assms(1) assms(2) assms(3) less_le_trans min_le_iff_disj)
	+
	+lemma eint_plus_times:
	+ assumes "(d::eint) \<ge> 0"
	+ assumes "(b::eint) \<ge> c + (eint k)*d"
	+ assumes "k \<ge> l"
	+ shows "b \<ge> c + l*d"
	+proof-
	+ have "kd \<ge> ld"
	+ by (smt assms(1) assms(3) eint_mult_mono' eint_ord_simps(2) eq_iff times_eint_simps(4))
	+ thus ?thesis
	+ by (meson add_mono_thms_linordered_semiring(2) assms(2) order_subst2)
	+qed
	+end
	+
	diff --git a/thys/Padic_Ints/Function_Ring.thy b/thys/Padic_Ints/Function_Ring.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Function_Ring.thy
	@@ -0,0 +1,1250 @@
	+theory Function_Ring
	+ imports "HOL-Algebra.Ring" "HOL-Library.FuncSet" "HOL-Algebra.Module"
	+begin
	+
	+text\<open>
	+ This theory formalizes basic facts about the ring of extensional functions from a fixed set to
	+ a fixed ring. This will be useful for providing a generic framework for various constructions
	+ related to the $p$-adics such as polynomial evaluation and sequences. The rings of semialgebraic
	+ functions will be defined as subrings of these function rings, which will be necessary for the
	+ proof of $p$-adic quantifier elimination.
	+\<close>
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>The Ring of Extensional Functions from a Fixed Base Set to a Fixed Base Ring\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Basic Operations on Extensional Functions\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+definition function_mult:: "'c set \<Rightarrow> ('a, 'b) ring_scheme \<Rightarrow> ('c \<Rightarrow> 'a) \<Rightarrow> ('c \<Rightarrow> 'a) \<Rightarrow> ('c \<Rightarrow> 'a)" where
	+"function_mult S R f g = (\<lambda>x \<in> S. (f x) \<otimes>\<^bsub>R\<^esub> (g x))"
	+
	+abbreviation(input) ring_function_mult:: "('a, 'b) ring_scheme \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)" where
	+"ring_function_mult R f g \<equiv> function_mult (carrier R) R f g"
	+
	+definition function_add:: "'c set \<Rightarrow> ('a, 'b) ring_scheme \<Rightarrow> ('c \<Rightarrow> 'a) \<Rightarrow> ('c \<Rightarrow> 'a) \<Rightarrow> ('c \<Rightarrow> 'a)" where
	+"function_add S R f g = (\<lambda>x \<in> S. (f x) \<oplus>\<^bsub>R\<^esub> (g x))"
	+
	+abbreviation(input) ring_function_add:: "('a, 'b) ring_scheme \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)" where
	+"ring_function_add R f g \<equiv> function_add (carrier R) R f g"
	+
	+definition function_one:: "'c set \<Rightarrow> ('a, 'b) ring_scheme \<Rightarrow> ('c \<Rightarrow> 'a)" where
	+"function_one S R = (\<lambda>x \<in> S. \<one>\<^bsub>R\<^esub>)"
	+
	+abbreviation(input) ring_function_one :: "('a, 'b) ring_scheme \<Rightarrow> ('a \<Rightarrow> 'a)" where
	+"ring_function_one R \<equiv> function_one (carrier R) R"
	+
	+definition function_zero:: "'c set \<Rightarrow> ('a, 'b) ring_scheme \<Rightarrow> ('c \<Rightarrow> 'a)" where
	+"function_zero S R = (\<lambda>x \<in> S. \<zero>\<^bsub>R\<^esub>)"
	+
	+abbreviation(input) ring_function_zero :: "('a, 'b) ring_scheme \<Rightarrow> ('a \<Rightarrow> 'a)" where
	+"ring_function_zero R \<equiv> function_zero (carrier R) R"
	+
	+definition function_uminus:: "'c set \<Rightarrow> ('a, 'b) ring_scheme \<Rightarrow> ('c \<Rightarrow> 'a) \<Rightarrow> ('c \<Rightarrow> 'a)" where
	+"function_uminus S R a = (\<lambda> x \<in> S. \<ominus>\<^bsub>R\<^esub> (a x))"
	+
	+definition ring_function_uminus:: " ('a, 'b) ring_scheme \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)" where
	+"ring_function_uminus R a = function_uminus (carrier R) R a"
	+
	+definition function_scalar_mult:: "'c set \<Rightarrow> ('a, 'b) ring_scheme \<Rightarrow> 'a \<Rightarrow> ('c \<Rightarrow> 'a) \<Rightarrow> ('c \<Rightarrow> 'a)" where
	+"function_scalar_mult S R a f = (\<lambda> x \<in> S. a \<otimes>\<^bsub>R\<^esub> (f x))"
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Defining the Ring of Extensional Functions\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+definition function_ring:: "'c set \<Rightarrow> ('a, 'b) ring_scheme \<Rightarrow> ( 'a, 'c \<Rightarrow> 'a) module" where
	+"function_ring S R = \<lparr>
	+ carrier = extensional_funcset S (carrier R),
	+ Group.monoid.mult = (function_mult S R),
	+ one = (function_one S R),
	+ zero = (function_zero S R),
	+ add = (function_add S R),
	+ smult = function_scalar_mult S R \<rparr> "
	+
	+text\<open>The following locale consists of a struct R, and a distinguished set S which is meant to serve as the domain for a ring of functions $S \to carrier R$. \<close>
	+locale struct_functions =
	+ fixes R ::"('a, 'b) partial_object_scheme" (structure)
	+ and S :: "'c set"
	+
	+text\<open>The following are locales which fix a ring R (which may be commutative, a domain, or a field) and a function ring F of extensional functions from a fixed set S to $carrier R$\<close>
	+locale ring_functions = struct_functions + R?: ring R +
	+ fixes F (structure)
	+ defines F_def: "F \<equiv> function_ring S R"
	+
	+locale cring_functions = ring_functions + R?: cring R
	+
	+locale domain_functions = ring_functions + R?: domain R
	+
	+locale field_functions = ring_functions + R?: field R
	+
	+sublocale cring_functions < ring_functions
	+ apply (simp add: ring_functions_axioms)
	+ by (simp add: F_def)
	+
	+sublocale domain_functions < ring_functions
	+ apply (simp add: ring_functions_axioms)
	+ by (simp add: F_def)
	+
	+sublocale domain_functions < cring_functions
	+ apply (simp add: cring_functions_def is_cring ring_functions_axioms)
	+ by (simp add: F_def)
	+
	+sublocale field_functions < domain_functions
	+ apply (simp add: domain_axioms domain_functions_def ring_functions_axioms)
	+ by (simp add: F_def)
	+
	+sublocale field_functions < ring_functions
	+ apply (simp add: ring_functions_axioms)
	+ by (simp add: F_def)
	+
	+sublocale field_functions < cring_functions
	+ apply (simp add: cring_functions_axioms)
	+ by (simp add: F_def)
	+
	+abbreviation(input) ring_function_ring:: "('a, 'b) ring_scheme \<Rightarrow> ('a, 'a \<Rightarrow> 'a) module" ("Fun") where
	+"ring_function_ring R \<equiv> function_ring (carrier R) R"
	+
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Algebraic Properties of the Basic Operations\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Basic Carrier Facts\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_ring_defs:
	+"carrier F = extensional_funcset S (carrier R)"
	+"(\<otimes>\<^bsub>F\<^esub>) = (function_mult S R)"
	+"(\<oplus>\<^bsub>F\<^esub>) = (function_add S R)"
	+"\<one>\<^bsub>F\<^esub> = function_one S R"
	+"\<zero>\<^bsub>F\<^esub> = function_zero S R"
	+"(\<odot>\<^bsub>F\<^esub>) = function_scalar_mult S R"
	+ unfolding F_def
	+ by ( auto simp add: function_ring_def)
	+
	+lemma(in ring_functions) function_ring_car_memE:
	+ assumes "a \<in> carrier F"
	+ shows "a \<in> extensional S"
	+ "a \<in> S \<rightarrow> carrier R"
	+ using assms function_ring_defs apply auto[1]
	+ using assms function_ring_defs PiE_iff apply blast
	+ using assms function_ring_defs(1) by fastforce
	+
	+lemma(in ring_functions) function_ring_car_closed:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ shows "f a \<in> carrier R"
	+ using assms unfolding function_ring_def F_def by auto
	+
	+lemma(in ring_functions) function_ring_not_car:
	+ assumes "a \<notin> S"
	+ assumes "f \<in> carrier F"
	+ shows "f a = undefined"
	+ using assms unfolding function_ring_def F_def by auto
	+
	+lemma(in ring_functions) function_ring_car_eqI:
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ assumes "\<And>a. a \<in> S \<Longrightarrow> f a = g a"
	+ shows "f = g"
	+ using assms(1) assms(2) assms(3) extensionalityI function_ring_car_memE(1) by blast
	+
	+lemma(in ring_functions) function_ring_car_memI:
	+ assumes "\<And>a. a \<in> S \<Longrightarrow> f a \<in> carrier R"
	+ assumes "\<And> a. a \<notin> S\<Longrightarrow> f a = undefined"
	+ shows "f \<in> carrier F"
	+ using function_ring_defs assms
	+ unfolding extensional_funcset_def
	+ by (simp add: \<open>\<And>a. a \<in> S \<Longrightarrow> f a \<in> carrier R\<close> extensional_def)
	+
	+lemma(in ring) function_ring_car_memI:
	+ assumes "\<And>a. a \<in> S \<Longrightarrow> f a \<in> carrier R"
	+ assumes "\<And> a. a \<notin> S\<Longrightarrow> f a = undefined"
	+ shows "f \<in> carrier (function_ring S R)"
	+ by (simp add: assms(1) assms(2) local.ring_axioms ring_functions.function_ring_car_memI ring_functions.intro)
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Basic Multiplication Facts\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_mult_eval_car:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ shows "(f \<otimes>\<^bsub>F\<^esub> g) a = (f a) \<otimes> (g a)"
	+ using assms function_ring_defs
	+ unfolding function_mult_def
	+ by simp
	+
	+lemma(in ring_functions) function_mult_eval_closed:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ shows "(f \<otimes>\<^bsub>F\<^esub> g) a \<in> carrier R"
	+ using assms function_mult_eval_car
	+ using F_def ring_functions.function_ring_car_closed ring_functions_axioms by fastforce
	+
	+lemma(in ring_functions) fun_mult_closed:
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ shows "f \<otimes>\<^bsub>F\<^esub> g \<in> carrier F"
	+ apply(rule function_ring_car_memI)
	+ apply (simp add: assms(1) assms(2) function_mult_eval_closed)
	+ by (simp add: function_mult_def function_ring_defs(2))
	+
	+lemma(in ring_functions) fun_mult_eval_assoc:
	+ assumes "x \<in> carrier F"
	+ assumes "y \<in> carrier F"
	+ assumes " z \<in> carrier F"
	+ assumes "a \<in> S"
	+ shows "(x \<otimes>\<^bsub>F\<^esub> y \<otimes>\<^bsub>F\<^esub> z) a = (x \<otimes>\<^bsub>F\<^esub> (y \<otimes>\<^bsub>F\<^esub> z)) a"
	+proof-
	+ have 0: "(x \<otimes>\<^bsub>F\<^esub> y \<otimes>\<^bsub>F\<^esub> z) a = (x a) \<otimes> (y a) \<otimes> (z a) "
	+ by (simp add: assms(1) assms(2) assms(3) assms(4) fun_mult_closed function_mult_eval_car)
	+ have 1: "(x \<otimes>\<^bsub>F\<^esub> (y \<otimes>\<^bsub>F\<^esub> z)) a = (x a) \<otimes> ((y a) \<otimes> (z a))"
	+ by (simp add: assms(1) assms(2) assms(3) assms(4) fun_mult_closed function_mult_eval_car)
	+ have 2:"(x \<otimes>\<^bsub>F\<^esub> (y \<otimes>\<^bsub>F\<^esub> z)) a = (x a) \<otimes> (y a) \<otimes> (z a)"
	+ using 1 assms
	+ by (simp add: function_ring_car_closed m_assoc)
	+ show ?thesis
	+ using 0 2 by auto
	+qed
	+
	+lemma(in ring_functions) fun_mult_assoc:
	+ assumes "x \<in> carrier F"
	+ assumes "y \<in> carrier F"
	+ assumes "z \<in> carrier F"
	+ shows "(x \<otimes>\<^bsub>F\<^esub> y \<otimes>\<^bsub>F\<^esub> z) = (x \<otimes>\<^bsub>F\<^esub> (y \<otimes>\<^bsub>F\<^esub> z))"
	+ using fun_mult_eval_assoc[of x]
	+ by (simp add: assms(1) assms(2) assms(3) fun_mult_closed function_ring_car_eqI)
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Basic Addition Facts\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) fun_add_eval_car:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ shows "(f \<oplus>\<^bsub>F\<^esub> g) a = (f a) \<oplus> (g a)"
	+ by (simp add: assms(1) function_add_def function_ring_defs(3))
	+
	+lemma(in ring_functions) fun_add_eval_closed:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ shows "(f \<oplus>\<^bsub>F\<^esub> g) a \<in> carrier R"
	+ using assms unfolding F_def
	+ using F_def fun_add_eval_car function_ring_car_closed
	+ by auto
	+
	+lemma(in ring_functions) fun_add_closed:
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ shows "f \<oplus>\<^bsub>F\<^esub> g \<in> carrier F"
	+ apply(rule function_ring_car_memI)
	+ using assms unfolding F_def
	+ using F_def fun_add_eval_closed apply blast
	+ by (simp add: function_add_def function_ring_def)
	+
	+lemma(in ring_functions) fun_add_eval_assoc:
	+ assumes "x \<in> carrier F"
	+ assumes "y \<in> carrier F"
	+ assumes " z \<in> carrier F"
	+ assumes "a \<in> S"
	+ shows "(x \<oplus>\<^bsub>F\<^esub> y \<oplus>\<^bsub>F\<^esub> z) a = (x \<oplus>\<^bsub>F\<^esub> (y \<oplus>\<^bsub>F\<^esub> z)) a"
	+proof-
	+ have 0: "(x \<oplus>\<^bsub>F\<^esub> y \<oplus>\<^bsub>F\<^esub> z) a = (x a) \<oplus> (y a) \<oplus> (z a) "
	+ by (simp add: assms(1) assms(2) assms(3) assms(4) fun_add_closed fun_add_eval_car)
	+ have 1: "(x \<oplus>\<^bsub>F\<^esub> (y \<oplus>\<^bsub>F\<^esub> z)) a = (x a) \<oplus> ((y a) \<oplus> (z a))"
	+ by (simp add: assms(1) assms(2) assms(3) assms(4) fun_add_closed fun_add_eval_car)
	+ have 2:"(x \<oplus>\<^bsub>F\<^esub> (y \<oplus>\<^bsub>F\<^esub> z)) a = (x a) \<oplus> (y a) \<oplus> (z a)"
	+ using 1 assms
	+ by (simp add: add.m_assoc function_ring_car_closed)
	+ show ?thesis
	+ using 0 2 by auto
	+qed
	+
	+lemma(in ring_functions) fun_add_assoc:
	+ assumes "x \<in> carrier F"
	+ assumes "y \<in> carrier F"
	+ assumes " z \<in> carrier F"
	+ shows "x \<oplus>\<^bsub>F\<^esub> y \<oplus>\<^bsub>F\<^esub> z = x \<oplus>\<^bsub>F\<^esub> (y \<oplus>\<^bsub>F\<^esub> z)"
	+ apply(rule function_ring_car_eqI)
	+ using assms apply (simp add: fun_add_closed)
	+ apply (simp add: assms(1) assms(2) assms(3) fun_add_closed)
	+ by (simp add: assms(1) assms(2) assms(3) fun_add_eval_assoc)
	+
	+lemma(in ring_functions) fun_add_eval_comm:
	+ assumes "a \<in> S"
	+ assumes "x \<in> carrier F"
	+ assumes "y \<in> carrier F"
	+ shows "(x \<oplus>\<^bsub>F\<^esub> y) a = (y \<oplus>\<^bsub>F\<^esub> x) a"
	+ by (metis F_def assms(1) assms(2) assms(3) fun_add_eval_car ring.ring_simprules(10) ring_functions.function_ring_car_closed ring_functions_axioms ring_functions_def)
	+
	+lemma(in ring_functions) fun_add_comm:
	+ assumes "x \<in> carrier F"
	+ assumes "y \<in> carrier F"
	+ shows "x \<oplus>\<^bsub>F\<^esub> y = y \<oplus>\<^bsub>F\<^esub> x"
	+ using fun_add_eval_comm assms
	+ by (metis (no_types, hide_lams) fun_add_closed function_ring_car_eqI)
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Basic Facts About the Multiplicative Unit\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_one_eval:
	+ assumes "a \<in> S"
	+ shows "\<one>\<^bsub>F\<^esub> a = \<one>"
	+ using assms function_ring_defs unfolding function_one_def
	+ by simp
	+
	+lemma(in ring_functions) function_one_closed:
	+"\<one>\<^bsub>F\<^esub> \<in>carrier F"
	+ apply(rule function_ring_car_memI)
	+ using function_ring_defs
	+ using function_one_eval apply auto[1]
	+ by (simp add: function_one_def function_ring_defs(4))
	+
	+lemma(in ring_functions) function_times_one_l:
	+ assumes "a \<in> carrier F"
	+ shows "\<one>\<^bsub>F\<^esub> \<otimes>\<^bsub>F\<^esub> a = a"
	+proof(rule function_ring_car_eqI)
	+ show "\<one>\<^bsub>F\<^esub> \<otimes>\<^bsub>F\<^esub> a \<in> carrier F"
	+ using assms fun_mult_closed function_one_closed
	+ by blast
	+ show " a \<in> carrier F"
	+ using assms by simp
	+ show "\<And>c. c \<in> S \<Longrightarrow> (\<one>\<^bsub>F\<^esub> \<otimes>\<^bsub>F\<^esub> a) c = a c "
	+ by (simp add: assms function_mult_eval_car function_one_eval function_one_closed function_ring_car_closed)
	+qed
	+
	+lemma(in ring_functions) function_times_one_r:
	+ assumes "a \<in> carrier F"
	+ shows "a\<otimes>\<^bsub>F\<^esub> \<one>\<^bsub>F\<^esub> = a"
	+proof(rule function_ring_car_eqI)
	+ show "a\<otimes>\<^bsub>F\<^esub> \<one>\<^bsub>F\<^esub> \<in> carrier F"
	+ using assms fun_mult_closed function_one_closed
	+ by blast
	+ show " a \<in> carrier F"
	+ using assms by simp
	+ show "\<And>c. c \<in> S \<Longrightarrow> (a\<otimes>\<^bsub>F\<^esub> \<one>\<^bsub>F\<^esub>) c = a c "
	+ using assms
	+ by (simp add: function_mult_eval_car function_one_eval function_one_closed function_ring_car_closed)
	+qed
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Basic Facts About the Additive Unit\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_zero_eval:
	+ assumes "a \<in> S"
	+ shows "\<zero>\<^bsub>F\<^esub> a = \<zero>"
	+ using assms function_ring_defs
	+ unfolding function_zero_def
	+ by simp
	+
	+lemma(in ring_functions) function_zero_closed:
	+"\<zero>\<^bsub>F\<^esub> \<in>carrier F"
	+ apply(rule function_ring_car_memI)
	+ apply (simp add: function_zero_eval)
	+ by (simp add: function_ring_defs(5) function_zero_def)
	+
	+lemma(in ring_functions) fun_add_zeroL:
	+ assumes "a \<in> carrier F"
	+ shows "\<zero>\<^bsub>F\<^esub> \<oplus>\<^bsub>F\<^esub> a = a"
	+proof(rule function_ring_car_eqI)
	+ show "\<zero>\<^bsub>F\<^esub> \<oplus>\<^bsub>F\<^esub> a \<in> carrier F"
	+ using assms fun_add_closed function_zero_closed
	+ by blast
	+ show "a \<in> carrier F"
	+ using assms by simp
	+ show "\<And>c. c \<in> S \<Longrightarrow> (\<zero>\<^bsub>F\<^esub> \<oplus>\<^bsub>F\<^esub> a) c = a c "
	+ using assms F_def fun_add_eval_car function_zero_closed
	+ ring_functions.function_zero_eval ring_functions_axioms
	+ by (simp add: ring_functions.function_zero_eval function_ring_car_closed)
	+qed
	+
	+lemma(in ring_functions) fun_add_zeroR:
	+ assumes "a \<in> carrier F"
	+ shows "a \<oplus>\<^bsub>F\<^esub> \<zero>\<^bsub>F\<^esub> = a"
	+ using assms fun_add_comm fun_add_zeroL
	+ by (simp add: function_zero_closed)
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Distributive Laws\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_mult_r_distr:
	+ assumes "x \<in> carrier F"
	+ assumes" y \<in> carrier F"
	+ assumes " z \<in> carrier F"
	+ shows " (x \<oplus>\<^bsub>F\<^esub> y) \<otimes>\<^bsub>F\<^esub> z = x \<otimes>\<^bsub>F\<^esub> z \<oplus>\<^bsub>F\<^esub> y \<otimes>\<^bsub>F\<^esub> z"
	+proof(rule function_ring_car_eqI)
	+ show "(x \<oplus>\<^bsub>F\<^esub> y) \<otimes>\<^bsub>F\<^esub> z \<in> carrier F"
	+ by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
	+ show "x \<otimes>\<^bsub>F\<^esub> z \<oplus>\<^bsub>F\<^esub> y \<otimes>\<^bsub>F\<^esub> z \<in> carrier F"
	+ by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
	+ show "\<And>a. a \<in> S \<Longrightarrow> ((x \<oplus>\<^bsub>F\<^esub> y) \<otimes>\<^bsub>F\<^esub> z) a = (x \<otimes>\<^bsub>F\<^esub> z \<oplus>\<^bsub>F\<^esub> y \<otimes>\<^bsub>F\<^esub> z) a"
	+ proof-
	+ fix a
	+ assume A: "a \<in> S"
	+ show "((x \<oplus>\<^bsub>F\<^esub> y) \<otimes>\<^bsub>F\<^esub> z) a = (x \<otimes>\<^bsub>F\<^esub> z \<oplus>\<^bsub>F\<^esub> y \<otimes>\<^bsub>F\<^esub> z) a"
	+ using A assms fun_add_eval_car[of a x y] fun_add_eval_car[of a "x \<otimes>\<^bsub>F\<^esub>z" "y \<otimes>\<^bsub>F\<^esub> z"]
	+ function_mult_eval_car[of a "x \<oplus>\<^bsub>F\<^esub> y" z] semiring_simprules(10)
	+ F_def
	+ by (smt fun_add_closed function_mult_eval_car function_ring_car_closed
	+ ring_functions.fun_mult_closed ring_functions_axioms)
	+ qed
	+qed
	+
	+lemma(in ring_functions) function_mult_l_distr:
	+ assumes "x \<in> carrier F"
	+ assumes" y \<in> carrier F"
	+ assumes " z \<in> carrier F"
	+ shows "z \<otimes>\<^bsub>F\<^esub> (x \<oplus>\<^bsub>F\<^esub> y) = z \<otimes>\<^bsub>F\<^esub> x \<oplus>\<^bsub>F\<^esub> z \<otimes>\<^bsub>F\<^esub> y"
	+proof(rule function_ring_car_eqI)
	+ show "z \<otimes>\<^bsub>F\<^esub> (x \<oplus>\<^bsub>F\<^esub> y) \<in> carrier F"
	+ by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
	+ show "z \<otimes>\<^bsub>F\<^esub> x \<oplus>\<^bsub>F\<^esub> z \<otimes>\<^bsub>F\<^esub> y \<in> carrier F"
	+ by (simp add: assms(1) assms(2) assms(3) fun_add_closed fun_mult_closed)
	+ show "\<And>a. a \<in> S \<Longrightarrow> (z \<otimes>\<^bsub>F\<^esub> (x \<oplus>\<^bsub>F\<^esub> y)) a = (z \<otimes>\<^bsub>F\<^esub> x \<oplus>\<^bsub>F\<^esub> z \<otimes>\<^bsub>F\<^esub> y) a"
	+ proof-
	+ fix a
	+ assume A: "a \<in> S"
	+ show "(z \<otimes>\<^bsub>F\<^esub> (x \<oplus>\<^bsub>F\<^esub> y)) a = (z \<otimes>\<^bsub>F\<^esub> x \<oplus>\<^bsub>F\<^esub> z \<otimes>\<^bsub>F\<^esub> y) a"
	+ using A assms function_ring_defs fun_add_closed fun_mult_closed
	+ function_mult_eval_car[of a z "x \<oplus>\<^bsub>F\<^esub> y"]
	+ function_mult_eval_car[of a z x]
	+ function_mult_eval_car[of a z y]
	+ fun_add_eval_car[of a x y]
	+ semiring_simprules(13)
	+ fun_add_eval_car function_ring_car_closed by auto
	+ qed
	+qed
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Additive Inverses\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_uminus_closed:
	+ assumes "f \<in> carrier F"
	+ shows "function_uminus S R f \<in> carrier F"
	+proof(rule function_ring_car_memI)
	+ show "\<And>a. a \<in> S \<Longrightarrow> function_uminus S R f a \<in> carrier R"
	+ using assms function_ring_car_closed[of _ f] unfolding function_uminus_def
	+ by simp
	+ show "\<And>a. a \<notin> S \<Longrightarrow> function_uminus S R f a = undefined"
	+ by (simp add: function_uminus_def)
	+qed
	+
	+lemma(in ring_functions) function_uminus_eval:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ shows "(function_uminus S R f) a = \<ominus> (f a)"
	+ using assms unfolding function_uminus_def
	+ by simp
	+
	+lemma(in ring_functions) function_uminus_add_r:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ shows "f \<oplus>\<^bsub>F\<^esub> function_uminus S R f = \<zero>\<^bsub>F\<^esub>"
	+ apply(rule function_ring_car_eqI)
	+ using assms fun_add_closed function_uminus_closed apply blast
	+ unfolding F_def using F_def function_zero_closed apply blast
	+ using F_def assms(2) fun_add_eval_car function_ring_car_closed function_uminus_closed
	+ function_uminus_eval function_zero_eval r_neg by auto
	+
	+lemma(in ring_functions) function_uminus_add_l:
	+ assumes "a \<in> S"
	+ assumes "f \<in> carrier F"
	+ shows "function_uminus S R f \<oplus>\<^bsub>F\<^esub> f = \<zero>\<^bsub>F\<^esub>"
	+ using assms(1) assms(2) fun_add_comm function_uminus_add_r function_uminus_closed by auto
	+
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Scalar Multiplication\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_smult_eval:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier F"
	+ assumes "b \<in> S"
	+ shows "(a \<odot>\<^bsub>F\<^esub> f) b = a \<otimes> (f b)"
	+ using function_ring_defs(6) unfolding function_scalar_mult_def
	+ by(simp add: assms)
	+
	+lemma(in ring_functions) function_smult_closed:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier F"
	+ shows "a \<odot>\<^bsub>F\<^esub> f \<in> carrier F"
	+ apply(rule function_ring_car_memI)
	+ using function_smult_eval assms
	+ apply (simp add: function_ring_car_closed)
	+ using function_scalar_mult_def F_def
	+ by (metis function_ring_defs(6) restrict_apply)
	+
	+lemma(in ring_functions) function_smult_assoc1:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "f \<in> carrier F"
	+ shows "b \<odot>\<^bsub>F\<^esub> (a \<odot>\<^bsub>F\<^esub> f) = (b \<otimes> a)\<odot>\<^bsub>F\<^esub>f"
	+ apply(rule function_ring_car_eqI)
	+ using assms function_smult_closed apply simp
	+ using assms function_smult_closed apply simp
	+ by (metis F_def assms(1) assms(2) assms(3) function_mult_eval_closed function_one_closed
	+ function_smult_eval function_times_one_r m_assoc m_closed ring_functions.function_smult_closed ring_functions_axioms)
	+
	+lemma(in ring_functions) function_smult_assoc2:
	+ assumes "a \<in> carrier R"
	+ assumes "f \<in> carrier F"
	+ assumes "g \<in> carrier F"
	+ shows "(a \<odot>\<^bsub>F\<^esub> f)\<otimes>\<^bsub>F\<^esub>g = a \<odot>\<^bsub>F\<^esub> (f \<otimes>\<^bsub>F\<^esub> g)"
	+ apply(rule function_ring_car_eqI)
	+ using assms function_smult_closed apply (simp add: fun_mult_closed)
	+ apply (simp add: assms(1) assms(2) assms(3) fun_mult_closed function_smult_closed)
	+ by (metis (full_types) F_def assms(1) assms(2) assms(3) fun_mult_closed
	+ function_mult_eval_car function_smult_closed function_smult_eval m_assoc ring_functions.function_ring_car_closed ring_functions_axioms)
	+
	+lemma(in ring_functions) function_smult_one:
	+ assumes "f \<in> carrier F"
	+ shows "\<one>\<odot>\<^bsub>F\<^esub>f = f"
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: assms function_smult_closed)
	+ apply (simp add: assms)
	+ by (simp add: assms function_ring_car_closed function_smult_eval)
	+
	+lemma(in ring_functions) function_smult_l_distr:
	+"[\| a \<in> carrier R; b \<in> carrier R; x \<in> carrier F \|] ==>
	+ (a \<oplus> b) \<odot>\<^bsub>F\<^esub> x = a \<odot>\<^bsub>F\<^esub> x \<oplus>\<^bsub>F\<^esub> b \<odot>\<^bsub>F\<^esub> x"
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: function_smult_closed)
	+ apply (simp add: fun_add_closed function_smult_closed)
	+ using function_smult_eval
	+ by (simp add: fun_add_eval_car function_ring_car_closed function_smult_closed l_distr)
	+
	+lemma(in ring_functions) function_smult_r_distr:
	+ "[\| a \<in> carrier R; x \<in> carrier F; y \<in> carrier F \|] ==>
	+ a \<odot>\<^bsub>F\<^esub> (x \<oplus>\<^bsub>F\<^esub> y) = a \<odot>\<^bsub>F\<^esub> x \<oplus>\<^bsub>F\<^esub> a \<odot>\<^bsub>F\<^esub> y"
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: fun_add_closed function_smult_closed)
	+ apply (simp add: fun_add_closed function_smult_closed)
	+ by (simp add: fun_add_closed fun_add_eval_car function_ring_car_closed function_smult_closed function_smult_eval r_distr)
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>The Ring of Functions Forms an Algebra\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+lemma(in ring_functions) function_ring_is_abelian_group:
	+"abelian_group F"
	+ apply(rule abelian_groupI)
	+ apply (simp add: fun_add_closed)
	+ apply (simp add: function_zero_closed)
	+ using fun_add_assoc apply simp
	+ apply (simp add: fun_add_comm)
	+ apply (simp add: fun_add_comm fun_add_zeroR function_zero_closed)
	+ using fun_add_zeroL function_ring_car_eqI function_uminus_add_l
	+ function_uminus_closed function_zero_closed by blast
	+
	+lemma(in ring_functions) function_ring_is_monoid:
	+"monoid F"
	+ apply(rule monoidI)
	+ apply (simp add: fun_mult_closed)
	+ apply (simp add: function_one_closed)
	+ apply (simp add: fun_mult_assoc)
	+ apply (simp add: function_times_one_l)
	+ by (simp add: function_times_one_r)
	+
	+lemma(in ring_functions) function_ring_is_ring:
	+"ring F"
	+ apply(rule ringI)
	+ apply (simp add: function_ring_is_abelian_group)
	+ apply (simp add: function_ring_is_monoid)
	+ apply (simp add: function_mult_r_distr)
	+ by (simp add: function_mult_l_distr)
	+
	+sublocale ring_functions < F?: ring F
	+ by (rule function_ring_is_ring)
	+
	+lemma(in cring_functions) function_mult_comm:
	+ assumes "x \<in> carrier F"
	+ assumes" y \<in> carrier F"
	+ shows "x \<otimes>\<^bsub>F\<^esub> y = y \<otimes>\<^bsub>F\<^esub> x"
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: assms(1) assms(2) fun_mult_closed)
	+ apply (simp add: assms(1) assms(2) fun_mult_closed)
	+ by (simp add: assms(1) assms(2) function_mult_eval_car function_ring_car_closed m_comm)
	+
	+lemma(in cring_functions) function_ring_is_comm_monoid:
	+"comm_monoid F"
	+ apply(rule comm_monoidI)
	+ using fun_mult_assoc function_one_closed
	+ apply (simp add: fun_mult_closed)
	+ apply (simp add: function_one_closed)
	+ apply (simp add: fun_mult_assoc)
	+ apply (simp add: function_times_one_l)
	+ by (simp add: function_mult_comm)
	+
	+lemma(in cring_functions) function_ring_is_cring:
	+"cring F"
	+ apply(rule cringI)
	+ apply (simp add: function_ring_is_abelian_group)
	+ apply (simp add: function_ring_is_comm_monoid)
	+ by (simp add: function_mult_r_distr)
	+
	+lemma(in cring_functions) function_ring_is_algebra:
	+"algebra R F"
	+ apply(rule algebraI)
	+ apply (simp add: is_cring)
	+ apply (simp add: function_ring_is_cring)
	+ using function_smult_closed apply blast
	+ apply (simp add: function_smult_l_distr)
	+ apply (simp add: function_smult_r_distr)
	+ apply (simp add: function_smult_assoc1)
	+ apply (simp add: function_smult_one)
	+ by (simp add: function_smult_assoc2)
	+
	+lemma(in ring_functions) function_uminus:
	+ assumes "f \<in> carrier F"
	+ shows "\<ominus>\<^bsub>F\<^esub> f = (function_uminus S R) f"
	+ using assms a_inv_def[of F]
	+ by (metis F_def abelian_group.a_group abelian_group.r_neg function_uminus_add_r function_uminus_closed group.inv_closed partial_object.select_convs(1) ring.ring_simprules(18) ring_functions.function_ring_car_eqI ring_functions.function_ring_is_abelian_group ring_functions.function_ring_is_ring ring_functions_axioms)
	+
	+lemma(in ring_functions) function_uminus_eval':
	+ assumes "f \<in> carrier F"
	+ assumes "a \<in> S"
	+ shows "(\<ominus>\<^bsub>F\<^esub> f) a = (function_uminus S R) f a"
	+ using assms
	+ by (simp add: function_uminus)
	+
	+lemma(in ring_functions) function_uminus_eval'':
	+ assumes "f \<in> carrier F"
	+ assumes "a \<in> S"
	+ shows "(\<ominus>\<^bsub>F\<^esub> f) a = \<ominus> (f a)"
	+ using assms(1) assms(2) function_uminus
	+ by (simp add: function_uminus_eval)
	+
	+sublocale cring_functions < F?: algebra R F
	+ using function_ring_is_algebra by auto
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Constant Functions\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+definition constant_function where
	+"constant_function S a =(\<lambda>x \<in> S. a)"
	+
	+abbreviation(in ring_functions)(input) const where
	+"const \<equiv> constant_function S"
	+
	+lemma(in ring_functions) constant_function_closed:
	+ assumes "a \<in> carrier R"
	+ shows "const a \<in> carrier F"
	+ apply(rule function_ring_car_memI)
	+ unfolding constant_function_def
	+ apply (simp add: assms)
	+ by simp
	+
	+lemma(in ring_functions) constant_functionE:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> S"
	+ shows "const a b = a"
	+ by (simp add: assms(2) constant_function_def)
	+
	+lemma(in ring_functions) constant_function_add:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "const (a \<oplus>\<^bsub>R\<^esub> b) = (const a) \<oplus>\<^bsub>F\<^esub> (const b) "
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: constant_function_closed assms(1) assms(2))
	+ using assms(1) constant_function_closed assms(2) fun_add_closed apply auto[1]
	+ by (simp add: assms(1) assms(2) constant_function_closed constant_functionE fun_add_eval_car)
	+
	+lemma(in ring_functions) constant_function_mult:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "const (a \<otimes>\<^bsub>R\<^esub> b) = (const a) \<otimes>\<^bsub>F\<^esub> (const b)"
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: constant_function_closed assms(1) assms(2))
	+ using assms(1) constant_function_closed assms(2) fun_mult_closed apply auto[1]
	+ by (simp add: constant_function_closed assms(1) assms(2) constant_functionE function_mult_eval_car)
	+
	+lemma(in ring_functions) constant_function_minus:
	+ assumes "a \<in> carrier R"
	+ shows "\<ominus>\<^bsub>F\<^esub>(const a) = (const (\<ominus>\<^bsub>R\<^esub> a)) "
	+apply(rule function_ring_car_eqI)
	+ apply (simp add: constant_function_closed assms local.function_uminus)
	+ apply (simp add: constant_function_closed assms function_uminus_closed)
	+ apply (simp add: constant_function_closed assms)
	+ by (simp add: constant_function_closed assms constant_functionE function_uminus_eval'')
	+
	+lemma(in ring_functions) function_one_is_constant:
	+"const \<one> = \<one>\<^bsub>F\<^esub>"
	+ unfolding F_def
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: constant_function_closed)
	+ using F_def function_one_closed apply auto[1]
	+ using F_def constant_functionE function_one_eval by auto
	+
	+lemma(in ring_functions) function_zero_is_constant:
	+"const \<zero> = \<zero>\<^bsub>F\<^esub>"
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: constant_function_closed)
	+ using F_def function_zero_closed apply auto[1]
	+ using F_def constant_functionE function_zero_eval by auto
	+
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsection\<open>Special Examples of Functions Rings\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Functions from the Carrier of a Ring to Itself\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+
	+locale U_function_ring = ring
	+
	+locale U_function_cring = U_function_ring + cring
	+
	+sublocale U_function_ring < S?: struct_functions R "carrier R"
	+ done
	+
	+sublocale U_function_ring < FunR?: ring_functions R "carrier R" "Fun R"
	+ apply (simp add: local.ring_axioms ring_functions.intro)
	+ by simp
	+
	+sublocale U_function_cring < FunR?: cring_functions R "carrier R" "Fun R"
	+ apply (simp add: cring_functions_def is_cring ring_functions_axioms)
	+ by simp
	+
	+abbreviation(in U_function_ring)(input) ring_compose :: "('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)" where
	+"ring_compose \<equiv> compose (carrier R)"
	+
	+lemma(in U_function_ring) ring_function_ring_comp:
	+ assumes "f \<in> carrier (Fun R)"
	+ assumes "g \<in> carrier (Fun R)"
	+ shows "ring_compose f g \<in> carrier (Fun R)"
	+ apply(rule function_ring_car_memI)
	+ apply (simp add: assms(1) assms(2) compose_eq)
	+ apply (simp add: assms(1) assms(2) function_ring_car_closed)
	+ by (meson compose_extensional extensional_arb)
	+
	+abbreviation(in U_function_ring)(input) ring_const ("\<cc>\<index>") where
	+"ring_const \<equiv> constant_function (carrier R)"
	+
	+lemma(in ring_functions) function_nat_pow_eval:
	+ assumes "f \<in> carrier F"
	+ assumes "s \<in> S"
	+ shows "(f[^]\<^bsub>F\<^esub>(n::nat)) s = (f s)[^]n"
	+ apply(induction n)
	+ using assms(2) function_one_eval apply auto[1]
	+ by (simp add: assms(1) assms(2) function_mult_eval_car function_ring_is_monoid monoid.nat_pow_closed)
	+
	+
	+context U_function_ring
	+begin
	+
	+definition a_translate :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
	+"a_translate = (\<lambda> r \<in> carrier R. restrict ((add R) r) (carrier R))"
	+
	+definition m_translate :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
	+"m_translate = (\<lambda> r \<in> carrier R. restrict ((mult R) r) (carrier R))"
	+
	+definition nat_power :: "nat \<Rightarrow> 'a \<Rightarrow> 'a" where
	+"nat_power = (\<lambda>(n::nat). restrict (\<lambda>a. a[^]\<^bsub>R\<^esub>n) (carrier R)) "
	+
	+text\<open>Restricted operations are in Fs\<close>
	+
	+lemma a_translate_functions:
	+ assumes "c \<in> carrier R"
	+ shows "a_translate c \<in> carrier (Fun R)"
	+ apply(rule function_ring_car_memI)
	+ using assms a_translate_def
	+ apply simp
	+ using assms a_translate_def
	+ by simp
	+
	+lemma m_translate_functions:
	+ assumes "c \<in> carrier R"
	+ shows "m_translate c \<in> carrier (Fun R)"
	+ apply(rule function_ring_car_memI)
	+ using assms m_translate_def
	+ apply simp
	+ using assms m_translate_def
	+ by simp
	+
	+lemma nat_power_functions:
	+ shows "nat_power n \<in> carrier (Fun R)"
	+ apply(rule function_ring_car_memI)
	+ using nat_power_def
	+ apply simp
	+ by (simp add: nat_power_def)
	+
	+text\<open>Restricted operations simps\<close>
	+
	+lemma a_translate_eq:
	+ assumes "c \<in> carrier R"
	+ assumes "a \<in> carrier R"
	+ shows "a_translate c a = c \<oplus> a"
	+ by (simp add: a_translate_def assms(1) assms(2))
	+
	+lemma a_translate_eq':
	+ assumes "c \<in> carrier R"
	+ assumes "a \<notin> carrier R"
	+ shows "a_translate c a = undefined"
	+ by (meson a_translate_functions assms(1) assms(2) function_ring_not_car)
	+
	+lemma a_translate_eq'':
	+ assumes "c \<notin> carrier R"
	+ shows "a_translate c = undefined"
	+ by (simp add: a_translate_def assms)
	+
	+lemma m_translate_eq:
	+ assumes "c \<in> carrier R"
	+ assumes "a \<in> carrier R"
	+ shows "m_translate c a = c \<otimes> a"
	+ by (simp add: m_translate_def assms(1) assms(2))
	+
	+lemma m_translate_eq':
	+ assumes "c \<in> carrier R"
	+ assumes "a \<notin> carrier R"
	+ shows "m_translate c a = undefined "
	+ by (meson m_translate_functions assms(1) assms(2) function_ring_not_car)
	+
	+lemma m_translate_eq'':
	+ assumes "c \<notin> carrier R"
	+ shows "m_translate c = undefined"
	+ by (simp add: m_translate_def assms)
	+
	+lemma nat_power_eq:
	+ assumes "a \<in> carrier R"
	+ shows "nat_power n a = a[^]\<^bsub>R\<^esub> n"
	+ by (simp add: assms nat_power_def)
	+
	+lemma nat_power_eq':
	+ assumes "a \<notin> carrier R"
	+ shows "nat_power n a = undefined"
	+ by (simp add: assms nat_power_def)
	+
	+text\<open>Constant ring\_function properties\<close>
	+
	+lemma constant_function_eq:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "\<cc>\<^bsub>a\<^esub> b = a"
	+ using assms
	+
	+ by (simp add: constant_functionE)
	+
	+lemma constant_function_eq':
	+ assumes "a \<in> carrier R"
	+ assumes "b \<notin> carrier R"
	+ shows "\<cc>\<^bsub>a\<^esub> b = undefined"
	+ by (simp add: constant_function_closed assms(1) assms(2) function_ring_not_car)
	+
	+text\<open>Compound expressions from algebraic operations\<close>
	+end
	+
	+definition monomial_function where
	+"monomial_function R c (n::nat) = (\<lambda> x \<in> carrier R. c \<otimes>\<^bsub>R\<^esub> (x[^]\<^bsub>R\<^esub>n))"
	+
	+context U_function_ring
	+begin
	+
	+abbreviation monomial where
	+"monomial \<equiv> monomial_function R"
	+
	+lemma monomial_functions:
	+ assumes "c \<in> carrier R"
	+ shows "monomial c n \<in> carrier (Fun R)"
	+ apply(rule function_ring_car_memI)
	+ unfolding monomial_function_def
	+ apply (simp add: assms)
	+ by simp
	+
	+definition ring_id where
	+"ring_id \<equiv> restrict (\<lambda>x. x) (carrier R) "
	+
	+lemma ring_id_closed[simp]:
	+"ring_id \<in> carrier (Fun R)"
	+ by (simp add: function_ring_car_memI ring_id_def)
	+
	+lemma ring_id_eval:
	+ assumes "a \<in> carrier R"
	+ shows "ring_id a = a"
	+ using assms unfolding ring_id_def
	+ by simp
	+
	+lemma constant_a_trans:
	+ assumes "a \<in>carrier R"
	+ shows "m_translate a = \<cc>\<^bsub>a\<^esub> \<otimes>\<^bsub>Fun R\<^esub> ring_id"
	+proof(rule function_ring_car_eqI)
	+ show "m_translate a \<in> carrier (Fun R)"
	+ using assms
	+ using m_translate_functions by blast
	+ show "\<cc>\<^bsub>a\<^esub> \<otimes>\<^bsub>Fun R\<^esub> ring_id \<in> carrier (Fun R)"
	+ unfolding ring_id_def
	+ using assms ring_id_closed ring_id_def
	+ by (simp add: constant_function_closed fun_mult_closed)
	+ show "\<And>x. x \<in> carrier R \<Longrightarrow> m_translate a x = (\<cc>\<^bsub>a\<^esub> \<otimes>\<^bsub>Fun R\<^esub> ring_id) x"
	+ by (simp add: constant_function_closed assms constant_function_eq function_mult_eval_car m_translate_eq ring_id_eval)
	+qed
	+
	+text\<open>polynomials in one variable\<close>
	+
	+fun polynomial :: "'a list \<Rightarrow> ('a \<Rightarrow> 'a)" where
	+"polynomial [] = \<zero>\<^bsub>Fun R\<^esub> "\|
	+"polynomial (a#as) = (\<lambda>x \<in> carrier R. a \<oplus> x \<otimes> (polynomial as x))"
	+
	+lemma polynomial_induct_lemma:
	+ assumes "f \<in> carrier (Fun R)"
	+ assumes "a \<in> carrier R"
	+ shows "(\<lambda>x \<in> carrier R. a \<oplus> x \<otimes> (f x)) \<in> carrier (Fun R)"
	+proof(rule function_ring_car_memI)
	+ show "\<And>aa. aa \<in> carrier R \<Longrightarrow> (\<lambda>x\<in>carrier R. a \<oplus> x \<otimes> f x) aa \<in> carrier R"
	+ proof- fix y assume A: "y \<in> carrier R"
	+ have "a \<oplus> y \<otimes> f y \<in> carrier R"
	+ using A assms(1) assms(2) function_ring_car_closed by blast
	+ thus "(\<lambda>x\<in>carrier R. a \<oplus> x \<otimes> f x) y \<in> carrier R"
	+ using A by auto
	+ qed
	+ show "\<And>aa. aa \<notin> carrier R \<Longrightarrow> (\<lambda>x\<in>carrier R. a \<oplus> x \<otimes> f x) aa = undefined"
	+ by auto
	+qed
	+
	+lemma polynomial_function:
	+ shows "set as \<subseteq> carrier R \<Longrightarrow> polynomial as \<in> carrier (Fun R)"
	+proof(induction as)
	+ case Nil
	+ then show ?case
	+ by (simp add: function_zero_closed)
	+next
	+ case (Cons a as)
	+ then show "polynomial (a # as) \<in> carrier (function_ring (carrier R) R)"
	+ using polynomial.simps(2)[of a as] polynomial_induct_lemma[of "polynomial as" a]
	+ by simp
	+qed
	+
	+lemma polynomial_constant:
	+ assumes "a \<in> carrier R"
	+ shows "polynomial [a] = \<cc>\<^bsub>a\<^esub>"
	+ apply(rule function_ring_car_eqI)
	+ using assms polynomial_function
	+ apply (metis (full_types) list.distinct(1) list.set_cases set_ConsD subset_code(1))
	+ apply (simp add: constant_function_closed assms)
	+ using polynomial.simps(2)[of a "[]"] polynomial.simps(1) assms
	+ by (simp add: constant_function_eq function_zero_eval)
	+
	+
	+end
	+
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+ subsubsection\<open>Sequences Indexed by the Natural Numbers\<close>
	+ (**************************************************************************************************)
	+ (**************************************************************************************************)
	+
	+definition nat_seqs ("_\<^bsup>\<omega>\<^esup>")where
	+"nat_seqs R \<equiv> function_ring (UNIV::nat set) R"
	+
	+abbreviation(input) closed_seqs where
	+"closed_seqs R \<equiv> carrier (R\<^bsup>\<omega>\<^esup>)"
	+
	+lemma closed_seqs_memI:
	+ assumes "\<And>k. s k \<in> carrier R"
	+ shows "s \<in> closed_seqs R"
	+ unfolding nat_seqs_def function_ring_def
	+ by (simp add: PiE_UNIV_domain assms)
	+
	+lemma closed_seqs_memE:
	+ assumes "s \<in> closed_seqs R"
	+ shows "s k \<in> carrier R"
	+ using assms unfolding nat_seqs_def function_ring_def
	+ by (simp add: PiE_iff)
	+
	+definition is_constant_fun where
	+"is_constant_fun R f = (\<exists>x \<in> carrier R. f = constant_function (carrier R) R x)"
	+
	+definition is_constant_seq where
	+"is_constant_seq R s = (\<exists>x \<in> carrier R. s = constant_function (UNIV::nat set) x)"
	+
	+lemma is_constant_seqI:
	+ fixes a
	+ assumes "s \<in> closed_seqs R"
	+ assumes "\<And>k. s k = a"
	+ shows "is_constant_seq R s"
	+ unfolding is_constant_seq_def constant_function_def
	+ by (metis assms(1) assms(2) closed_seqs_memE restrict_UNIV restrict_ext)
	+
	+lemma is_constant_seqE:
	+ assumes "is_constant_seq R s"
	+ assumes "s k = a"
	+ shows "s n = a"
	+ using assms unfolding is_constant_seq_def
	+ by (metis constant_function_def restrict_UNIV)
	+
	+lemma is_constant_seq_imp_closed:
	+ assumes "is_constant_seq R s"
	+ shows "s \<in> closed_seqs R"
	+ apply(rule closed_seqs_memI)
	+ using assms unfolding is_constant_seq_def constant_function_def
	+ by auto
	+
	+context U_function_ring
	+begin
	+
	+text\<open>Sequence sums and products are closed\<close>
	+
	+lemma seq_plus_closed:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "s' \<in> closed_seqs R"
	+ shows "s \<oplus>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> s' \<in> closed_seqs R"
	+ by (metis assms(1) assms(2) nat_seqs_def ring_functions.fun_add_closed ring_functions_axioms)
	+
	+lemma seq_mult_closed:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "s' \<in> closed_seqs R"
	+ shows "s \<otimes>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> s' \<in> closed_seqs R"
	+ apply(rule closed_seqs_memI)
	+ by (metis assms(1) assms(2) closed_seqs_memE nat_seqs_def ring_functions.fun_mult_closed ring_functions_axioms)
	+
	+lemma constant_function_comp_is_closed_seq:
	+ assumes "a \<in> carrier R"
	+ assumes "s \<in> closed_seqs R"
	+ shows "(const a \<circ> s) \<in> closed_seqs R"
	+ by (simp add: constant_functionE assms(1) assms(2) closed_seqs_memE closed_seqs_memI)
	+
	+lemma constant_function_comp_is_constant_seq:
	+ assumes "a \<in> carrier R"
	+ assumes "s \<in> closed_seqs R"
	+ shows "is_constant_seq R ((const a) \<circ> s)"
	+ apply(rule is_constant_seqI[of _ _ a] )
	+ apply (simp add: assms(1) assms(2) constant_function_comp_is_closed_seq)
	+ using assms(1) assms(2) closed_seqs_memE
	+ by (simp add: closed_seqs_memE constant_functionE)
	+
	+lemma function_comp_is_closed_seq:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "f \<in> carrier (Fun R)"
	+ shows "f \<circ> s \<in> closed_seqs R"
	+ apply(rule closed_seqs_memI)
	+ using assms(1) assms(2) closed_seqs_memE
	+ by (metis comp_apply fun_add_eval_closed fun_add_zeroR function_zero_closed)
	+
	+lemma function_sum_comp_is_seq_sum:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "f \<in> carrier (Fun R)"
	+ assumes "g \<in> carrier (Fun R)"
	+ shows "(f \<oplus>\<^bsub>Fun R\<^esub> g) \<circ> s = (f \<circ> s) \<oplus>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> (g \<circ> s)"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "UNIV :: nat set"])
	+ apply (simp add: ring_functions_axioms)
	+ using function_comp_is_closed_seq
	+ apply (metis assms(1) assms(2) assms(3) fun_add_closed nat_seqs_def)
	+ apply (metis assms(1) assms(2) assms(3) function_comp_is_closed_seq nat_seqs_def seq_plus_closed)
	+ by (smt UNIV_eq_I assms(1) assms(2) assms(3) closed_seqs_memE comp_apply function_comp_is_closed_seq nat_seqs_def ring_functions.fun_add_eval_car ring_functions_axioms)
	+
	+lemma function_mult_comp_is_seq_mult:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "f \<in> carrier (Fun R)"
	+ assumes "g \<in> carrier (Fun R)"
	+ shows "(f \<otimes>\<^bsub>Fun R\<^esub> g) \<circ> s = (f \<circ> s) \<otimes>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> (g \<circ> s)"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "UNIV :: nat set"])
	+ apply (simp add: ring_functions_axioms)
	+ using function_comp_is_closed_seq
	+ apply (metis assms(1) assms(2) assms(3) fun_mult_closed nat_seqs_def)
	+ apply (metis assms(1) assms(2) assms(3) function_comp_is_closed_seq nat_seqs_def seq_mult_closed)
	+ by (metis (no_types, lifting) assms(1) assms(2) assms(3) comp_apply function_comp_is_closed_seq nat_seqs_def ring_functions.function_mult_eval_car ring_functions.function_ring_car_closed ring_functions_axioms)
	+
	+lemma seq_plus_simp:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "t \<in> closed_seqs R"
	+ shows "(s \<oplus>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> t) k = s k \<oplus> t k"
	+ using assms unfolding nat_seqs_def
	+ by (simp add: ring_functions.fun_add_eval_car ring_functions_axioms)
	+
	+lemma seq_mult_simp:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "t \<in> closed_seqs R"
	+ shows "(s \<otimes>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> t) k = s k \<otimes> t k"
	+ using assms unfolding nat_seqs_def
	+ by (simp add: ring_functions.function_mult_eval_car ring_functions_axioms)
	+
	+lemma seq_one_simp:
	+"\<one>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> k = \<one>"
	+ by (simp add: nat_seqs_def ring_functions.function_one_eval ring_functions_axioms)
	+
	+lemma seq_zero_simp:
	+"\<zero>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> k = \<zero>"
	+ by (simp add: nat_seqs_def ring_functions.function_zero_eval ring_functions_axioms)
	+
	+lemma(in U_function_ring) ring_id_seq_comp:
	+ assumes "s \<in> closed_seqs R"
	+ shows "ring_id \<circ> s = s"
	+ apply(rule ring_functions.function_ring_car_eqI[of R _ "UNIV::nat set"])
	+ using ring_functions_axioms apply auto[1]
	+ apply (metis assms function_comp_is_closed_seq nat_seqs_def ring_id_closed)
	+ apply (metis assms nat_seqs_def)
	+ by (simp add: assms closed_seqs_memE ring_id_eval)
	+
	+lemma(in U_function_ring) ring_seq_smult_closed:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "a \<in> carrier R"
	+ shows "a \<odot>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> s \<in> closed_seqs R"
	+ apply(rule closed_seqs_memI)
	+ by (metis assms(1) assms(2) closed_seqs_memE nat_seqs_def ring_functions.function_smult_closed ring_functions_axioms)
	+
	+lemma(in U_function_ring) ring_seq_smult_eval:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "a \<in> carrier R"
	+ shows "(a \<odot>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> s) k = a \<otimes> (s k)"
	+ by (metis UNIV_I assms(1) assms(2) nat_seqs_def ring_functions.function_smult_eval ring_functions_axioms)
	+
	+lemma(in U_function_ring) ring_seq_smult_comp_assoc:
	+ assumes "s \<in> closed_seqs R"
	+ assumes "f \<in> carrier (Fun R)"
	+ assumes "a \<in> carrier R"
	+ shows "((a \<odot>\<^bsub>Fun R\<^esub> f) \<circ> s) = a \<odot>\<^bsub>R\<^bsup>\<omega>\<^esup>\<^esub> (f \<circ> s)"
	+ apply(rule ext)
	+ using function_smult_eval[of a f] ring_seq_smult_eval[of "f \<circ> s" a]
	+ by (simp add: assms(1) assms(2) assms(3) closed_seqs_memE function_comp_is_closed_seq)
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Extensional Maps Between the Carriers of two Structures\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+definition struct_maps :: "('a, 'c) partial_object_scheme \<Rightarrow> ('b, 'd) partial_object_scheme
	+ \<Rightarrow> ('a \<Rightarrow> 'b) set" where
	+"struct_maps T S = {f. (f \<in> (carrier T) \<rightarrow> (carrier S)) \<and> f = restrict f (carrier T) }"
	+
	+definition to_struct_map where
	+"to_struct_map T f = restrict f (carrier T)"
	+
	+lemma to_struct_map_closed:
	+ assumes "f \<in> (carrier T) \<rightarrow> (carrier S)"
	+ shows "to_struct_map T f \<in> (struct_maps T S)"
	+ by (smt PiE_restrict Pi_iff assms mem_Collect_eq restrict_PiE struct_maps_def to_struct_map_def)
	+
	+lemma struct_maps_memI:
	+ assumes "\<And> x. x \<in> carrier T \<Longrightarrow> f x \<in> carrier S"
	+ assumes "\<And>x. x \<notin> carrier T \<Longrightarrow> f x = undefined"
	+ shows "f \<in> struct_maps T S"
	+proof-
	+ have 0: " (f \<in> (carrier T) \<rightarrow> (carrier S))"
	+ using assms
	+ by blast
	+ have 1: "f = restrict f (carrier T)"
	+ using assms
	+ by (simp add: extensional_def extensional_restrict)
	+ show ?thesis
	+ using 0 1
	+ unfolding struct_maps_def
	+ by blast
	+qed
	+
	+lemma struct_maps_memE:
	+ assumes "f \<in> struct_maps T S"
	+ shows "\<And> x. x \<in> carrier T \<Longrightarrow> f x \<in> carrier S"
	+ "\<And>x. x \<notin> carrier T \<Longrightarrow> f x = undefined"
	+ using assms unfolding struct_maps_def
	+ apply blast
	+ using assms unfolding struct_maps_def
	+ by (metis (mono_tags, lifting) mem_Collect_eq restrict_apply)
	+
	+text\<open>An abbreviation for restricted composition of function of functions. This is necessary for the composition of two struct maps to again be a struct map.\<close>
	+abbreviation(input) rcomp
	+ where "rcomp \<equiv> FuncSet.compose"
	+
	+lemma struct_map_comp:
	+ assumes "g \<in> (struct_maps T S)"
	+ assumes "f \<in> (struct_maps S U)"
	+ shows "rcomp (carrier T) f g \<in> (struct_maps T U)"
	+proof(rule struct_maps_memI)
	+ show "\<And>x. x \<in> carrier T \<Longrightarrow> rcomp (carrier T) f g x \<in> carrier U"
	+ using assms struct_maps_memE(1)
	+ by (metis compose_eq)
	+ show " \<And>x. x \<notin> carrier T \<Longrightarrow> rcomp (carrier T) f g x = undefined"
	+ by (meson compose_extensional extensional_arb)
	+qed
	+
	+lemma r_comp_is_compose:
	+ assumes "g \<in> (struct_maps T S)"
	+ assumes "f \<in> (struct_maps S U)"
	+ assumes "a \<in> (carrier T)"
	+ shows "(rcomp (carrier T) f g) a = (f \<circ> g) a"
	+ by (simp add: FuncSet.compose_def assms(3))
	+
	+lemma r_comp_not_in_car:
	+ assumes "g \<in> (struct_maps T S)"
	+ assumes "f \<in> (struct_maps S U)"
	+ assumes "a \<notin> (carrier T)"
	+ shows "(rcomp (carrier T) f g) a = undefined"
	+ by (simp add: FuncSet.compose_def assms(3))
	+
	+text\<open>The reverse composition of two struct maps:\<close>
	+
	+definition pullback ::
	+ "('a, 'd) partial_object_scheme \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'c)" where
	+"pullback T f g = rcomp (carrier T) g f"
	+
	+lemma pullback_closed:
	+ assumes "f \<in> (struct_maps T S)"
	+ assumes "g \<in> (struct_maps S U)"
	+ shows "pullback T f g \<in> (struct_maps T U)"
	+ by (metis assms(1) assms(2) pullback_def struct_map_comp)
	+
	+text\<open>Composition of struct maps which takes the structure itself rather than the carrier as a parameter:\<close>
	+
	+definition pushforward ::
	+ "('a, 'd) partial_object_scheme \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'c)" where
	+"pushforward T f g \<equiv> rcomp (carrier T) f g"
	+
	+lemma pushforward_closed:
	+ assumes "g \<in> (struct_maps T S)"
	+ assumes "f \<in> (struct_maps S U)"
	+ shows "pushforward T f g \<in> (struct_maps T U)"
	+ using assms(1) assms(2) struct_map_comp
	+ by (metis pushforward_def)
	+
	+
	+end
	+
	diff --git a/thys/Padic_Ints/Hensels_Lemma.thy b/thys/Padic_Ints/Hensels_Lemma.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Hensels_Lemma.thy
	@@ -0,0 +1,1987 @@
	+theory Hensels_Lemma
	+ imports Padic_Int_Polynomials
	+begin
	+
	+
	+text\<open>
	+ The following proof of Hensel's Lemma is directly adapted from Keith Conrad's proof which is
	+ given in an online note \cite{keithconrad}. The same note was used as the basis for a
	+ formalization of Hensel's Lemma by Robert Lewis in the Lean proof assistant
	+ \cite{10.1145/3293880.3294089}. \<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Auxiliary Lemmas for Hensel's Lemma\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+lemma(in ring) minus_sum:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "\<ominus> (a \<oplus> b) = \<ominus> a \<oplus> \<ominus> b"
	+ by (simp add: assms(1) assms(2) local.minus_add)
	+
	+context padic_integers
	+begin
	+
	+
	+lemma poly_diff_val:
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ shows "val_Zp (f\<bullet>a \<ominus> f\<bullet>b) \<ge> val_Zp (a \<ominus> b)"
	+proof-
	+ obtain c where c_def: "c \<in> carrier Zp \<and> (f\<bullet>a \<ominus> f\<bullet>b) = (a \<ominus> b) \<otimes> c"
	+ using assms
	+ by (meson to_fun_diff_factor)
	+ have 1: "val_Zp c \<ge> 0"
	+ using c_def val_pos by blast
	+ have 2: "val_Zp (f\<bullet>a \<ominus> f\<bullet>b) = val_Zp (a \<ominus> b) + (val_Zp c)"
	+ using c_def val_Zp_mult
	+ by (simp add: assms(2) assms(3))
	+ then show ?thesis
	+ using "1" by auto
	+qed
	+
	+text\<open>Restricted p-adic division\<close>
	+
	+definition divide where
	+"divide x y = (if x = \<zero> then \<zero> else
	+ (\<p>[^](nat (ord_Zp x - ord_Zp y)) \<otimes> ac_Zp x \<otimes> (inv ac_Zp y)))"
	+
	+lemma divide_closed:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "y \<noteq> \<zero>"
	+ shows "divide x y \<in> carrier Zp"
	+ unfolding divide_def
	+ apply(cases "x = \<zero>")
	+ apply auto[1]
	+ using assms ac_Zp_is_Unit
	+ by (simp add: ac_Zp_in_Zp)
	+
	+lemma divide_formula:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "y \<noteq> \<zero>"
	+ assumes "val_Zp x \<ge> val_Zp y"
	+ shows "y \<otimes> divide x y = x"
	+ apply(cases "x = \<zero>")
	+ apply (simp add: divide_def mult_zero_l)
	+proof- assume A: "x \<noteq> \<zero>"
	+ have 0: "y \<otimes> divide x y = \<p>[^] nat (ord_Zp y) \<otimes> ac_Zp y \<otimes> (\<p>[^](nat (ord_Zp x - ord_Zp y)) \<otimes> ac_Zp x \<otimes> (inv ac_Zp y))"
	+ using assms ac_Zp_factors_x[of x] ac_Zp_factors_x[of y] A divide_def
	+ by auto
	+ hence 1: "y \<otimes> divide x y = \<p>[^] nat (ord_Zp y) \<otimes> (\<p>[^](nat (ord_Zp x - ord_Zp y)) \<otimes> ac_Zp x \<otimes> ac_Zp y \<otimes> (inv ac_Zp y))"
	+ using mult_assoc mult_comm by auto
	+ have 2: "(nat (ord_Zp y) + nat (ord_Zp x - ord_Zp y)) = nat (ord_Zp x)"
	+ using assms ord_pos[of x] ord_pos[of y] A val_ord_Zp by auto
	+ have "y \<otimes> divide x y = \<p>[^] nat (ord_Zp y) \<otimes> \<p>[^](nat (ord_Zp x - ord_Zp y)) \<otimes> ac_Zp x"
	+ using 1 A assms
	+ by (simp add: ac_Zp_in_Zp ac_Zp_is_Unit mult_assoc)
	+ thus "y \<otimes> divide x y = x"
	+ using "2" A ac_Zp_factors_x(1) assms(1) p_natpow_prod by auto
	+qed
	+
	+lemma divide_nonzero:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "val_Zp x \<ge> val_Zp y"
	+ shows "divide x y \<in> nonzero Zp"
	+ by (metis assms(1) assms(2) assms(3) divide_closed divide_formula mult_zero_l nonzero_closed nonzero_memE(2) nonzero_memI)
	+
	+lemma val_of_divide:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "val_Zp x \<ge> val_Zp y"
	+ shows "val_Zp (divide x y) = val_Zp x - val_Zp y"
	+proof-
	+ have 0: "y \<otimes> divide x y = x"
	+ by (simp add: assms(1) assms(2) assms(3) divide_formula nonzero_closed nonzero_memE(2))
	+ hence "val_Zp y + val_Zp (divide x y) = val_Zp x"
	+ using assms(1) assms(2) divide_closed nonzero_closed not_nonzero_memI val_Zp_mult by fastforce
	+ thus ?thesis
	+ by (smt Zp_def add.commute add.left_neutral add.right_neutral add_diff_assoc_eint assms(1)
	+ assms(2) divide_nonzero eSuc_minus_eSuc iadd_Suc idiff_0_right mult_zero(1) mult_zero_l
	+ nonzero_closed ord_pos order_refl padic_integers.Zp_int_inc_closed padic_integers.mult_comm
	+ padic_integers.ord_of_nonzero(2) padic_integers_axioms val_Zp_eq_frac_0 val_Zp_mult val_Zp_p)
	+qed
	+
	+lemma val_of_divide':
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "y \<noteq> \<zero>"
	+ assumes "val_Zp x \<ge> val_Zp y"
	+ shows "val_Zp (divide x y) = val_Zp x - val_Zp y"
	+ using Zp_def assms(1) assms(2) assms(3) assms(4) padic_integers.not_nonzero_Zp
	+ padic_integers.val_of_divide padic_integers_axioms by blast
	+end
	+
	+lemma(in UP_cring) taylor_deg_1_eval''':
	+ assumes "f \<in> carrier P"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) (\<ominus>b)"
	+ assumes "b \<otimes> (deriv f a) = (to_fun f a)"
	+ shows "to_fun f (a \<ominus> b) = (c \<otimes> b[^](2::nat))"
	+proof-
	+ have 0: "to_fun f (a \<ominus> b) = (to_fun f a) \<ominus> (deriv f a \<otimes> b) \<oplus> (c \<otimes> b[^](2::nat))"
	+ using assms taylor_deg_1_eval''
	+ by blast
	+ have 1: "(to_fun f a) \<ominus> (deriv f a \<otimes> b) = \<zero>"
	+ using assms
	+ proof -
	+ have "\<forall>f a. f \<notin> carrier P \<or> a \<notin> carrier R \<or> to_fun f a \<in> carrier R"
	+ using to_fun_closed by presburger
	+ then show ?thesis
	+ using R.m_comm R.r_right_minus_eq assms(1) assms(2) assms(3) assms(5)
	+ by (simp add: deriv_closed)
	+ qed
	+ have 2: "to_fun f (a \<ominus> b) = \<zero> \<oplus> (c \<otimes> b[^](2::nat))"
	+ using 0 1
	+ by simp
	+ then show ?thesis using assms
	+ by (simp add: taylor_closed to_fun_closed shift_closed)
	+qed
	+
	+lemma(in padic_integers) res_diff_zero_fact:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "(a \<ominus> b) k = 0"
	+ shows "a k = b k" "a k \<ominus>\<^bsub>Zp_res_ring k\<^esub> b k = 0"
	+ apply(cases "k = 0")
	+ apply (metis assms(1) assms(2) p_res_ring_0 p_res_ring_0' p_res_ring_car p_residue_padic_int p_residue_range' zero_le)
	+ apply (metis R.add.inv_closed R.add.m_lcomm R.minus_eq R.r_neg R.r_zero Zp_residue_add_zero(2) assms(1) assms(2) assms(3))
	+ using assms(2) assms(3) residue_of_diff by auto
	+
	+lemma(in padic_integers) res_diff_zero_fact':
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "a k = b k"
	+ shows "a k \<ominus>\<^bsub>Zp_res_ring k\<^esub> b k = 0"
	+ by (simp add: assms(3) residue_minus)
	+
	+lemma(in padic_integers) res_diff_zero_fact'':
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "a k = b k"
	+ shows "(a \<ominus> b) k = 0"
	+ by (simp add: assms(2) assms(3) res_diff_zero_fact' residue_of_diff)
	+
	+lemma(in padic_integers) is_Zp_cauchyI':
	+assumes "s \<in> closed_seqs Zp"
	+assumes "\<forall>n::nat. \<exists> k::int.\<forall>m. m \<ge> k \<longrightarrow> val_Zp (s (Suc m) \<ominus> s m) \<ge> n"
	+shows "is_Zp_cauchy s"
	+proof(rule is_Zp_cauchyI)
	+ show A0: "s \<in> closed_seqs Zp"
	+ by (simp add: assms(1))
	+ show "\<And>n. \<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 n = s n1 n"
	+ proof-
	+ fix n
	+ show "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 n = s n1 n"
	+ proof(induction n)
	+ case 0
	+ then show ?case
	+ proof-
	+ have "\<forall>n0 n1. 0 < n0 \<and> 0 < n1 \<longrightarrow> s n0 0 = s n1 0"
	+ apply auto
	+ proof-
	+ fix n0 n1::nat
	+ assume A: "n0 > 0" "n1 > 0"
	+ have 0: "s n0 \<in> carrier Zp"
	+ using A0
	+ by (simp add: closed_seqs_memE)
	+ have 1: "s n1 \<in> carrier Zp"
	+ using A0
	+ by (simp add: closed_seqs_memE)
	+ show " s n0 (0::nat) = s n1 (0::nat)"
	+ using A0 Zp_def 0 1 residues_closed
	+ by (metis p_res_ring_0')
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+ next
	+ case (Suc n)
	+ fix n
	+ assume IH: "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 n = s n1 n"
	+ show " \<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 (Suc n) = s n1 (Suc n)"
	+ proof-
	+ obtain N where N_def: "\<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 n = s n1 n"
	+ using IH
	+ by blast
	+ obtain k where k_def: "\<forall>m. (Suc m) \<ge> k \<longrightarrow> val_Zp (s (Suc (Suc m)) \<ominus> s (Suc m)) \<ge> Suc (Suc n)"
	+ using assms Suc_n_not_le_n
	+ by (meson nat_le_iff)
	+ have "\<forall>n0 n1. Suc (max N (max n k)) < n0 \<and> Suc (max N (max n k))< n1 \<longrightarrow> s n0 (Suc n) = s n1 (Suc n)"
	+ apply auto
	+ proof-
	+ fix n0 n1
	+ assume A: "Suc (max N (max n k)) < n0" " Suc (max N (max n k)) < n1"
	+ show "s n0 (Suc n) = s n1 (Suc n) "
	+ proof-
	+ obtain K where K_def: "K = Suc (max N (max n k))"
	+ by simp
	+ have P0: "\<And>m. s ((Suc m)+ K) (Suc n) = s (Suc K) (Suc n)"
	+ apply auto
	+ proof-
	+ fix m
	+ show "s (Suc (m + K)) (Suc n) = s (Suc K) (Suc n)"
	+ apply(induction m)
	+ apply auto
	+ proof-
	+ fix m
	+ assume A0: " s (Suc (m + K)) (Suc n) = s (Suc K) (Suc n)"
	+ show " s (Suc (Suc (m + K))) (Suc n) = s (Suc K) (Suc n)"
	+ proof-
	+ have I: "k < m + K"
	+ using K_def
	+ by linarith
	+ have "val_Zp (s (Suc (Suc (m + K))) \<ominus> s (Suc (m + K))) \<ge> Suc (Suc n)"
	+ proof-
	+ have "(Suc (m + K)) > k"
	+ by (simp add: I less_Suc_eq)
	+ then show ?thesis
	+ using k_def less_imp_le_nat
	+ by blast
	+ qed
	+ hence D: "val_Zp (s (Suc (Suc (m + K))) \<ominus> s (Suc (m + K))) > (Suc n)"
	+ using Suc_ile_eq by fastforce
	+ have "s (Suc (Suc (m + K))) (Suc n) = s (Suc (m + K)) (Suc n)"
	+ proof-
	+ have "(s (Suc (Suc (m + K))) \<ominus> s (Suc (m + K))) (Suc n) = 0"
	+ using D assms(1) res_diff_zero_fact''[of "s (Suc (Suc (m + K)))" "s (Suc (m + K)) " "Suc n"]
	+ val_Zp_dist_res_eq[of "s (Suc (Suc (m + K)))" "s (Suc (m + K)) " "Suc n"] unfolding val_Zp_dist_def
	+ by (simp add: closed_seqs_memE)
	+ hence 0: "(s (Suc (Suc (m + K))) (Suc n) \<ominus>\<^bsub>Zp_res_ring (Suc n)\<^esub> (s (Suc (m + K))) (Suc n)) = 0"
	+ using res_diff_zero_fact(2)[of "s (Suc (Suc (m + K)))" "s (Suc (m + K))" "Suc n" ]
	+ assms(1)
	+ by (simp add: closed_seqs_memE)
	+
	+ show ?thesis
	+ proof-
	+ have 00: "cring (Zp_res_ring (Suc n))"
	+ using R_cring by blast
	+ have 01: " s (Suc (Suc (m + K))) (Suc n) \<in> carrier (Zp_res_ring (Suc n))"
	+ using assms(1) closed_seqs_memE residues_closed by blast
	+ have 02: "(\<ominus>\<^bsub>Zp_res_ring (Suc n)\<^esub> (s (Suc (m + K)) (Suc n))) \<in> carrier (Zp_res_ring (Suc n)) "
	+ by (meson "00" assms(1) cring.cring_simprules(3) closed_seqs_memE residues_closed)
	+ show ?thesis
	+ unfolding a_minus_def
	+ using 00 01 02
	+ cring.sum_zero_eq_neg[of "Zp_res_ring (Suc n)" "s (Suc (Suc (m + K))) (Suc n)"
	+ "\<ominus>\<^bsub>Zp_res_ring (Suc n)\<^esub>s (Suc (m + K)) (Suc n)"]
	+ by (metis 0 a_minus_def assms(1) cring.cring_simprules(21) closed_seqs_memE
	+ p_res_ring_zero residues_closed)
	+ qed
	+ qed
	+ then show ?thesis using A0 assms(1)
	+ by simp
	+ qed
	+ qed
	+ qed
	+ have "\<exists>m0. n0 = (Suc m0) + K"
	+ proof-
	+ have "n0 > K"
	+ by (simp add: A(1) K_def)
	+ then have "n0 = (Suc (n0 - K - 1)) + K"
	+ by auto
	+ then show ?thesis by blast
	+ qed
	+ then obtain m0 where m0_def: "n0 = (Suc m0) + K"
	+ by blast
	+ have "\<exists>m0. n1 = (Suc m0) + K"
	+ proof-
	+ have "n1 > K"
	+ by (simp add: A(2) K_def)
	+ then have "n1 = (Suc (n1 - K - 1)) + K"
	+ by auto
	+ then show ?thesis by blast
	+ qed
	+ then obtain m1 where m1_def: "n1 = (Suc m1) + K"
	+ by blast
	+ have 0: "s n0 (Suc n) = s (Suc K) (Suc n)"
	+ using m0_def P0[of "m0"] by auto
	+ have 1: "s n1 (Suc n) = s (Suc K) (Suc n)"
	+ using m1_def P0[of "m1"] by auto
	+ show ?thesis using 0 1
	+ by auto
	+ qed
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+ qed
	+ qed
	+qed
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>The Proof of Hensel's Lemma\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+subsection\<open>Building a Locale for the Proof of Hensel's Lemma\<close>
	+
	+locale hensel = padic_integers+
	+ fixes f::padic_int_poly
	+ fixes a::padic_int
	+ assumes f_closed[simp]: "f \<in> carrier Zp_x"
	+ assumes a_closed[simp]: "a \<in> carrier Zp"
	+ assumes fa_nonzero[simp]: "f\<bullet>a \<noteq>\<zero>"
	+ assumes hensel_hypothesis[simp]: "(val_Zp (f\<bullet>a) > 2* val_Zp ((pderiv f)\<bullet>a))"
	+
	+sublocale hensel < cring Zp
	+ by (simp add: R.is_cring)
	+
	+context hensel
	+begin
	+
	+abbreviation f' where
	+"f' \<equiv> pderiv f"
	+
	+lemma f'_closed:
	+"f' \<in> carrier Zp_x"
	+ using f_closed pderiv_closed by blast
	+
	+lemma f'_vals_closed:
	+ assumes "a \<in> carrier Zp"
	+ shows "f'\<bullet>a \<in> carrier Zp"
	+ by (simp add: UP_cring.to_fun_closed Zp_x_is_UP_cring f'_closed)
	+
	+lemma fa_closed:
	+"(f\<bullet>a) \<in> carrier Zp"
	+ by (simp add: UP_cring.to_fun_closed Zp_x_is_UP_cring)
	+
	+lemma f'a_closed:
	+"(f'\<bullet>a) \<in> carrier Zp"
	+proof-
	+ have "f' \<in> carrier Zp_x"
	+ by (simp add: f'_closed)
	+ then show ?thesis
	+ by (simp add: f'_vals_closed)
	+qed
	+
	+lemma fa_nonzero':
	+"(f\<bullet>a) \<in> nonzero Zp"
	+ using fa_closed fa_nonzero not_nonzero_Zp by blast
	+
	+lemma f'a_nonzero[simp]:
	+"(f'\<bullet>a) \<noteq> \<zero>"
	+proof(rule ccontr)
	+ assume "\<not> (f'\<bullet>a) \<noteq> \<zero>"
	+ then have "(f'\<bullet>a) = \<zero>"
	+ by blast
	+ then have "\<infinity> < val_Zp (f\<bullet>a)" using hensel_hypothesis
	+ by (simp add: val_Zp_def)
	+ thus False
	+ using eint_ord_simps(6) by blast
	+qed
	+
	+lemma f'a_nonzero':
	+"(f'\<bullet>a) \<in> nonzero Zp"
	+ using f'a_closed f'a_nonzero not_nonzero_Zp by blast
	+
	+lemma f'a_not_infinite[simp]:
	+"val_Zp (f'\<bullet>a) \<noteq> \<infinity>"
	+ by (metis eint_ord_code(3) hensel_hypothesis linorder_not_less times_eint_simps(4))
	+
	+lemma f'a_nonneg_val[simp]:
	+"val_Zp ((f'\<bullet>a)) \<ge> 0"
	+ using f'a_closed val_pos by blast
	+
	+lemma hensel_hypothesis_weakened:
	+"val_Zp (f\<bullet>a) > val_Zp (f'\<bullet>a)"
	+proof-
	+ have 0: "0 \<le> val_Zp (f'\<bullet>a) \<and> val_Zp (f'\<bullet>a) \<noteq> \<infinity>"
	+ using f'a_closed val_ord_Zp val_pos by force
	+ have 1: "1 < eint 2 "
	+ by (simp add: one_eint_def)
	+ thus ?thesis using 0 eint_mult_mono'[of "val_Zp (f'\<bullet>a)" 1 2] hensel_hypothesis
	+ by (metis linorder_not_less mult_one_left order_trans)
	+qed
	+
	+subsection\<open>Constructing the Newton Sequence\<close>
	+
	+definition newton_step :: "padic_int \<Rightarrow> padic_int" where
	+"newton_step x = x \<ominus> (divide (f\<bullet>x) (f'\<bullet>x))"
	+
	+lemma newton_step_closed:
	+ "newton_step a \<in> carrier Zp"
	+ using divide_closed unfolding newton_step_def
	+ using f'a_closed f'a_nonzero fa_closed local.a_closed by blast
	+
	+fun newton_seq :: "padic_int_seq" ("ns") where
	+"newton_seq 0 = a"\|
	+"newton_seq (Suc n) = newton_step (newton_seq n)"
	+
	+subsection\<open>Key Properties of the Newton Sequence\<close>
	+
	+lemma hensel_factor_id:
	+"(divide (f\<bullet>a) (f'\<bullet>a)) \<otimes> ((f'\<bullet>a)) = (f\<bullet>a)"
	+ using hensel_hypothesis hensel_axioms divide_formula f'a_closed
	+ fa_closed hensel_hypothesis_weakened mult_comm
	+ by auto
	+
	+definition hensel_factor ("t") where
	+"hensel_factor = val_Zp (f\<bullet>a) - 2*(val_Zp (f'\<bullet>a))"
	+
	+lemma t_pos[simp]:
	+"t > 0"
	+ using hensel_factor_def hensel_hypothesis
	+ by (simp add: eint_minus_le)
	+
	+lemma t_neq_infty[simp]:
	+"t \<noteq> \<infinity>"
	+ by (simp add: hensel_factor_def val_Zp_def)
	+
	+lemma t_times_pow_pos[simp]:
	+"(2^(n::nat))*t > 0"
	+ apply(cases "n = 0")
	+ using one_eint_def apply auto[1]
	+ using eint_mult_mono'[of t 1 "2^n"] t_pos
	+ by (smt eint_ord_simps(2) linorder_not_less mult_one_left neq0_conv one_eint_def order_less_le order_trans self_le_power t_neq_infty)
	+
	+lemma newton_seq_props_induct:
	+shows "\<And>k. k \<le> n \<Longrightarrow> (ns k) \<in> carrier Zp
	+ \<and> val_Zp (f'\<bullet>(ns k)) = val_Zp ((f'\<bullet>a))
	+ \<and> val_Zp (f\<bullet>(ns k)) \<ge> 2(val_Zp (f'\<bullet>a)) + (2^k)t"
	+proof(induction n)
	+ case 0
	+ then have kz: "k = 0"
	+ by simp
	+ have B0: "( ns k) \<in> carrier Zp"
	+ using kz
	+ by simp
	+ have B1: "val_Zp (f' \<bullet> ns k) = (val_Zp (f'\<bullet>a))"
	+ using kz newton_seq.simps(1)
	+ by presburger
	+ have B2: "val_Zp (f \<bullet> (ns k)) \<ge> (2 * (val_Zp (f'\<bullet>a))) + 2 ^ k * t"
	+ proof-
	+ have B20: "(2 * (val_Zp (f'\<bullet>a))) + 2 ^ k * t = (2 * (val_Zp (f'\<bullet>a))) + t"
	+ proof-
	+ have "(2 * (val_Zp (f'\<bullet>a))) + 2 ^ k * t = (2 * (val_Zp (f'\<bullet>a))) + t"
	+ using kz one_eint_def by auto
	+ then show ?thesis
	+ by blast
	+ qed
	+ then have "(2 * (val_Zp (f'\<bullet>a))) + 2 ^ k * t = (2 * (val_Zp (f'\<bullet>a))) + val_Zp (f\<bullet>a) - 2*(val_Zp (f'\<bullet>a))"
	+ unfolding hensel_factor_def
	+ by (simp add: val_Zp_def)
	+ then have "(2 * (val_Zp (f'\<bullet>a))) + 2 ^ k * t = val_Zp (f\<bullet>a)"
	+ by (metis add_diff_cancel_eint eint_ord_simps(6) hensel_hypothesis)
	+ thus ?thesis by (simp add: kz)
	+ qed
	+ thus ?case
	+ using B0 B1 by blast
	+next
	+ case (Suc n)
	+ show ?case
	+ proof(cases "k \<le> n")
	+ case True
	+ then show ?thesis using Suc.IH
	+ by blast
	+ next
	+ case False
	+ have F1: "(ns n) \<in> carrier Zp"
	+ using Suc.IH by blast
	+ have F2: "val_Zp (f'\<bullet>(ns n)) = val_Zp ((f'\<bullet>a))"
	+ using Suc.IH by blast
	+ have F3: "val_Zp (f\<bullet>(ns n)) \<ge> 2(val_Zp (f'\<bullet>a)) + (2^n)t"
	+ using Suc.IH by blast
	+ have kval: "k = Suc n"
	+ using False Suc.prems le_Suc_eq by blast
	+ have F6: "val_Zp (f\<bullet>(ns n)) \<ge> val_Zp (f'\<bullet>(ns n))"
	+ proof-
	+ have "2*(val_Zp (f'\<bullet>a)) \<ge> val_Zp (f'\<bullet>a)"
	+ using f'a_closed val_pos eint_mult_mono'[of "val_Zp (f'\<bullet>a)" 1 2]
	+ by (metis Groups.add_ac(2) add.right_neutral eSuc_eint eint_0_iff(2) eint_add_left_cancel_le
	+ eint_ord_simps(2) f'a_nonneg_val f'a_not_infinite infinity_ne_i1 linorder_not_less
	+ mult_one_left not_one_less_zero one_add_one one_eint_def order_less_le order_trans zero_one_eint_neq(1))
	+ hence "2(val_Zp (f'\<bullet>a)) + (2^n)t \<ge> val_Zp (f'\<bullet>a)"
	+ using t_times_pow_pos[of n]
	+ by (metis (no_types, lifting) add.right_neutral eint_add_left_cancel_le order_less_le order_trans)
	+ then show ?thesis
	+ using F2 F3 by auto
	+ qed
	+ have F5: " divide (f\<bullet>(ns n))(f'\<bullet>(ns n)) \<in> carrier Zp"
	+ proof-
	+ have 00: "f \<bullet> ns n \<in> carrier Zp"
	+ by (simp add: F1 to_fun_closed)
	+ have "val_Zp ((f'\<bullet>a)) \<noteq> val_Zp \<zero>"
	+ by (simp add: val_Zp_def)
	+ then have 01: "f' \<bullet> ns n \<in> nonzero Zp"
	+ using F2 F1 Zp_x_is_UP_cring f'_closed nonzero_def
	+ proof -
	+ have "f' \<bullet> ns n \<in> carrier Zp"
	+ using F1 Zp_continuous_is_Zp_closed f'_closed polynomial_is_Zp_continuous
	+ by (simp add: to_fun_closed)
	+ then show ?thesis
	+ using F2 \<open>val_Zp (f'\<bullet>a) \<noteq> val_Zp \<zero>\<close> not_nonzero_Zp by fastforce
	+ qed
	+ then show ?thesis
	+ using F6
	+ by (metis "00" F2 \<open>val_Zp (f'\<bullet>a) \<noteq> val_Zp \<zero>\<close> divide_closed nonzero_closed)
	+ qed
	+ have F4: "(ns k) \<ominus> (ns n) = (\<ominus> divide (f\<bullet>(ns n))(f'\<bullet>(ns n)))"
	+ using F1 F5 newton_seq.simps(2)[of n] kval
	+ unfolding newton_step_def
	+ by (metis R.l_neg R.minus_closed R.minus_zero R.plus_diff_simp R.r_neg2 R.r_right_minus_eq
	+ a_minus_def local.a_closed minus_a_inv)
	+ have F7: "val_Zp (divide (f\<bullet>(ns n))(f'\<bullet>(ns n))) = val_Zp (f\<bullet>(ns n)) - val_Zp (f'\<bullet>(ns n))"
	+ apply(rule val_of_divide)
	+ apply (simp add: F1 to_fun_closed)
	+ using F1 f'_closed to_fun_closed F2 not_nonzero_Zp val_Zp_def apply fastforce
	+ by (simp add: F6)
	+ show ?thesis
	+ proof
	+ show P0:"ns k \<in> carrier Zp"
	+ proof-
	+ have A0: "ns k = ns n \<ominus> (divide (f\<bullet> (ns n)) (f'\<bullet>(ns n)))"
	+ by (simp add: kval newton_step_def)
	+ have A1: "val_Zp (f'\<bullet>(ns n)) = val_Zp (f'\<bullet>a)"
	+ using Suc.IH
	+ by blast
	+ have A2: "val_Zp (f\<bullet>(ns n)) \<ge>val_Zp (f'\<bullet>a)"
	+ proof-
	+ have A20: "(2 * val_Zp (f'\<bullet>a)) + 2 ^ n * (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a)) \<ge>val_Zp (f'\<bullet>a)"
	+ proof-
	+ have "val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a) > 0"
	+ using hensel_hypothesis eint_minus_le by blast
	+ then have " (2 ^ n) * (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a))
	+ \<ge> (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a))"
	+ using eint_pos_int_times_ge by auto
	+ then have " ((2 * val_Zp (f'\<bullet>a)) + 2 ^ n * (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a)))
	+ \<ge> (2 * val_Zp (f'\<bullet>a)) + (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a))"
	+ by (simp add: val_Zp_def)
	+ then have " ((2 * val_Zp (f'\<bullet>a)) + 2 ^ n * (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a)))
	+ \<ge> (val_Zp (f\<bullet>a) )"
	+ by simp
	+ then show " ((2 * val_Zp (f'\<bullet>a)) + 2 ^ n * (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a)))
	+ \<ge> (val_Zp (f'\<bullet>a) )"
	+ using hensel_hypothesis_weakened by auto
	+ qed
	+ have A21:"val_Zp (f\<bullet>(ns n)) \<ge> (2 * val_Zp (f'\<bullet>a)) + 2 ^ n * (val_Zp (f\<bullet>a) - 2 * val_Zp (f'\<bullet>a))"
	+ using Suc.IH unfolding hensel_factor_def
	+ by blast
	+ show ?thesis using A21 A20
	+ by auto
	+ qed
	+ have A3: "ns n \<in> carrier Zp"
	+ using Suc.IH by blast
	+ have A4: "val_Zp (f\<bullet>(ns n)) \<ge>val_Zp (f'\<bullet>(ns n))"
	+ using A1 A2
	+ by presburger
	+ have A5: "f\<bullet>(ns n) \<in> carrier Zp"
	+ by (simp add: F1 UP_cring.to_fun_closed Zp_x_is_UP_cring)
	+ have A6: "(f'\<bullet>(ns n)) \<in> nonzero Zp"
	+ proof-
	+ have "(f'\<bullet>(ns n)) \<in> carrier Zp"
	+ by (simp add: F1 UP_cring.to_fun_closed Zp_x_is_UP_cring f'_closed)
	+ have "val_Zp (f'\<bullet>(ns n)) \<noteq> \<infinity>"
	+ using A1
	+ by (simp add: val_Zp_def)
	+ then show ?thesis
	+ using \<open>f' \<bullet> ns n \<in> carrier Zp\<close> not_nonzero_Zp val_Zp_def
	+ by meson
	+ qed
	+ have A7: " (divide (f\<bullet> (ns n)) (f'\<bullet>(ns n))) \<in> carrier Zp"
	+ using A5 A6 A4 A3 F5 by linarith
	+ then show ?thesis
	+ using A0 A3 cring.cring_simprules(4)
	+ by (simp add: F1 F5 cring.cring_simprules(4))
	+ qed
	+ have P1: "val_Zp (f' \<bullet> ns k) = val_Zp (f'\<bullet>a) "
	+ proof(cases "(f' \<bullet> ns k) = (f' \<bullet> ns n)")
	+ case True
	+ then show ?thesis using Suc.IH
	+ by (metis order_refl)
	+ next
	+ case False
	+ have "val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) \<ge> val_Zp ((ns k) \<ominus> (ns n))"
	+ using False P0 f'_closed poly_diff_val Suc.IH
	+ by blast
	+ then have "val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) \<ge> val_Zp (\<ominus> divide (f\<bullet>(ns n))(f'\<bullet>(ns n)))"
	+ using F4 by metis
	+ then have "val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) \<ge> val_Zp (divide (f\<bullet>(ns n))(f'\<bullet>(ns n)))"
	+ using F5 val_Zp_of_minus
	+ by presburger
	+ then have P10: "val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) \<ge> val_Zp (f\<bullet>(ns n)) - val_Zp (f'\<bullet>(ns n))"
	+ using F7 by metis
	+ have P11: "val_Zp (f'\<bullet>(ns n)) \<noteq> \<infinity>"
	+ by (simp add: F2)
	+ then have "val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) \<ge> (2 * val_Zp (f'\<bullet>a)) + 2 ^ n * t - val_Zp (f'\<bullet>(ns n))"
	+ using F3 P10
	+ by (smt eint_add_cancel_fact eint_add_left_cancel_le order_trans)
	+ then have P12: "val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) \<ge> (2 (val_Zp (f'\<bullet>a))) + 2 ^ n t - (val_Zp (f'\<bullet>a))"
	+ by (simp add: F2)
	+ have P13:"val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) \<ge> (val_Zp (f'\<bullet>a)) + 2 ^ n * t "
	+ proof-
	+ have "(2 (val_Zp (f'\<bullet>a))) + (2 ^ n t) - (val_Zp (f'\<bullet>a)) = (2 (val_Zp (f'\<bullet>a))) - (val_Zp (f'\<bullet>a)) + (2 ^ n t) "
	+ using eint_minus_comm by blast
	+ then show ?thesis using P12
	+ using f'a_not_infinite by force
	+ qed
	+ then have P14: "val_Zp ((f' \<bullet> ns k) \<ominus> (f' \<bullet> ns n)) > (val_Zp (f'\<bullet>a))"
	+ using f'a_not_infinite ge_plus_pos_imp_gt t_times_pow_pos by blast
	+ show ?thesis
	+ by (meson F1 F2 P0 P14 equal_val_Zp f'_closed f'a_closed to_fun_closed)
	+ qed
	+ have P2: "val_Zp (f\<bullet>(ns k)) \<ge> 2(val_Zp (f'\<bullet>a)) + (2^k)t"
	+ proof-
	+ have P23: "2 * (val_Zp (f'\<bullet>a)) + ((2 ^ k) * t) \<le> val_Zp (f \<bullet> ns k)"
	+ proof-
	+ have 0: "ns n \<in> carrier Zp"
	+ by (simp add: F1)
	+ have 1: "local.divide (f \<bullet> ns n) (f' \<bullet> ns n) \<in> carrier Zp"
	+ using F5 by blast
	+ have 2: "(poly_shift_iter 2 (taylor (ns n) f)) \<bullet> \<ominus> local.divide (f \<bullet> ns n) (f' \<bullet> ns n) \<in> carrier Zp"
	+ using F1 F5 shift_closed 1
	+ by (simp add: taylor_closed to_fun_closed)
	+ have 3: "divide (f \<bullet> ns n) (f' \<bullet> ns n) \<otimes> deriv f (ns n) = f \<bullet> ns n"
	+ by (metis F1 F2 F6 divide_formula f'_closed f'a_not_infinite f_closed mult_comm pderiv_eval_deriv to_fun_closed val_Zp_def)
	+ have 4: "f \<in> carrier Zp_x"
	+ by simp
	+ obtain c where c_def: "c = poly_shift_iter (2::nat) (taylor (ns n) f) \<bullet> \<ominus> local.divide (f \<bullet> ns n) (f' \<bullet> ns n)"
	+ by blast
	+ then have c_def': "c \<in> carrier Zp \<and> f \<bullet> (ns n \<ominus> local.divide (f \<bullet> ns n) (f' \<bullet> ns n)) = c \<otimes> local.divide (f \<bullet> ns n) (f' \<bullet> ns n) [^] (2::nat)"
	+ using 0 1 2 3 4 UP_cring.taylor_deg_1_eval'''[of Zp f "ns n" "(divide (f\<bullet>(ns n)) (f'\<bullet>(ns n)))" c]
	+ Zp_x_is_UP_cring
	+ by blast
	+ have P230: "f\<bullet>(ns k) = (c \<otimes> (divide (f\<bullet>(ns n)) (f'\<bullet>(ns n)))[^](2::nat))"
	+ using c_def'
	+ by (simp add: kval newton_step_def)
	+ have P231: "val_Zp (f\<bullet>(ns k)) = val_Zp c + 2*(val_Zp (f\<bullet>(ns n)) - val_Zp(f'\<bullet>(ns n)))"
	+ proof-
	+ have P2310: "val_Zp (f\<bullet>(ns k)) = val_Zp c + val_Zp ((divide (f\<bullet>(ns n)) (f'\<bullet>(ns n)))[^](2::nat))"
	+ by (simp add: F5 P230 c_def' val_Zp_mult)
	+ have P2311: "val_Zp ((divide (f\<bullet>(ns n)) (f'\<bullet>(ns n)))[^](2::nat))
	+ = 2*(val_Zp (f\<bullet>(ns n)) - val_Zp(f'\<bullet>(ns n)))"
	+ by (metis F5 F7 R.pow_zero mult.commute not_nonzero_Zp of_nat_numeral times_eint_simps(3) val_Zp_def val_Zp_pow' zero_less_numeral)
	+ thus ?thesis
	+ by (simp add: P2310)
	+ qed
	+ have P232: "val_Zp (f\<bullet>(ns k)) \<ge> 2*(val_Zp (f\<bullet>(ns n)) - val_Zp(f'\<bullet>(ns n)))"
	+ by (simp add: P231 c_def' val_pos)
	+ have P236: "val_Zp (f\<bullet>(ns k)) \<ge> 2(2 val_Zp (f'\<bullet>a) + 2 ^ n * t) - 2* val_Zp(f'\<bullet>(ns n))"
	+ using P232 F3 eint_minus_ineq''[of "val_Zp(f'\<bullet>(ns n))" "(2 val_Zp (f'\<bullet>a)) + 2 ^ n t" "val_Zp (f\<bullet>(ns n))" 2 ]
	+ F2 eint_pow_int_is_pos by auto
	+ hence P237: "val_Zp (f\<bullet>(ns k)) \<ge>(4val_Zp (f'\<bullet>a)) + (2((2 ^ n)* t)) - 2* val_Zp(f'\<bullet>(ns n))"
	+ proof-
	+ have "2(2val_Zp (f'\<bullet>a) + 2 ^ n * t) = (4val_Zp (f'\<bullet>a)) + 2(2 ^ n)* t "
	+ using distrib_left[of 2 "2val_Zp (f'\<bullet>a)" "2 ^ n t"] mult.assoc mult_one_right one_eint_def plus_eint_simps(1)
	+ hensel_factor_def val_Zp_def by auto
	+ then show ?thesis
	+ using P236
	+ by (metis mult.assoc)
	+ qed
	+ hence P237: "val_Zp (f\<bullet>(ns k)) \<ge> 4val_Zp (f'\<bullet>a) + 2(2 ^ n)* t - 2* val_Zp((f'\<bullet>a))"
	+ by (metis F2 mult.assoc)
	+ hence P238: "val_Zp (f\<bullet>(ns k)) \<ge> 2val_Zp (f'\<bullet>a) + 2(2 ^ n)* t"
	+ using eint_minus_comm[of "4val_Zp (f'\<bullet>a) " "2(2 ^ n)* t" "2* val_Zp((f'\<bullet>a))"]
	+ by (simp add: eint_int_minus_distr)
	+ thus ?thesis
	+ by (simp add: kval)
	+ qed
	+ thus ?thesis
	+ by blast
	+ qed
	+ show "val_Zp (to_fun f' (ns k)) = val_Zp (f'\<bullet>a) \<and>
	+ 2 * val_Zp (f'\<bullet>a) + eint (2 ^ k) * t \<le> val_Zp (to_fun f (ns k))"
	+ using P1 P2 by blast
	+ qed
	+ qed
	+qed
	+
	+lemma newton_seq_closed:
	+shows "ns m \<in> carrier Zp"
	+ using newton_seq_props_induct
	+ by blast
	+
	+lemma f_of_newton_seq_closed:
	+shows "f \<bullet> ns m \<in> carrier Zp"
	+ by (simp add: to_fun_closed newton_seq_closed)
	+
	+lemma newton_seq_fact1[simp]:
	+" val_Zp (f'\<bullet>(ns k)) = val_Zp ((f'\<bullet>a))"
	+using newton_seq_props_induct by blast
	+
	+lemma newton_seq_fact2:
	+"\<And>k. val_Zp (f\<bullet>(ns k)) \<ge> 2(val_Zp (f'\<bullet>a)) + (2^k)t"
	+ by (meson le_iff_add newton_seq_props_induct)
	+
	+lemma newton_seq_fact3:
	+"val_Zp (f\<bullet>(ns l)) \<ge> val_Zp (f'\<bullet>(ns l))"
	+proof-
	+ have "2(val_Zp (f'\<bullet>a)) + (2^l)t \<ge> (val_Zp (f'\<bullet>a))"
	+ using f'a_closed ord_pos t_pos
	+ by (smt eint_pos_int_times_ge f'a_nonneg_val f'a_not_infinite ge_plus_pos_imp_gt linorder_not_less nat_mult_not_infty order_less_le t_times_pow_pos)
	+ then show "val_Zp (f \<bullet> ns l) \<ge> val_Zp (f' \<bullet> ns l) "
	+ using f'a_closed f'a_nonzero newton_seq_fact1[of l] newton_seq_fact2[of l] val_Zp_def
	+ proof -
	+ show ?thesis
	+ using \<open>eint 2 * val_Zp (f'\<bullet>a) + eint (2 ^ l) * t \<le> val_Zp (to_fun f (ns l))\<close> \<open>val_Zp (f'\<bullet>a) \<le> eint 2 * val_Zp (f'\<bullet>a) + eint (2 ^ l) * t\<close> by force
	+ qed
	+qed
	+
	+lemma newton_seq_fact4[simp]:
	+ assumes "f\<bullet>(ns l) \<noteq>\<zero>"
	+ shows "val_Zp (f\<bullet>(ns l)) \<ge> val_Zp (f'\<bullet>(ns l))"
	+ using newton_seq_fact3 by blast
	+
	+lemma newton_seq_fact5:
	+"divide (f \<bullet> ns l) (f' \<bullet> ns l) \<in> carrier Zp"
	+ apply(rule divide_closed)
	+ apply (simp add: to_fun_closed newton_seq_closed)
	+ apply (simp add: f'_closed to_fun_closed newton_seq_closed)
	+ by (metis f'a_not_infinite newton_seq_fact1 val_Zp_def)
	+
	+lemma newton_seq_fact6:
	+"(f'\<bullet>(ns l)) \<in> nonzero Zp"
	+ apply(rule ccontr)
	+ using nonzero_memI nonzero_memE
	+ f'a_nonzero newton_seq_fact1 val_Zp_def
	+ by (metis (no_types, lifting) divide_closed f'_closed f'a_closed fa_closed hensel_factor_id
	+ hensel_hypothesis_weakened mult_zero_l newton_seq_closed order_less_le to_fun_closed val_Zp_mult)
	+
	+lemma newton_seq_fact7:
	+ "(ns (Suc n)) \<ominus> (ns n) = \<ominus>divide (f\<bullet>(ns n)) (f'\<bullet>(ns n))"
	+ using newton_seq.simps(2)[of n] newton_seq_fact5[of n]
	+ newton_seq_closed[of "Suc n"] newton_seq_closed[of n]
	+ R.ring_simprules
	+ unfolding newton_step_def a_minus_def
	+ by smt
	+
	+lemma newton_seq_fact8:
	+ assumes "f\<bullet>(ns l) \<noteq>\<zero>"
	+ shows "divide (f \<bullet> ns l) (f' \<bullet> ns l) \<in> nonzero Zp"
	+ using assms divide_nonzero[of "f \<bullet> ns l" "f' \<bullet> ns l"]
	+ nonzero_memI
	+ using f_of_newton_seq_closed newton_seq_fact3 newton_seq_fact6 by blast
	+
	+lemma newton_seq_fact9:
	+ assumes "f\<bullet>(ns n) \<noteq>\<zero>"
	+ shows "val_Zp((ns (Suc n)) \<ominus> (ns n)) = val_Zp (f\<bullet>(ns n)) - val_Zp (f'\<bullet>(ns n))"
	+ using newton_seq_fact7 val_of_divide newton_seq_fact6 assms nonzero_memI
	+ f_of_newton_seq_closed newton_seq_fact4 newton_seq_fact5
	+ by (metis val_Zp_of_minus)
	+
	+text\<open>Assuming no element of the Newton sequence is a root of f, the Newton sequence is Cauchy.\<close>
	+
	+lemma newton_seq_is_Zp_cauchy_0:
	+assumes "\<And>k. f\<bullet>(ns k) \<noteq>\<zero>"
	+shows "is_Zp_cauchy ns"
	+proof(rule is_Zp_cauchyI')
	+ show P0: "ns \<in> closed_seqs Zp"
	+ proof(rule closed_seqs_memI)
	+ show "\<And>k. ns k \<in> carrier Zp "
	+ by (simp add: newton_seq_closed)
	+ qed
	+ show "\<forall>n. \<exists>k. \<forall>m. k \<le> int m \<longrightarrow> int n \<le> val_Zp (ns (Suc m) \<ominus> ns m)"
	+ proof
	+ fix n
	+ show "\<exists>k. \<forall>m. k \<le> int m \<longrightarrow> int n \<le> val_Zp (ns (Suc m) \<ominus> ns m)"
	+ proof(induction "n")
	+ case 0
	+ have B0: "\<forall>n0 n1. 0 < n0 \<and> 0 < n1 \<longrightarrow> ns n0 0 = ns n1 0"
	+ apply auto
	+ proof-
	+ fix n0 n1::nat
	+ assume A: "0 < n0" "0 < n1"
	+ show "ns n0 0 = ns n1 0"
	+ proof-
	+ have 0: "ns n0 \<in> carrier Zp"
	+ using P0
	+ by (simp add: newton_seq_closed)
	+ have 1: "ns n1 \<in> carrier Zp"
	+ using P0
	+ by (simp add: newton_seq_closed)
	+ show ?thesis
	+ using 0 1 Zp_defs(3) prime
	+ by (metis p_res_ring_0' residue_closed)
	+ qed
	+ qed
	+ have "\<forall>m. 1 \<le> int m \<longrightarrow> int 0 \<le> val_Zp_dist (newton_step (ns m)) (ns m)"
	+ proof
	+ fix m
	+ show "1 \<le> int m \<longrightarrow> int 0 \<le> val_Zp_dist (newton_step (ns m)) (ns m)"
	+ proof
	+ assume "1 \<le> int m "
	+ then have C0:"ns (Suc m) 0 = ns m 0"
	+ using B0
	+ by (metis int_one_le_iff_zero_less int_ops(1) less_Suc_eq_0_disj of_nat_less_iff)
	+ then show "int 0 \<le> val_Zp_dist (newton_step (ns m)) (ns m)"
	+ proof-
	+ have "(newton_step (ns m)) \<noteq>(ns m)"
	+ proof-
	+ have A0: "divide (f\<bullet>(ns m)) (f'\<bullet>(ns m)) \<noteq>\<zero>"
	+ proof-
	+ have 0: "(f\<bullet>(ns m)) \<noteq> \<zero>"
	+ using assms by auto
	+ have 1: " (f'\<bullet>(ns m)) \<in> carrier Zp"
	+ by (simp add: UP_cring.to_fun_closed Zp_x_is_UP_cring f'_closed newton_seq_closed)
	+ have 2: "(f'\<bullet>(ns m)) \<noteq> \<zero>"
	+ using newton_seq_fact6 not_nonzero_memI by blast
	+ show ?thesis using 0 1 2
	+ by (metis R.r_null divide_formula f_closed to_fun_closed newton_seq_closed newton_seq_fact4)
	+ qed
	+ have A2: "local.divide (f \<bullet> ns m) (f' \<bullet> ns m) \<in> carrier Zp"
	+ using newton_seq_fact5 by blast
	+ have A3: "ns m \<in> carrier Zp"
	+ by (simp add: newton_seq_closed)
	+ have A4: "newton_step (ns m) \<in> carrier Zp"
	+ by (metis newton_seq.simps(2) newton_seq_closed)
	+ show ?thesis
	+ apply(rule ccontr)
	+ using A4 A3 A2 A0 newton_step_def[of "(ns m)"]
	+ by (simp add: a_minus_def)
	+ qed
	+ then show ?thesis using C0
	+ by (metis newton_seq.simps(2) newton_seq_closed val_Zp_dist_res_eq2)
	+ qed
	+ qed
	+ qed
	+ then show ?case
	+ using val_Zp_def val_Zp_dist_def
	+ by (metis int_ops(1) newton_seq.simps(2) zero_eint_def)
	+ next
	+ case (Suc n)
	+ show "\<exists>k. \<forall>m. k \<le> int m \<longrightarrow> int (Suc n) \<le> val_Zp (ns (Suc m) \<ominus> ns m)"
	+ proof-
	+ obtain k0 where k0_def: "k0 \<ge>0 \<and> (\<forall>m. k0 \<le> int m \<longrightarrow> int n \<le> val_Zp (ns (Suc m) \<ominus> ns m))"
	+ using Suc.IH
	+ by (metis int_nat_eq le0 nat_le_iff of_nat_0_eq_iff )
	+ have I0: "\<And>l. val_Zp (ns (Suc l) \<ominus> ns l) = val_Zp (f\<bullet> (ns l)) - val_Zp (f'\<bullet>(ns l))"
	+ proof-
	+ fix l
	+ have I00:"(ns (Suc l) \<ominus> ns l) = (\<ominus> divide (f\<bullet>(ns l)) (f'\<bullet>(ns l)))"
	+ proof-
	+ have "local.divide (f \<bullet> ns l) (f' \<bullet> ns l) \<in> carrier Zp"
	+ by (simp add: newton_seq_fact5)
	+ then show ?thesis
	+ using newton_seq.simps(2)[of l] newton_seq_closed R.ring_simprules
	+ unfolding newton_step_def a_minus_def
	+ by (metis add_comm)
	+ qed
	+ have I01: "val_Zp (ns (Suc l) \<ominus> ns l) = val_Zp (divide (f\<bullet>(ns l)) (f'\<bullet>(ns l)))"
	+ proof-
	+ have I010: "(divide (f\<bullet>(ns l)) (f'\<bullet>(ns l))) \<in>carrier Zp"
	+ by (simp add: newton_seq_fact5)
	+ have I011: "(divide (f\<bullet>(ns l)) (f'\<bullet>(ns l))) \<noteq> \<zero>"
	+ proof-
	+ have A: "(f\<bullet>(ns l)) \<noteq>\<zero>"
	+ by (simp add: assms)
	+ have B: " (f'\<bullet>(ns l)) \<in>carrier Zp"
	+ using nonzero_memE newton_seq_fact6 by auto
	+ then have C: " (f'\<bullet>(ns l)) \<in>nonzero Zp"
	+ using f'a_closed fa_closed fa_nonzero hensel_factor_id hensel_hypothesis_weakened
	+ newton_seq_fact1[of l] not_nonzero_Zp val_Zp_def
	+ by fastforce
	+ then show ?thesis using I010 A
	+ by (metis B R.r_null divide_formula f_closed to_fun_closed newton_seq_closed newton_seq_fact4 nonzero_memE(2))
	+ qed
	+ then have "val_Zp (divide (f\<bullet>(ns l)) (f'\<bullet>(ns l)))
	+ = val_Zp (\<ominus> divide (f\<bullet>(ns l)) (f'\<bullet>(ns l)))"
	+ using I010 not_nonzero_Zp val_Zp_of_minus by blast
	+ then show ?thesis using I00 by metis
	+ qed
	+ have I02: "val_Zp (f\<bullet>(ns l)) \<ge> val_Zp (f'\<bullet>(ns l))"
	+ using assms newton_seq_fact4
	+ by blast
	+ have I03: "(f\<bullet>(ns l)) \<in> nonzero Zp"
	+ by (meson UP_cring.to_fun_closed Zp_x_is_UP_cring assms f_closed newton_seq_closed not_nonzero_Zp)
	+ have I04: "f'\<bullet>(ns l) \<in> nonzero Zp"
	+ by (simp add: newton_seq_fact6)
	+ have I05 :" val_Zp (divide (f\<bullet>(ns l)) (f'\<bullet>(ns l))) = val_Zp (f\<bullet> (ns l)) - val_Zp (f'\<bullet>(ns l))"
	+ using I02 I03 I04 I01 assms newton_seq_fact9 by auto
	+ then show " val_Zp (ns (Suc l) \<ominus> ns l) = val_Zp (f\<bullet> (ns l)) - val_Zp (f'\<bullet>(ns l))"
	+ using I01 by simp
	+ qed
	+ have "\<forall>m. int(Suc n) + k0 + 1 \<le> int m \<longrightarrow> int (Suc n) \<le> val_Zp_dist (newton_step (ns m)) (ns m)"
	+ proof
	+ fix m
	+ show "int (Suc n) + k0 + 1 \<le> int m \<longrightarrow> int (Suc n) \<le> val_Zp_dist (newton_step (ns m)) (ns m)"
	+ proof
	+ assume A: "int (Suc n) + k0 + 1 \<le> int m "
	+ show " int (Suc n) \<le> val_Zp_dist (newton_step (ns m)) (ns m)"
	+ proof-
	+ have 0: " val_Zp_dist (newton_step (ns m)) (ns m) = val_Zp (f\<bullet> (ns m)) - val_Zp (f'\<bullet>(ns m))"
	+ using I0 val_Zp_dist_def by auto
	+ have 1: "val_Zp (f\<bullet> (ns m)) - val_Zp (f'\<bullet>(ns m)) > int n"
	+ proof-
	+ have "val_Zp (f\<bullet> (ns m)) \<ge> 2(val_Zp (f'\<bullet>a)) + (2^m)t"
	+ by (simp add: newton_seq_fact2)
	+ then have 10:"val_Zp (f\<bullet> (ns m)) - val_Zp (f'\<bullet>(ns m)) \<ge> 2(val_Zp (f'\<bullet>a)) + (2^m)t - val_Zp (f'\<bullet>(ns m))"
	+ by (simp add: eint_minus_ineq)
	+ have "2^m * t > m"
	+ apply(induction m)
	+ using one_eint_def zero_eint_def apply auto[1]
	+ proof- fix m
	+ assume IH : "int m < 2 ^ m * t "
	+ then have "((2 ^ (Suc m)) * t) = 2* ((2 ^ m) * t)"
	+ by (metis mult.assoc power_Suc times_eint_simps(1))
	+ then show "int (Suc m) < 2 ^ Suc m * t"
	+ using IH t_neq_infty by force
	+ qed
	+ then have 100: "2^m * t > int m"
	+ by blast
	+ have "int m \<ge>2 + (int n + k0)"
	+ using A by simp
	+ hence 1000: "2^m * t > 2 + (int n + k0)"
	+ using 100
	+ by (meson eint_ord_simps(2) less_le_trans linorder_not_less)
	+ have "2 + (int n + k0) > 1 + int n"
	+ using k0_def by linarith
	+ then have "2^m * t > 1 + int n"
	+ using 1000 eint_ord_simps(2) k0_def less_le_trans linorder_not_less
	+ proof -
	+ have "eint (2 + (int n + k0)) < t * eint (int (2 ^ m))"
	+ by (metis "1000" mult.commute numeral_power_eq_of_nat_cancel_iff)
	+ then have "eint (int (Suc n)) < t * eint (int (2 ^ m))"
	+ by (metis \<open>1 + int n < 2 + (int n + k0)\<close> eint_ord_simps(2) less_trans of_nat_Suc)
	+ then show ?thesis
	+ by (simp add: mult.commute)
	+ qed
	+ hence "2val_Zp (f'\<bullet>a) + eint (2 ^ m) t \<ge> 2*(val_Zp (f'\<bullet>a)) + 1 + int n"
	+ by (smt eSuc_eint eint_add_left_cancel_le iadd_Suc iadd_Suc_right order_less_le)
	+ then have 11: "val_Zp (f\<bullet> (ns m)) - val_Zp (f'\<bullet>(ns m))
	+ \<ge> 2*(val_Zp (f'\<bullet>a)) + 1 + int n - val_Zp (f'\<bullet>(ns m))"
	+ using "10"
	+ by (smt \<open>eint 2 * val_Zp (f'\<bullet>a) + eint (2 ^ m) * t \<le> val_Zp (to_fun f (ns m))\<close>
	+ f'a_not_infinite eint_minus_ineq hensel_axioms newton_seq_fact1 order_trans)
	+ have 12: "val_Zp (f'\<bullet>(ns m)) = val_Zp (f'\<bullet>a) "
	+ using nonzero_memE newton_seq_fact1 newton_seq_fact6 val_Zp_def val_Zp_def
	+ by auto
	+ then have 13: "val_Zp (f\<bullet> (ns m)) - val_Zp (f'\<bullet>(ns m))
	+ \<ge> 2*(val_Zp (f'\<bullet>a)) + (1 + int n) - val_Zp ((f'\<bullet>a))"
	+ using 11
	+ by (smt eSuc_eint iadd_Suc iadd_Suc_right)
	+ then have 14:"val_Zp (f\<bullet> (ns m)) - val_Zp (f'\<bullet>(ns m))
	+ \<ge> 1 + int n + val_Zp ((f'\<bullet>a))"
	+ using eint_minus_comm[of "2*(val_Zp (f'\<bullet>a))" "1 + int n" "val_Zp ((f'\<bullet>a))"]
	+ by (simp add: Groups.add_ac(2))
	+ then show ?thesis
	+ by (smt Suc_ile_eq add.right_neutral eint.distinct(2) f'a_nonneg_val ge_plus_pos_imp_gt order_less_le)
	+ qed
	+ then show ?thesis
	+ by (smt "0" Suc_ile_eq of_nat_Suc)
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ using val_Zp_def val_Zp_dist_def
	+ by (metis newton_seq.simps(2))
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma eventually_zero:
	+"f \<bullet> ns (k + m) = \<zero> \<Longrightarrow> f \<bullet> ns (k + Suc m) = \<zero>"
	+proof-
	+ assume A: "f \<bullet> ns (k + m) = \<zero>"
	+ have 0: "ns (k + Suc m) = ns (k + m) \<ominus> (divide (f \<bullet> ns (k + m)) (f' \<bullet> ns (k + m)))"
	+ by (simp add: newton_step_def)
	+ have 1: "(divide (f \<bullet> ns (k + m)) (f' \<bullet> ns (k + m))) = \<zero>"
	+ by (simp add: A divide_def)
	+ show "f \<bullet> ns (k + Suc m) = \<zero>"
	+ using A 0 1
	+ by (simp add: a_minus_def newton_seq_closed)
	+qed
	+
	+text\<open>The Newton Sequence is Cauchy:\<close>
	+
	+lemma newton_seq_is_Zp_cauchy:
	+"is_Zp_cauchy ns"
	+proof(cases "\<forall>k. f\<bullet>(ns k) \<noteq>\<zero>")
	+ case True
	+ then show ?thesis using newton_seq_is_Zp_cauchy_0
	+ by blast
	+next
	+ case False
	+ obtain k where k_def:"f\<bullet>(ns k) = \<zero>"
	+ using False by blast
	+ have 0: "\<And>m. (ns (m + k)) = (ns k)"
	+ proof-
	+ fix m
	+ show "(ns (m + k)) = (ns k)"
	+ proof(induction m)
	+ case 0
	+ then show ?case
	+ by simp
	+ next
	+ case (Suc m)
	+ show "(ns (Suc m + k)) = (ns k)"
	+ proof-
	+ have "f \<bullet> ns (m + k) = \<zero>"
	+ by (simp add: Suc.IH k_def)
	+ then have "divide ( f \<bullet> ns (m + k)) (f' \<bullet> ns (m + k)) = \<zero>"
	+ by (simp add: divide_def)
	+ then show ?thesis using newton_step_def
	+ by (simp add: Suc.IH a_minus_def newton_seq_closed)
	+ qed
	+ qed
	+ qed
	+ show "is_Zp_cauchy ns"
	+ apply(rule is_Zp_cauchyI)
	+ apply (simp add: closed_seqs_memI newton_seq_closed)
	+ proof-
	+ show "\<And>n.\<And>n. \<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> ns n0 n = ns n1 n"
	+ proof-
	+ fix n
	+ show "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> ns n0 n = ns n1 n"
	+ proof-
	+ have "\<forall>n0 n1. k < n0 \<and> k < n1 \<longrightarrow> ns n0 n = ns n1 n"
	+ apply auto
	+ proof-
	+ fix n0 n1
	+ assume A0: "k < n0"
	+ assume A1: "k < n1"
	+ obtain m0 where m0_def: "n0 = k + m0"
	+ using A0 less_imp_add_positive by blast
	+ obtain m1 where m1_def: "n1 = k + m1"
	+ using A1 less_imp_add_positive by auto
	+ show "ns n0 n = ns n1 n"
	+ using 0 m0_def m1_def
	+ by (metis add.commute)
	+ qed
	+ then show ?thesis by blast
	+ qed
	+ qed
	+ qed
	+qed
	+
	+subsection\<open>The Proof of Hensel's Lemma\<close>
	+lemma pre_hensel:
	+"val_Zp (a \<ominus> (ns n)) > val_Zp (f'\<bullet>a)"
	+"\<exists>N. \<forall>n. n> N \<longrightarrow> (val_Zp (a \<ominus> (ns n)) = val_Zp (divide (f\<bullet>a) (f'\<bullet>a)))"
	+"val_Zp (f'\<bullet>(ns n)) = val_Zp (f'\<bullet>a)"
	+proof-
	+ show "val_Zp (a \<ominus> (ns n)) > val_Zp (f'\<bullet>a)"
	+ proof(induction n)
	+ case 0
	+ then show ?case
	+ by (simp add: val_Zp_def)
	+ next
	+ case (Suc n)
	+ show "val_Zp (a \<ominus> (ns (Suc n))) > val_Zp (f'\<bullet>a)"
	+ proof-
	+ have I0: "val_Zp ((ns (Suc n)) \<ominus> (ns n)) > val_Zp (f'\<bullet>a)"
	+ proof(cases "(ns (Suc n)) = (ns n)")
	+ case True
	+ then show ?thesis
	+ by (simp add: newton_seq_closed val_Zp_def)
	+ next
	+ case False
	+ have 00:"(ns (Suc n)) \<ominus> (ns n) = \<ominus>divide (f\<bullet>(ns n)) (f'\<bullet>(ns n))"
	+ using newton_seq_fact7 by blast
	+ then have 0: "val_Zp((ns (Suc n)) \<ominus> (ns n)) = val_Zp (divide (f\<bullet>(ns n)) (f'\<bullet>(ns n)))"
	+ using newton_seq_fact5 val_Zp_of_minus by presburger
	+ have 1: "(f\<bullet>(ns n)) \<in> nonzero Zp"
	+ by (metis False R.minus_zero R.r_right_minus_eq 00 divide_def f_closed to_fun_closed
	+ newton_seq_closed not_nonzero_Zp)
	+ have 2: "f'\<bullet>(ns n) \<in> nonzero Zp"
	+ by (simp add: newton_seq_fact6)
	+ have "val_Zp (f\<bullet>(ns n)) \<ge> val_Zp (f'\<bullet>(ns n))"
	+ using nonzero_memE \<open>f \<bullet> ns n \<in> nonzero Zp\<close> newton_seq_fact4 by blast
	+ then have 3:"val_Zp((ns (Suc n)) \<ominus> (ns n)) = val_Zp (f\<bullet>(ns n)) - val_Zp (f'\<bullet>(ns n))"
	+ using 0 1 2 newton_seq_fact9 nonzero_memE(2) by blast
	+ have 4: "val_Zp (f \<bullet> ns n) \<ge> (2 * val_Zp (f'\<bullet>a)) + 2 ^ n * t"
	+ using newton_seq_fact2[of n] by metis
	+ then have 5: "val_Zp((ns (Suc n)) \<ominus> (ns n)) \<ge> ((2 * val_Zp (f'\<bullet>a)) + 2 ^ n * t) - val_Zp (f'\<bullet>(ns n))"
	+ using "3" eint_minus_ineq f'a_not_infinite newton_seq_fact1 by presburger
	+ have 6: "((ns (Suc n)) \<ominus> (ns n)) \<in> nonzero Zp"
	+ using False not_eq_diff_nonzero newton_seq_closed by blast
	+ then have "val_Zp((ns (Suc n)) \<ominus> (ns n)) \<ge> (2 * val_Zp (f'\<bullet>a)) + 2 ^ n * t - val_Zp ((f'\<bullet>a))"
	+ using "5" by auto
	+ then have 7: "val_Zp((ns (Suc n)) \<ominus> (ns n)) \<ge> (val_Zp (f'\<bullet>a)) + 2 ^ n * t"
	+ by (simp add: eint_minus_comm)
	+ then show "val_Zp((ns (Suc n)) \<ominus> (ns n)) > (val_Zp (f'\<bullet>a))"
	+ using f'a_not_infinite ge_plus_pos_imp_gt t_times_pow_pos by blast
	+ qed
	+ have "val_Zp ((ns (Suc n)) \<ominus> (ns n)) = val_Zp ((ns n) \<ominus> (ns (Suc n)))"
	+ using newton_seq_closed[of "n"] newton_seq_closed[of "Suc n"]
	+ val_Zp_def val_Zp_dist_def val_Zp_dist_sym val_Zp_def
	+ by auto
	+ then have I1: "val_Zp ((ns n) \<ominus> (ns (Suc n))) > val_Zp (f'\<bullet>a)"
	+ using I0
	+ by presburger
	+ have I2: " (a \<ominus> (ns n)) \<oplus> ((ns n) \<ominus> (ns (Suc n))) = (a \<ominus> (ns (Suc n)))"
	+ by (metis R.plus_diff_simp add_comm local.a_closed newton_seq_closed)
	+ then have "val_Zp (a \<ominus> (ns (Suc n))) \<ge> min (val_Zp (a \<ominus> ns n)) (val_Zp (ns n \<ominus> ns (Suc n)))"
	+ by (metis R.minus_closed local.a_closed newton_seq_closed val_Zp_ultrametric)
	+ thus ?thesis
	+ using I1 Suc.IH eint_min_ineq by blast
	+ qed
	+ qed
	+ show "val_Zp (f'\<bullet>(ns n)) = val_Zp (f'\<bullet>a)"
	+ using newton_seq_fact1 by blast
	+ show "\<exists>N.\<forall>n. n> N \<longrightarrow> (val_Zp (a \<ominus> (ns n)) = val_Zp (divide (f\<bullet>a) (f'\<bullet>a)))"
	+ proof-
	+ have P: "\<And>m. m > 1 \<Longrightarrow> (val_Zp (a \<ominus> (ns m)) = val_Zp (divide (f\<bullet>a) (f'\<bullet>a)))"
	+ proof-
	+ fix n::nat
	+ assume AA: "n >1"
	+ show " (val_Zp (a \<ominus> (ns n)) = val_Zp (divide (f\<bullet>a) (f'\<bullet>a)))"
	+ proof(cases "(ns 1) = a")
	+ case True
	+ have T0: "\<And>k. \<forall>n. n \<le> k \<longrightarrow> ns n = a"
	+ proof-
	+ fix k
	+ show " \<forall>n. n \<le> k \<longrightarrow> ns n = a"
	+ proof(induction k)
	+ case 0
	+ then show ?case
	+ by simp
	+ next
	+ case (Suc k)
	+ show "\<forall>n\<le>Suc k. ns n = a" apply auto
	+ proof-
	+ fix n
	+ assume A: "n \<le>Suc k"
	+ show "ns n = a"
	+ proof(cases "n < Suc k")
	+ case True
	+ then show ?thesis using Suc.IH by auto
	+ next
	+ case False thus ?thesis
	+ using A Suc.IH True by auto
	+ qed
	+ qed
	+ qed
	+ qed
	+ show "val_Zp (a \<ominus> ns n) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ by (metis T0 Zp_def Zp_defs(3) f'a_closed f'a_nonzero fa_nonzero
	+ hensel.fa_closed hensel_axioms hensel_hypothesis_weakened le_eq_less_or_eq
	+ newton_seq_fact9 not_nonzero_Qp order_less_le val_of_divide)
	+ next
	+ case False
	+ have F0: "(1::nat) \<le> n"
	+ using AA by simp
	+ have "(f\<bullet>a) \<noteq> \<zero>"
	+ by simp
	+ have "\<And>k. val_Zp (a \<ominus> ns (Suc k)) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ proof-
	+ fix k
	+ show " val_Zp (a \<ominus> ns (Suc k)) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ proof(induction k)
	+ case 0
	+ have "(a \<ominus> ns (Suc 0)) = (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ by (metis R.minus_minus Zp_def hensel.newton_seq_fact7 hensel_axioms
	+ local.a_closed minus_a_inv newton_seq.simps(1) newton_seq.simps(2) newton_seq_fact5 newton_step_closed)
	+ then show ?case by simp
	+ next
	+ case (Suc k)
	+ have I0: "ns (Suc (Suc k)) = ns (Suc k) \<ominus> (divide (f\<bullet>(ns (Suc k))) (f'\<bullet>(ns (Suc k))))"
	+ by (simp add: newton_step_def)
	+ have I1: "val_Zp (f\<bullet>(ns (Suc k))) \<ge> val_Zp(f'\<bullet>(ns (Suc k)))"
	+ using newton_seq_fact3 by blast
	+ have I2: "(divide (f\<bullet>(ns (Suc k))) (f'\<bullet>(ns (Suc k)))) \<in> carrier Zp"
	+ using newton_seq_fact5 by blast
	+ have I3: "ns (Suc (Suc k)) \<ominus> ns (Suc k) = \<ominus>(divide (f\<bullet>(ns (Suc k))) (f'\<bullet>(ns (Suc k))))"
	+ using I0 I2 newton_seq_fact7 by blast
	+ then have "val_Zp (ns (Suc (Suc k)) \<ominus> ns (Suc k)) = val_Zp (divide (f\<bullet>(ns (Suc k))) (f'\<bullet>(ns (Suc k))))"
	+ using I2 val_Zp_of_minus
	+ by presburger
	+ then have "val_Zp (ns (Suc (Suc k)) \<ominus> ns (Suc k)) = val_Zp (f\<bullet>(ns (Suc k))) - val_Zp (f'\<bullet>(ns (Suc k)))"
	+ by (metis I1 R.zero_closed Zp_def newton_seq_fact6 newton_seq_fact9 padic_integers.val_of_divide padic_integers_axioms)
	+ then have I4: "val_Zp (ns (Suc (Suc k)) \<ominus> ns (Suc k)) = val_Zp (f\<bullet>(ns (Suc k))) - val_Zp ((f'\<bullet>a))"
	+ using newton_seq_fact1 by presburger
	+ have F3: "val_Zp (a \<ominus> ns (Suc k)) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ using Suc.IH by blast
	+ have F4: "a \<ominus> ns (Suc (Suc k)) = (a \<ominus> ( ns (Suc k))) \<oplus> (ns (Suc k)) \<ominus> ns (Suc (Suc k))"
	+ by (metis R.ring_simprules(17) a_minus_def add_comm local.a_closed newton_seq_closed)
	+ have F5: "val_Zp ((ns (Suc k)) \<ominus> ns (Suc (Suc k))) > val_Zp (a \<ominus> ( ns (Suc k)))"
	+ proof-
	+ have F50: "val_Zp ((ns (Suc k)) \<ominus> ns (Suc (Suc k))) = val_Zp (f\<bullet>(ns (Suc k))) - val_Zp ((f'\<bullet>a))"
	+ by (metis I4 R.minus_closed minus_a_inv newton_seq_closed val_Zp_of_minus)
	+
	+ have F51: "val_Zp (f\<bullet>(ns (Suc k))) > val_Zp ((f\<bullet>a))"
	+ proof-
	+ have F510: "val_Zp (f\<bullet>(ns (Suc k))) \<ge> 2val_Zp (f'\<bullet>a) + 2^(Suc k)t "
	+ using newton_seq_fact2 by blast
	+ hence F511: "val_Zp (f\<bullet>(ns (Suc k))) \<ge> 2val_Zp (f'\<bullet>a) + 2t "
	+ using eint_plus_times[of t "2*val_Zp (f'\<bullet>a)" "2^(Suc k)" "val_Zp (f\<bullet>(ns (Suc k)))" 2] t_pos
	+ by (simp add: order_less_le)
	+ have F512: "2val_Zp (f'\<bullet>a) + 2t = 2 val_Zp (f\<bullet>a) - 2 val_Zp (f'\<bullet>a)"
	+ unfolding hensel_factor_def
	+ using eint_minus_distr[of "val_Zp (f\<bullet>a)" "2 * val_Zp (f'\<bullet>a)" 2]
	+ eint_minus_comm[of _ _ "eint 2 * (eint 2 * val_Zp (f'\<bullet>a))"]
	+ by (smt eint_2_minus_1_mult eint_add_cancel_fact eint_minus_comm f'a_not_infinite hensel_hypothesis nat_mult_not_infty order_less_le)
	+ hence "2val_Zp (f'\<bullet>a) + 2t > val_Zp (f\<bullet>a)"
	+ using hensel_hypothesis
	+ by (smt add_diff_cancel_eint eint_add_cancel_fact eint_add_left_cancel_le
	+ eint_pos_int_times_gt f'a_not_infinite hensel_factor_def nat_mult_not_infty order_less_le t_neq_infty t_pos)
	+ thus ?thesis using F512
	+ using F511 less_le_trans by blast
	+ qed
	+ thus ?thesis
	+ by (metis F3 F50 Zp_def divide_closed eint_add_cancel_fact eint_minus_ineq
	+ f'a_closed f'a_nonzero f'a_not_infinite fa_closed fa_nonzero hensel.newton_seq_fact7
	+ hensel_axioms newton_seq.simps(1) newton_seq_fact9 order_less_le val_Zp_of_minus)
	+ qed
	+ have "a \<ominus> ns (Suc k) \<oplus> (ns (Suc k) \<ominus> ns (Suc (Suc k))) = a \<ominus> ns (Suc (Suc k))"
	+ by (metis F4 a_minus_def add_assoc)
	+ then show F6: "val_Zp (a \<ominus> ns (Suc (Suc k))) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ using F5 F4 F3
	+ by (metis R.minus_closed local.a_closed newton_seq_closed order_less_le val_Zp_not_equal_ord_plus_minus val_Zp_ultrametric_eq'')
	+ qed
	+ qed
	+ thus ?thesis
	+ by (metis AA less_imp_add_positive plus_1_eq_Suc)
	+ qed
	+ qed
	+ thus ?thesis
	+ by blast
	+ qed
	+qed
	+
	+lemma hensel_seq_comp_f:
	+ "res_lim ((to_fun f) \<circ> ns) = \<zero>"
	+proof-
	+ have A: "is_Zp_cauchy ((to_fun f) \<circ> ns)"
	+ using f_closed is_Zp_continuous_def newton_seq_is_Zp_cauchy polynomial_is_Zp_continuous
	+ by blast
	+ have "Zp_converges_to ((to_fun f) \<circ> ns) \<zero>"
	+ apply(rule Zp_converges_toI)
	+ using A is_Zp_cauchy_def apply blast
	+ apply simp
	+ proof-
	+ fix n
	+ show " \<exists>N. \<forall>k>N. (((to_fun f) \<circ> ns) k) n = \<zero> n"
	+ proof-
	+ have 0: "\<And>k. (k::nat)>3 \<longrightarrow> val_Zp (f\<bullet>(ns k)) > k"
	+ proof
	+ fix k::nat
	+ assume A: "k >3"
	+ show "val_Zp (f\<bullet>(ns k)) > k "
	+ proof-
	+ have 0: " val_Zp (f\<bullet>(ns k)) \<ge> 2(val_Zp (f'\<bullet>a)) + (2^k)t"
	+ using newton_seq_fact2 by blast
	+ have 1: "2(val_Zp (f'\<bullet>a)) + (2^k)t > k "
	+ proof-
	+ have "(2^k)*t \<ge> (2^k) "
	+ apply(cases "t = \<infinity>")
	+ apply simp
	+ using t_pos eint_mult_mono'
	+ proof -
	+ obtain ii :: "eint \<Rightarrow> int" where
	+ f1: "\<forall>e. (\<infinity> \<noteq> e \<or> (\<forall>i. eint i \<noteq> e)) \<and> (eint (ii e) = e \<or> \<infinity> = e)"
	+ by (metis not_infinity_eq)
	+ then have "0 < ii t"
	+ by (metis (no_types) eint_ord_simps(2) t_neq_infty t_pos zero_eint_def)
	+ then show ?thesis
	+ using f1 by (metis eint_pos_int_times_ge eint_mult_mono linorder_not_less
	+ mult.commute order_less_le t_neq_infty t_pos t_times_pow_pos)
	+ qed
	+ hence " 2(val_Zp (f'\<bullet>a)) + (2^k)t \<ge> (2^k) "
	+ by (smt Groups.add_ac(2) add.right_neutral eint_2_minus_1_mult eint_pos_times_is_pos
	+ eint_pow_int_is_pos f'a_nonneg_val ge_plus_pos_imp_gt idiff_0_right linorder_not_less
	+ nat_mult_not_infty order_less_le t_neq_infty)
	+ then have " 2(val_Zp (f'\<bullet>a)) + (2^k)t > k"
	+ using A of_nat_1 of_nat_add of_nat_less_two_power
	+ by (smt eint_ord_simps(1) linorder_not_less order_trans)
	+ then show ?thesis
	+ by metis
	+ qed
	+ thus ?thesis
	+ using 0 less_le_trans by blast
	+ qed
	+ qed
	+ have 1: "\<And>k. (k::nat)>3 \<longrightarrow> (f\<bullet>(ns k)) k = 0"
	+ proof
	+ fix k::nat
	+ assume B: "3<k"
	+ show " (f\<bullet>(ns k)) k = 0"
	+ proof-
	+ have B0: " val_Zp (f\<bullet>(ns k)) > k"
	+ using 0 B
	+ by blast
	+ then show ?thesis
	+ by (simp add: f_of_newton_seq_closed zero_below_val_Zp)
	+ qed
	+ qed
	+ have "\<forall>k>(max 3 n). (((to_fun f) \<circ> ns) k) n = \<zero> n"
	+ apply auto
	+ proof-
	+ fix k::nat
	+ assume A: "3< k"
	+ assume A': "n < k"
	+ have A0: "(f\<bullet>(ns k)) k = 0"
	+ using 1[of k] A by auto
	+ then have "(f\<bullet>(ns k)) n = 0"
	+ using A A'
	+ using above_ord_nonzero[of "(f\<bullet>(ns k))"]
	+ by (smt UP_cring.to_fun_closed Zp_x_is_UP_cring f_closed le_eq_less_or_eq
	+ newton_seq_closed of_nat_mono residue_of_zero(2) zero_below_ord)
	+ then show A1: "to_fun f (ns k) n = \<zero> n"
	+ by (simp add: residue_of_zero(2))
	+ qed
	+ then show ?thesis by blast
	+ qed
	+ qed
	+ then show ?thesis
	+ by (metis Zp_converges_to_def unique_limit')
	+qed
	+
	+lemma full_hensels_lemma:
	+ obtains \<alpha> where
	+ "f\<bullet>\<alpha> = \<zero>" and "\<alpha> \<in> carrier Zp"
	+ "val_Zp (a \<ominus> \<alpha>) > val_Zp (f'\<bullet>a)"
	+ "(val_Zp (a \<ominus> \<alpha>) = val_Zp (divide (f\<bullet>a) (f'\<bullet>a)))"
	+ "val_Zp (f'\<bullet>\<alpha>) = val_Zp (f'\<bullet>a)"
	+proof(cases "\<exists>k. f\<bullet>(ns k) =\<zero>")
	+ case True
	+ obtain k where k_def: "f\<bullet>(ns k) =\<zero>"
	+ using True by blast
	+ obtain N where N_def: "\<forall>n. n> N \<longrightarrow> (val_Zp (a \<ominus> (ns n)) = val_Zp (divide (f\<bullet>a) (f'\<bullet>a)))"
	+ using pre_hensel(2) by blast
	+ have Z: "\<And>n. n \<ge>k \<Longrightarrow> f\<bullet>(ns n) =\<zero>"
	+ proof-
	+ fix n
	+ assume A: "n \<ge>k"
	+ obtain l where l_def:"n = k + l"
	+ using A le_Suc_ex
	+ by blast
	+ have "\<And>m. f\<bullet>(ns (k+m)) =\<zero>"
	+ proof-
	+ fix m
	+ show "f\<bullet>(ns (k+m)) =\<zero>"
	+ apply(induction m)
	+ apply (simp add: k_def)
	+ using eventually_zero
	+ by simp
	+ qed
	+ then show "f\<bullet>(ns n) =\<zero>"
	+ by (simp add: l_def)
	+ qed
	+ obtain M where M_def: "M = N + k"
	+ by simp
	+ then have M_root: "f\<bullet>(ns M) =\<zero>"
	+ by (simp add: Z)
	+ obtain \<alpha> where alpha_def: "\<alpha>= ns M"
	+ by simp
	+ have T0: "f\<bullet>\<alpha> = \<zero>"
	+ using alpha_def M_root
	+ by auto
	+ have T1: "val_Zp (a \<ominus> \<alpha>) > val_Zp (f'\<bullet>a)"
	+ using alpha_def pre_hensel(1) by blast
	+ have T2: "(val_Zp (a \<ominus> \<alpha>) = val_Zp (divide (f\<bullet>a) (f'\<bullet>a)))"
	+ by (metis M_def N_def alpha_def fa_nonzero k_def
	+ less_add_same_cancel1 newton_seq.elims zero_less_Suc)
	+ have T3: "val_Zp (f'\<bullet>\<alpha>) = val_Zp (f'\<bullet>a)"
	+ using alpha_def newton_seq_fact1 by blast
	+ show ?thesis using T0 T1 T2 T3
	+ using that alpha_def newton_seq_closed
	+ by blast
	+next
	+ case False
	+ then have Nz: "\<And>k. f\<bullet>(ns k) \<noteq>\<zero>"
	+ by blast
	+ have ns_cauchy: "is_Zp_cauchy ns"
	+ by (simp add: newton_seq_is_Zp_cauchy)
	+ have fns_cauchy: "is_Zp_cauchy ((to_fun f) \<circ> ns)"
	+ using f_closed is_Zp_continuous_def ns_cauchy polynomial_is_Zp_continuous by blast
	+ have F0: "res_lim ((to_fun f) \<circ> ns) = \<zero>"
	+ proof-
	+ show ?thesis
	+ using hensel_seq_comp_f by auto
	+ qed
	+ obtain \<alpha> where alpha_def: "\<alpha> = res_lim ns"
	+ by simp
	+ have F1: "(f\<bullet>\<alpha>)= \<zero>"
	+ using F0 alpha_def alt_seq_limit
	+ ns_cauchy polynomial_is_Zp_continuous res_lim_pushforward
	+ res_lim_pushforward' by auto
	+ have F2: "val_Zp (a \<ominus> \<alpha>) > val_Zp (f'\<bullet>a) \<and> val_Zp (a \<ominus> \<alpha>) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ proof-
	+ have 0: "Zp_converges_to ns \<alpha>"
	+ by (simp add: alpha_def is_Zp_cauchy_imp_has_limit ns_cauchy)
	+ have "val_Zp (a \<ominus> \<alpha>) < \<infinity>"
	+ using "0" F1 R.r_right_minus_eq Zp_converges_to_def Zp_def hensel.fa_nonzero hensel_axioms local.a_closed val_Zp_def
	+ by auto
	+ hence "1 + max (eint 2 + val_Zp (f'\<bullet>a)) (val_Zp (\<alpha> \<ominus> a)) < \<infinity>"
	+ by (metis "0" R.minus_closed Zp_converges_to_def eint.distinct(2) eint_ord_simps(4)
	+ f'a_not_infinite infinity_ne_i1 local.a_closed max_def minus_a_inv
	+ sum_infinity_imp_summand_infinity val_Zp_of_minus)
	+ then obtain l where l_def: "eint l = 1 + max (eint 2 + val_Zp (f'\<bullet>a)) (val_Zp (\<alpha> \<ominus> a))"
	+ by auto
	+ then obtain N where N_def: "(\<forall>m>N. 1 + max (2 + val_Zp (f'\<bullet>a)) (val_Zp (\<alpha> \<ominus> a)) < val_Zp_dist (ns m) \<alpha>)"
	+ using 0 l_def Zp_converges_to_def[of ns \<alpha>] unfolding val_Zp_dist_def
	+ by metis
	+ obtain N' where N'_def: "\<forall>n>N'. val_Zp (a \<ominus> ns n) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ using pre_hensel(2) by blast
	+ obtain K where K_def: "K = Suc (max N N')"
	+ by simp
	+ then have F21: "(1+ (max (2 + val_Zp (f'\<bullet>a)) (val_Zp (\<alpha> \<ominus> a)))) < val_Zp_dist (ns K) \<alpha>"
	+ by (metis N_def lessI linorder_not_less max_def order_trans)
	+ have F22: "a \<noteq> ns K"
	+ by (smt False K_def N'_def Zp_def cring_def eint.distinct(2) hensel_factor_id lessI
	+ less_le_trans linorder_not_less max_def mult_comm mult_zero_l newton_seq_closed
	+ order_less_le padic_int_is_cring padic_integers.prime padic_integers_axioms ring.r_right_minus_eq
	+ val_Zp_def)
	+ show ?thesis
	+ proof(cases "ns K = \<alpha>")
	+ case True
	+ then show ?thesis
	+ using pre_hensel F1 False by blast
	+ next
	+ case False
	+ assume "ns K \<noteq> \<alpha>"
	+ show ?thesis
	+ proof-
	+ have P0: " (a \<ominus> \<alpha>) \<in> nonzero Zp"
	+ by (metis (mono_tags, hide_lams) F1 not_eq_diff_nonzero
	+ \<open>Zp_converges_to ns \<alpha>\<close> a_closed Zp_converges_to_def fa_nonzero)
	+ have P1: "(\<alpha> \<ominus> (ns K)) \<in> nonzero Zp"
	+ using False not_eq_diff_nonzero \<open>Zp_converges_to ns \<alpha>\<close>
	+ Zp_converges_to_def newton_seq_closed
	+ by (metis (mono_tags, hide_lams))
	+ have P2: "a \<ominus> (ns K) \<in> nonzero Zp"
	+ using F22 not_eq_diff_nonzero
	+ a_closed newton_seq_closed
	+ by blast
	+ have P3: "(a \<ominus> \<alpha>) = a \<ominus> (ns K) \<oplus> ((ns K) \<ominus> \<alpha>)"
	+ by (metis R.plus_diff_simp \<open>Zp_converges_to ns \<alpha>\<close> add_comm Zp_converges_to_def local.a_closed newton_seq_closed)
	+ have P4: "val_Zp (a \<ominus> \<alpha>) \<ge> min (val_Zp (a \<ominus> (ns K))) (val_Zp ((ns K) \<ominus> \<alpha>))"
	+ using "0" P3 Zp_converges_to_def newton_seq_closed val_Zp_ultrametric
	+ by auto
	+ have P5: "val_Zp (a \<ominus> (ns K)) > val_Zp (f'\<bullet>a)"
	+ using pre_hensel(1)[of "K"]
	+ by metis
	+ have "1 + max (eint 2 + val_Zp (f'\<bullet>a)) (val_Zp (\<alpha> \<ominus> a)) > val_Zp (f'\<bullet>a)"
	+ proof-
	+ have "1 + max (eint 2 + val_Zp (f'\<bullet>a)) (val_Zp (\<alpha> \<ominus> a)) > (eint 2 + val_Zp (f'\<bullet>a))"
	+ proof -
	+ obtain ii :: int where
	+ f1: "eint ii = 1 + max (eint 2 + val_Zp (f'\<bullet>a)) (val_Zp (\<alpha> \<ominus> a))"
	+ by (meson l_def)
	+ then have "1 + (eint 2 + val_Zp (f'\<bullet>a)) \<le> eint ii"
	+ by simp
	+ then show ?thesis
	+ using f1 by (metis Groups.add_ac(2) iless_Suc_eq linorder_not_less)
	+ qed
	+ thus ?thesis
	+ by (smt Groups.add_ac(2) eint_pow_int_is_pos f'a_not_infinite ge_plus_pos_imp_gt order_less_le)
	+ qed
	+ hence P6: "val_Zp ((ns K) \<ominus> \<alpha>) > val_Zp (f'\<bullet>a)"
	+ using F21 unfolding val_Zp_dist_def
	+ by auto
	+ have P7: "val_Zp (a \<ominus> \<alpha>) > val_Zp (f'\<bullet>a)"
	+ using P4 P5 P6 eint_min_ineq by blast
	+ have P8: "val_Zp (a \<ominus> \<alpha>) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ proof-
	+ have " 1 + max (2 + val_Zp (f'\<bullet>a)) (val_Zp_dist \<alpha> a) \<le> val_Zp_dist (ns K) \<alpha>"
	+ using False F21
	+ by (simp add: val_Zp_dist_def)
	+ then have "val_Zp(\<alpha> \<ominus> (ns K)) > max (2 + val_Zp (f'\<bullet>a)) (val_Zp_dist \<alpha> a)"
	+ by (metis "0" Groups.add_ac(2) P1 Zp_converges_to_def eSuc_mono iless_Suc_eq l_def
	+ minus_a_inv newton_seq_closed nonzero_closed val_Zp_dist_def val_Zp_of_minus)
	+ then have "val_Zp(\<alpha> \<ominus> (ns K)) > val_Zp (a \<ominus> \<alpha>) "
	+ using \<open>Zp_converges_to ns \<alpha>\<close> Zp_converges_to_def val_Zp_dist_def val_Zp_dist_sym
	+ by auto
	+ then have P80: "val_Zp (a \<ominus> \<alpha>) = val_Zp (a \<ominus> (ns K))"
	+ using P0 P1 Zp_def val_Zp_ultrametric_eq[of "\<alpha> \<ominus> ns K" "a \<ominus> \<alpha>"] 0 R.plus_diff_simp
	+ Zp_converges_to_def local.a_closed newton_seq_closed nonzero_closed by auto
	+ have P81: "val_Zp (a \<ominus> ns K) = val_Zp (local.divide (f\<bullet>a) (f'\<bullet>a))"
	+ using K_def N'_def
	+ by (metis (no_types, lifting) lessI linorder_not_less max_def order_less_le order_trans)
	+ then show ?thesis
	+ by (simp add: P80)
	+ qed
	+ thus ?thesis
	+ using P7 by blast
	+ qed
	+ qed
	+ qed
	+ have F3: "val_Zp (f' \<bullet> \<alpha>) = val_Zp (f'\<bullet>a)"
	+ proof-
	+ have F31: " (f' \<bullet> \<alpha>) = res_lim ((to_fun f') \<circ> ns)"
	+ using alpha_def alt_seq_limit ns_cauchy polynomial_is_Zp_continuous res_lim_pushforward
	+ res_lim_pushforward' f'_closed
	+ by auto
	+ obtain N where N_def: "val_Zp (f'\<bullet>\<alpha> \<ominus> f'\<bullet>(ns N)) > val_Zp ((f'\<bullet>a))"
	+ by (smt F2 False R.minus_closed Suc_ile_eq Zp_def alpha_def f'_closed f'a_nonzero
	+ local.a_closed minus_a_inv newton_seq.simps(1) newton_seq_is_Zp_cauchy_0 order_trans
	+ padic_integers.poly_diff_val padic_integers_axioms res_lim_in_Zp val_Zp_def val_Zp_of_minus)
	+ show ?thesis
	+ by (metis False N_def alpha_def equal_val_Zp f'_closed newton_seq_closed newton_seq_is_Zp_cauchy_0 newton_seq_fact1 res_lim_in_Zp to_fun_closed)
	+ qed
	+ show ?thesis
	+ using F1 F2 F3 that alpha_def ns_cauchy res_lim_in_Zp
	+ by blast
	+qed
	+
	+
	+end
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Removing Hensel's Lemma from the Hensel Locale\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+context padic_integers
	+begin
	+
	+
	+lemma hensels_lemma:
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "a \<in> carrier Zp"
	+ assumes "(pderiv f)\<bullet>a \<noteq> \<zero>"
	+ assumes "f\<bullet>a \<noteq>\<zero>"
	+ assumes "val_Zp (f\<bullet>a) > 2* val_Zp ((pderiv f)\<bullet>a)"
	+ obtains \<alpha> where
	+ "f\<bullet>\<alpha> = \<zero>" and "\<alpha> \<in> carrier Zp"
	+ "val_Zp (a \<ominus> \<alpha>) > val_Zp ((pderiv f)\<bullet>a)"
	+ "val_Zp (a \<ominus> \<alpha>) = val_Zp (divide (f\<bullet>a) ((pderiv f)\<bullet>a))"
	+ "val_Zp ((pderiv f)\<bullet>\<alpha>) = val_Zp ((pderiv f)\<bullet>a)"
	+proof-
	+ have "hensel p f a"
	+ using assms
	+ by (simp add: Zp_def hensel.intro hensel_axioms.intro padic_integers_axioms)
	+ then show ?thesis
	+ using hensel.full_hensels_lemma Zp_def that
	+ by blast
	+qed
	+
	+text\<open>Uniqueness of the root found in Hensel's lemma \<close>
	+
	+lemma hensels_lemma_unique_root:
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "a \<in> carrier Zp"
	+ assumes "(pderiv f)\<bullet>a \<noteq> \<zero>"
	+ assumes "f\<bullet>a \<noteq>\<zero>"
	+ assumes "(val_Zp (f\<bullet>a) > 2* val_Zp ((pderiv f)\<bullet>a))"
	+ assumes "f\<bullet>\<alpha> = \<zero>"
	+ assumes "\<alpha> \<in> carrier Zp"
	+ assumes "val_Zp (a \<ominus> \<alpha>) > val_Zp ((pderiv f)\<bullet>a)"
	+ assumes "f\<bullet>\<beta> = \<zero>"
	+ assumes "\<beta> \<in> carrier Zp"
	+ assumes "val_Zp (a \<ominus> \<beta>) > val_Zp ((pderiv f)\<bullet>a)"
	+ assumes "val_Zp ((pderiv f)\<bullet>\<alpha>) = val_Zp ((pderiv f)\<bullet>a)"
	+ shows "\<alpha> = \<beta>"
	+proof-
	+ have "\<alpha> \<noteq> a"
	+ using assms(4) assms(6) by auto
	+ have "\<beta> \<noteq> a"
	+ using assms(4) assms(9) by auto
	+ have 0: "val_Zp (\<beta> \<ominus> \<alpha>) > val_Zp ((pderiv f)\<bullet>a)"
	+ proof-
	+ have "\<beta> \<ominus> \<alpha> = \<ominus> ((a \<ominus> \<beta>) \<ominus> (a \<ominus> \<alpha>))"
	+ by (metis R.minus_eq R.plus_diff_simp assms(10) assms(2) assms(7) minus_a_inv)
	+ hence "val_Zp (\<beta> \<ominus> \<alpha>) = val_Zp ((a \<ominus> \<beta>) \<ominus> (a \<ominus> \<alpha>))"
	+ using R.minus_closed assms(10) assms(2) assms(7) val_Zp_of_minus by presburger
	+ thus ?thesis using val_Zp_ultrametric_diff[of "a \<ominus> \<beta>" "a \<ominus> \<alpha>"]
	+ by (smt R.minus_closed assms(10) assms(11) assms(2) assms(7) assms(8) min.absorb2 min_less_iff_conj)
	+ qed
	+ obtain h where h_def: "h = \<beta> \<ominus> \<alpha>"
	+ by blast
	+ then have h_fact: "h \<in> carrier Zp \<and> \<beta> = \<alpha> \<oplus> h"
	+ by (metis R.l_neg R.minus_closed R.minus_eq R.r_zero add_assoc add_comm assms(10) assms(7))
	+ then have 1: "f\<bullet>(\<alpha> \<oplus> h) = \<zero>"
	+ using assms
	+ by blast
	+ obtain c where c_def: "c \<in> carrier Zp \<and> f\<bullet>(\<alpha> \<oplus> h) = (f \<bullet> \<alpha>) \<oplus> (deriv f \<alpha>)\<otimes>h \<oplus> c \<otimes>(h[^](2::nat))"
	+ using taylor_deg_1_eval'[of f \<alpha> h _ "f \<bullet> \<alpha>" "deriv f \<alpha>" ]
	+ by (meson taylor_closed assms(1) assms(7) to_fun_closed h_fact shift_closed)
	+ then have "(f \<bullet> \<alpha>) \<oplus> (deriv f \<alpha>)\<otimes>h \<oplus> c \<otimes>(h[^](2::nat)) = \<zero>"
	+ by (simp add: "1")
	+ then have 2: "(deriv f \<alpha>)\<otimes>h \<oplus> c \<otimes>(h[^](2::nat)) = \<zero>"
	+ by (simp add: assms(1) assms(6) assms(7) deriv_closed h_fact)
	+ have 3: "((deriv f \<alpha>) \<oplus> c \<otimes>h)\<otimes>h = \<zero>"
	+ proof-
	+ have "((deriv f \<alpha>) \<oplus> c \<otimes>h)\<otimes>h = ((deriv f \<alpha>)\<otimes>h \<oplus> (c \<otimes>h)\<otimes>h)"
	+ by (simp add: R.r_distr UP_cring.deriv_closed Zp_x_is_UP_cring assms(1) assms(7) c_def h_fact mult_comm)
	+ then have "((deriv f \<alpha>) \<oplus> c \<otimes>h)\<otimes>h = (deriv f \<alpha>)\<otimes>h \<oplus> (c \<otimes>(h\<otimes>h))"
	+ by (simp add: mult_assoc)
	+ then have "((deriv f \<alpha>) \<oplus> c \<otimes>h)\<otimes>h = (deriv f \<alpha>)\<otimes>h \<oplus> (c \<otimes>(h[^](2::nat)))"
	+ using nat_pow_def[of Zp h "2"]
	+ by (simp add: h_fact)
	+ then show ?thesis
	+ using 2
	+ by simp
	+ qed
	+ have "h = \<zero>"
	+ proof(rule ccontr)
	+ assume "h \<noteq> \<zero>"
	+ then have "(deriv f \<alpha>) \<oplus> c \<otimes>h = \<zero>"
	+ using 2 3
	+ by (meson R.m_closed assms(1) assms(7) c_def deriv_closed h_fact local.integral sum_closed)
	+ then have "(deriv f \<alpha>) = \<ominus> c \<otimes>h"
	+ by (simp add: R.l_minus R.sum_zero_eq_neg UP_cring.deriv_closed Zp_x_is_UP_cring assms(1) assms(7) c_def h_fact)
	+ then have "val_Zp (deriv f \<alpha>) = val_Zp (c \<otimes> h)"
	+ by (meson R.m_closed \<open>deriv f \<alpha> \<oplus> c \<otimes> h = \<zero>\<close> assms(1) assms(7) c_def deriv_closed h_fact val_Zp_not_equal_imp_notequal(3))
	+ then have P: "val_Zp (deriv f \<alpha>) = val_Zp h + val_Zp c"
	+ using val_Zp_mult c_def h_fact by force
	+ hence "val_Zp (deriv f \<alpha>) \<ge> val_Zp h "
	+ using val_pos[of c]
	+ by (simp add: c_def)
	+ then have "val_Zp (deriv f \<alpha>) \<ge> val_Zp (\<beta> \<ominus> \<alpha>) "
	+ using h_def by blast
	+ then have "val_Zp (deriv f \<alpha>) > val_Zp ((pderiv f)\<bullet>a)"
	+ using "0" by auto
	+ then show False using pderiv_eval_deriv[of f \<alpha>]
	+ using assms(1) assms(12) assms(7) by auto
	+ qed
	+ then show "\<alpha> = \<beta>"
	+ using assms(10) assms(7) h_def
	+ by auto
	+qed
	+
	+lemma hensels_lemma':
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "a \<in> carrier Zp"
	+ assumes "val_Zp (f\<bullet>a) > 2*val_Zp ((pderiv f)\<bullet>a)"
	+ shows "\<exists>!\<alpha> \<in> carrier Zp. f\<bullet>\<alpha> = \<zero> \<and> val_Zp (a \<ominus> \<alpha>) > val_Zp ((pderiv f)\<bullet>a)"
	+proof(cases "f\<bullet>a = \<zero>")
	+ case True
	+ have T0: "pderiv f \<bullet> a \<noteq> \<zero>"
	+ apply(rule ccontr) using assms(3)
	+ unfolding val_Zp_def by simp
	+ then have T1: "a \<in> carrier Zp \<and> f\<bullet>a = \<zero> \<and> val_Zp (a \<ominus> a) > val_Zp ((pderiv f)\<bullet>a)"
	+ using assms True
	+ by(simp add: val_Zp_def)
	+ have T2: "\<And>b. b \<in> carrier Zp \<and> f\<bullet>b = \<zero> \<and> val_Zp (a \<ominus> b) > val_Zp ((pderiv f)\<bullet>a) \<Longrightarrow> a = b"
	+ proof- fix b assume A: "b \<in> carrier Zp \<and> f\<bullet>b = \<zero> \<and> val_Zp (a \<ominus> b) > val_Zp ((pderiv f)\<bullet>a)"
	+ obtain h where h_def: "h = b \<ominus> a"
	+ by blast
	+ then have h_fact: "h \<in> carrier Zp \<and> b = a \<oplus> h"
	+ by (metis A R.l_neg R.minus_closed R.minus_eq R.r_zero add_assoc add_comm assms(2))
	+ then have 1: "f\<bullet>(a \<oplus> h) = \<zero>"
	+ using assms A by blast
	+ obtain c where c_def: "c \<in> carrier Zp \<and> f\<bullet>(a \<oplus> h) = (f \<bullet> a) \<oplus> (deriv f a)\<otimes>h \<oplus> c \<otimes>(h[^](2::nat))"
	+ using taylor_deg_1_eval'[of f a h _ "f \<bullet> a" "deriv f a" ]
	+ by (meson taylor_closed assms(1) assms(2) to_fun_closed h_fact shift_closed)
	+ then have "(f \<bullet> a) \<oplus> (deriv f a)\<otimes>h \<oplus> c \<otimes>(h[^](2::nat)) = \<zero>"
	+ by (simp add: "1")
	+ then have 2: "(deriv f a)\<otimes>h \<oplus> c \<otimes>(h[^](2::nat)) = \<zero>"
	+ by (simp add: True assms(1) assms(2) deriv_closed h_fact)
	+ hence 3: "((deriv f a) \<oplus> c \<otimes>h)\<otimes>h = \<zero>"
	+ proof-
	+ have "((deriv f a) \<oplus> c \<otimes>h)\<otimes>h = ((deriv f a)\<otimes>h \<oplus> (c \<otimes>h)\<otimes>h)"
	+ by (simp add: R.l_distr assms(1) assms(2) c_def deriv_closed h_fact)
	+ then have "((deriv f a) \<oplus> c \<otimes>h)\<otimes>h = (deriv f a)\<otimes>h \<oplus> (c \<otimes>(h\<otimes>h))"
	+ by (simp add: mult_assoc)
	+ then have "((deriv f a) \<oplus> c \<otimes>h)\<otimes>h = (deriv f a)\<otimes>h \<oplus> (c \<otimes>(h[^](2::nat)))"
	+ using nat_pow_def[of Zp h "2"]
	+ by (simp add: h_fact)
	+ then show ?thesis
	+ using 2
	+ by simp
	+ qed
	+ have "h = \<zero>"
	+ proof(rule ccontr)
	+ assume "h \<noteq> \<zero>"
	+ then have "(deriv f a) \<oplus> c \<otimes>h = \<zero>"
	+ using 2 3
	+ by (meson R.m_closed UP_cring.deriv_closed Zp_x_is_UP_cring assms(1) assms(2) c_def h_fact local.integral sum_closed)
	+ then have "(deriv f a) = \<ominus> c \<otimes>h"
	+ using R.l_minus R.minus_equality assms(1) assms(2) c_def deriv_closed h_fact by auto
	+ then have "val_Zp (deriv f a) = val_Zp (c \<otimes> h)"
	+ by (meson R.m_closed \<open>deriv f a \<oplus> c \<otimes> h = \<zero>\<close> assms(1) assms(2) c_def deriv_closed h_fact val_Zp_not_equal_imp_notequal(3))
	+ then have P: "val_Zp (deriv f a) = val_Zp h + val_Zp c"
	+ by (simp add: c_def h_fact val_Zp_mult)
	+ have "val_Zp (deriv f a) \<ge> val_Zp h "
	+ using P val_pos[of c] c_def
	+ by simp
	+ then have "val_Zp (deriv f a) \<ge> val_Zp (b \<ominus> a) "
	+ using h_def by blast
	+ then have "val_Zp (deriv f a) > val_Zp ((pderiv f)\<bullet>a)"
	+ by (metis (no_types, lifting) A assms(2) h_def h_fact minus_a_inv not_less order_trans val_Zp_of_minus)
	+ then have P0:"val_Zp (deriv f a) > val_Zp (deriv f a)"
	+ by (metis UP_cring.pderiv_eval_deriv Zp_x_is_UP_cring assms(1) assms(2))
	+ thus False by auto
	+ qed
	+ then show "a = b"
	+ by (simp add: assms(2) h_fact)
	+ qed
	+ show ?thesis
	+ using T1 T2
	+ by blast
	+next
	+ case False
	+ have F0: "pderiv f \<bullet> a \<noteq> \<zero>"
	+ apply(rule ccontr) using assms(3)
	+ unfolding val_Zp_def by simp
	+ obtain \<alpha> where alpha_def:
	+ "f\<bullet>\<alpha> = \<zero>" "\<alpha> \<in> carrier Zp"
	+ "val_Zp (a \<ominus> \<alpha>) > val_Zp ((pderiv f)\<bullet>a)"
	+ "(val_Zp (a \<ominus> \<alpha>) = val_Zp (divide (f\<bullet>a) ((pderiv f)\<bullet>a)))"
	+ "val_Zp ((pderiv f)\<bullet>\<alpha>) = val_Zp ((pderiv f)\<bullet>a)"
	+ using assms hensels_lemma F0 False by blast
	+ have 0: "\<And>x. x \<in> carrier Zp \<and> f \<bullet> x = \<zero> \<and> val_Zp (a \<ominus> x) > val_Zp (pderiv f \<bullet> a) \<and> val_Zp (pderiv f \<bullet> a) \<noteq> val_Zp (a \<ominus> x) \<Longrightarrow> x= \<alpha>"
	+ using alpha_def assms hensels_lemma_unique_root[of f a \<alpha>] F0 False by blast
	+ have 1: "\<alpha> \<in> carrier Zp \<and> f \<bullet> \<alpha> = \<zero> \<and> val_Zp (a \<ominus> \<alpha>) > val_Zp (pderiv f \<bullet> a) \<and> val_Zp (pderiv f \<bullet> a) \<noteq> val_Zp (a \<ominus> \<alpha>)"
	+ using alpha_def order_less_le by blast
	+ thus ?thesis
	+ using 0
	+ by (metis (no_types, hide_lams) R.minus_closed alpha_def(1-3) assms(2) equal_val_Zp val_Zp_ultrametric_eq')
	+qed
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+section\<open>Some Applications of Hensel's Lemma to Root Finding for Polynomials over $\mathbb{Z}_p$\<close>
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+lemma Zp_square_root_criterion:
	+ assumes "p \<noteq> 2"
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "val_Zp b \<ge> val_Zp a"
	+ assumes "a \<noteq> \<zero>"
	+ assumes "b \<noteq> \<zero>"
	+ shows "\<exists>y \<in> carrier Zp. a[^](2::nat) \<oplus> \<p>\<otimes>b[^](2::nat) = (y [^]\<^bsub>Zp\<^esub> (2::nat))"
	+proof-
	+ have bounds: "val_Zp a < \<infinity>" "val_Zp a \<ge> 0" "val_Zp b < \<infinity>" "val_Zp b \<ge> 0"
	+ using assms(2) assms(3) assms(6) assms(5) val_Zp_def val_pos[of b] val_pos[of a]
	+ by auto
	+ obtain f where f_def: "f = monom Zp_x \<one> 2 \<oplus>\<^bsub>Zp_x\<^esub> to_polynomial Zp (\<ominus> (a[^](2::nat)\<oplus> \<p>\<otimes>b[^](2::nat)))"
	+ by simp
	+ have "\<exists> \<alpha>. f\<bullet>\<alpha> = \<zero> \<and> \<alpha> \<in> carrier Zp"
	+ proof-
	+ have 0: "f \<in> carrier Zp_x"
	+ using f_def
	+ by (simp add: X_closed assms(2) assms(3) to_poly_closed)
	+ have 1: "(pderiv f)\<bullet>a = [(2::nat)] \<cdot> \<one> \<otimes> a"
	+ proof-
	+ have "pderiv f = pderiv (monom Zp_x \<one> 2)"
	+ using assms f_def pderiv_add[of "monom Zp_x \<one> 2"] to_poly_closed R.nat_pow_closed
	+ pderiv_deg_0
	+ unfolding to_polynomial_def
	+ using P.nat_pow_closed P.r_zero R.add.inv_closed X_closed Zp_int_inc_closed deg_const monom_term_car pderiv_closed sum_closed
	+ by (metis (no_types, lifting) R.one_closed monom_closed)
	+ then have 20: "pderiv f = monom (Zp_x) ([(2::nat) ] \<cdot> \<one>) (1::nat)"
	+ using pderiv_monom[of \<one> 2]
	+ by simp
	+ have 21: "[(2::nat)] \<cdot> \<one> \<noteq> \<zero>"
	+ using Zp_char_0'[of 2] by simp
	+ have 22: "(pderiv f)\<bullet>a = [(2::nat)] \<cdot> \<one> \<otimes> (a[^]((1::nat)))"
	+ using 20
	+ by (simp add: Zp_nat_inc_closed assms(2) to_fun_monom)
	+ then show ?thesis
	+ using assms(2)
	+ by (simp add: cring.cring_simprules(12))
	+ qed
	+ have 2: "(pderiv f)\<bullet>a \<noteq> \<zero>"
	+ using 1 assms
	+ by (metis Zp_char_0' Zp_nat_inc_closed local.integral zero_less_numeral)
	+ have 3: "f\<bullet>a = \<ominus> (\<p>\<otimes>b[^](2::nat))"
	+ proof-
	+ have 3: "f\<bullet>a =
	+ monom (UP Zp) \<one> 2 \<bullet> a \<oplus>
	+ to_polynomial Zp (\<ominus> (a [^] (2::nat) \<oplus> [p] \<cdot> \<one> \<otimes> b [^] (2::nat)))\<bullet>a"
	+ unfolding f_def apply(rule to_fun_plus)
	+ apply (simp add: assms(2) assms(3) to_poly_closed)
	+ apply simp
	+ by (simp add: assms(2))
	+ have 30: "f\<bullet>a = a[^](2::nat) \<ominus> (a[^](2::nat) \<oplus> \<p>\<otimes>b[^](2::nat))"
	+ unfolding 3 by (simp add: R.minus_eq assms(2) assms(3) to_fun_monic_monom to_fun_to_poly)
	+ have 31: "f\<bullet>a = a[^](2::nat) \<ominus> a[^](2::nat) \<ominus> (\<p>\<otimes>b[^](2::nat))"
	+ proof-
	+ have 310: "a[^](2::nat) \<in> carrier Zp"
	+ using assms(2) pow_closed
	+ by blast
	+ have 311: "\<p>\<otimes>(b[^](2::nat)) \<in> carrier Zp"
	+ by (simp add: assms(3) monom_term_car)
	+ have "\<ominus> (a [^] (2::nat)\<oplus>(\<p> \<otimes> b [^] (2::nat))) = \<ominus> (a [^] (2::nat)) \<oplus> \<ominus> (\<p> \<otimes> (b [^] (2::nat)))"
	+ using 310 311 R.minus_add by blast
	+ then show ?thesis
	+ by (simp add: "30" R.minus_eq add_assoc)
	+ qed
	+ have 32: "f\<bullet>a = (a[^](2::nat) \<ominus> a[^](2::nat)) \<ominus> (\<p>\<otimes>b[^](2::nat))"
	+ using 31 unfolding a_minus_def
	+ by blast
	+ have 33: "\<p>\<otimes>b[^](2::nat) \<in> carrier Zp"
	+ by (simp add: Zp_nat_inc_closed assms(3) monom_term_car)
	+ have 34: "a[^](2::nat) \<in> carrier Zp"
	+ using assms(2) pow_closed by blast
	+ then have 34: "(a[^](2::nat) \<ominus> a[^](2::nat)) = \<zero> "
	+ by simp
	+ have 35: "f\<bullet>a = \<zero> \<ominus> (\<p>\<otimes>b[^](2::nat))"
	+ by (simp add: "32" "34")
	+ then show ?thesis
	+ using 33 unfolding a_minus_def
	+ by (simp add: cring.cring_simprules(3))
	+ qed
	+ have 4: "f\<bullet>a \<noteq>\<zero>"
	+ using 3 assms
	+ by (metis R.add.inv_eq_1_iff R.m_closed R.nat_pow_closed Zp.integral Zp_int_inc_closed
	+ mult_zero_r nonzero_pow_nonzero p_natpow_prod_Suc(1) p_pow_nonzero(2))
	+ have 5: "val_Zp (f\<bullet>a) = 1 + 2*val_Zp b"
	+ proof-
	+ have "val_Zp (f\<bullet>a) = val_Zp (\<p>\<otimes>b[^](2::nat))"
	+ using 3 Zp_int_inc_closed assms(3) monom_term_car val_Zp_of_minus by presburger
	+ then have "val_Zp (\<p>\<otimes>b[^](2::nat)) = 1 + val_Zp (b[^](2::nat))"
	+ by (simp add: assms(3) val_Zp_mult val_Zp_p)
	+ then show ?thesis
	+ using assms(3) assms(6)
	+ using Zp_def \<open>val_Zp (to_fun f a) = val_Zp ([p] \<cdot> \<one> \<otimes> b [^] 2)\<close> not_nonzero_Zp
	+ padic_integers_axioms val_Zp_pow' by fastforce
	+ qed
	+ have 6: "val_Zp ((pderiv f)\<bullet>a) = val_Zp a"
	+ proof-
	+ have 60: "val_Zp ([(2::nat)] \<cdot> \<one> \<otimes> a) = val_Zp ([(2::nat)] \<cdot> \<one>) + val_Zp a"
	+ by (simp add: Zp_char_0' assms(2) assms(5) val_Zp_mult ord_of_nonzero(2) ord_pos)
	+ have "val_Zp ([(2::nat)] \<cdot> \<one>) = 0"
	+ proof-
	+ have "(2::nat) < p"
	+ using prime assms prime_ge_2_int by auto
	+ then have "(2::nat) mod p = (2::nat)"
	+ by simp
	+ then show ?thesis
	+ by (simp add: val_Zp_p_nat_unit)
	+ qed
	+ then show ?thesis
	+ by (simp add: "1" "60")
	+ qed
	+ then have 7: "val_Zp (f\<bullet>a) > 2* val_Zp ((pderiv f)\<bullet>a)"
	+ using bounds 5 assms(4)
	+ by (simp add: assms(5) assms(6) one_eint_def val_Zp_def)
	+ obtain \<alpha> where
	+ A0: "f\<bullet>\<alpha> = \<zero>" "\<alpha> \<in> carrier Zp"
	+ using hensels_lemma[of f a] "0" "2" "4" "7" assms(2)
	+ by blast
	+ show ?thesis
	+ using A0 by blast
	+ qed
	+ then obtain \<alpha> where \<alpha>_def: "f\<bullet>\<alpha> = \<zero> \<and> \<alpha> \<in> carrier Zp"
	+ by blast
	+ have "f\<bullet>\<alpha> = \<alpha> [^](2::nat) \<ominus> (a[^](2::nat)\<oplus> \<p>\<otimes>b[^](2::nat))"
	+ proof-
	+ have 0: "f\<bullet>\<alpha> =
	+ monom (UP Zp) \<one> 2 \<bullet> \<alpha> \<oplus>
	+ to_polynomial Zp (\<ominus> (a [^] (2::nat) \<oplus> [p] \<cdot> \<one> \<otimes> b [^] (2::nat)))\<bullet>\<alpha>"
	+ unfolding f_def apply(rule to_fun_plus)
	+ apply (simp add: assms(2) assms(3) to_poly_closed)
	+ apply simp
	+ by (simp add: \<alpha>_def)
	+ thus ?thesis
	+ by (simp add: R.minus_eq \<alpha>_def assms(2) assms(3) to_fun_monic_monom to_fun_to_poly)
	+ qed
	+ then show ?thesis
	+ by (metis R.r_right_minus_eq Zp_int_inc_closed \<alpha>_def assms(2) assms(3) monom_term_car pow_closed sum_closed)
	+qed
	+
	+lemma Zp_semialg_eq:
	+ assumes "a \<in> nonzero Zp"
	+ shows "\<exists>y \<in> carrier Zp. \<one> \<oplus> (\<p> [^] (3::nat))\<otimes> (a [^] (4::nat)) = (y [^] (2::nat))"
	+proof-
	+ obtain f where f_def: "f = monom Zp_x \<one> 2 \<oplus>\<^bsub>Zp_x\<^esub> to_poly (\<ominus> (\<one> \<oplus> (\<p> [^] (3::nat))\<otimes> (a [^] (4::nat))))"
	+ by simp
	+ have a_car: "a \<in> carrier Zp"
	+ by (simp add: nonzero_memE assms)
	+ have "f \<in> carrier Zp_x"
	+ using f_def
	+ by (simp add: a_car to_poly_closed)
	+ hence 0:"f\<bullet>\<one> = \<one> \<ominus> (\<one> \<oplus> (\<p> [^] (3::nat))\<otimes> (a [^] (4::nat)))"
	+ using f_def
	+ by (simp add: R.minus_eq assms nat_pow_nonzero nonzero_mult_in_car p_pow_nonzero' to_fun_monom_plus to_fun_to_poly to_poly_closed)
	+ then have 1: "f\<bullet>\<one> = \<ominus> (\<p> [^] (3::nat))\<otimes> (a [^] (4::nat))"
	+ unfolding a_minus_def
	+ by (smt R.add.inv_closed R.l_minus R.minus_add R.minus_minus R.nat_pow_closed R.one_closed R.r_neg1 a_car monom_term_car p_pow_nonzero(1))
	+ then have "val_Zp (f\<bullet>\<one>) = 3 + val_Zp (a [^] (4::nat))"
	+ using assms val_Zp_mult[of "\<p> [^] (3::nat)" "(a [^] (4::nat))" ]
	+ val_Zp_p_pow p_pow_nonzero[of "3::nat"] val_Zp_of_minus
	+ by (metis R.l_minus R.nat_pow_closed a_car monom_term_car of_nat_numeral)
	+ then have 2: "val_Zp (f\<bullet>\<one>) = 3 + 4* val_Zp a"
	+ using assms val_Zp_pow' by auto
	+ have "pderiv f = pderiv (monom Zp_x \<one> 2)"
	+ using assms f_def pderiv_add[of "monom Zp_x \<one> 2"] to_poly_closed R.nat_pow_closed pderiv_deg_0
	+ unfolding to_polynomial_def
	+ by (metis (no_types, lifting) P.r_zero R.add.inv_closed R.add.m_closed R.one_closed
	+ UP_zero_closed a_car deg_const deg_nzero_nzero monom_closed monom_term_car p_pow_nonzero(1))
	+ then have 3: "pderiv f = [(2::nat)] \<cdot> \<one> \<odot>\<^bsub>Zp_x\<^esub> X "
	+ by (metis P.nat_pow_eone R.one_closed Suc_1 X_closed diff_Suc_1 monom_rep_X_pow pderiv_monom')
	+ hence 4: "val_Zp ((pderiv f)\<bullet>\<one>) = val_Zp ([(2::nat)] \<cdot> \<one> )"
	+ by (metis R.add.nat_pow_eone R.nat_inc_prod R.nat_inc_prod' R.nat_pow_one R.one_closed
	+ Zp_nat_inc_closed \<open>pderiv f = pderiv (monom Zp_x \<one> 2)\<close> pderiv_monom to_fun_monom)
	+ have "(2::int) = (int (2::nat))"
	+ by simp
	+ then have 5: "[(2::nat)] \<cdot> \<one> = ([(int (2::nat))] \<cdot> \<one> )"
	+ using add_pow_def int_pow_int
	+ by metis
	+ have 6: "val_Zp ((pderiv f)\<bullet>\<one>) \<le> 1"
	+ apply(cases "p = 2")
	+ using "4" "5" val_Zp_p apply auto[1]
	+ proof-
	+ assume "p \<noteq> 2"
	+ then have 60: "coprime 2 p"
	+ using prime prime_int_numeral_eq primes_coprime two_is_prime_nat by blast
	+ have 61: "2 < p"
	+ using 60 prime
	+ by (smt \<open>p \<noteq> 2\<close> prime_gt_1_int)
	+ then show ?thesis
	+ by (smt "4" "5" \<open>2 = int 2\<close> mod_pos_pos_trivial nonzero_closed p_nonzero val_Zp_p val_Zp_p_int_unit val_pos)
	+ qed
	+ have 7: "val_Zp (f\<bullet>\<one>) \<ge> 3"
	+ proof-
	+ have "eint 4 * val_Zp a \<ge> 0"
	+ using 2 val_pos[of a]
	+ by (metis R.nat_pow_closed a_car assms of_nat_numeral val_Zp_pow' val_pos)
	+ thus ?thesis
	+ using "2" by auto
	+ qed
	+ have "2val_Zp ((pderiv f)\<bullet>\<one>) \<le> 21"
	+ using 6 one_eint_def eint_mult_mono'
	+ by (smt \<open>2 = int 2\<close> eint.distinct(2) eint_ile eint_ord_simps(1) eint_ord_simps(2) mult.commute
	+ ord_Zp_p ord_Zp_p_pow ord_Zp_pow p_nonzero p_pow_nonzero(1) times_eint_simps(1) val_Zp_p val_Zp_pow' val_pos)
	+ hence 8: "2 * val_Zp ((pderiv f)\<bullet> \<one>) < val_Zp (f\<bullet>\<one>)"
	+ using 7 le_less_trans[of "2 * val_Zp ((pderiv f)\<bullet> \<one>)" "2::eint" 3]
	+ less_le_trans[of "2 * val_Zp ((pderiv f)\<bullet> \<one>)" 3 "val_Zp (f\<bullet>\<one>)"] one_eint_def
	+ by auto
	+ obtain \<alpha> where \<alpha>_def: "f\<bullet>\<alpha> = \<zero>" and \<alpha>_def' :"\<alpha> \<in> carrier Zp"
	+ using 2 6 7 hensels_lemma' 8 \<open>f \<in> carrier Zp_x\<close> by blast
	+ have 0: "(monom Zp_x \<one> 2) \<bullet> \<alpha> = \<alpha> [^] (2::nat)"
	+ by (simp add: \<alpha>_def' to_fun_monic_monom)
	+ have 1: "to_poly (\<ominus> (\<one> \<oplus> (\<p> [^] (3::nat))\<otimes> (a [^] (4::nat)))) \<bullet> \<alpha> =\<ominus>( \<one> \<oplus> (\<p> [^] (3::nat))\<otimes> (a [^] (4::nat)))"
	+ by (simp add: \<alpha>_def' a_car to_fun_to_poly)
	+ then have "\<alpha> [^] (2::nat) \<ominus> (\<one> \<oplus> (\<p> [^] (3::nat))\<otimes> (a [^] (4::nat))) = \<zero>"
	+ using \<alpha>_def \<alpha>_def'
	+ by (simp add: R.minus_eq a_car f_def to_fun_monom_plus to_poly_closed)
	+ then show ?thesis
	+ by (metis R.add.m_closed R.nat_pow_closed R.one_closed R.r_right_minus_eq \<alpha>_def' a_car monom_term_car p_pow_nonzero(1))
	+qed
	+
	+lemma Zp_nth_root_lemma:
	+ assumes "a \<in> carrier Zp"
	+ assumes "a \<noteq> \<one>"
	+ assumes "n > 1"
	+ assumes "val_Zp (\<one> \<ominus> a) > 2*val_Zp ([(n::nat)]\<cdot> \<one>)"
	+ shows "\<exists> b \<in> carrier Zp. b[^]n = a"
	+proof-
	+ obtain f where f_def: "f = monom Zp_x \<one> n \<oplus>\<^bsub>Zp_x\<^esub> monom Zp_x (\<ominus>a) 0"
	+ by simp
	+ have "f \<in> carrier Zp_x"
	+ using f_def monom_closed assms
	+ by simp
	+ have 0: "pderiv f = monom Zp_x ([n]\<cdot> \<one>) (n-1)"
	+ by (simp add: assms(1) f_def pderiv_add pderiv_monom)
	+ have 1: "f \<bullet> \<one> = \<one> \<ominus> a"
	+ using f_def
	+ by (metis R.add.inv_closed R.minus_eq R.nat_pow_one R.one_closed assms(1) to_fun_const to_fun_monom to_fun_monom_plus monom_closed)
	+ have 2: "(pderiv f) \<bullet> \<one> = ([n]\<cdot> \<one>)"
	+ using 0 to_fun_monom assms
	+ by simp
	+ have 3: "val_Zp (f \<bullet> \<one>) > 2* val_Zp ((pderiv f) \<bullet> \<one>)"
	+ using 1 2 assms
	+ by (simp add: val_Zp_def)
	+ have 4: "f \<bullet> \<one> \<noteq> \<zero>"
	+ using 1 assms(1) assms(2) by auto
	+ have 5: "(pderiv f) \<bullet> \<one> \<noteq> \<zero>"
	+ using "2" Zp_char_0' assms(3) by auto
	+ obtain \<beta> where beta_def: "\<beta> \<in> carrier Zp \<and> f \<bullet> \<beta> = \<zero>"
	+ using hensels_lemma[of f \<one>]
	+ by (metis "3" "5" R.one_closed \<open>f \<in> carrier Zp_x\<close>)
	+ then have "(\<beta> [^] n) \<ominus> a = \<zero>"
	+ using f_def R.add.inv_closed assms(1) to_fun_const[of "\<ominus> a"] to_fun_monic_monom[of \<beta> n] to_fun_plus monom_closed
	+ unfolding a_minus_def
	+ by (simp add: beta_def)
	+ then have "\<beta> \<in> carrier Zp \<and> \<beta> [^] n = a"
	+ using beta_def nonzero_memE not_eq_diff_nonzero assms(1) pow_closed
	+ by blast
	+ then show ?thesis by blast
	+qed
	+
	+end
	+end
	diff --git a/thys/Padic_Ints/Padic_Construction.thy b/thys/Padic_Ints/Padic_Construction.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Padic_Construction.thy
	@@ -0,0 +1,1560 @@
	+theory Padic_Construction
	+imports "HOL-Number_Theory.Residues" "HOL-Algebra.RingHom" "HOL-Algebra.IntRing"
	+begin
	+
	+type_synonym padic_int = "nat \<Rightarrow> int"
	+
	+section \<open>Inverse Limit Construction of the $p$-adic Integers\<close>
	+
	+text\<open>
	+ This section formalizes the standard construction of the $p$-adic integers as the inverse
	+ limit of the finite rings $\mathbb{Z} / p^n \mathbb{Z}$ along the residue maps
	+ $\mathbb{Z} / p^n \mathbb{Z} \mapsto \mathbb{Z} / p^n \mathbb{Z} $ defined by
	+ $x \mapsto x \mod p^m$ when $n \geq m$. This is exposited, for example, in section 7.6 of
	+ \cite{dummit2004abstract}. The other main route for formalization is to first define the
	+ $p$-adic absolute value $\|\cdot\|_p$ on the rational numbers, and then define the field
	+ $\mathbb{Q}_p$ of $p$-adic numbers as the completion of the rationals under this absolute
	+ value. One can then define the ring of $p$-adic integers $\mathbb{Z}_p$ as the unit ball in
	+ $\mathbb{Q}_p$ using the unique extension of $\|\cdot\|_p$. There exist advantages and
	+ disadvantages to both approaches. The primary advantage to the absolute value approach is
	+ that the construction can be done generically using existing libraries for completions of
	+ normed fields. There are difficulties associated with performing such a construction in
	+ Isabelle using existing HOL formalizations. The chief issue is that the tools in HOL-Analysis
	+ require that a metric space be a type. If one then wanted to construct the fields
	+ $\mathbb{Q}_p$ as metric spaces, one would have to circumvent the apparent dependence on
	+ the parameter $p$, as Isabelle does not support dependent types. A workaround to this proposed
	+ by José Manuel Rodríguez Caballero on the Isabelle mailing list is to define a typeclass for
	+ fields $\mathbb{Q}_p$ as the completions of the rational numbers with a non-Archimedean absolute
	+ value. By Ostrowski's Theorem, any such absolute value must be a $p$-adic absolute value. We can
	+ recover the parameter $p$ from a completion under one of these absolute values as the cardinality
	+ of the residue field.
	+
	+ Our approach uses HOL-Algebra, where algebraic structures are constructed as records which carry
	+ the data of the underlying carrier set plus other algebraic operations, and assumptions about
	+ these structures can be organized into locales. This approach is practical for abstract
	+ algebraic reasoning where definitions of structures which are dependent on object-level
	+ parameters are ubiquitous. Using this approach, we define $\mathbb{Z}_p$ directly as an
	+ inverse limit of rings, from which $\mathbb{Q}_p$ can later be defined as the field of fractions.
	+\<close>
	+
	+subsection\<open>Canonical Projection Maps Between Residue Rings\<close>
	+
	+definition residue :: "int \<Rightarrow> int \<Rightarrow> int" where
	+"residue n m = m mod n"
	+
	+lemma residue_is_hom_0:
	+ assumes "n > 1"
	+ shows "residue n \<in> ring_hom \<Z> (residue_ring n)"
	+proof(rule ring_hom_memI)
	+ have R: "residues n"
	+ by (simp add: assms residues_def)
	+ show "\<And>x. x \<in> carrier \<Z> \<Longrightarrow> residue n x \<in> carrier (residue_ring n)"
	+ using assms residue_def residues.mod_in_carrier residues_def by auto
	+ show " \<And>x y. x \<in> carrier \<Z> \<Longrightarrow> y \<in> carrier \<Z> \<Longrightarrow>
	+ residue n (x \<otimes>\<^bsub>\<Z>\<^esub> y) = residue n x \<otimes>\<^bsub>residue_ring n\<^esub> residue n y"
	+ by (simp add: R residue_def residues.mult_cong)
	+ show "\<And>x y. x \<in> carrier \<Z> \<Longrightarrow>
	+ y \<in> carrier \<Z> \<Longrightarrow>
	+ residue n (x \<oplus>\<^bsub>\<Z>\<^esub> y) = residue n x \<oplus>\<^bsub>residue_ring n\<^esub> residue n y"
	+ by (simp add: R residue_def residues.res_to_cong_simps(1))
	+ show "residue n \<one>\<^bsub>\<Z>\<^esub> = \<one>\<^bsub>residue_ring n\<^esub>"
	+ by (simp add: R residue_def residues.res_to_cong_simps(4))
	+qed
	+
	+text\<open>The residue map is a ring homomorphism from $\mathbb{Z}/m\mathbb{Z} \to \mathbb{Z}/n\mathbb{Z}$ when n divides m\<close>
	+
	+lemma residue_is_hom_1:
	+ assumes "n > 1"
	+ assumes "m > 1"
	+ assumes "n dvd m"
	+ shows "residue n \<in> ring_hom (residue_ring m) (residue_ring n)"
	+proof(rule ring_hom_memI)
	+ have 0: "residues n"
	+ by (simp add: assms(1) residues_def)
	+ have 1: "residues m"
	+ by (simp add: assms(2) residues_def)
	+ show "\<And>x. x \<in> carrier (residue_ring m) \<Longrightarrow> residue n x \<in> carrier (residue_ring n)"
	+ using assms(1) residue_def residue_ring_def by auto
	+ show "\<And>x y. x \<in> carrier (residue_ring m) \<Longrightarrow>
	+ y \<in> carrier (residue_ring m) \<Longrightarrow>
	+ residue n (x \<otimes>\<^bsub>residue_ring m\<^esub> y) = residue n x \<otimes>\<^bsub>residue_ring n\<^esub> residue n y"
	+ using 0 1 assms by (metis mod_mod_cancel residue_def residues.mult_cong residues.res_mult_eq)
	+ show "\<And>x y. x \<in> carrier (residue_ring m)
	+ \<Longrightarrow> y \<in> carrier (residue_ring m)
	+ \<Longrightarrow> residue n (x \<oplus>\<^bsub>residue_ring m\<^esub> y) = residue n x \<oplus>\<^bsub>residue_ring n\<^esub> residue n y"
	+ using 0 1 assms by (metis mod_mod_cancel residue_def residues.add_cong residues.res_add_eq)
	+ show "residue n \<one>\<^bsub>residue_ring m\<^esub> = \<one>\<^bsub>residue_ring n\<^esub>"
	+ by (simp add: assms(1) residue_def residue_ring_def)
	+qed
	+
	+lemma residue_id:
	+ assumes "x \<in> carrier (residue_ring n)"
	+ assumes "n \<ge>0"
	+ shows "residue n x = x"
	+proof(cases "n=0")
	+ case True
	+ then show ?thesis
	+ by (simp add: residue_def)
	+next
	+ case False
	+ have 0: "x \<ge>0"
	+ using assms(1) by (simp add: residue_ring_def)
	+ have 1: "x < n"
	+ using assms(1) residue_ring_def by auto
	+ have "x mod n = x"
	+ using 0 1 by simp
	+ then show ?thesis
	+ using residue_def by auto
	+qed
	+
	+text\<open>
	+ The residue map is a ring homomorphism from
	+ $\mathbb{Z}/p^n\mathbb{Z} \to \mathbb{Z}/p^m\mathbb{Z}$ when $n \geq m$:
	+\<close>
	+
	+lemma residue_hom_p:
	+ assumes "(n::nat) \<ge> m"
	+ assumes "m >0"
	+ assumes "prime (p::int)"
	+ shows "residue (p^m) \<in> ring_hom (residue_ring (p^n)) (residue_ring (p^m))"
	+proof(rule residue_is_hom_1)
	+ show " 1 < p^n" using assms
	+ using prime_gt_1_int by auto
	+ show "1 < p^m"
	+ by (simp add: assms(2) assms(3) prime_gt_1_int)
	+ show "p ^ m dvd p ^ n" using assms(1)
	+ by (simp add: dvd_power_le)
	+qed
	+
	+subsection\<open>Defining the Set of $p$-adic Integers\<close>
	+
	+text\<open>
	+ The set of $p$-adic integers is the set of all maps $f: \mathbb{N} \to \mathbb{Z}$ which maps
	+ $n \to \{0,...,p^n -1\}$ such that $f m \mod p^{n} = f n$ when $m \geq n$. A p-adic integer $x$
	+ consists of the data of a residue map $x \mapsto x\mod p^n$ which commutes with further reduction
	+ $\mod p^m$. This formalization is specialized to just the $p$-adics, but this definition would
	+ work essentially as-is for any family of rings and residue maps indexed by a partially
	+ ordered type.
	+\<close>
	+
	+definition padic_set :: "int \<Rightarrow> padic_int set" where
	+"padic_set p = {f::nat \<Rightarrow> int .(\<forall> m::nat. (f m) \<in> carrier (residue_ring (p^m)))
	+
	+ \<and>(\<forall>(n::nat) (m::nat). n > m \<longrightarrow> residue (p^m) (f n) = (f m)) }"
	+
	+
	+lemma padic_set_res_closed:
	+ assumes "f \<in> padic_set p"
	+ shows "(f m) \<in> (carrier (residue_ring (p^m)))"
	+ using assms padic_set_def by auto
	+
	+lemma padic_set_res_coherent:
	+ assumes "f \<in> padic_set p"
	+ assumes "n \<ge> m"
	+ assumes "prime p"
	+ shows "residue (p^m) (f n) = (f m)"
	+proof(cases "n=m")
	+ case True
	+ have "(f m) \<in> carrier (residue_ring (p^m))"
	+ using assms padic_set_res_closed by blast
	+ then have "residue (p^m) (f m) = (f m)"
	+ by (simp add: residue_def residue_ring_def)
	+ then show ?thesis
	+ using True by blast
	+next
	+ case False
	+ then show ?thesis
	+ using assms(1) assms(2) padic_set_def by auto
	+qed
	+
	+text\<open>
	+ A consequence of this formalization is that each $p$-adic number is trivially
	+ defined to take a value of $0$ at $0$:
	+\<close>
	+
	+lemma padic_set_zero_res:
	+ assumes "prime p"
	+ assumes "f \<in> (padic_set p)"
	+ shows "f 0 = 0"
	+proof-
	+ have "f 0 \<in> carrier (residue_ring 1)"
	+ using assms(1) padic_set_res_closed
	+ by (metis assms(2) power_0)
	+ then show ?thesis
	+ using residue_ring_def by simp
	+qed
	+
	+lemma padic_set_memI:
	+ fixes f :: "padic_int"
	+ assumes "\<And>m. (f m) \<in> (carrier (residue_ring (p^m)))"
	+ assumes "(\<And>(m::nat) n. (n > m \<Longrightarrow> (residue (p^m) (f n) = (f m))))"
	+ shows "f \<in> padic_set (p::int)"
	+ by (simp add: assms(1) assms(2) padic_set_def)
	+
	+lemma padic_set_memI':
	+ fixes f :: "padic_int"
	+ assumes "\<And>m. (f m) \<in> {0..<p^m}"
	+ assumes "\<And>(m::nat) n. n > m \<Longrightarrow> (f n) mod p^m = (f m)"
	+ shows "f \<in> padic_set (p::int)"
	+ apply(rule padic_set_memI)
	+ using assms(1) residue_ring_def apply auto[1]
	+ by (simp add: assms(2) residue_def)
	+
	+
	+section\<open>The standard operations on the $p$-adic integers\<close>
	+
	+ (**********************************************************************************************)
	+ subsection\<open>Addition\<close>
	+ (**********************************************************************************************)
	+
	+text\<open>Addition and multiplication are defined componentwise on residue rings:\<close>
	+
	+definition padic_add :: "int \<Rightarrow> padic_int \<Rightarrow> padic_int \<Rightarrow> padic_int "
	+ where "padic_add p f g \<equiv> (\<lambda> n. (f n) \<oplus>\<^bsub>(residue_ring (p^n))\<^esub> (g n))"
	+
	+lemma padic_add_res:
	+"(padic_add p f g) n = (f n) \<oplus>\<^bsub>(residue_ring (p^n))\<^esub> (g n)"
	+ by (simp add: padic_add_def)
	+
	+text\<open>Definition of the $p$-adic additive unit:\<close>
	+
	+definition padic_zero :: "int \<Rightarrow> padic_int" where
	+"padic_zero p \<equiv> (\<lambda>n. 0)"
	+
	+lemma padic_zero_simp:
	+"padic_zero p n = \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+"padic_zero p n = 0"
	+ apply (simp add: padic_zero_def residue_ring_def)
	+ using padic_zero_def by auto
	+
	+lemma padic_zero_in_padic_set:
	+ assumes "p > 0"
	+ shows "padic_zero p \<in> padic_set p"
	+ apply(rule padic_set_memI)
	+ by(auto simp: assms padic_zero_def residue_def residue_ring_def)
	+
	+text\<open>$p$-adic additive inverses:\<close>
	+
	+definition padic_a_inv :: "int \<Rightarrow> padic_int \<Rightarrow> padic_int" where
	+"padic_a_inv p f \<equiv> \<lambda> n. \<ominus>\<^bsub>residue_ring (p^n)\<^esub> (f n)"
	+
	+lemma padic_a_inv_simp:
	+"padic_a_inv p f n\<equiv> \<ominus>\<^bsub>residue_ring (p^n)\<^esub> (f n)"
	+ by (simp add: padic_a_inv_def)
	+
	+lemma padic_a_inv_simp':
	+ assumes "prime p"
	+ assumes "f \<in> padic_set p"
	+ assumes "n >0"
	+ shows "padic_a_inv p f n = (if n=0 then 0 else (- (f n)) mod (p^n))"
	+proof-
	+ have "residues (p^n)"
	+ by (simp add: assms(1) assms(3) prime_gt_1_int residues.intro)
	+ then show ?thesis
	+ using residue_ring_def padic_a_inv_def residues.res_neg_eq
	+ by auto
	+qed
	+
	+text\<open>
	+ We show that \<^const>\<open>padic_set\<close> is closed under additive inverses. Note that we have to treat the
	+ case of residues at $0$ separately.
	+\<close>
	+
	+lemma residue_1_prop:
	+"\<ominus>\<^bsub>residue_ring 1\<^esub> \<zero>\<^bsub>residue_ring 1\<^esub> = \<zero>\<^bsub>residue_ring 1\<^esub>"
	+proof-
	+ let ?x = "\<zero>\<^bsub>residue_ring 1\<^esub>"
	+ let ?y = "\<ominus>\<^bsub>residue_ring 1\<^esub> \<zero>\<^bsub>residue_ring 1\<^esub>"
	+ let ?G = "add_monoid (residue_ring 1)"
	+ have P0:" ?x \<oplus>\<^bsub>residue_ring 1\<^esub> ?x = ?x"
	+ by (simp add: residue_ring_def)
	+ have P1: "?x \<in> carrier (residue_ring 1)"
	+ by (simp add: residue_ring_def)
	+ have "?x \<in> carrier ?G \<and> ?x \<otimes>\<^bsub>?G\<^esub> ?x = \<one>\<^bsub>?G\<^esub> \<and> ?x \<otimes>\<^bsub>?G\<^esub> ?x = \<one>\<^bsub>?G\<^esub>"
	+ using P0 P1 by auto
	+ then show ?thesis
	+ by (simp add: m_inv_def a_inv_def residue_ring_def)
	+qed
	+
	+lemma residue_1_zero:
	+ "residue 1 n = 0"
	+ by (simp add: residue_def)
	+
	+lemma padic_a_inv_in_padic_set:
	+ assumes "f \<in> padic_set p"
	+ assumes "prime (p::int)"
	+ shows "(padic_a_inv p f) \<in> padic_set p"
	+proof(rule padic_set_memI)
	+ show "\<And>m. padic_a_inv p f m \<in> carrier (residue_ring (p ^ m))"
	+ proof-
	+ fix m
	+ show "padic_a_inv p f m \<in> carrier (residue_ring (p ^ m))"
	+ proof-
	+ have P0: "padic_a_inv p f m = \<ominus>\<^bsub>residue_ring (p^m)\<^esub> (f m)"
	+ using padic_a_inv_def by simp
	+ then show ?thesis
	+ by (metis (no_types, lifting) assms(1) assms(2) cring.cring_simprules(3) neq0_conv
	+ one_less_power padic_set_res_closed padic_set_zero_res power_0 prime_gt_1_int residue_1_prop
	+ residue_ring_def residues.cring residues.intro ring.simps(1))
	+ qed
	+ qed
	+ show "\<And>m n. m < n \<Longrightarrow> residue (p ^ m) (padic_a_inv p f n) = padic_a_inv p f m"
	+ proof-
	+ fix m n::nat
	+ assume "m < n"
	+ show "residue (p ^ m) (padic_a_inv p f n) = padic_a_inv p f m"
	+ proof(cases "m=0")
	+ case True
	+ then have 0: "residue (p ^ m) (padic_a_inv p f n) = 0" using residue_1_zero
	+ by simp
	+ have "f m = 0"
	+ using assms True padic_set_def residue_ring_def padic_set_zero_res
	+ by auto
	+ then have 1: "padic_a_inv p f m = 0" using residue_1_prop assms
	+ by (simp add: True padic_a_inv_def residue_ring_def)
	+ then show ?thesis using 0 1
	+ by simp
	+ next
	+ case False
	+ have 0: "f n \<in> carrier (residue_ring (p^n)) "
	+ using assms(1) padic_set_res_closed by auto
	+ have 1: "padic_a_inv p f n = \<ominus>\<^bsub>residue_ring (p^n)\<^esub> (f n)" using padic_a_inv_def
	+ by simp
	+ have 2: "padic_a_inv p f m = \<ominus>\<^bsub>residue_ring (p^m)\<^esub> (f m)" using False padic_a_inv_def
	+ by simp
	+ have 3: "residue (p ^ m) \<in> ring_hom (residue_ring (p ^ n)) (residue_ring (p ^ m))"
	+ using residue_hom_p False \<open>m < n\<close> assms(2) by auto
	+ have 4: " cring (residue_ring (p ^ n))"
	+ using \<open>m < n\<close> assms(2) prime_gt_1_int residues.cring residues.intro by auto
	+ have 5: " cring (residue_ring (p ^ m))"
	+ using False assms(2) prime_gt_1_int residues.cring residues.intro by auto
	+ have "ring_hom_cring (residue_ring (p ^ n)) (residue_ring (p ^ m)) (residue (p ^ m))"
	+ using 3 4 5 UnivPoly.ring_hom_cringI by blast
	+ then show ?thesis using 0 1 2 ring_hom_cring.hom_a_inv
	+ by (metis \<open>m < n\<close> assms(1) assms(2) less_imp_le_nat padic_set_res_coherent)
	+ qed
	+ qed
	+ qed
	+
	+ (**********************************************************************************************)
	+ subsection\<open>Multiplication\<close>
	+ (**********************************************************************************************)
	+
	+definition padic_mult :: "int \<Rightarrow> padic_int \<Rightarrow> padic_int \<Rightarrow> padic_int"
	+ where "padic_mult p f g \<equiv> (\<lambda> n. (f n) \<otimes>\<^bsub>(residue_ring (p^n))\<^esub> (g n))"
	+
	+lemma padic_mult_res:
	+"(padic_mult p f g) n = (f n) \<otimes>\<^bsub>(residue_ring (p^n))\<^esub> (g n)"
	+ by (simp add: padic_mult_def)
	+
	+text\<open>Definition of the $p$-adic multiplicative unit:\<close>
	+
	+definition padic_one :: "int \<Rightarrow> padic_int" where
	+"padic_one p \<equiv> (\<lambda>n.(if n=0 then 0 else 1))"
	+
	+lemma padic_one_simp:
	+ assumes "n >0"
	+ shows "padic_one p n = \<one>\<^bsub>residue_ring (p^n)\<^esub>"
	+ "padic_one p n = 1"
	+ apply (simp add: assms padic_one_def residue_ring_def)
	+ using assms padic_one_def by auto
	+
	+lemma padic_one_in_padic_set:
	+ assumes "prime p"
	+ shows "padic_one p \<in> padic_set p"
	+ apply(rule padic_set_memI)
	+ by(auto simp : assms padic_one_def prime_gt_1_int residue_def residue_ring_def)
	+
	+lemma padic_simps:
	+"padic_zero p n = \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+"padic_a_inv p f n \<equiv> \<ominus>\<^bsub>residue_ring (p^n)\<^esub> (f n)"
	+"(padic_mult p f g) n = (f n) \<otimes>\<^bsub>(residue_ring (p^n))\<^esub> (g n)"
	+"(padic_add p f g) n = (f n) \<oplus>\<^bsub>(residue_ring (p^n))\<^esub> (g n)"
	+"n>0 \<Longrightarrow>padic_one p n = \<one>\<^bsub>residue_ring (p^n)\<^esub>"
	+ apply (simp add: padic_zero_simp)
	+ apply (simp add: padic_a_inv_simp)
	+ apply (simp add: padic_mult_def)
	+ apply (simp add: padic_add_res)
	+ using padic_one_simp by auto
	+
	+lemma residue_1_mult:
	+ assumes "x \<in> carrier (residue_ring 1)"
	+ assumes "y \<in> carrier (residue_ring 1)"
	+ shows "x \<otimes>\<^bsub>residue_ring 1\<^esub> y = 0"
	+ by (simp add: residue_ring_def)
	+
	+lemma padic_mult_in_padic_set:
	+ assumes "f \<in> (padic_set p)"
	+ assumes "g \<in> (padic_set p)"
	+ assumes "prime p"
	+ shows "(padic_mult p f g)\<in> (padic_set p)"
	+proof(rule padic_set_memI')
	+ show "\<And>m. padic_mult p f g m \<in> {0..<p ^ m}"
	+ unfolding padic_mult_def
	+ using assms residue_ring_def
	+ by (simp add: prime_gt_0_int)
	+ show "\<And>m n. m < n \<Longrightarrow> padic_mult p f g n mod p ^ m = padic_mult p f g m"
	+ proof-
	+ fix m n::nat
	+ assume A: "m < n"
	+ then show "padic_mult p f g n mod p ^ m = padic_mult p f g m"
	+ proof(cases "m=0")
	+ case True
	+ then show ?thesis
	+ by (metis assms(1) assms(2) mod_by_1 padic_mult_def padic_set_res_closed power_0 residue_1_mult)
	+ next
	+ case False
	+ have 0:"residue (p ^ m) \<in> ring_hom (residue_ring (p^n)) (residue_ring (p^m))"
	+ using A residue_hom_p assms False by auto
	+ have 1:"f n \<in> carrier (residue_ring (p^n))"
	+ using assms(1) padic_set_res_closed by auto
	+ have 2:"g n \<in> carrier (residue_ring (p^n))"
	+ using assms(2) padic_set_res_closed by auto
	+ have 3: "residue (p^m) (f n \<otimes>\<^bsub>residue_ring (p^n)\<^esub> g n)
	+ = f m \<otimes>\<^bsub>residue_ring (p^m)\<^esub> g m"
	+ using "0" "1" "2" A assms(1) assms(2) assms(3) less_imp_le of_nat_power padic_set_res_coherent
	+ by (simp add: assms(2) ring_hom_mult)
	+ then show ?thesis
	+ using ring_hom_mult padic_simps[simp] residue_def
	+ by auto
	+ qed
	+ qed
	+qed
	+
	+section\<open>The $p$-adic Valuation\<close>
	+
	+text\<open>This section defines the integer-valued $p$-adic valuation. Maps $0$ to $-1$ for now, otherwise is correct. We want the valuation to be integer-valued, but in practice we know it will always be positive. When we extend the valuation from the $p$-adic integers to the $p$-adic field we will have elements of negative valuation. \<close>
	+
	+definition padic_val :: "int \<Rightarrow> padic_int \<Rightarrow> int" where
	+"padic_val p f \<equiv> if (f = padic_zero p) then -1 else int (LEAST k::nat. (f (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>)"
	+
	+text\<open>Characterization of $padic\_val$ on nonzero elements\<close>
	+
	+lemma val_of_nonzero:
	+ assumes "f \<in> padic_set p"
	+ assumes "f \<noteq> padic_zero p"
	+ assumes "prime p"
	+ shows "f (nat (padic_val p f) + 1) \<noteq> \<zero>\<^bsub>residue_ring (p^((nat (padic_val p f) + 1)))\<^esub>"
	+ "f (nat (padic_val p f)) = \<zero>\<^bsub>residue_ring (p^((nat (padic_val p f))))\<^esub>"
	+ "f (nat (padic_val p f) + 1) \<noteq> 0"
	+ "f (nat (padic_val p f)) = 0"
	+proof-
	+ let ?vf = "padic_val p f"
	+ have 0: "?vf =int (LEAST k::nat. (f (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>)"
	+ using assms(2) padic_val_def by auto
	+ have 1: "(\<exists> k::nat. (f (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>)"
	+ proof-
	+ obtain k where 1: "(f k) \<noteq> (padic_zero p k)"
	+ using assms(2) by (meson ext)
	+ have 2: "k \<noteq> 0"
	+ proof
	+ assume "k=0"
	+ then have "f k = 0"
	+ using assms padic_set_zero_res by blast
	+ then show False
	+ using padic_zero_def 1 by simp
	+ qed
	+ then obtain m where "k = Suc m"
	+ by (meson lessI less_Suc_eq_0_disj)
	+ then have "(f (Suc m)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc m))\<^esub>"
	+ using "1" padic_zero_simp by simp
	+ then show ?thesis
	+ by auto
	+ qed
	+ then have "(f (Suc (nat ?vf))) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc (nat ?vf)))\<^esub>"
	+ using 0 by (metis (mono_tags, lifting) LeastI_ex nat_int)
	+ then show C0: "f (nat (padic_val p f) + 1) \<noteq> \<zero>\<^bsub>residue_ring (p^((nat (padic_val p f) + 1)))\<^esub>"
	+ using 0 1 by simp
	+ show C1: "f (nat (padic_val p f)) = \<zero>\<^bsub>residue_ring (p^((nat (padic_val p f))))\<^esub>"
	+ proof(cases "(padic_val p f) = 0")
	+ case True
	+ then show ?thesis
	+ using assms(1) assms(3) padic_set_zero_res residue_ring_def by auto
	+ next
	+ case False
	+ have "\<not> f (nat (padic_val p f)) \<noteq> \<zero>\<^bsub>residue_ring (p ^ nat (padic_val p f))\<^esub>"
	+ proof
	+ assume "f (nat (padic_val p f)) \<noteq> \<zero>\<^bsub>residue_ring (p ^ nat (padic_val p f))\<^esub>"
	+ obtain k where " (Suc k) = (nat (padic_val p f))" using False
	+ using "0" gr0_conv_Suc by auto
	+ then have "?vf \<noteq> int (LEAST k::nat. (f (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>)"
	+ using False by (metis (mono_tags, lifting) Least_le
	+ \<open>f (nat (padic_val p f)) \<noteq> \<zero>\<^bsub>residue_ring (p ^ nat (padic_val p f))\<^esub>\<close>
	+ add_le_same_cancel2 nat_int not_one_le_zero plus_1_eq_Suc)
	+ then show False using "0" by blast
	+ qed
	+ then show "f (nat (padic_val p f)) = \<zero>\<^bsub>residue_ring (p ^ nat (padic_val p f))\<^esub>" by auto
	+ qed
	+ show "f (nat (padic_val p f) + 1) \<noteq> 0"
	+ using C0 residue_ring_def
	+ by auto
	+ show "f (nat (padic_val p f)) = 0"
	+ by (simp add: C1 residue_ring_def)
	+qed
	+
	+text\<open>If $x \mod p^{n+1} \neq 0$, then $n \geq val x$.\<close>
	+
	+lemma below_val_zero:
	+ assumes "prime p"
	+ assumes "x \<in> (padic_set p)"
	+ assumes "x (Suc n) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc n))\<^esub>"
	+ shows "int n \<ge> (padic_val p x )"
	+proof(cases "x = padic_zero p")
	+ case True
	+ then show ?thesis
	+ using assms(3) padic_zero_simp by blast
	+next
	+ case False
	+ then have "padic_val p x = int (LEAST k::nat. x (Suc k) \<noteq> \<zero>\<^bsub>residue_ring (p ^ Suc k)\<^esub>)"
	+ using padic_val_def by auto
	+ then show "of_nat n \<ge> (padic_val p x )"
	+ by (metis (mono_tags, lifting) Least_le assms(3) nat_int nat_le_iff)
	+qed
	+
	+text\<open>If $n < val x$ then $x \mod p^n = 0$:\<close>
	+
	+lemma zero_below_val:
	+ assumes "prime p"
	+ assumes "x \<in> padic_set p"
	+ assumes "n \<le> padic_val p x"
	+ shows "x n = \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+ "x n = 0"
	+proof-
	+ show "x n = \<zero>\<^bsub>residue_ring (p ^ n)\<^esub>"
	+ proof(cases "n=0")
	+ case True
	+ then have "x 0 \<in>carrier (residue_ring (p^0))"
	+ using assms(2) padic_set_res_closed by blast
	+ then show ?thesis
	+ by (simp add: True residue_ring_def)
	+ next
	+ case False
	+ show ?thesis
	+ proof(cases "x = padic_zero p")
	+ case True
	+ then show ?thesis
	+ by (simp add: padic_zero_simp)
	+ next
	+ case F: False
	+ then have A: "padic_val p x = int (LEAST k::nat. (x (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>)"
	+ using padic_val_def by auto
	+ have "\<not> (x n) \<noteq> \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+ proof
	+ assume "(x n) \<noteq> \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+ obtain k where "n = Suc k"
	+ using False old.nat.exhaust by auto
	+ then have "k \<ge> padic_val p x" using A
	+ using \<open>x n \<noteq> \<zero>\<^bsub>residue_ring (p ^ n)\<^esub>\<close> assms(1) assms(2) below_val_zero by blast
	+ then have "n > padic_val p x"
	+ using \<open>n = Suc k\<close> by linarith
	+ then show False using assms(3)
	+ by linarith
	+ qed
	+ then show ?thesis
	+ by simp
	+ qed
	+ qed
	+ show "x n = 0"
	+ by (simp add: \<open>x n = \<zero>\<^bsub>residue_ring (p ^ n)\<^esub>\<close> residue_ring_def)
	+qed
	+
	+text\<open>Zero is the only element with valuation equal to $-1$:\<close>
	+
	+lemma val_zero:
	+ assumes P: "f \<in> (padic_set p)"
	+ shows "padic_val p f = -1 \<longleftrightarrow> (f = (padic_zero p))"
	+proof
	+ show "padic_val p f = -1 \<Longrightarrow> (f = (padic_zero p))"
	+ proof
	+ assume A:"padic_val p f = -1"
	+ fix k
	+ show "f k = padic_zero p k"
	+ proof-
	+ have "f k \<noteq> padic_zero p k \<Longrightarrow> False"
	+ proof-
	+ assume A0: " f k \<noteq> padic_zero p k"
	+ have False
	+ proof-
	+ have "f 0 \<in> carrier (residue_ring 1)" using P padic_set_def
	+ by (metis (no_types, lifting) mem_Collect_eq power_0)
	+ then have "f 0 = \<zero>\<^bsub>residue_ring (p^0)\<^esub>"
	+ by (simp add: residue_ring_def)
	+ then have "k>0"
	+ using A0 gr0I padic_zero_def
	+ by (metis padic_zero_simp)
	+ then have "(LEAST k. 0 < k \<and> f (Suc k) \<noteq> padic_zero p (Suc k)) \<ge>0 "
	+ by simp
	+ then have "padic_val p f \<ge>0"
	+ using A0 padic_val_def by auto
	+ then show ?thesis using A0 by (simp add: A)
	+ qed
	+ then show ?thesis by blast
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+ qed
	+ assume B: "f = padic_zero p"
	+ then show "padic_val p f = -1"
	+ using padic_val_def by simp
	+qed
	+
	+text\<open>
	+ The valuation turns multiplication into integer addition on nonzero elements. Note that this i
	+ the first instance where we need to explicity use the fact that $p$ is a prime.
	+\<close>
	+
	+lemma val_prod:
	+ assumes "prime p"
	+ assumes "f \<in> (padic_set p)"
	+ assumes "g \<in> (padic_set p)"
	+ assumes "f \<noteq> padic_zero p"
	+ assumes "g \<noteq> padic_zero p"
	+ shows "padic_val p (padic_mult p f g) = padic_val p f + padic_val p g"
	+proof-
	+ let ?vp = "padic_val p (padic_mult p f g)"
	+ let ?vf = "padic_val p f"
	+ let ?vg = "padic_val p g"
	+ have 0: "f (nat ?vf + 1) \<noteq> \<zero>\<^bsub>residue_ring (p^(nat ?vf + 1))\<^esub>"
	+ using assms(2) assms(4) val_of_nonzero assms(1) by blast
	+ have 1: "g (nat ?vg + 1) \<noteq> \<zero>\<^bsub>residue_ring (p^(nat ?vg + 1))\<^esub>"
	+ using assms(3) assms(5) val_of_nonzero assms(1) by blast
	+ have 2: "f (nat ?vf) = \<zero>\<^bsub>residue_ring (p^(nat ?vf))\<^esub>"
	+ using assms(1) assms(2) assms(4) val_of_nonzero(2) by blast
	+ have 3: "g (nat ?vg) = \<zero>\<^bsub>residue_ring (p^(nat ?vg))\<^esub>"
	+ using assms(1) assms(3) assms(5) val_of_nonzero(2) by blast
	+ let ?nm = "((padic_mult p f g) (Suc (nat (?vf + ?vg))))"
	+ let ?n = "(f (Suc (nat (?vf + ?vg))))"
	+ let ?m = "(g (Suc (nat (?vf + ?vg))))"
	+ have A: "?nm = ?n \<otimes>\<^bsub>residue_ring (p^((Suc (nat (?vf + ?vg))))) \<^esub> ?m"
	+ using padic_mult_def by simp
	+ have 5: "f (nat ?vf + 1) = residue (p^(nat ?vf + 1)) ?n"
	+ proof-
	+ have "(Suc (nat (?vf + ?vg))) \<ge> (nat ?vf + 1)"
	+ by (simp add: assms(5) padic_val_def)
	+ then have "f (nat ?vf + 1) = residue (p^(nat ?vf + 1)) (f (Suc (nat (?vf + ?vg))))"
	+ using assms(1) assms(2) padic_set_res_coherent by presburger
	+ then show ?thesis by auto
	+ qed
	+ have 6: "f (nat ?vf) = residue (p^(nat ?vf)) ?n"
	+ using add.commute assms(1) assms(2) assms(5) int_nat_eq nat_int
	+ nat_le_iff not_less_eq_eq padic_set_res_coherent padic_val_def plus_1_eq_Suc by auto
	+ have 7: "g (nat ?vg + 1) = residue (p^(nat ?vg + 1)) ?m"
	+ proof-
	+ have "(Suc (nat (?vf + ?vg))) \<ge> (nat ?vg + 1)"
	+ by (simp add: assms(4) padic_val_def)
	+ then have "g (nat ?vg + 1) = residue (p^(nat ?vg + 1)) (g (Suc (nat (?vf + ?vg))))"
	+ using assms(1) assms(3) padic_set_res_coherent by presburger
	+ then show ?thesis by auto
	+ qed
	+ have 8: "g (nat ?vg) = residue (p^(nat ?vg)) ?m"
	+ proof-
	+ have "(Suc (nat (?vf + ?vg))) \<ge> (nat ?vg)"
	+ by (simp add: assms(4) padic_val_def)
	+ then have "g (nat ?vg) = residue (p^(nat ?vg)) (g (Suc (nat (?vf + ?vg))))"
	+ using assms(1) assms(3) padic_set_res_coherent by presburger
	+ then show ?thesis by auto
	+ qed
	+ have 9: "f (nat ?vf) = 0"
	+ by (simp add: "2" residue_ring_def)
	+ have 10: "g (nat ?vg) = 0"
	+ by (simp add: "3" residue_ring_def)
	+ have 11: "f (nat ?vf + 1) \<noteq> 0"
	+ using "0" residue_ring_def by auto
	+ have 12: "g (nat ?vg + 1) \<noteq>0"
	+ using "1" residue_ring_def by auto
	+ have 13:"\<exists>i. ?n = i*p^(nat ?vf) \<and> \<not> p dvd (nat i)"
	+ proof-
	+ have "residue (p^(nat ?vf)) (?n) = f (nat ?vf)"
	+ by (simp add: "6")
	+ then have P0: "residue (p^(nat ?vf)) (?n) = 0"
	+ using "9" by linarith
	+ have "residue (p^(nat ?vf + 1)) (?n) = f (nat ?vf + 1)"
	+ using "5" by linarith
	+ then have P1: "residue (p^(nat ?vf + 1)) (?n) \<noteq> 0"
	+ using "11" by linarith
	+ have P2: "?n mod (p^(nat ?vf)) = 0"
	+ using P0 residue_def by auto
	+ have P3: "?n mod (p^(nat ?vf + 1)) \<noteq> 0"
	+ using P1 residue_def by auto
	+ have "p^(nat ?vf) dvd ?n"
	+ using P2 by auto
	+ then obtain i where A0:"?n = i*(p^(nat ?vf))"
	+ by fastforce
	+ have "?n \<in> carrier (residue_ring (p^(Suc (nat (?vf + ?vg)))))"
	+ using assms(2) padic_set_res_closed by blast
	+ then have "?n \<ge>0"
	+ by (simp add: residue_ring_def)
	+ then have NN:"i \<ge> 0"
	+ proof-
	+ have S0:"?n \<ge>0"
	+ using \<open>0 \<le> f (Suc (nat (padic_val p f + padic_val p g)))\<close> by blast
	+ have S1:"(p^(nat ?vf)) > 0"
	+ using assms(1) prime_gt_0_int zero_less_power by blast
	+ have "\<not> i<0"
	+ proof
	+ assume "i < 0"
	+ then have "?n < 0"
	+ using S1 A0 by (metis mult.commute times_int_code(1) zmult_zless_mono2)
	+ then show False
	+ using S0 by linarith
	+ qed
	+ then show ?thesis by auto
	+ qed
	+ have A1: "\<not> p dvd (nat i)"
	+ proof
	+ assume "p dvd nat i"
	+ then obtain j where "nat i = j*p"
	+ by fastforce
	+ then have "?n = jp(p^(nat ?vf))" using A0 NN
	+ by simp
	+ then show False
	+ using P3 by auto
	+ qed
	+ then show ?thesis
	+ using A0 by blast
	+ qed
	+ have 14:"\<exists> i. ?m = i*p^(nat ?vg) \<and> \<not> p dvd (nat i)"
	+ proof-
	+ have "residue (p^(nat ?vg)) (?m) = g (nat ?vg)"
	+ by (simp add: "8")
	+ then have P0: "residue (p^(nat ?vg)) (?m) = 0"
	+ using "10" by linarith
	+ have "residue (p^(nat ?vg + 1)) (?m) = g (nat ?vg + 1)"
	+ using "7" by auto
	+ then have P1: "residue (p^(nat ?vg + 1)) (?m) \<noteq> 0"
	+ using "12" by linarith
	+ have P2: "?m mod (p^(nat ?vg)) = 0"
	+ using P0 residue_def by auto
	+ have P3: "?m mod (p^(nat ?vg + 1)) \<noteq> 0"
	+ using P1 residue_def by auto
	+ have "p^(nat ?vg) dvd ?m"
	+ using P2 by auto
	+ then obtain i where A0:"?m = i*(p^(nat ?vg))"
	+ by fastforce
	+ have "?m \<in> carrier (residue_ring (p^(Suc (nat (?vf + ?vg)))))"
	+ using assms(3) padic_set_res_closed by blast
	+ then have S0: "?m \<ge>0"
	+ by (simp add: residue_ring_def)
	+ then have NN:"i \<ge> 0"
	+ using 0 assms(1) prime_gt_0_int[of p] zero_le_mult_iff zero_less_power[of p]
	+ by (metis A0 linorder_not_less)
	+ have A1: "\<not> p dvd (nat i)"
	+ proof
	+ assume "p dvd nat i"
	+ then obtain j where "nat i = j*p"
	+ by fastforce
	+ then have "?m = jp(p^(nat ?vg))" using A0 NN
	+ by (metis int_nat_eq )
	+ then show False
	+ using P3 by auto
	+ qed
	+ then show ?thesis
	+ by (metis (no_types, lifting) A0)
	+ qed
	+ obtain i where I:"?n = i*p^(nat ?vf) \<and> \<not> p dvd (nat i)"
	+ using "13" by blast
	+ obtain j where J:"?m = j*p^(nat ?vg) \<and> \<not> p dvd (nat j)"
	+ using "14" by blast
	+ let ?i = "(p^(Suc (nat (?vf + ?vg))))"
	+ have P:"?nm mod ?i = ?n*?m mod ?i"
	+ proof-
	+ have P1:"?nm = (?n \<otimes>\<^bsub>residue_ring ?i \<^esub> ?m)"
	+ using A by simp
	+ have P2:"(?n \<otimes>\<^bsub>residue_ring ?i \<^esub> ?m) = (residue ?i (?n)) \<otimes>\<^bsub>residue_ring ?i\<^esub> (residue ?i (?m))"
	+ using assms(1) assms(2) assms(3) padic_set_res_closed prime_ge_0_int residue_id by presburger
	+ then have P3:"(?n \<otimes>\<^bsub>residue_ring ?i \<^esub> ?m) = (residue ?i (?n*?m))"
	+ by (metis monoid.simps(1) residue_def residue_ring_def)
	+ then show ?thesis
	+ by (simp add: P1 residue_def)
	+ qed
	+ then have 15: "?nm mod ?i = ijp^((nat ?vf) +(nat ?vg)) mod ?i"
	+ by (simp add: I J mult.assoc mult.left_commute power_add)
	+ have 16: "\<not> p dvd (i*j)" using 13 14
	+ using I J assms(1) prime_dvd_mult_iff
	+ by (metis dvd_0_right int_nat_eq)
	+ have 17: "((nat ?vf) +(nat ?vg)) < (Suc (nat (?vf + ?vg)))"
	+ by (simp add: assms(4) assms(5) nat_add_distrib padic_val_def)
	+ have 18:"?nm mod ?i \<noteq>0"
	+ proof-
	+ have A0:"\<not> p^((Suc (nat (?vf + ?vg)))) dvd p^((nat ?vf) +(nat ?vg)) "
	+ using 17
	+ by (metis "16" assms(1) dvd_power_iff dvd_trans less_int_code(1) linorder_not_less one_dvd prime_gt_0_int)
	+ then have A1: "p^((nat ?vf) +(nat ?vg)) mod ?i \<noteq> 0"
	+ using dvd_eq_mod_eq_0
	+ by auto
	+ have "\<not> p^((Suc (nat (?vf + ?vg)))) dvd ijp^((nat ?vf) +(nat ?vg)) "
	+ using 16 A0 assms(1) assms(4) assms(5) nat_int_add padic_val_def by auto
	+ then show ?thesis
	+ using "15" by force
	+ qed
	+ have 19: "(?nm mod ?i ) mod (p^(nat ?vf + nat ?vg)) = ijp^((nat ?vf) +(nat ?vg)) mod (p^(nat ?vf + nat ?vg))"
	+ using 15 by (simp add: assms(4) assms(5) nat_add_distrib padic_val_def)
	+ have 20: "?nm mod (p^(nat ?vf + nat ?vg)) = 0"
	+ proof-
	+ have "(?nm mod ?i ) mod (p^(nat ?vf + nat ?vg)) = 0"
	+ using 19
	+ by simp
	+ then show ?thesis
	+ using "17" assms(1) int_nat_eq mod_mod_cancel[of "p^(nat ?vf + nat ?vg)" ?i]
	+ mod_pos_pos_trivial
	+ by (metis le_imp_power_dvd less_imp_le_nat)
	+ qed
	+ have 21: "(padic_mult p f g) \<noteq> padic_zero p"
	+ proof
	+ assume "(padic_mult p f g) = padic_zero p"
	+ then have "(padic_mult p f g) (Suc (nat (padic_val p f + padic_val p g))) = padic_zero p (Suc (nat (padic_val p f + padic_val p g)))"
	+ by simp
	+ then have "?nm = (padic_zero p (Suc (nat (padic_val p f + padic_val p g))))"
	+ by blast
	+ then have "?nm = 0"
	+ by (simp add: padic_zero_def)
	+ then show False
	+ using "18" by auto
	+ qed
	+ have 22: "(padic_mult p f g)\<in> (padic_set p)"
	+ using assms(1) assms(2) assms(3) padic_mult_in_padic_set by blast
	+ have 23: "\<And> j. j < Suc (nat (padic_val p f + padic_val p g)) \<Longrightarrow> (padic_mult p f g) j = \<zero>\<^bsub>residue_ring (p^j)\<^esub>"
	+ proof-
	+ fix k
	+ let ?j = "Suc (nat (padic_val p f + padic_val p g))"
	+ assume P: "k < ?j"
	+ show "(padic_mult p f g) k = \<zero>\<^bsub>residue_ring (p^k)\<^esub>"
	+ proof-
	+ have P0: "(padic_mult p f g) (nat ?vf + nat ?vg) = \<zero>\<^bsub>residue_ring (p^(nat ?vf + nat ?vg))\<^esub>"
	+ proof-
	+ let ?k = "(nat ?vf + nat ?vg)"
	+ have "((padic_mult p f g) ?k) = residue (p^?k) ((padic_mult p f g) ?k) "
	+ using P 22 padic_set_res_coherent by (simp add: assms(1) prime_gt_0_nat)
	+ then have "((padic_mult p f g) ?k) = residue (p^?k) ?nm"
	+ using "17" "22" assms(1) padic_set_res_coherent by fastforce
	+ then have "((padic_mult p f g) ?k) = residue (p^?k) ?nm"
	+ by (simp add: residue_def)
	+ then have "((padic_mult p f g) ?k) = residue (p^?k) 0"
	+ using "20" residue_def by auto
	+ then show ?thesis
	+ by (simp add: residue_def residue_ring_def)
	+ qed
	+ then show ?thesis
	+ proof(cases "k = (nat ?vf + nat ?vg)")
	+ case True then show ?thesis
	+ using P0 by blast
	+ next
	+ case B: False
	+ then show ?thesis
	+ proof(cases "k=0")
	+ case True
	+ then show ?thesis
	+ using "22" assms(1) padic_set_zero_res residue_ring_def by auto
	+ next
	+ case C: False
	+ then have "((padic_mult p f g) k) = residue (p^k) ((padic_mult p f g) (nat ?vf + nat ?vg)) "
	+ using B P 22 padic_set_res_coherent by (simp add: assms(1) assms(4) assms(5) padic_val_def prime_gt_0_nat)
	+ then have S: "((padic_mult p f g) k) = residue (p^k) \<zero>\<^bsub>residue_ring (p^((nat ?vf + nat ?vg)))\<^esub>"
	+ by (simp add: P0)
	+ have "residue (p^k) \<in> ring_hom (residue_ring (p^((nat ?vf + nat ?vg)))) (residue_ring (p^k))"
	+ using B P C residue_hom_p
	+ using assms(1) assms(4) assms(5) less_Suc0 nat_int not_less_eq of_nat_power padic_val_def prime_nat_int_transfer by auto
	+ then show ?thesis using S
	+ using P0 padic_zero_def padic_zero_simp residue_def by auto
	+ qed
	+ qed
	+ qed
	+qed
	+ have 24: "(padic_mult p f g) (Suc (nat ?vf + nat ?vg)) \<noteq> \<zero>\<^bsub>residue_ring ((p ^ Suc (nat (padic_val p f + padic_val p g))))\<^esub>"
	+ by (metis (no_types, lifting) "18" A P assms(4) assms(5) monoid.simps(1) nat_int nat_int_add padic_val_def residue_ring_def ring.simps(1))
	+ have 25: "padic_val p (padic_mult p f g) = int (LEAST k::nat. ((padic_mult p f g) (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>)"
	+ using padic_val_def 21 by auto
	+ have 26:"(nat (padic_val p f + padic_val p g)) \<in> {k::nat. ((padic_mult p f g) (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>}" using 24
	+ using "18" assms(1) prime_gt_0_nat
	+ by (metis (mono_tags, lifting) mem_Collect_eq mod_0 residue_ring_def ring.simps(1))
	+ have 27: "\<And> j. j < (nat (padic_val p f + padic_val p g)) \<Longrightarrow>
	+ j \<notin> {k::nat. ((padic_mult p f g) (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>}"
	+ by (simp add: "23")
	+ have "(nat (padic_val p f + padic_val p g)) = (LEAST k::nat. ((padic_mult p f g) (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>) "
	+ proof-
	+ obtain P where C0: "P= (\<lambda> k. ((padic_mult p f g) (Suc k)) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc k))\<^esub>)"
	+ by simp
	+ obtain x where C1: "x = (nat (padic_val p f + padic_val p g))"
	+ by blast
	+ have C2: "P x"
	+ using "26" C0 C1 by blast
	+ have C3:"\<And> j. j< x \<Longrightarrow> \<not> P j"
	+ using C0 C1 by (simp add: "23")
	+ have C4: "\<And> j. P j \<Longrightarrow> x \<le>j"
	+ using C3 le_less_linear by blast
	+ have "x = (LEAST k. P k)"
	+ using C2 C4 Least_equality by auto
	+ then show ?thesis using C0 C1 by auto
	+ qed
	+ then have "padic_val p (padic_mult p f g) = (nat (padic_val p f + padic_val p g))"
	+ using "25" by linarith
	+ then show ?thesis
	+ by (simp add: assms(4) assms(5) padic_val_def)
	+
	+qed
	+
	+section\<open>Defining the Ring of $p$-adic Integers:\<close>
	+
	+definition padic_int :: "int \<Rightarrow> padic_int ring"
	+ where "padic_int p \<equiv> \<lparr>carrier = (padic_set p),
	+ Group.monoid.mult = (padic_mult p), one = (padic_one p),
	+ zero = (padic_zero p), add = (padic_add p)\<rparr>"
	+
	+lemma padic_int_simps:
	+ "\<one>\<^bsub>padic_int p\<^esub> = padic_one p"
	+ "\<zero>\<^bsub>padic_int p\<^esub> = padic_zero p"
	+ "(\<oplus>\<^bsub>padic_int p\<^esub>) = padic_add p"
	+ "(\<otimes>\<^bsub>padic_int p\<^esub>) = padic_mult p"
	+ "carrier (padic_int p) = padic_set p"
	+ unfolding padic_int_def by auto
	+
	+lemma residues_n:
	+ assumes "n \<noteq> 0"
	+ assumes "prime p"
	+ shows "residues (p^n)"
	+proof
	+ have "p > 1" using assms(2)
	+ using prime_gt_1_int by auto
	+ then show " 1 < p ^ n "
	+ using assms(1) by auto
	+qed
	+
	+text\<open>$p$-adic multiplication is associative\<close>
	+
	+lemma padic_mult_assoc:
	+assumes "prime p"
	+shows "\<And>x y z.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ z \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<otimes>\<^bsub>padic_int p\<^esub> y \<otimes>\<^bsub>padic_int p\<^esub> z = x \<otimes>\<^bsub>padic_int p\<^esub> (y \<otimes>\<^bsub>padic_int p\<^esub> z)"
	+proof-
	+ fix x y z
	+ assume Ax: " x \<in> carrier (padic_int p)"
	+ assume Ay: " y \<in> carrier (padic_int p)"
	+ assume Az: " z \<in> carrier (padic_int p)"
	+ show "x \<otimes>\<^bsub>padic_int p\<^esub> y \<otimes>\<^bsub>padic_int p\<^esub> z = x \<otimes>\<^bsub>padic_int p\<^esub> (y \<otimes>\<^bsub>padic_int p\<^esub> z)"
	+ proof
	+ fix n
	+ show "((x \<otimes>\<^bsub>padic_int p\<^esub> y) \<otimes>\<^bsub>padic_int p\<^esub> z) n = (x \<otimes>\<^bsub>padic_int p\<^esub> (y \<otimes>\<^bsub>padic_int p\<^esub> z)) n"
	+ proof(cases "n=0")
	+ case True
	+ then show ?thesis using padic_int_simps
	+ by (metis Ax Ay Az assms padic_mult_in_padic_set padic_set_zero_res)
	+ next
	+ case False
	+ then have "residues (p^n)"
	+ by (simp add: assms residues_n)
	+ then show ?thesis
	+ using residues.cring padic_set_res_closed padic_mult_in_padic_set Ax Ay Az padic_mult_res
	+ by (simp add: cring.cring_simprules(11) padic_int_def)
	+ qed
	+ qed
	+qed
	+
	+text\<open>The $p$-adic integers are closed under addition:\<close>
	+
	+lemma padic_add_closed:
	+ assumes "prime p"
	+ shows "\<And>x y.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<oplus>\<^bsub>(padic_int p)\<^esub> y \<in> carrier (padic_int p)"
	+proof
	+ fix x::"padic_int"
	+ fix y::"padic_int"
	+ assume Px: "x \<in>carrier (padic_int p) "
	+ assume Py: "y \<in>carrier (padic_int p)"
	+ show "x \<oplus>\<^bsub>(padic_int p)\<^esub> y \<in> carrier (padic_int p)"
	+ proof-
	+ let ?f = "x \<oplus>\<^bsub>(padic_int p)\<^esub> y"
	+ have 0: "(\<forall>(m::nat). (?f m) \<in> (carrier (residue_ring (p^m))))"
	+ proof fix m
	+ have A1 : "?f m = (x m) \<oplus>\<^bsub>(residue_ring (p^m))\<^esub> (y m)"
	+ by (simp add: padic_int_def padic_add_def)
	+ have A2: "(x m) \<in>(carrier (residue_ring (p^m)))"
	+ using Px by (simp add: padic_int_def padic_set_def)
	+ have A3: "(y m) \<in>(carrier (residue_ring (p^m)))"
	+ using Py by (simp add: padic_int_def padic_set_def)
	+ then show "(?f m) \<in> (carrier (residue_ring (p^m)))"
	+ using A1 assms of_nat_0_less_iff prime_gt_0_nat residue_ring_def by force
	+ qed
	+ have 1: "(\<forall>(n::nat) (m::nat). (n > m \<longrightarrow> (residue (p^m) (?f n) = (?f m))))"
	+ proof
	+ fix n::nat
	+ show "(\<forall>(m::nat). (n > m \<longrightarrow> (residue (p^m) (?f n) = (?f m))))"
	+ proof
	+ fix m::nat
	+ show "(n > m \<longrightarrow> (residue (p^m) (?f n) = (?f m)))"
	+ proof
	+ assume A: "m < n"
	+ show "(residue (p^m) (?f n) = (?f m))"
	+ proof(cases "m = 0")
	+ case True
	+ then have A0: "(residue (p^m) (?f n)) = 0"
	+ by (simp add: residue_1_zero)
	+ have A1: "?f m = 0" using True
	+ by (simp add: padic_add_res padic_int_simps(3) residue_ring_def)
	+ then show ?thesis
	+ using A0 by linarith
	+ next
	+ case False
	+ then have "m \<noteq>0" using A by linarith
	+ have D: "p^n mod p^m = 0" using A
	+ by (simp add: le_imp_power_dvd)
	+ let ?LHS = "residue (p ^ m) ((x \<oplus>\<^bsub>padic_int p\<^esub> y) n)"
	+ have A0: "?LHS = residue (p ^ m) ((x n)\<oplus>\<^bsub>residue_ring (p^n)\<^esub>( y n))"
	+ by (simp add: padic_int_def padic_add_def)
	+ have "residue (p^m) \<in> ring_hom (residue_ring ((p^n))) (residue_ring ((p^m)))"
	+ using A False assms residue_hom_p by auto
	+ then have "residue (p ^ m) ((x n)\<oplus>\<^bsub>residue_ring (p^n)\<^esub>( y n)) = (residue (p ^ m) (x n))\<oplus>\<^bsub>residue_ring (p^m)\<^esub>((residue (p ^ m) (y n)))"
	+ by (metis (no_types, lifting) padic_int_simps(5) Px Py mem_Collect_eq padic_set_def ring_hom_add)
	+ then have "?LHS =(residue (p ^ m) (x n))\<oplus>\<^bsub>residue_ring (p^m)\<^esub>((residue (p ^ m) (y n)))"
	+ using A0 by force
	+ then show ?thesis
	+ using A Px Py padic_set_def by (simp add: padic_int_def padic_add_def)
	+ qed
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ using "0" padic_set_memI padic_int_simps by auto
	+ qed
	+ then have " x \<oplus>\<^bsub>padic_int p\<^esub> y \<in> (padic_set p)"
	+ by(simp add: padic_int_def)
	+ then show "carrier (padic_int p) \<subseteq> carrier (padic_int p)"
	+ by blast
	+qed
	+
	+text\<open>$p$-adic addition is associative:\<close>
	+
	+lemma padic_add_assoc:
	+assumes "prime p"
	+shows " \<And>x y z.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow> z \<in> carrier (padic_int p)
	+ \<Longrightarrow> x \<oplus>\<^bsub>padic_int p\<^esub> y \<oplus>\<^bsub>padic_int p\<^esub> z = x \<oplus>\<^bsub>padic_int p\<^esub> (y \<oplus>\<^bsub>padic_int p\<^esub> z)"
	+proof-
	+ fix x y z
	+ assume Ax: "x \<in> carrier (padic_int p)"
	+ assume Ay: "y \<in> carrier (padic_int p)"
	+ assume Az: "z \<in> carrier (padic_int p)"
	+ show " (x \<oplus>\<^bsub>padic_int p\<^esub> y) \<oplus>\<^bsub>padic_int p\<^esub> z = x \<oplus>\<^bsub>padic_int p\<^esub> (y \<oplus>\<^bsub>padic_int p\<^esub> z)"
	+ proof
	+ fix n
	+ show "((x \<oplus>\<^bsub>padic_int p\<^esub> y) \<oplus>\<^bsub>padic_int p\<^esub> z) n = (x \<oplus>\<^bsub>padic_int p\<^esub> (y \<oplus>\<^bsub>padic_int p\<^esub> z)) n "
	+ proof-
	+ have Ex: "(x n) \<in> carrier (residue_ring (p^n))"
	+ using Ax padic_set_def padic_int_simps by auto
	+ have Ey: "(y n) \<in> carrier (residue_ring (p^n))"
	+ using Ay padic_set_def padic_int_simps by auto
	+ have Ez: "(z n) \<in> carrier (residue_ring (p^n))"
	+ using Az padic_set_def padic_int_simps by auto
	+ let ?x = "(x n)"
	+ let ?y = "(y n)"
	+ let ?z = "(z n)"
	+ have P1: "(?x \<oplus>\<^bsub>residue_ring (p^n)\<^esub> ?y) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> ?z = (x n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> ((y \<oplus>\<^bsub>padic_int p\<^esub> z) n)"
	+ proof(cases "n = 0")
	+ case True
	+ then show ?thesis
	+ by (simp add: residue_ring_def)
	+ next
	+ case False
	+ then have "residues (p^n)"
	+ by (simp add: assms residues_n)
	+ then show ?thesis
	+ using Ex Ey Ez cring.cring_simprules(7) padic_add_res residues.cring padic_int_simps
	+ by fastforce
	+ qed
	+ have " ((y n)) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> z n =((y \<oplus>\<^bsub>padic_int p\<^esub> z) n)"
	+ using padic_add_def padic_int_simps by simp
	+ then have P0: "(x n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> ((y \<oplus>\<^bsub>padic_int p\<^esub> z) n) = ((x n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> ((y n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> z n))"
	+ using padic_add_def padic_int_simps by simp
	+ have "((x \<oplus>\<^bsub>padic_int p\<^esub> y) \<oplus>\<^bsub>padic_int p\<^esub> z) n = ((x \<oplus>\<^bsub>padic_int p\<^esub> y) n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> z n"
	+ using padic_add_def padic_int_simps by simp
	+ then have "((x \<oplus>\<^bsub>padic_int p\<^esub> y) \<oplus>\<^bsub>padic_int p\<^esub> z) n =((x n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> (y n)) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> z n"
	+ using padic_add_def padic_int_simps by simp
	+ then have "((x \<oplus>\<^bsub>padic_int p\<^esub> y) \<oplus>\<^bsub>padic_int p\<^esub> z) n =((x n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> ((y n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> z n))"
	+ using Ex Ey Ez P1 P0 by linarith
	+ then have "((x \<oplus>\<^bsub>padic_int p\<^esub> y) \<oplus>\<^bsub>padic_int p\<^esub> z) n = (x n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> ((y \<oplus>\<^bsub>padic_int p\<^esub> z) n)"
	+ using P0 by linarith
	+ then show ?thesis by (simp add: padic_int_def padic_add_def)
	+ qed
	+ qed
	+qed
	+
	+text\<open>$p$-adic addition is commutative:\<close>
	+
	+lemma padic_add_comm:
	+ assumes "prime p"
	+ shows " \<And>x y.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<oplus>\<^bsub>padic_int p\<^esub> y = y \<oplus>\<^bsub>padic_int p\<^esub> x"
	+proof-
	+ fix x y
	+ assume Ax: "x \<in> carrier (padic_int p)" assume Ay:"y \<in> carrier (padic_int p)"
	+ show "x \<oplus>\<^bsub>padic_int p\<^esub> y = y \<oplus>\<^bsub>padic_int p\<^esub> x"
	+ proof fix n
	+ show "(x \<oplus>\<^bsub>padic_int p\<^esub> y) n = (y \<oplus>\<^bsub>padic_int p\<^esub> x) n "
	+ proof(cases "n=0")
	+ case True
	+ then show ?thesis
	+ by (metis Ax Ay assms padic_add_def padic_set_zero_res padic_int_simps(3,5))
	+ next
	+ case False
	+ have LHS0: "(x \<oplus>\<^bsub>padic_int p\<^esub> y) n = (x n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> (y n)"
	+ by (simp add: padic_int_simps padic_add_res)
	+ have RHS0: "(y \<oplus>\<^bsub>padic_int p\<^esub> x) n = (y n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> (x n)"
	+ by (simp add: padic_int_simps padic_add_res)
	+ have Ex: "(x n) \<in> carrier (residue_ring (p^n))"
	+ using Ax padic_set_res_closed padic_int_simps by auto
	+ have Ey: "(y n) \<in> carrier (residue_ring (p^n))"
	+ using Ay padic_set_res_closed padic_int_simps by auto
	+ have LHS1: "(x \<oplus>\<^bsub>padic_int p\<^esub> y) n = ((x n) +(y n)) mod (p^n)"
	+ using LHS0 residue_ring_def by simp
	+ have RHS1: "(y \<oplus>\<^bsub>padic_int p\<^esub> x) n = ((y n) +(x n)) mod (p^n)"
	+ using RHS0 residue_ring_def by simp
	+ then show ?thesis using LHS1 RHS1 by presburger
	+ qed
	+ qed
	+qed
	+
	+text\<open>$padic\_zero$ is an additive identity:\<close>
	+
	+lemma padic_add_zero:
	+assumes "prime p"
	+shows "\<And>x. x \<in> carrier (padic_int p) \<Longrightarrow> \<zero>\<^bsub>padic_int p\<^esub> \<oplus>\<^bsub>padic_int p\<^esub> x = x"
	+proof-
	+ fix x
	+ assume Ax: "x \<in> carrier (padic_int p)"
	+ show " \<zero>\<^bsub>padic_int p\<^esub> \<oplus>\<^bsub>padic_int p\<^esub> x = x "
	+ proof fix n
	+ have A: "(padic_zero p) n = 0"
	+ by (simp add: padic_zero_def)
	+ have "((padic_zero p) \<oplus>\<^bsub>padic_int p\<^esub> x) n = x n"
	+ using Ax padic_int_simps(5) padic_set_res_closed residue_ring_def
	+ by(auto simp add: padic_zero_def padic_int_simps padic_add_res residue_ring_def)
	+ then show "(\<zero>\<^bsub>padic_int p\<^esub> \<oplus>\<^bsub>padic_int p\<^esub> x) n = x n"
	+ by (simp add: padic_int_def)
	+ qed
	+qed
	+
	+text\<open>Closure under additive inverses:\<close>
	+
	+lemma padic_add_inv:
	+assumes "prime p"
	+shows "\<And>x. x \<in> carrier (padic_int p) \<Longrightarrow>
	+ \<exists>y\<in>carrier (padic_int p). y \<oplus>\<^bsub>padic_int p\<^esub> x = \<zero>\<^bsub>padic_int p\<^esub>"
	+proof-
	+ fix x
	+ assume Ax: " x \<in> carrier (padic_int p)"
	+ show "\<exists>y\<in>carrier (padic_int p). y \<oplus>\<^bsub>padic_int p\<^esub> x = \<zero>\<^bsub>padic_int p\<^esub>"
	+ proof
	+ let ?y = "(padic_a_inv p) x"
	+ show "?y \<oplus>\<^bsub>padic_int p\<^esub> x = \<zero>\<^bsub>padic_int p\<^esub>"
	+ proof
	+ fix n
	+ show "(?y \<oplus>\<^bsub>padic_int p\<^esub> x) n = \<zero>\<^bsub>padic_int p\<^esub> n"
	+ proof(cases "n=0")
	+ case True
	+ then show ?thesis
	+ using Ax assms padic_add_closed padic_set_zero_res
	+ padic_a_inv_in_padic_set padic_zero_def padic_int_simps by auto
	+ next
	+ case False
	+ have C: "(x n) \<in> carrier (residue_ring (p^n))"
	+ using Ax padic_set_res_closed padic_int_simps by auto
	+ have R: "residues (p^n)"
	+ using False by (simp add: assms residues_n)
	+ have "(?y \<oplus>\<^bsub>padic_int p\<^esub> x) n = (?y n) \<oplus>\<^bsub>residue_ring (p^n)\<^esub> x n"
	+ by (simp add: padic_int_def padic_add_res)
	+ then have "(?y \<oplus>\<^bsub>padic_int p\<^esub> x) n = 0"
	+ using C R residue_ring_def[simp] residues.cring
	+ by (metis (no_types, lifting) cring.cring_simprules(9) padic_a_inv_def residues.zero_cong)
	+ then show ?thesis
	+ by (simp add: padic_int_def padic_zero_def)
	+ qed
	+ qed
	+ then show "padic_a_inv p x \<in> carrier (padic_int p)"
	+ using padic_a_inv_in_padic_set padic_int_simps
	+ Ax assms prime_gt_0_nat by auto
	+ qed
	+qed
	+
	+text\<open>The ring of padic integers forms an abelian group under addition:\<close>
	+
	+lemma padic_is_abelian_group:
	+assumes "prime p"
	+shows "abelian_group (padic_int p)"
	+ proof (rule abelian_groupI)
	+ show 0: "\<And>x y. x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<oplus>\<^bsub>(padic_int p)\<^esub> y \<in> carrier (padic_int p)"
	+ using padic_add_closed by (simp add: assms)
	+ show zero: "\<zero>\<^bsub>padic_int p\<^esub> \<in> carrier (padic_int p)"
	+ by (metis "0" assms padic_add_inv padic_int_simps(5) padic_one_in_padic_set)
	+ show add_assoc: " \<And>x y z.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ z \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<oplus>\<^bsub>padic_int p\<^esub> y \<oplus>\<^bsub>padic_int p\<^esub> z
	+ = x \<oplus>\<^bsub>padic_int p\<^esub> (y \<oplus>\<^bsub>padic_int p\<^esub> z)"
	+ using assms padic_add_assoc by auto
	+ show comm: " \<And>x y.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<oplus>\<^bsub>padic_int p\<^esub> y = y \<oplus>\<^bsub>padic_int p\<^esub> x"
	+ using assms padic_add_comm by blast
	+ show "\<And>x. x \<in> carrier (padic_int p) \<Longrightarrow> \<zero>\<^bsub>padic_int p\<^esub> \<oplus>\<^bsub>padic_int p\<^esub> x = x"
	+ using assms padic_add_zero by blast
	+ show "\<And>x. x \<in> carrier (padic_int p) \<Longrightarrow>
	+ \<exists>y\<in>carrier (padic_int p). y \<oplus>\<^bsub>padic_int p\<^esub> x = \<zero>\<^bsub>padic_int p\<^esub>"
	+ using assms padic_add_inv by blast
	+ qed
	+
	+text\<open>One is a multiplicative identity:\<close>
	+
	+lemma padic_one_id:
	+assumes "prime p"
	+assumes "x \<in> carrier (padic_int p)"
	+shows "\<one>\<^bsub>padic_int p\<^esub> \<otimes>\<^bsub>padic_int p\<^esub> x = x"
	+proof
	+ fix n
	+ show "(\<one>\<^bsub>padic_int p\<^esub> \<otimes>\<^bsub>padic_int p\<^esub> x) n = x n "
	+ proof(cases "n=0")
	+ case True
	+ then show ?thesis
	+ by (metis padic_int_simps(1,4,5) assms(1) assms(2) padic_mult_in_padic_set padic_one_in_padic_set padic_set_zero_res)
	+ next
	+ case False
	+ then have "residues (p^n)"
	+ by (simp add: assms(1) residues_n)
	+ then show ?thesis
	+ using False assms(2) cring.cring_simprules(12) padic_int_simps
	+ padic_mult_res padic_one_simp padic_set_res_closed residues.cring by fastforce
	+ qed
	+qed
	+
	+text\<open>$p$-adic multiplication is commutative:\<close>
	+
	+lemma padic_mult_comm:
	+assumes "prime p"
	+assumes "x \<in> carrier (padic_int p)"
	+assumes "y \<in> carrier (padic_int p)"
	+shows "x \<otimes>\<^bsub>padic_int p\<^esub> y = y \<otimes>\<^bsub>padic_int p\<^esub> x"
	+proof
	+ fix n
	+ have Ax: "(x n) \<in> carrier (residue_ring (p^n))"
	+ using padic_set_def assms(2) padic_int_simps by auto
	+ have Ay: "(y n) \<in>carrier (residue_ring (p^n))"
	+ using padic_set_def assms(3) padic_set_res_closed padic_int_simps
	+ by blast
	+ show "(x \<otimes>\<^bsub>padic_int p\<^esub> y) n = (y \<otimes>\<^bsub>padic_int p\<^esub> x) n"
	+ proof(cases "n=0")
	+ case True
	+ then show ?thesis
	+ by (metis padic_int_simps(4,5) assms(1) assms(2) assms(3) padic_set_zero_res padic_simps(3))
	+ next
	+ case False
	+ have LHS0: "(x \<otimes>\<^bsub>padic_int p\<^esub> y) n = (x n) \<otimes>\<^bsub>residue_ring (p^n)\<^esub> (y n)"
	+ by (simp add: padic_int_def padic_mult_res)
	+ have RHS0: "(y \<otimes>\<^bsub>padic_int p\<^esub> x) n = (y n) \<otimes>\<^bsub>residue_ring (p^n)\<^esub> (x n)"
	+ by (simp add: padic_int_def padic_mult_res)
	+ have Ex: "(x n) \<in> carrier (residue_ring (p^n))"
	+ using Ax padic_set_res_closed by auto
	+ have Ey: "(y n) \<in> carrier (residue_ring (p^n))"
	+ using Ay padic_set_res_closed by auto
	+ have LHS1: "(x \<otimes>\<^bsub>padic_int p\<^esub> y) n = ((x n) *(y n)) mod (p^n)"
	+ using LHS0
	+ by (simp add: residue_ring_def)
	+ have RHS1: "(y \<otimes>\<^bsub>padic_int p\<^esub> x) n = ((y n) *(x n)) mod (p^n)"
	+ using RHS0
	+ by (simp add: residue_ring_def)
	+ then show ?thesis using LHS1 RHS1
	+ by (simp add: mult.commute)
	+ qed
	+qed
	+
	+lemma padic_is_comm_monoid:
	+assumes "prime p"
	+shows "Group.comm_monoid (padic_int p)"
	+proof(rule comm_monoidI)
	+ show "\<And>x y.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<otimes>\<^bsub>padic_int p\<^esub> y \<in> carrier (padic_int p)"
	+ by (simp add: padic_int_def assms padic_mult_in_padic_set)
	+ show "\<one>\<^bsub>padic_int p\<^esub> \<in> carrier (padic_int p)"
	+ by (metis padic_int_simps(1,5) assms padic_one_in_padic_set)
	+ show "\<And>x y z.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ z \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<otimes>\<^bsub>padic_int p\<^esub> y \<otimes>\<^bsub>padic_int p\<^esub> z = x \<otimes>\<^bsub>padic_int p\<^esub> (y \<otimes>\<^bsub>padic_int p\<^esub> z)"
	+ using assms padic_mult_assoc by auto
	+ show "\<And>x. x \<in> carrier (padic_int p) \<Longrightarrow> \<one>\<^bsub>padic_int p\<^esub> \<otimes>\<^bsub>padic_int p\<^esub> x = x"
	+ using assms padic_one_id by blast
	+ show "\<And>x y.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ x \<otimes>\<^bsub>padic_int p\<^esub> y = y \<otimes>\<^bsub>padic_int p\<^esub> x"
	+ using padic_mult_comm by (simp add: assms)
	+qed
	+
	+lemma padic_int_is_cring:
	+ assumes "prime p"
	+ shows "cring (padic_int p)"
	+proof (rule cringI)
	+ show "abelian_group (padic_int p)"
	+ by (simp add: assms padic_is_abelian_group)
	+ show "Group.comm_monoid (padic_int p)"
	+ by (simp add: assms padic_is_comm_monoid)
	+ show "\<And>x y z.
	+ x \<in> carrier (padic_int p) \<Longrightarrow>
	+ y \<in> carrier (padic_int p) \<Longrightarrow>
	+ z \<in> carrier (padic_int p) \<Longrightarrow>
	+ (x \<oplus>\<^bsub>padic_int p\<^esub> y) \<otimes>\<^bsub>padic_int p\<^esub> z =
	+ x \<otimes>\<^bsub>padic_int p\<^esub> z \<oplus>\<^bsub>padic_int p\<^esub> y \<otimes>\<^bsub>padic_int p\<^esub> z "
	+ proof-
	+ fix x y z
	+ assume Ax: " x \<in> carrier (padic_int p)"
	+ assume Ay: " y \<in> carrier (padic_int p)"
	+ assume Az: " z \<in> carrier (padic_int p)"
	+ show "(x \<oplus>\<^bsub>padic_int p\<^esub> y) \<otimes>\<^bsub>padic_int p\<^esub> z
	+ = x \<otimes>\<^bsub>padic_int p\<^esub> z \<oplus>\<^bsub>padic_int p\<^esub> y \<otimes>\<^bsub>padic_int p\<^esub> z"
	+ proof
	+ fix n
	+ have Ex: " (x n) \<in> carrier (residue_ring (p^n))"
	+ using Ax padic_set_def padic_int_simps by auto
	+ have Ey: " (y n) \<in> carrier (residue_ring (p^n))"
	+ using Ay padic_set_def padic_int_simps by auto
	+ have Ez: " (z n) \<in> carrier (residue_ring (p^n))"
	+ using Az padic_set_def padic_int_simps by auto
	+ show "( (x \<oplus>\<^bsub>padic_int p\<^esub> y) \<otimes>\<^bsub>padic_int p\<^esub> z) n
	+ = (x \<otimes>\<^bsub>padic_int p\<^esub> z \<oplus>\<^bsub>padic_int p\<^esub> y \<otimes>\<^bsub>padic_int p\<^esub> z) n "
	+ proof(cases "n=0")
	+ case True
	+ then show ?thesis
	+ by (metis Ax Ay Az assms padic_add_closed padic_int_simps(4) padic_int_simps(5) padic_mult_in_padic_set padic_set_zero_res)
	+ next
	+ case False
	+ then have "residues (p^n)"
	+ by (simp add: assms residues_n)
	+ then show ?thesis
	+ using Ex Ey Ez cring.cring_simprules(13) padic_add_res padic_int_simps
	+ padic_mult_res residues.cring by fastforce
	+ qed
	+ qed
	+ qed
	+qed
	+
	+text\<open>The $p$-adic ring has no nontrivial zero divisors. Note that this argument is short because we have proved that the valuation is multiplicative on nonzero elements, which is where the primality assumption is used.\<close>
	+
	+lemma padic_no_zero_divisors:
	+assumes "prime p"
	+assumes "a \<in> carrier (padic_int p)"
	+assumes "b \<in>carrier (padic_int p)"
	+assumes "a \<noteq>\<zero>\<^bsub>padic_int p\<^esub> "
	+assumes "b \<noteq>\<zero>\<^bsub>padic_int p\<^esub> "
	+shows "a \<otimes>\<^bsub>padic_int p\<^esub> b \<noteq> \<zero>\<^bsub>padic_int p\<^esub> "
	+proof
	+ assume C: "a \<otimes>\<^bsub>padic_int p\<^esub> b = \<zero>\<^bsub>padic_int p\<^esub>"
	+ show False
	+ proof-
	+ have 0: "a = \<zero>\<^bsub>padic_int p\<^esub> \<or> b = \<zero>\<^bsub>padic_int p\<^esub>"
	+ proof(cases "a = \<zero>\<^bsub>padic_int p\<^esub>")
	+ case True
	+ then show ?thesis by auto
	+ next
	+ case False
	+ have "\<not> b \<noteq>\<zero>\<^bsub>padic_int p\<^esub>"
	+ proof
	+ assume "b \<noteq> \<zero>\<^bsub>padic_int p\<^esub>"
	+ have "padic_val p (a \<otimes>\<^bsub>padic_int p\<^esub> b) = (padic_val p a) + (padic_val p b)"
	+ using False assms(1) assms(2) assms(3) assms(5) val_prod padic_int_simps by auto
	+ then have "padic_val p (a \<otimes>\<^bsub>padic_int p\<^esub> b) \<noteq> -1"
	+ using False \<open>b \<noteq> \<zero>\<^bsub>padic_int p\<^esub>\<close> padic_val_def padic_int_simps by auto
	+ then show False
	+ using C padic_val_def padic_int_simps by auto
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+ show ?thesis
	+ using "0" assms(4) assms(5) by blast
	+ qed
	+qed
	+
	+lemma padic_int_is_domain:
	+ assumes "prime p"
	+ shows "domain (padic_int p)"
	+proof(rule domainI)
	+ show "cring (padic_int p)"
	+ using padic_int_is_cring assms(1) by auto
	+ show "\<one>\<^bsub>padic_int p\<^esub> \<noteq> \<zero>\<^bsub>padic_int p\<^esub>"
	+ proof
	+ assume "\<one>\<^bsub>padic_int p\<^esub> = \<zero>\<^bsub>padic_int p\<^esub> "
	+ then have "(\<one>\<^bsub>padic_int p\<^esub>) 1 = \<zero>\<^bsub>padic_int p\<^esub> 1" by auto
	+ then show False
	+ using padic_int_simps(1,2)
	+ unfolding padic_one_def padic_zero_def by auto
	+ qed
	+ show "\<And>a b. a \<otimes>\<^bsub>padic_int p\<^esub> b = \<zero>\<^bsub>padic_int p\<^esub> \<Longrightarrow>
	+ a \<in> carrier (padic_int p) \<Longrightarrow>
	+ b \<in> carrier (padic_int p) \<Longrightarrow>
	+ a = \<zero>\<^bsub>padic_int p\<^esub> \<or> b = \<zero>\<^bsub>padic_int p\<^esub>"
	+ using assms padic_no_zero_divisors
	+ by (meson prime_nat_int_transfer)
	+qed
	+
	+section\<open>The Ultrametric Inequality:\<close>
	+
	+lemma padic_val_ultrametric:
	+ assumes "prime p"
	+ assumes "a \<in> carrier (padic_int p) "
	+ assumes "b \<in> carrier (padic_int p) "
	+ assumes "a \<noteq> \<zero>\<^bsub>(padic_int p)\<^esub>"
	+ assumes "b \<noteq> \<zero>\<^bsub>(padic_int p)\<^esub>"
	+ assumes "a \<oplus>\<^bsub>(padic_int p)\<^esub> b \<noteq> \<zero>\<^bsub>(padic_int p)\<^esub>"
	+ shows "padic_val p (a \<oplus>\<^bsub>(padic_int p)\<^esub> b) \<ge> min (padic_val p a) (padic_val p b)"
	+proof-
	+ let ?va = " nat (padic_val p a)"
	+ let ?vb = "nat (padic_val p b)"
	+ let ?vab = "nat (padic_val p (a \<oplus>\<^bsub>(padic_int p)\<^esub> b))"
	+ have P:" \<not> ?vab < min ?va ?vb"
	+ proof
	+ assume P0: "?vab < min ?va ?vb"
	+ then have "Suc ?vab \<le> min ?va ?vb"
	+ using Suc_leI by blast
	+ have "(a \<oplus>\<^bsub>(padic_int p)\<^esub> b) \<in> carrier (padic_int p) "
	+ using assms(1) assms(2) assms(3) padic_add_closed by simp
	+ then have C: "(a \<oplus>\<^bsub>(padic_int p)\<^esub> b) (?vab + 1) \<noteq> \<zero>\<^bsub>residue_ring (p^(?vab + 1))\<^esub>"
	+ using val_of_nonzero(1) assms(6)
	+ by (simp add: padic_int_def val_of_nonzero(1) assms(1))
	+ have S: "(a \<oplus>\<^bsub>(padic_int p)\<^esub> b) (?vab + 1) = (a (?vab + 1)) \<oplus>\<^bsub>residue_ring (p^((?vab + 1)))\<^esub> (b ((?vab + 1)))"
	+ by (simp add: padic_int_def padic_add_def)
	+ have "int (?vab + 1) \<le> padic_val p a"
	+ using P0 using Suc_le_eq by auto
	+ then have A: "(a (?vab + 1)) = \<zero>\<^bsub>residue_ring (p^((?vab + 1)))\<^esub> "
	+ using assms(1) assms(2) zero_below_val padic_int_simps residue_ring_def
	+ by auto
	+ have "int (?vab + 1) \<le> padic_val p b"
	+ using P0 using Suc_le_eq by auto
	+ then have B: "(b (?vab + 1)) = \<zero>\<^bsub>residue_ring (p^((?vab + 1)))\<^esub> "
	+ using assms(1) assms(3) zero_below_val
	+ by (metis A \<open>int (nat (padic_val p (a \<oplus>\<^bsub>padic_int p\<^esub> b)) + 1) \<le> padic_val p a\<close>
	+ assms(2) padic_int_simps(3,5))
	+ have "p^(?vab + 1) > 1"
	+ using assms(1) by (metis add.commute plus_1_eq_Suc power_gt1 prime_gt_1_int)
	+ then have "residues (p^(?vab + 1))"
	+ using less_imp_of_nat_less residues.intro by fastforce
	+ then have "(a \<oplus>\<^bsub>(padic_int p)\<^esub> b) (?vab + 1) = \<zero>\<^bsub>residue_ring (p^((?vab + 1)))\<^esub> "
	+ using A B by (metis (no_types, lifting) S cring.cring_simprules(2)
	+ cring.cring_simprules(8) residues.cring)
	+ then show False using C by auto
	+ qed
	+ have A0: "(padic_val p a) \<ge> 0"
	+ using assms(4) padic_val_def by(auto simp: padic_int_def)
	+ have A1: "(padic_val p b) \<ge> 0"
	+ using assms(5) padic_val_def by(auto simp: padic_int_def)
	+ have A2: "padic_val p (a \<oplus>\<^bsub>(padic_int p)\<^esub> b) \<ge> 0"
	+ using assms(6) padic_val_def by(auto simp: padic_int_def)
	+ show ?thesis using P A0 A1 A2
	+ by linarith
	+qed
	+
	+lemma padic_a_inv:
	+ assumes "prime p"
	+ assumes "a \<in> carrier (padic_int p)"
	+ shows "\<ominus>\<^bsub>padic_int p\<^esub> a = (\<lambda> n. \<ominus>\<^bsub>residue_ring (p^n)\<^esub> (a n))"
	+proof
	+ fix n
	+ show "(\<ominus>\<^bsub>padic_int p\<^esub> a) n = \<ominus>\<^bsub>residue_ring (p^n)\<^esub> a n"
	+ proof(cases "n=0")
	+ case True
	+ then show ?thesis
	+ by (metis (no_types, lifting) abelian_group.a_inv_closed assms(1) assms(2) padic_int_simps(5)
	+ padic_is_abelian_group padic_set_zero_res power_0 residue_1_prop residue_ring_def ring.simps(1))
	+ next
	+ case False
	+ then have R: "residues (p^n)"
	+ by (simp add: assms(1) residues_n)
	+ have "(\<ominus>\<^bsub>padic_int p\<^esub> a) \<oplus>\<^bsub>padic_int p\<^esub> a = \<zero>\<^bsub>padic_int p\<^esub>"
	+ by (simp add: abelian_group.l_neg assms(1) assms(2) padic_is_abelian_group)
	+ then have P: "(\<ominus>\<^bsub>padic_int p\<^esub> a) n \<oplus>\<^bsub>residue_ring (p^n)\<^esub> a n = 0"
	+ by (metis padic_add_res padic_int_simps(2) padic_int_simps(3) padic_zero_def)
	+ have Q: "(a n) \<in> carrier (residue_ring (p^n))"
	+ using assms(2) padic_set_res_closed by(auto simp: padic_int_def)
	+ show ?thesis using R Q residues.cring
	+ by (metis P abelian_group.a_inv_closed abelian_group.minus_equality assms(1) assms(2)
	+ padic_int_simps(5) padic_is_abelian_group padic_set_res_closed residues.abelian_group
	+ residues.res_zero_eq)
	+ qed
	+qed
	+
	+lemma padic_val_a_inv:
	+ assumes "prime p"
	+ assumes "a \<in> carrier (padic_int p)"
	+ shows "padic_val p a = padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a)"
	+proof(cases "a = \<zero>\<^bsub>padic_int p\<^esub>")
	+ case True
	+ then show ?thesis
	+ by (metis abelian_group.a_inv_closed abelian_group.r_neg abelian_groupE(5) assms(1) assms(2) padic_is_abelian_group)
	+next
	+ case False
	+ have 0: "\<And> n. (a n) = \<zero>\<^bsub>residue_ring (p^n)\<^esub> \<Longrightarrow> (\<ominus>\<^bsub>padic_int p\<^esub> a) n = \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+ using padic_a_inv
	+ by (metis (no_types, lifting) assms(1) assms(2) cring.cring_simprules(22) power_0 residue_1_prop residues.cring residues_n)
	+ have 1: "\<And> n. (a n) \<noteq> \<zero>\<^bsub>residue_ring (p^n)\<^esub> \<Longrightarrow> (\<ominus>\<^bsub>padic_int p\<^esub> a) n \<noteq> \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+ using padic_a_inv
	+ by (metis (no_types, lifting) abelian_group.a_inv_closed abelian_group.minus_minus assms(1)
	+ assms(2) cring.cring_simprules(22) padic_int_simps(5) padic_is_abelian_group padic_set_zero_res
	+ residues.cring residues_n)
	+ have A:"padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a) \<ge> (padic_val p a)"
	+ proof-
	+ have "\<not> padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a) < (padic_val p a)"
	+ proof
	+ assume "padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a) < padic_val p a"
	+ let ?n = "padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a)"
	+ let ?m = " padic_val p a"
	+ have "(\<ominus>\<^bsub>padic_int p\<^esub> a) \<noteq> (padic_zero p)"
	+ by (metis False abelian_group.l_neg assms(1) assms(2) padic_add_zero padic_int_simps(2) padic_is_abelian_group)
	+ then have P0: "?n \<ge>0"
	+ by (simp add: padic_val_def)
	+ have P1: "?m \<ge>0" using False
	+ using \<open>0 \<le> padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a)\<close>
	+ \<open>padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a) < padic_val p a\<close> by linarith
	+ have "(Suc (nat ?n)) < Suc (nat (padic_val p a))"
	+ using P0 P1 \<open>padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a) < padic_val p a\<close> by linarith
	+ then have "int (Suc (nat ?n)) \<le> (padic_val p a)"
	+ using of_nat_less_iff by linarith
	+ then have "a (Suc (nat ?n)) = \<zero>\<^bsub>residue_ring (p ^ ((Suc (nat ?n))))\<^esub>"
	+ using assms(1) assms(2) zero_below_val residue_ring_def by(auto simp: padic_int_def)
	+ then have "(\<ominus>\<^bsub>padic_int p\<^esub> a) (Suc (nat ?n)) = \<zero>\<^bsub>residue_ring (p ^ ((Suc (nat ?n))))\<^esub>"
	+ using 0 by simp
	+ then show False using below_val_zero assms
	+ by (metis Suc_eq_plus1 \<open>\<ominus>\<^bsub>padic_int p\<^esub> a \<noteq> padic_zero p\<close> abelian_group.a_inv_closed
	+ padic_int_simps(5) padic_is_abelian_group val_of_nonzero(1))
	+ qed
	+ then show ?thesis
	+ by linarith
	+ qed
	+ have B: "padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a) \<le> (padic_val p a)"
	+ proof-
	+ let ?n = "nat (padic_val p a)"
	+ have "a (Suc ?n) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc ?n))\<^esub> "
	+ using False assms(2) val_of_nonzero(1)
	+ by (metis padic_int_simps(2,5) Suc_eq_plus1 assms(1))
	+ then have "(\<ominus>\<^bsub>padic_int p\<^esub> a) (Suc ?n) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc ?n))\<^esub> "
	+ using 1 by blast
	+ then have "padic_val p (\<ominus>\<^bsub>padic_int p\<^esub> a) \<le> int ?n" using assms(1) assms(2) below_val_zero
	+ by (metis padic_int_simps(5) abelian_group.a_inv_closed padic_is_abelian_group)
	+ then show ?thesis
	+ using False padic_val_def padic_int_simps by auto
	+ qed
	+ then show ?thesis using A B by auto
	+qed
	+
	+end
	diff --git a/thys/Padic_Ints/Padic_Int_Polynomials.thy b/thys/Padic_Ints/Padic_Int_Polynomials.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Padic_Int_Polynomials.thy
	@@ -0,0 +1,188 @@
	+theory Padic_Int_Polynomials
	+imports Padic_Int_Topology Cring_Poly
	+begin
	+
	+context padic_integers
	+begin
	+
	+text\<open>
	+ This theory states and proves basic lemmas connecting the topology on $\mathbb{Z}_p$ with the
	+ functions induced by polynomial evaluation over $\mathbb{Z}_p$. This will imply that polynomial
	+ evaluation applied to a Cauchy Sequence will always produce a cauchy sequence, which is a key
	+ fact in the proof of Hensel's Lemma.
	+\<close>
	+
	+type_synonym padic_int_poly = "nat \<Rightarrow> padic_int"
	+
	+lemma monom_term_car:
	+ assumes "c \<in> carrier Zp"
	+ assumes "x \<in> carrier Zp"
	+ shows "c \<otimes> x[^](n::nat) \<in> carrier Zp"
	+ using assms R.nat_pow_closed
	+ by (simp add: monoid.nat_pow_closed cring.cring_simprules(5) cring_def ring_def)
	+
	+text\<open>Univariate polynomial ring over Zp\<close>
	+
	+abbreviation(input) Zp_x where
	+"Zp_x \<equiv> UP Zp"
	+
	+lemma Zp_x_is_UP_cring:
	+"UP_cring Zp"
	+ using UP_cring.intro domain_axioms domain_def by auto
	+
	+lemma Zp_x_is_UP_domain:
	+"UP_domain Zp"
	+ by (simp add: UP_domain_def domain_axioms)
	+
	+lemma Zp_x_domain:
	+"domain Zp_x "
	+ by (simp add: UP_domain.UP_domain Zp_x_is_UP_domain)
	+
	+lemma pow_closed:
	+ assumes "a \<in> carrier Zp"
	+ shows "a[^](n::nat) \<in> carrier Zp"
	+ by (meson domain_axioms domain_def cring_def assms monoid.nat_pow_closed ring_def)
	+
	+lemma(in ring) pow_zero:
	+ assumes "(n::nat)>0"
	+ shows "\<zero>[^] n = \<zero>"
	+ by (simp add: assms nat_pow_zero)
	+
	+lemma sum_closed:
	+ assumes "f \<in> carrier Zp"
	+ assumes "g \<in> carrier Zp"
	+ shows "f \<oplus> g \<in> carrier Zp"
	+ by (simp add: assms(1) assms(2) cring.cring_simprules(1))
	+
	+lemma mult_zero:
	+ assumes "f \<in> carrier Zp"
	+ shows "f \<otimes> \<zero> = \<zero>"
	+ "\<zero> \<otimes> f = \<zero>"
	+ apply (simp add: assms cring.cring_simprules(27))
	+ by (simp add: assms cring.cring_simprules(26))
	+
	+lemma monom_poly_is_Zp_continuous:
	+ assumes "c \<in> carrier Zp"
	+ assumes "f = monom Zp_x c n"
	+ shows "is_Zp_continuous (to_fun f)"
	+ using monomial_is_Zp_continuous assms monom_to_monomial by auto
	+
	+lemma degree_0_is_Zp_continuous:
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "degree f = 0"
	+ shows "is_Zp_continuous (to_fun f)"
	+ using const_to_constant[of "lcf f"] assms constant_is_Zp_continuous ltrm_deg_0
	+ by (simp add: cfs_closed)
	+
	+lemma UP_sum_is_Zp_continuous:
	+ assumes "a \<in> carrier Zp_x"
	+ assumes "b \<in> carrier Zp_x"
	+ assumes "is_Zp_continuous (to_fun a)"
	+ assumes "is_Zp_continuous (to_fun b)"
	+ shows "is_Zp_continuous (to_fun (a \<oplus>\<^bsub>Zp_x\<^esub> b))"
	+ using sum_of_cont_is_cont assms
	+ by (simp add: to_fun_Fun_add)
	+
	+lemma polynomial_is_Zp_continuous:
	+ assumes "f \<in> carrier Zp_x"
	+ shows "is_Zp_continuous (to_fun f)"
	+ apply(rule poly_induct3)
	+ apply (simp add: assms)
	+ using UP_sum_is_Zp_continuous apply blast
	+ using monom_poly_is_Zp_continuous by blast
	+end
	+
	+text\<open>Notation for polynomial function application\<close>
	+
	+context padic_integers
	+begin
	+notation to_fun (infixl\<open>\<bullet>\<close> 70)
	+text\<open>Evaluating polynomials in the residue rings\<close>
	+
	+lemma res_to_fun_monic_monom:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "a k = b k"
	+ shows "(monom Zp_x \<one> n \<bullet> a) k = (monom Zp_x \<one> n \<bullet> b) k"
	+proof(induction n)
	+ case 0
	+ then show ?case
	+ using UP_cring.to_fun_X_pow Zp_x_is_UP_domain assms(1) assms(2) nat_pow_0 to_fun_one monom_one
	+ by presburger
	+next
	+ case (Suc n)
	+ fix n::nat
	+ assume IH: "to_fun (monom Zp_x \<one> n) a k = to_fun (monom Zp_x \<one> n) b k"
	+ show "to_fun (monom Zp_x \<one> (Suc n)) a k = to_fun (monom Zp_x \<one> (Suc n)) b k"
	+ proof-
	+ have LHS0: "(monom Zp_x \<one> (Suc n) \<bullet> a) k = ((monom Zp_x \<one> n \<bullet> a) \<otimes> (X \<bullet> a)) k"
	+ by (simp add: UP_cring.to_fun_monic_monom Zp_x_is_UP_cring assms(1))
	+ then show ?thesis
	+ using assms IH Zp_x_is_UP_domain
	+ Zp_continuous_is_Zp_closed
	+ by (metis (mono_tags, lifting) R.one_closed X_poly_def monom_closed monom_one_Suc
	+ residue_of_prod to_fun_X to_fun_mult)
	+ qed
	+qed
	+
	+lemma res_to_fun_monom:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "c \<in> carrier Zp"
	+ assumes "a k = b k"
	+ shows "(monom Zp_x c n \<bullet> a) k = (monom Zp_x c n \<bullet> b) k"
	+ using res_to_fun_monic_monom assms
	+ by (smt to_fun_monic_monom to_fun_monom residue_of_prod)
	+
	+lemma to_fun_res_ltrm:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "a k = b k"
	+ shows "((ltrm f)\<bullet>a) k = ((ltrm f)\<bullet>b) k"
	+ by (simp add: lcf_closed assms(1) assms(2) assms(3) assms(4) res_to_fun_monom)
	+
	+text\<open>Polynomial application commutes with taking residues\<close>
	+lemma to_fun_res:
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "a k = b k"
	+ shows "(f\<bullet>a) k = (f\<bullet>b) k"
	+ apply(rule poly_induct3[of f])
	+ apply (simp add: assms(1))
	+ using assms(2) assms(3) to_fun_plus residue_of_sum apply presburger
	+ using assms(2) assms(3) assms(4) res_to_fun_monom by blast
	+
	+
	+text\<open>If a and b have equal kth residues, then so do f'(a) and f'(b)\<close>
	+
	+lemma deriv_res:
	+ assumes "f \<in> carrier Zp_x"
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "a k = b k"
	+ shows "(deriv f a) k = (deriv f b) k"
	+ using assms to_fun_res[of "pderiv f" a b k]
	+ by (simp add: pderiv_closed pderiv_eval_deriv)
	+
	+text\<open>Propositions about evaluation:\<close>
	+
	+
	+lemma to_fun_monom_plus:
	+ assumes "a \<in> carrier Zp"
	+ assumes "g \<in> carrier Zp_x"
	+ assumes "c \<in> carrier Zp"
	+ shows "(monom Zp_x a n \<oplus>\<^bsub>Zp_x\<^esub> g)\<bullet>c = a \<otimes> c[^]n \<oplus> (g \<bullet> c)"
	+ by (simp add: assms(1) assms(2) assms(3) to_fun_monom to_fun_plus)
	+
	+lemma to_fun_monom_minus:
	+ assumes "a \<in> carrier Zp"
	+ assumes "g \<in> carrier Zp_x"
	+ assumes "c \<in> carrier Zp"
	+ shows "(monom Zp_x a n \<ominus>\<^bsub>Zp_x\<^esub> g)\<bullet>c = a \<otimes> c[^]n \<ominus> (g \<bullet> c)"
	+ by (simp add: UP_cring.to_fun_diff Zp_x_is_UP_cring assms(1) assms(2) assms(3) to_fun_monom)
	+
	+end
	+
	+end
	diff --git a/thys/Padic_Ints/Padic_Int_Topology.thy b/thys/Padic_Ints/Padic_Int_Topology.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Padic_Int_Topology.thy
	@@ -0,0 +1,1093 @@
	+theory Padic_Int_Topology
	+imports Padic_Integers Function_Ring
	+begin
	+
	+type_synonym padic_int_seq = "nat \<Rightarrow> padic_int"
	+
	+type_synonym padic_int_fun = "padic_int \<Rightarrow> padic_int"
	+
	+sublocale padic_integers < FunZp?: U_function_ring "Zp"
	+ unfolding U_function_ring_def
	+ by (simp add: R.ring_axioms)
	+
	+context padic_integers
	+begin
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+(*********************************)section\<open>Sequences over Zp\<close>(*********************************)
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+text\<open>
	+ The $p$-adic valuation can be thought of as equivalent to the $p$-adic absolute value, but with
	+ the notion of size inverted so that small numbers have large valuation, and zero has maximally
	+ large valuation. The $p$-adic distance between two points is just the valuation of the difference
	+ of those points, and is thus equivalent to the metric induced by the $p$-adic absolute value.
	+ For background on valuations and absolute values for $p$-adic rings see \cite{engler2005valued}.
	+ In what follows, we develop the topology of the $p$-adic from a valuative perspective rather than
	+ a metric perspective. Though equivalent to the metric approach in the $p$-adic case, this
	+ approach is more general in that there exist valued rings whose valuations take values in
	+ non-Archimedean ordered ablelian groups which do not embed into the real numbers.
	+\<close>
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>The Valuative Distance Function on $\mathbb{Z}_p$\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+
	+text\<open>
	+ The following lemmas establish that the $p$-adic distance function satifies the standard
	+ properties of an ultrametric. It is symmetric, obeys the ultrametric inequality, and only
	+ identical elements are infinitely close.
	+\<close>
	+
	+definition val_Zp_dist :: "padic_int \<Rightarrow> padic_int \<Rightarrow> eint" where
	+"val_Zp_dist a b \<equiv> val_Zp (a \<ominus> b)"
	+
	+lemma val_Zp_dist_sym:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ shows "val_Zp_dist a b = val_Zp_dist b a"
	+proof-
	+ have 1: "a \<ominus> b = \<ominus> (b \<ominus> a)" using assms(1) assms(2)
	+ using minus_a_inv by blast
	+ then show ?thesis
	+ using R.minus_closed Zp_def assms(1) assms(2) padic_integers.val_Zp_of_minus
	+ padic_integers_axioms val_Zp_dist_def by auto
	+qed
	+
	+lemma val_Zp_dist_ultrametric:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "c \<in> carrier Zp"
	+ shows "val_Zp_dist b c \<ge> min (val_Zp_dist a c) (val_Zp_dist a b)"
	+proof-
	+ let ?X = "b \<ominus> a"
	+ let ?Y = "a \<ominus> c"
	+ let ?Z = "b \<ominus> c"
	+ have 0: "?Z = ?X \<oplus> ?Y"
	+ using R.add.m_comm assms(1) assms(2) assms(3) R.plus_diff_simp by auto
	+ have 4: "val_Zp ?Z \<ge> min (val_Zp ?X) (val_Zp ?Y)"
	+ using "0" assms(1) assms(2) assms(3) val_Zp_ultrametric by auto
	+ then show ?thesis
	+ using assms val_Zp_dist_sym
	+ unfolding val_Zp_dist_def
	+ by (simp add: min.commute)
	+qed
	+
	+lemma val_Zp_dist_infty:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "val_Zp_dist a b = \<infinity>"
	+ shows "a = b"
	+ using assms unfolding val_Zp_dist_def
	+ by (metis R.r_right_minus_eq not_eint_eq val_ord_Zp)
	+
	+lemma val_Zp_dist_infty':
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "a = b"
	+ shows "val_Zp_dist a b = \<infinity>"
	+ using assms unfolding val_Zp_dist_def
	+ by (simp add: val_Zp_def)
	+
	+text\<open>
	+ The following property will be useful in the proof of Hensel's Lemma: two $p$-adic integers are
	+ close together if and only if their residues are equal at high orders.
	+\<close>
	+
	+lemma val_Zp_dist_res_eq:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "val_Zp_dist a b > k"
	+ shows "(a k) = (b k)"
	+ using assms(1) assms(2) assms(3) val_Zp_dist_def
	+ by (simp add: Zp_residue_eq)
	+
	+lemma val_Zp_dist_res_eq2:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "(a k) = (b k)"
	+ shows "val_Zp_dist a b \<ge> k"
	+ using assms(1) assms(2) assms(3) Zp_residue_eq2
	+ unfolding val_Zp_dist_def
	+ by (simp add: val_Zp_def)
	+
	+lemma val_Zp_dist_triangle_eqs:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "c \<in> carrier Zp"
	+ assumes "val_Zp_dist a b > n"
	+ assumes "val_Zp_dist a c > n"
	+ assumes "(k::nat) < n"
	+ shows "a k = b k"
	+ "a k = c k"
	+ "b k = c k"
	+ unfolding val_Zp_dist_def
	+proof-
	+ show 0: "a k = b k"
	+ using assms(1) assms(2) assms(4) assms(6) val_Zp_dist_res_eq
	+ by (metis less_imp_le_nat p_residue_padic_int)
	+ show 1: "a k = c k"
	+ using assms(1) assms(3) assms(5) assms(6) val_Zp_dist_res_eq
	+ by (meson eint_ord_simps(1) le_less_trans less_imp_triv not_less of_nat_le_iff)
	+ show "b k = c k"
	+ using 0 1 by auto
	+qed
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Cauchy Sequences\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+
	+text\<open>
	+ The definition of Cauchy sequence here is equivalent to standard the metric notion, and is
	+ identical to the one found on page 50 of \cite{engler2005valued}.
	+\<close>
	+
	+lemma closed_seqs_diff_closed:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a \<in> carrier Zp"
	+ shows "s m \<ominus> a \<in> carrier Zp"
	+ using assms
	+ by (simp add: closed_seqs_memE)
	+
	+definition is_Zp_cauchy :: "padic_int_seq \<Rightarrow> bool" where
	+"is_Zp_cauchy s = ((s \<in> closed_seqs Zp) \<and> (\<forall> (n::int). \<exists> (N::nat). \<forall> m k::nat.
	+
	+ (m>N \<and> k>N \<longrightarrow> (val_Zp_dist (s m) (s k)) > eint n)))"
	+
	+text\<open>Relation for a sequence which converges to a point:\<close>
	+
	+definition Zp_converges_to :: "padic_int_seq \<Rightarrow> padic_int \<Rightarrow> bool" where
	+ "Zp_converges_to s a = ((a \<in> carrier Zp \<and> s \<in> closed_seqs Zp)
	+ \<and> (\<forall>(n::int). (\<exists>(k:: nat). (\<forall>( m::nat).
	+ (m > k \<longrightarrow> (val_Zp ((s m) \<ominus> a)) > eint n) ))))"
	+
	+lemma is_Zp_cauchy_imp_closed:
	+ assumes "is_Zp_cauchy s"
	+ shows "s \<in> closed_seqs Zp"
	+ using assms unfolding is_Zp_cauchy_def by blast
	+
	+text\<open>
	+ Analogous to the lemmas about residues and $p$-adic distances, we can characterize Cauchy
	+ sequences without reference to a distance function: a sequence is Cauchy if and only if for
	+ every natural number $k$, the $k^{th}$ residues of the elements in the sequence are eventually
	+ all equal.
	+\<close>
	+
	+lemma is_Zp_cauchy_imp_res_eventually_const_0:
	+ assumes "is_Zp_cauchy s"
	+ fixes n::nat
	+ obtains N where "\<And> n0 n1. n0 > N \<and> n1 > N \<Longrightarrow> (s n0) n = (s n1) n"
	+proof-
	+ have "\<exists> (N::nat). \<forall> m k::nat. (m>N \<and> k>N \<longrightarrow> (val_Zp_dist (s m) (s k)) > (int n))"
	+ using assms is_Zp_cauchy_def by blast
	+ then obtain N where P0: " \<forall> m k::nat. (m>N \<and> k>N \<longrightarrow> (val_Zp_dist (s m) (s k)) > (int n))"
	+ by blast
	+ have P1: "\<And> n0 n1. n0 > N \<and> n1 > N \<Longrightarrow> (s n0) n = (s n1) n"
	+ proof-
	+ fix n0 n1
	+ assume A: "n0 > N \<and> n1 > N"
	+ have "(n0>N \<and> n1>N \<longrightarrow> (val_Zp_dist (s n0) (s n1)) > (int n))"
	+ using P0 by blast
	+ then have C0: "(val_Zp_dist (s n0) (s n1)) > (int n)"
	+ using A by blast
	+ show "(s n0) n = (s n1) n"
	+ proof-
	+ have A0: "(val_Zp_dist (s n0) (s n1)) > (int n)"
	+ using C0 by blast
	+ have A1: "s n0 \<in> carrier Zp"
	+ using is_Zp_cauchy_imp_closed[of s] assms
	+ by (simp add: closed_seqs_memE)
	+ have A2: "s n1 \<in> carrier Zp"
	+ using is_Zp_cauchy_def assms closed_seqs_memE[of _ Zp]
	+ by blast
	+ show ?thesis
	+ using A0 val_Zp_dist_res_eq A1 A2 by metis
	+ qed
	+ qed
	+ then show ?thesis
	+ using that by blast
	+qed
	+
	+lemma is_Zp_cauchyI:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "\<And> n. (\<exists>N. (\<forall> n0 n1. n0 > N \<and> n1 > N \<longrightarrow> (s n0) n = (s n1) n))"
	+ shows "is_Zp_cauchy s"
	+proof-
	+ have "(\<forall> (n::int). \<exists> (N::nat). \<forall> m k::nat. (m>N \<and> k>N \<longrightarrow> (val_Zp_dist (s m) (s k)) > n))"
	+ proof
	+ fix n
	+ show "\<exists> (N::nat). \<forall> m k::nat. (m>N \<and> k>N \<longrightarrow> (val_Zp_dist (s m) (s k)) > eint n)"
	+ proof-
	+ have "(\<exists>N. (\<forall> n0 n1. n0 > N \<and> n1 > N \<longrightarrow> (s n0) (Suc (nat n)) = (s n1) (Suc (nat n))))"
	+ using assms(2) by blast
	+ then obtain N where N_def: "(\<forall> n0 n1. n0 > N \<and> n1 > N \<longrightarrow> (s n0) (Suc (nat n)) = (s n1) (Suc (nat n)))"
	+ by blast
	+ have 0: "n \<le> eint (int (nat n))"
	+ by simp
	+ have "\<forall>m k. N < m \<and> N < k \<longrightarrow> (nat n) < val_Zp_dist (s m) (s k)"
	+ proof
	+ fix m
	+ show "\<forall>k. N < m \<and> N < k \<longrightarrow> int (nat n) < val_Zp_dist (s m) (s k)"
	+ proof
	+ fix k
	+ show "N < m \<and> N < k \<longrightarrow> int(nat n) < val_Zp_dist (s m) (s k)"
	+ proof
	+ assume A: "N < m \<and> N < k"
	+ then have E: "(s m) (Suc(nat n)) = (s k) (Suc(nat n))"
	+ using N_def by blast
	+ then show " int (nat n) < val_Zp_dist (s m) (s k)"
	+ proof-
	+ have 0: "(s m) \<in> carrier Zp"
	+ by (simp add: assms(1) closed_seqs_memE)
	+ have 1: "(s k) \<in> carrier Zp"
	+ using Zp_def assms(1) closed_seqs_memE[of _ Zp] padic_integers_axioms by blast
	+ have "int (Suc (nat n)) \<le> val_Zp_dist (s m) (s k)"
	+ using E 0 1 val_Zp_dist_res_eq[of "(s m)" "(s k)" "Suc (nat n)"] val_Zp_dist_res_eq2
	+ by blast
	+ then have "int (nat n) < val_Zp_dist (s m) (s k)"
	+ by (metis Suc_ile_eq add.commute of_nat_Suc)
	+ then show ?thesis
	+ by blast
	+ qed
	+ qed
	+ qed
	+ qed
	+ hence "\<forall>m k. N < m \<and> N < k \<longrightarrow> n < val_Zp_dist (s m) (s k)"
	+ using 0
	+ by (simp add: order_le_less_subst2)
	+ thus ?thesis by blast
	+ qed
	+ qed
	+ then show ?thesis
	+ using is_Zp_cauchy_def assms by blast
	+qed
	+
	+lemma is_Zp_cauchy_imp_res_eventually_const:
	+ assumes "is_Zp_cauchy s"
	+ fixes n::nat
	+ obtains N r where "r \<in> carrier (Zp_res_ring n)" and "\<And> m. m > N \<Longrightarrow> (s m) n = r"
	+proof-
	+ obtain N where A0: "\<And> n0 n1. n0 > N \<and> n1 > N \<Longrightarrow> (s n0) n = (s n1) n"
	+ using assms is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
	+ obtain r where A1: "s (Suc N) n = r"
	+ by simp
	+ have 0: "r \<in> carrier (Zp_res_ring n)"
	+ using Zp_def \<open>s (Suc N) n = r\<close> assms closed_seqs_memE[of _ Zp]
	+ is_Zp_cauchy_def padic_integers_axioms residues_closed
	+ by blast
	+ have 1: "\<And> m. m > N \<Longrightarrow> (s m) n = r"
	+ proof-
	+ fix m
	+ assume " m > N"
	+ then show "(s m) n = r"
	+ using A0 A1 by blast
	+ qed
	+ then show ?thesis
	+ using 0 1 that by blast
	+qed
	+
	+text\<open>
	+ This function identifies the eventual residues of the elements of a cauchy sequence.
	+ Since a $p$-adic integer is defined to be the map which identifies its residues, this map
	+ will turn out to be precisely the limit of a cauchy sequence.
	+\<close>
	+definition res_lim :: "padic_int_seq \<Rightarrow> padic_int" where
	+"res_lim s = (\<lambda> k. (THE r. (\<exists>N. (\<forall> m. m > N \<longrightarrow> (s m) k = r))))"
	+
	+lemma res_lim_Zp_cauchy_0:
	+ assumes "is_Zp_cauchy s"
	+ assumes "f = (res_lim s) k"
	+ shows "(\<exists>N. (\<forall> m. (m > N \<longrightarrow> (s m) k = f)))"
	+ "f \<in> carrier (Zp_res_ring k)"
	+proof-
	+ obtain N r where P0: "r \<in> carrier (Zp_res_ring k)" and P1: "\<And> m. m > N \<Longrightarrow> (s m) k = r"
	+ by (meson assms(1) is_Zp_cauchy_imp_res_eventually_const)
	+ obtain P where P_def: "P = (\<lambda> x. (\<exists>N. (\<forall> m. m > N \<longrightarrow> (s m) k = x)))"
	+ by simp
	+ have 0: "P r"
	+ using P1 P_def by auto
	+ have 1: "(\<And>x. P x \<Longrightarrow> x = r)"
	+ proof-
	+ fix x
	+ assume A_x: "P x"
	+ obtain N0 where "(\<forall> m. m > N0 \<longrightarrow> (s m) k = x)"
	+ using A_x P_def by blast
	+ let ?M = "max N0 N"
	+ have C0: "s (Suc ?M) k = x"
	+ by (simp add: \<open>\<forall>m>N0. s m k = x\<close>)
	+ have C1: "s (Suc ?M) k = r"
	+ by (simp add: P1)
	+ show "x = r"
	+ using C0 C1 by auto
	+ qed
	+ have R: "r = (THE x. P x)"
	+ using the_equality 0 1 by metis
	+ have "(res_lim s) k = (THE r. \<exists>N. \<forall>m>N. s m k = r)"
	+ using res_lim_def by simp
	+ then have "f = (THE r. \<exists>N. \<forall>m>N. s m k = r)"
	+ using assms by auto
	+ then have "f = (THE r. P r)"
	+ using P_def by auto
	+ then have "r = f"
	+ using R by auto
	+ then show "(\<exists>N. (\<forall> m. (m > N \<longrightarrow> (s m) k = f)))" using 0 P_def
	+ by blast
	+ show "f \<in> carrier (Zp_res_ring k)"
	+ using P0 \<open>r = f\<close> by auto
	+qed
	+
	+lemma res_lim_Zp_cauchy:
	+ assumes "is_Zp_cauchy s"
	+ obtains N where "\<And> m. (m > N \<longrightarrow> (s m) k = (res_lim s) k)"
	+ using res_lim_Zp_cauchy_0 assms by presburger
	+
	+lemma res_lim_in_Zp:
	+ assumes "is_Zp_cauchy s"
	+ shows "res_lim s \<in> carrier Zp"
	+proof-
	+ have "res_lim s \<in> padic_set p"
	+ proof(rule padic_set_memI)
	+ show "\<And>m. res_lim s m \<in> carrier (residue_ring (p^ m))"
	+ using res_lim_Zp_cauchy_0 by (simp add: assms)
	+ show "\<And>m n. m < n \<Longrightarrow> residue (p^ m) (res_lim s n) = res_lim s m"
	+ proof-
	+ fix m n
	+ obtain N where N0: "\<And> l. (l > N \<longrightarrow> (s l) m = (res_lim s) m)"
	+ using assms res_lim_Zp_cauchy by blast
	+ obtain M where M0: "\<And> l. (l > M \<longrightarrow> (s l) n = (res_lim s) n)"
	+ using assms prod.simps(2) res_lim_Zp_cauchy by auto
	+ obtain K where K_def: "K = max M N"
	+ by simp
	+ have Km: "\<And> l. (l > K \<longrightarrow> (s l) m = (res_lim s) m)"
	+ using K_def N0 by simp
	+ have Kn: "\<And> l. (l > K \<longrightarrow> (s l) n = (res_lim s) n)"
	+ using K_def M0 by simp
	+ assume "m < n"
	+ show "residue (p^ m) (res_lim s n) = res_lim s m"
	+ proof-
	+ obtain l where l_def: "l = Suc K"
	+ by simp
	+ have ln: "(res_lim s n) = (s l) n"
	+ by (simp add: Kn l_def)
	+ have lm: "(res_lim s m) = (s l) m"
	+ by (simp add: Km l_def)
	+ have s_car: "s l \<in> carrier Zp"
	+ using assms is_Zp_cauchy_def closed_seqs_memE[of _ Zp] by blast
	+ then show ?thesis
	+ using s_car lm ln \<open>m < n\<close> p_residue_def p_residue_padic_int by auto
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ by (simp add: Zp_def padic_int_simps(5))
	+qed
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Completeness of $\mathbb{Z}_p$\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+
	+text\<open>
	+ We can use the developments above to show that a sequence of $p$-adic integers is convergent
	+ if and only if it is cauchy, and that limits of convergent sequences are always unique.
	+\<close>
	+
	+lemma is_Zp_cauchy_imp_has_limit:
	+ assumes "is_Zp_cauchy s"
	+ assumes "a = res_lim s"
	+ shows "Zp_converges_to s a"
	+proof-
	+ have 0: "(a \<in> carrier Zp \<and> s \<in> closed_seqs Zp)"
	+ using assms(1) assms(2) is_Zp_cauchy_def res_lim_in_Zp by blast
	+ have 1: "(\<forall>(n::int). (\<exists>(k:: nat). (\<forall>( m::nat).
	+ (m > k \<longrightarrow> (val_Zp ((s m) \<ominus> a)) \<ge> n))))"
	+ proof
	+ fix n
	+ show "\<exists>k. \<forall>m>k. eint n \<le> val_Zp (s m \<ominus> a)"
	+ proof-
	+ obtain K where K_def: "\<And>m. (m > K \<longrightarrow> (s m) (nat n) = (res_lim s) (nat n))"
	+ using assms(1) res_lim_Zp_cauchy
	+ by blast
	+ have "\<forall>m>K. n \<le> val_Zp_dist (s m) a"
	+ proof
	+ fix m
	+ show "K < m \<longrightarrow> n \<le> val_Zp_dist (s m) a"
	+ proof
	+ assume A: "K < m"
	+ show " n \<le> val_Zp_dist (s m) a"
	+ proof-
	+ have X: "(s m) \<in> carrier Zp"
	+ using "0" closed_seqs_memE[of _ Zp]
	+ by blast
	+ have "(s m) (nat n) = (res_lim s) (nat n)"
	+ using A K_def by blast
	+ then have "(s m) (nat n) = a (nat n)"
	+ using assms(2) by blast
	+ then have "int (nat n) \<le> val_Zp_dist (s m) a"
	+ using X val_Zp_dist_res_eq2 "0" by blast
	+ then show ?thesis
	+ by (metis eint_ord_simps(1) int_ops(1) less_not_sym nat_eq_iff2 not_le order_trans zero_eint_def)
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ using val_Zp_dist_def by auto
	+ qed
	+ qed
	+ then show ?thesis using
	+ "0" Zp_converges_to_def
	+ by (metis Suc_ile_eq val_Zp_dist_def)
	+qed
	+
	+lemma convergent_imp_Zp_cauchy:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a \<in> carrier Zp"
	+ assumes "Zp_converges_to s a"
	+ shows "is_Zp_cauchy s"
	+ apply(rule is_Zp_cauchyI)
	+ using assms apply simp
	+proof-
	+ fix n
	+ show "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 n = s n1 n "
	+ proof-
	+ obtain k where k_def:"\<forall>m>k. n < val_Zp_dist (s m) a"
	+ using assms val_Zp_dist_def
	+ unfolding Zp_converges_to_def
	+ by presburger
	+ have A0: "\<forall>n0 n1. k < n0 \<and> k < n1 \<longrightarrow> s n0 n = s n1 n "
	+ proof- have "\<And>n0 n1. k < n0 \<and> k < n1 \<longrightarrow> s n0 n = s n1 n"
	+ proof
	+ fix n0 n1
	+ assume A: " k < n0 \<and> k < n1"
	+ show " s n0 n = s n1 n "
	+ proof-
	+ have 0: "n < val_Zp_dist (s n0) a"
	+ using k_def using A
	+ by blast
	+ have 1: "n < val_Zp_dist (s n1) a"
	+ using k_def using A
	+ by blast
	+ hence 2: "(s n0) n = a n"
	+ using 0 assms val_Zp_dist_res_eq[of "s n0" a n] closed_seqs_memE
	+ by blast
	+ hence 3: "(s n1) n = a n"
	+ using 1 assms val_Zp_dist_res_eq[of "s n1" a n] closed_seqs_memE
	+ by blast
	+ show ?thesis
	+ using 2 3
	+ by auto
	+ qed
	+ qed
	+ thus ?thesis by blast
	+ qed
	+ show ?thesis
	+ using A0
	+ by blast
	+ qed
	+qed
	+
	+lemma unique_limit:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "Zp_converges_to s a"
	+ assumes "Zp_converges_to s b"
	+ shows "a = b"
	+proof-
	+ have "\<And>k. a k = b k"
	+ proof-
	+ fix k::nat
	+ obtain k0 where k0_def:"\<forall>m>k0. k < val_Zp_dist (s m) a"
	+ using assms unfolding val_Zp_dist_def Zp_converges_to_def
	+ by blast
	+ obtain k1 where k1_def:"\<forall>m>k1. k < val_Zp_dist (s m) b"
	+ using assms unfolding val_Zp_dist_def Zp_converges_to_def
	+ by blast
	+ have k0_prop: "\<And>m. m> k0 \<Longrightarrow> (s m) k = a k" proof- fix m assume A: "m > k0"
	+ then show "(s m) k = a k"
	+ using k0_def assms closed_seqs_memE[of s Zp] val_Zp_dist_res_eq[of _ a k] of_nat_Suc
	+ by blast
	+ qed
	+ have k1_prop: "\<And>m. m> k1 \<Longrightarrow> (s m) k = b k"
	+ using k1_def assms closed_seqs_memE[of s Zp]
	+ by (simp add: val_Zp_dist_res_eq)
	+ have "\<And> m. m > (max k0 k1) \<Longrightarrow> a k = b k"
	+ using k0_prop k1_prop
	+ by force
	+ then show "a k = b k"
	+ by blast
	+ qed
	+ then show ?thesis
	+ by blast
	+qed
	+
	+lemma unique_limit':
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a \<in> carrier Zp"
	+ assumes "Zp_converges_to s a"
	+ shows "a = res_lim s"
	+ using unique_limit[of s a "res_lim s"] assms
	+ convergent_imp_Zp_cauchy is_Zp_cauchy_imp_has_limit res_lim_in_Zp
	+ by blast
	+
	+lemma Zp_converges_toE:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a \<in> carrier Zp"
	+ assumes "Zp_converges_to s a"
	+ shows "\<exists>N. \<forall>k > N. s k n = a n"
	+ by (metis assms(1) assms(2) assms(3)
	+ convergent_imp_Zp_cauchy
	+ res_lim_Zp_cauchy unique_limit')
	+
	+lemma Zp_converges_toI:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a \<in> carrier Zp"
	+ assumes "\<And>n. \<exists>N. \<forall>k > N. s k n = a n"
	+ shows "Zp_converges_to s a"
	+proof-
	+ have 0: "(a \<in> carrier Zp \<and> s \<in> closed_seqs Zp)"
	+ using assms
	+ by auto
	+ have 1: "(\<forall>n::int. \<exists>k. \<forall>m>k. n < val_Zp_dist (s m) a) "
	+ proof
	+ fix n::int
	+ show "\<exists>k. \<forall>m>k. n < val_Zp_dist (s m) a "
	+ proof(cases "n < 0")
	+ case True
	+ have "\<forall>m>0. n < val_Zp_dist (s m) a "
	+ proof
	+ fix m ::nat
	+ show "0 < m \<longrightarrow> n < val_Zp_dist (s m) a"
	+ proof
	+ have 0: "eint n < 0"
	+ by (simp add: True zero_eint_def)
	+ have 1: " s m \<ominus> a \<in> carrier Zp"
	+ using assms
	+ by (simp add: closed_seqs_diff_closed)
	+ thus " n < val_Zp_dist (s m) a"
	+ using 0 True val_pos[of "s m \<ominus> a"]
	+ unfolding val_Zp_dist_def
	+ by auto
	+ qed
	+ qed
	+ then show ?thesis
	+ by blast
	+ next
	+ case False
	+ then have P0: "n \<ge> 0"
	+ by auto
	+ obtain N where N_def: "\<forall>k > N. s k (Suc (nat n)) = a (Suc (nat n))"
	+ using assms by blast
	+ have "\<forall>m>N. n < val_Zp_dist (s m) a "
	+ proof
	+ fix m
	+ show " N < m \<longrightarrow> n < val_Zp_dist (s m) a"
	+ proof
	+ assume A: "N < m"
	+ then have A0: "s m (Suc (nat n)) = a (Suc (nat n))"
	+ using N_def by blast
	+ have "(Suc (nat n)) \<le> val_Zp_dist (s m) a"
	+ using assms A0 val_Zp_dist_res_eq2[of "s m" a "Suc (nat n)"] closed_seqs_memE
	+ by blast
	+ thus "n < val_Zp_dist (s m) a"
	+ using False
	+ by (meson P0 eint_ord_simps(2) less_Suc_eq less_le_trans nat_less_iff)
	+ qed
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+ qed
	+ show ?thesis
	+ unfolding Zp_converges_to_def
	+ using 0 1
	+ by (simp add: val_Zp_dist_def)
	+qed
	+
	+text\<open>Sums and products of cauchy sequences are cauchy:\<close>
	+
	+lemma sum_of_Zp_cauchy_is_Zp_cauchy:
	+ assumes "is_Zp_cauchy s"
	+ assumes "is_Zp_cauchy t"
	+ shows "is_Zp_cauchy (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t)"
	+proof(rule is_Zp_cauchyI)
	+ show "(s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) \<in> closed_seqs Zp"
	+ using assms seq_plus_closed is_Zp_cauchy_def by blast
	+ show "\<And>n. \<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof-
	+ fix n
	+ show "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof-
	+ obtain N1 where N1_def: "\<forall>n0 n1. N1 < n0 \<and> N1 < n1 \<longrightarrow> s n0 n = s n1 n"
	+ using assms(1) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
	+ obtain N2 where N2_def: "\<forall>n0 n1. N2 < n0 \<and> N2 < n1 \<longrightarrow> t n0 n = t n1 n"
	+ using assms(2) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
	+ obtain M where M_def: "M = max N1 N2"
	+ by simp
	+ have "\<forall>n0 n1. M < n0 \<and> M < n1 \<longrightarrow> (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof
	+ fix n0
	+ show "\<forall>n1. M < n0 \<and> M < n1 \<longrightarrow> (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof
	+ fix n1
	+ show " M < n0 \<and> M < n1 \<longrightarrow> (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof
	+ assume A: "M < n0 \<and> M < n1 "
	+ have Fs: " s n0 n = s n1 n" using A M_def N1_def by auto
	+ have Ft: " t n0 n = t n1 n" using A M_def N2_def by auto
	+ then show "(s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<oplus>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ using seq_plus_simp[of s t] assms
	+ by (simp add: Fs is_Zp_cauchy_imp_closed residue_of_sum)
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+ qed
	+qed
	+
	+lemma prod_of_Zp_cauchy_is_Zp_cauchy:
	+ assumes "is_Zp_cauchy s"
	+ assumes "is_Zp_cauchy t"
	+ shows "is_Zp_cauchy (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t)"
	+proof(rule is_Zp_cauchyI)
	+ show "(s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) \<in> closed_seqs Zp"
	+ using assms(1) assms(2) is_Zp_cauchy_def seq_mult_closed by auto
	+ show "\<And>n. \<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof-
	+ fix n
	+ show "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof-
	+ obtain N1 where N1_def: "\<forall>n0 n1. N1 < n0 \<and> N1 < n1 \<longrightarrow> s n0 n = s n1 n"
	+ using assms(1) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
	+ obtain N2 where N2_def: "\<forall>n0 n1. N2 < n0 \<and> N2 < n1 \<longrightarrow> t n0 n = t n1 n"
	+ using assms(2) is_Zp_cauchy_imp_res_eventually_const_0 padic_integers_axioms by blast
	+ obtain M where M_def: "M = max N1 N2"
	+ by simp
	+ have "\<forall>n0 n1. M < n0 \<and> M < n1 \<longrightarrow> (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof
	+ fix n0
	+ show "\<forall>n1. M < n0 \<and> M < n1 \<longrightarrow> (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof
	+ fix n1
	+ show " M < n0 \<and> M < n1 \<longrightarrow> (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ proof
	+ assume A: "M < n0 \<and> M < n1 "
	+ have Fs: " s n0 n = s n1 n" using A M_def N1_def by auto
	+ have Ft: " t n0 n = t n1 n" using A M_def N2_def by auto
	+ then show "(s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n0 n = (s \<otimes>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> t) n1 n"
	+ using seq_mult_simp[of s t] is_Zp_cauchy_imp_closed assms
	+ by (simp add: Fs residue_of_prod)
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+ qed
	+qed
	+
	+text\<open>Constant sequences are cauchy:\<close>
	+
	+lemma constant_is_Zp_cauchy:
	+ assumes "is_constant_seq Zp s"
	+ shows "is_Zp_cauchy s"
	+proof(rule is_Zp_cauchyI)
	+ show "s \<in> closed_seqs Zp"
	+ proof(rule closed_seqs_memI)
	+ fix k
	+ show "s k \<in> carrier Zp"
	+ using assms is_constant_seq_imp_closed
	+ by (simp add: is_constant_seq_imp_closed closed_seqs_memE)
	+ qed
	+ obtain x where "\<And> k. s k = x"
	+ using assms
	+ by (meson is_constant_seqE)
	+ then show "\<And>n. \<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 n = s n1 n"
	+ by simp
	+qed
	+
	+text\<open>Scalar multiplies of cauchy sequences are cauchy:\<close>
	+
	+lemma smult_is_Zp_cauchy:
	+ assumes "is_Zp_cauchy s"
	+ assumes "a \<in> carrier Zp"
	+ shows "is_Zp_cauchy (a \<odot>\<^bsub>Zp\<^bsup>\<omega>\<^esup>\<^esub> s)"
	+ apply(rule is_Zp_cauchyI)
	+ apply (meson U_function_ring.ring_seq_smult_closed U_function_ring_axioms assms(1) assms(2) is_Zp_cauchy_def)
	+ using assms ring_seq_smult_eval[of s a] is_Zp_cauchy_imp_closed[of s]
	+ by (metis res_lim_Zp_cauchy residue_of_prod)
	+
	+lemma Zp_cauchy_imp_approaches_res_lim:
	+ assumes "is_Zp_cauchy s"
	+ assumes "a = res_lim s"
	+ obtains N where "\<And>n. n> N \<Longrightarrow> val_Zp (a \<ominus> (s n)) > eint k"
	+proof-
	+ have " (\<forall>n::int. \<exists>k. \<forall>m>k. n < val_Zp_dist (s m) a)"
	+ using Zp_converges_to_def[of s a] assms is_Zp_cauchy_imp_has_limit[of s a] val_Zp_dist_def
	+ by simp
	+ then have "\<exists>N. \<forall>m>N. k < val_Zp_dist (s m) a"
	+ by blast
	+ then obtain N where N_def: "\<forall>m>N. k < val_Zp_dist (s m) a"
	+ by blast
	+ have "\<And>n. n> N \<Longrightarrow> val_Zp (a \<ominus> (s n)) > k"
	+ proof-
	+ fix m
	+ assume "m > N"
	+ then have 0: "k < val_Zp_dist (s m) a"
	+ using N_def
	+ by (simp add: val_Zp_def)
	+ show "k < val_Zp (a \<ominus> s m)"
	+ using "0" assms(1) assms(2) is_Zp_cauchy_def closed_seqs_memE[of _ Zp] val_Zp_dist_def val_Zp_dist_sym res_lim_in_Zp by auto
	+ qed
	+ then show ?thesis
	+ using that
	+ by blast
	+qed
	+
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+(**************************) section\<open>Continuous Functions\<close> (*********************************)
	+(**************************************************************************************************)
	+(**************************************************************************************************)
	+
	+text\<open>
	+ For convenience, we will use a slightly unorthodox definition of continuity here.
	+ Since $\mathbb{Z}_p$ is complete, a function is continuous if and only if its compositions
	+ with cauchy sequences are cauchy sequences. Thus we can define a continuous function on
	+ $\mathbb{Z}_p$ as a function which carries cauchy sequences to cauchy sequences under
	+ composition. Note that this does not generalize to a definition of continuity for functions
	+ defined on incomplete subsets of $\mathbb{Z}_p$. For example, the function $1/x$ defined on
	+ $\mathbb{Z}_p - \{0\}$ clearly does not have this property but is continuous. However, towards
	+ a proof of Hensel's Lemma we will only need to consider polynomial functions and so this
	+ definition suffices for our purposes.
	+\<close>
	+
	+subsection\<open>Defining Continuous Functions and Basic Examples\<close>
	+abbreviation Zp_constant_function ("\<cc>\<^bsub>Zp\<^esub>") where
	+"\<cc>\<^bsub>Zp\<^esub> a \<equiv> constant_function (carrier Zp) a"
	+
	+definition is_Zp_continuous ::"padic_int_fun \<Rightarrow> bool" where
	+"is_Zp_continuous f = (f \<in> carrier (Fun Zp) \<and>(\<forall> s. is_Zp_cauchy s \<longrightarrow> is_Zp_cauchy(f \<circ> s)))"
	+
	+lemma Zp_continuous_is_Zp_closed:
	+ assumes "is_Zp_continuous f"
	+ shows "f \<in> carrier (Fun Zp)"
	+ using assms is_Zp_continuous_def by blast
	+
	+lemma is_Zp_continuousI:
	+ assumes "f \<in> carrier (Fun Zp)"
	+ assumes "\<And>s. is_Zp_cauchy s \<Longrightarrow> is_Zp_cauchy (f \<circ> s)"
	+ shows "is_Zp_continuous f"
	+proof-
	+ have "(\<forall> s. is_Zp_cauchy s \<longrightarrow> is_Zp_cauchy(f \<circ> s))"
	+ proof
	+ fix s
	+ show "is_Zp_cauchy s \<longrightarrow> is_Zp_cauchy (f \<circ> s) "
	+ by (simp add: assms(2))
	+ qed
	+ then show ?thesis
	+ using assms(1) is_Zp_continuous_def by blast
	+qed
	+
	+lemma Zp_continuous_is_closed:
	+ assumes "is_Zp_continuous f"
	+ shows "f \<in> carrier (Fun Zp)"
	+ using assms unfolding is_Zp_continuous_def by blast
	+
	+lemma constant_is_Zp_continuous:
	+ assumes "a \<in> carrier Zp"
	+ shows "is_Zp_continuous (const a)"
	+proof(rule is_Zp_continuousI)
	+ show "\<cc>\<^bsub>Zp\<^esub> a \<in> carrier (function_ring (carrier Zp) Zp)"
	+ by (simp add: assms constant_function_closed)
	+ show "\<And>s. is_Zp_cauchy s \<Longrightarrow> is_Zp_cauchy (\<cc>\<^bsub>Zp\<^esub> a \<circ> s) "
	+ proof-
	+ fix s
	+ assume A: "is_Zp_cauchy s"
	+ have "is_constant_seq Zp (\<cc>\<^bsub>Zp\<^esub> a \<circ> s)"
	+ using constant_function_comp_is_constant_seq[of a s] A assms
	+ is_Zp_cauchy_imp_closed by blast
	+ then show "is_Zp_cauchy (\<cc>\<^bsub>Zp\<^esub> a \<circ> s)"
	+ using A assms constant_is_Zp_cauchy
	+ by blast
	+ qed
	+qed
	+
	+lemma sum_of_cont_is_cont:
	+ assumes "is_Zp_continuous f"
	+ assumes "is_Zp_continuous g"
	+ shows "is_Zp_continuous (f \<oplus>\<^bsub>Fun Zp\<^esub> g)"
	+ apply(rule is_Zp_continuousI)
	+ using assms Zp_continuous_is_closed assms function_sum_comp_is_seq_sum[of _ f g]
	+ apply (simp add: fun_add_closed)
	+ using assms(1) assms(2) function_sum_comp_is_seq_sum is_Zp_cauchy_def is_Zp_continuous_def sum_of_Zp_cauchy_is_Zp_cauchy by auto
	+
	+lemma prod_of_cont_is_cont:
	+ assumes "is_Zp_continuous f"
	+ assumes "is_Zp_continuous g"
	+ shows "is_Zp_continuous (f \<otimes>\<^bsub>Fun Zp\<^esub> g)"
	+ apply(rule is_Zp_continuousI)
	+ using assms Zp_continuous_is_closed assms
	+ apply (simp add: fun_mult_closed)
	+ using function_mult_comp_is_seq_mult[of _ f g] assms(1) assms(2) is_Zp_cauchy_imp_closed
	+ is_Zp_continuous_def prod_of_Zp_cauchy_is_Zp_cauchy by auto
	+
	+lemma smult_is_continuous:
	+ assumes "is_Zp_continuous f"
	+ assumes "a \<in> carrier Zp"
	+ shows "is_Zp_continuous (a \<odot>\<^bsub>Fun Zp\<^esub> f)"
	+ apply(rule is_Zp_continuousI)
	+ using assms apply (simp add: assms function_smult_closed is_Zp_continuous_def)
	+ using ring_seq_smult_comp_assoc assms
	+ by (simp add: is_Zp_cauchy_imp_closed is_Zp_continuous_def smult_is_Zp_cauchy)
	+
	+lemma id_Zp_is_Zp_continuous:
	+"is_Zp_continuous ring_id"
	+ apply(rule is_Zp_continuousI)
	+ by (auto simp add: is_Zp_cauchy_imp_closed ring_id_seq_comp)
	+
	+lemma nat_pow_is_Zp_continuous:
	+ assumes "is_Zp_continuous f"
	+ shows "is_Zp_continuous (f[^]\<^bsub>Fun Zp\<^esub>(n::nat))"
	+ apply(induction n)
	+ using constant_is_Zp_continuous function_one_is_constant apply force
	+ by (simp add: assms prod_of_cont_is_cont)
	+
	+lemma ring_id_pow_closed:
	+"(ring_id)[^]\<^bsub>Fun Zp\<^esub> (n::nat) \<in> carrier (Fun Zp)"
	+ by (simp add: function_ring_is_monoid monoid.nat_pow_closed)
	+
	+lemma monomial_equation:
	+ assumes "c \<in> carrier Zp"
	+ shows "monomial c n = c \<odot>\<^bsub>Fun Zp\<^esub> (ring_id)[^]\<^bsub>Fun Zp\<^esub>n"
	+ apply(rule function_ring_car_eqI)
	+ apply (simp add: assms monomial_functions)
	+ using assms function_smult_closed[of c "ring_id [^]\<^bsub>Fun Zp\<^esub> n"] ring_id_pow_closed apply blast
	+ unfolding monomial_function_def
	+ using assms function_smult_eval[of c "(ring_id)[^]\<^bsub>Fun Zp\<^esub> (n::nat)"]
	+ function_nat_pow_eval[of ring_id _ n]
	+ by (simp add: ring_id_eval ring_id_pow_closed)
	+
	+lemma monomial_is_Zp_continuous:
	+ assumes "c \<in> carrier Zp"
	+ shows "is_Zp_continuous (monomial c n)"
	+ using monomial_equation[of c n] nat_pow_is_Zp_continuous
	+ by (simp add: assms id_Zp_is_Zp_continuous smult_is_continuous)
	+
	+subsection\<open>Composition by a Continuous Function Commutes with Taking Limits of Sequences\<close>
	+
	+text \<open>
	+ Due to our choice of definition for continuity, a little bit of care is required to show that
	+ taking the limit of a cauchy sequence commutes with composition by a continuous function.
	+ For a sequence $(s_n)_{n \in \mathbb{N}}$ converging to a point $t$, we can consider the
	+ alternating sequence $(s_0, t, s_1, t, s_2, t, \dots)$ which is also cauchy. Clearly
	+ composition with $f$ yields $(f(s_0), f(t), f(s_1), f(t), f(s_2), f(t), \dots)$ from which
	+ we can see that the limit must be $f(t)$.
	+\<close>
	+definition alt_seq where
	+"alt_seq s = (\<lambda>k. (if (even k) then (s k) else (res_lim s)))"
	+
	+lemma alt_seq_Zp_cauchy:
	+ assumes "is_Zp_cauchy s"
	+ shows "is_Zp_cauchy (alt_seq s)"
	+proof(rule is_Zp_cauchyI)
	+ show "(alt_seq s) \<in> closed_seqs Zp"
	+ unfolding alt_seq_def using assms is_Zp_cauchy_imp_closed
	+ by (simp add: closed_seqs_memE closed_seqs_memI res_lim_in_Zp)
	+ fix n
	+ show "\<exists>N. \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> alt_seq s n0 n = alt_seq s n1 n "
	+ proof-
	+ obtain N where N_def: " \<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> s n0 n = s n1 n "
	+ using assms is_Zp_cauchy_imp_res_eventually_const_0
	+ padic_integers_axioms
	+ by blast
	+ have "\<forall>n0 n1. N < n0 \<and> N < n1 \<longrightarrow> alt_seq s n0 n = alt_seq s n1 n "
	+ apply auto
	+ proof-
	+ fix n0 n1
	+ assume A: "N < n0" "N < n1"
	+ show "alt_seq s n0 n = alt_seq s n1 n"
	+ using N_def
	+ unfolding alt_seq_def
	+ by (smt A(1) A(2) assms lessI max_less_iff_conj
	+ res_lim_Zp_cauchy padic_integers_axioms)
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+qed
	+
	+lemma alt_seq_limit:
	+ assumes "is_Zp_cauchy s"
	+ shows "res_lim(alt_seq s) = res_lim s"
	+proof-
	+ have "\<And>k. res_lim(alt_seq s) k = res_lim s k"
	+ proof-
	+ fix k
	+ obtain N where N_def: "\<forall> m. m> N \<longrightarrow> s m k = res_lim s k"
	+ using assms res_lim_Zp_cauchy
	+ by blast
	+ obtain N' where N'_def: "\<forall> m. m> N' \<longrightarrow> (alt_seq s) m k = res_lim (alt_seq s) k"
	+ using assms res_lim_Zp_cauchy
	+ alt_seq_Zp_cauchy
	+ by blast
	+ have "\<And>m. m > (max N N') \<Longrightarrow> s m k = res_lim (alt_seq s) k"
	+ proof-
	+ fix m
	+ assume A0: "m > (max N N')"
	+ have A1: "s m k = res_lim s k"
	+ using A0 N_def
	+ by simp
	+ have A2: "(alt_seq s) m k = res_lim (alt_seq s) k"
	+ using A0 N'_def
	+ by simp
	+ have A3: "(alt_seq s) m k = res_lim s k"
	+ using alt_seq_def A1 A2
	+ by presburger
	+ show "s m k = res_lim (alt_seq s) k"
	+ using A1 A2 A3
	+ by auto
	+ qed
	+ then have P:"\<And>m. m > (max N N') \<Longrightarrow> (res_lim s k) = res_lim (alt_seq s) k"
	+ using N_def
	+ by auto
	+ show "res_lim(alt_seq s) k = res_lim s k"
	+ using P[of "Suc (max N N')"]
	+ by auto
	+ qed
	+ then show ?thesis
	+ by (simp add: ext)
	+qed
	+
	+lemma res_lim_pushforward:
	+ assumes "is_Zp_continuous f"
	+ assumes "is_Zp_cauchy s"
	+ assumes "t = alt_seq s"
	+ shows "res_lim (f \<circ> t) = f (res_lim t)"
	+proof-
	+ have 0: "Zp_converges_to (f \<circ> t) (res_lim (f \<circ> t))"
	+ using assms alt_seq_Zp_cauchy is_Zp_cauchy_imp_has_limit
	+ is_Zp_continuous_def
	+ by blast
	+ have "\<And>k. res_lim (f \<circ> t) k = f (res_lim t) k"
	+ proof-
	+ fix k
	+ show "res_lim (f \<circ> t) k = f (res_lim t) k"
	+ proof-
	+ obtain N where N_def: "\<And>m. m> N \<Longrightarrow> (f \<circ> t) m k = (res_lim (f \<circ> t)) k"
	+ using 0
	+ by (meson convergent_imp_Zp_cauchy Zp_converges_to_def res_lim_Zp_cauchy)
	+ obtain M where M_def: "M = 2*(Suc N) + 1"
	+ by simp
	+ have 0: "t M = res_lim s"
	+ using assms
	+ unfolding alt_seq_def
	+ by (simp add: M_def)
	+ have 1: "(f \<circ> t) M k = (res_lim (f \<circ> t)) k"
	+ using N_def M_def
	+ by auto
	+ have 2: "(f \<circ> t) M k = f (t M) k"
	+ by simp
	+ have 3: "(f \<circ> t) M k = f (res_lim s) k"
	+ using 0 2 by simp
	+ have 4: "(f \<circ> t) M k = f (res_lim t) k"
	+ using 3 assms alt_seq_limit[of s]
	+ by auto
	+ show ?thesis
	+ using 4 1 by auto
	+ qed
	+ qed
	+ then show ?thesis by(simp add: ext)
	+qed
	+
	+lemma res_lim_pushforward':
	+ assumes "is_Zp_continuous f"
	+ assumes "is_Zp_cauchy s"
	+ assumes "t = alt_seq s"
	+ shows "res_lim (f \<circ> s) = res_lim (f \<circ> t)"
	+proof-
	+ obtain a where a_def: "a = res_lim (f \<circ> s)"
	+ by simp
	+ obtain b where b_def: "b = res_lim (f \<circ> t)"
	+ by simp
	+ have "\<And>k. a k = b k"
	+ proof-
	+ fix k
	+ obtain Na where Na_def: "\<And>m. m > Na \<Longrightarrow> (f \<circ> s) m k = a k"
	+ using a_def assms is_Zp_continuous_def
	+ padic_integers_axioms res_lim_Zp_cauchy
	+ by blast
	+ obtain Nb where Nb_def: "\<And>m. m > Nb \<Longrightarrow> (f \<circ> t) m k = b k"
	+ using b_def assms is_Zp_continuous_def
	+ padic_integers_axioms res_lim_Zp_cauchy
	+ alt_seq_Zp_cauchy
	+ by blast
	+ obtain M where M_def: "M = 2*(max Na Nb) + 1"
	+ by simp
	+ have M0: "odd M"
	+ by (simp add: M_def)
	+ have M1: "M > Na"
	+ using M_def
	+ by auto
	+ have M2: "M > Nb"
	+ using M_def
	+ by auto
	+ have M3: "t M = res_lim s"
	+ using assms alt_seq_def M0
	+ by auto
	+ have M4: "((f \<circ> t) M) = f (res_lim s)"
	+ using M3
	+ by auto
	+ have M5: "((f \<circ> t) M) k = b k"
	+ using M2 Nb_def by auto
	+ have M6: "f (res_lim s) = f (res_lim t)"
	+ using assms alt_seq_limit[of s]
	+ by auto
	+ have M7: "f (res_lim t) k = b k"
	+ using M4 M5 M6 by auto
	+ have M8: "(f \<circ> s) M k = (f \<circ> s) (Suc M) k"
	+ using M1 Na_def by auto
	+ have M9: "(f \<circ> s) (Suc M) = (f \<circ> t) (Suc M)"
	+ using assms unfolding alt_seq_def
	+ using M_def
	+ by auto
	+ have M10: "(f \<circ> t) M k = (f \<circ> t) (Suc M) k"
	+ using M2 Nb_def by auto
	+ have M11: "(f \<circ> t) M k = (f \<circ> s) M k"
	+ using M10 M8 M9 by auto
	+ show "a k = b k"
	+ using M1 M11 M5 Na_def by auto
	+ qed
	+ then show ?thesis using a_def b_def ext[of a b] by auto
	+qed
	+
	+lemma continuous_limit:
	+ assumes "is_Zp_continuous f"
	+ assumes "is_Zp_cauchy s"
	+ shows "Zp_converges_to (f \<circ> s) (f (res_lim s))"
	+proof-
	+ obtain t where t_def: "t = alt_seq s"
	+ by simp
	+ have 0: "Zp_converges_to (f \<circ> s) (res_lim (f \<circ> s))"
	+ using assms(1) assms(2) is_Zp_continuous_def
	+ is_Zp_cauchy_imp_has_limit padic_integers_axioms by blast
	+ have 1: "Zp_converges_to (f \<circ> s) (res_lim (f \<circ> t))"
	+ using "0" assms(1) assms(2) res_lim_pushforward' t_def by auto
	+ have 2: "Zp_converges_to (f \<circ> s) (f (res_lim t))"
	+ using "1" assms(1) assms(2) res_lim_pushforward padic_integers_axioms t_def by auto
	+ then show "Zp_converges_to (f \<circ> s) (f (res_lim s))"
	+ by (simp add: alt_seq_limit assms(2) t_def)
	+qed
	+
	+
	+end
	+end
	diff --git a/thys/Padic_Ints/Padic_Integers.thy b/thys/Padic_Ints/Padic_Integers.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Padic_Integers.thy
	@@ -0,0 +1,2505 @@
	+theory Padic_Integers
	+ imports Padic_Construction
	+ Extended_Int
	+ Supplementary_Ring_Facts
	+ "HOL-Algebra.Subrings"
	+ "HOL-Number_Theory.Residues"
	+ "HOL-Algebra.Multiplicative_Group"
	+
	+begin
	+
	+text\<open>
	+ In what follows we establish a locale for reasoning about the ring of $p$-adic integers for a
	+ fixed prime $p$. We will elaborate on the basic metric properties of $\mathbb{Z}_p$ and construct
	+ the angular component maps to the residue rings.
	+\<close>
	+
	+section\<open>A Locale for $p$-adic Integer Rings\<close>
	+locale padic_integers =
	+fixes Zp:: "_ ring" (structure)
	+fixes p
	+defines "Zp \<equiv> padic_int p"
	+assumes prime: "prime p"
	+
	+sublocale padic_integers < UPZ?: UP Zp "UP Zp"
	+ by simp
	+
	+sublocale padic_integers < Zp?:UP_cring Zp "UP Zp"
	+ unfolding UP_cring_def
	+ by(auto simp add: Zp_def padic_int_is_cring prime)
	+
	+sublocale padic_integers < Zp?:ring Zp
	+ using Zp_def cring.axioms(1) padic_int_is_cring prime
	+ by blast
	+
	+sublocale padic_integers < Zp?:cring Zp
	+ by (simp add: Zp_def padic_int_is_cring prime)
	+
	+sublocale padic_integers < Zp?:domain Zp
	+ by (simp add: Zp_def padic_int_is_domain padic_integers.prime padic_integers_axioms)
	+
	+
	+context padic_integers
	+begin
	+
	+lemma Zp_defs:
	+"\<one> = padic_one p"
	+"\<zero> = padic_zero p"
	+"carrier Zp = padic_set p"
	+"(\<otimes>) = padic_mult p"
	+"(\<oplus>) = padic_add p"
	+ unfolding Zp_def using padic_int_simps by auto
	+
	+end
	+
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+(*********************)section \<open>Residue Rings\<close>(***********************************)
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+
	+lemma(in field) field_inv:
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq>\<zero>"
	+ shows "inv\<^bsub>R\<^esub> a \<otimes> a = \<one>"
	+ "a \<otimes> inv\<^bsub>R\<^esub> a = \<one>"
	+ "inv \<^bsub>R\<^esub> a \<in> carrier R"
	+proof-
	+ have "a \<in> Units R"
	+ using assms by (simp add: local.field_Units)
	+ then show "inv\<^bsub>R\<^esub> a \<otimes> a = \<one>"
	+ by simp
	+ show "a \<otimes> inv a = \<one>"
	+ using \<open>a \<in> Units R\<close> by auto
	+ show "inv \<^bsub>R\<^esub> a \<in> carrier R"
	+ by (simp add: \<open>a \<in> Units R\<close>)
	+qed
	+
	+text\<open>$p_residue$ defines the standard projection maps between residue rings:\<close>
	+
	+definition(in padic_integers) p_residue:: "nat \<Rightarrow> int \<Rightarrow> _" where
	+"p_residue m n \<equiv> residue (p^m) n"
	+
	+lemma(in padic_integers) p_residue_alt_def:
	+"p_residue m n = n mod (p^m)"
	+ using residue_def
	+ by (simp add: p_residue_def)
	+
	+lemma(in padic_integers) p_residue_range:
	+"p_residue m n \<in> {0..<p^m}"
	+ using p_residue_def int_ops(6) prime prime_gt_0_nat
	+ by (metis Euclidean_Division.pos_mod_bound Euclidean_Division.pos_mod_sign atLeastLessThan_iff p_residue_alt_def prime_gt_0_int zero_less_power)
	+
	+lemma(in padic_integers) p_residue_mod:
	+ assumes "m > k"
	+ shows "p_residue k (p_residue m n) = p_residue k n"
	+ using assms
	+ unfolding p_residue_def residue_def
	+ by (simp add: le_imp_power_dvd mod_mod_cancel)
	+
	+text\<open>Compatibility of p\_residue with elements of $\mathbb{Z}_p$:\<close>
	+
	+lemma(in padic_integers) p_residue_padic_int:
	+ assumes "x \<in> carrier Zp"
	+ assumes "m \<ge> k"
	+ shows "p_residue k (x m) = x k"
	+ using Zp_def assms(1) assms(2) padic_set_res_coherent prime
	+ by (simp add: p_residue_def padic_int_simps(5))
	+
	+text\<open>Definition of residue rings:\<close>
	+
	+abbreviation(in padic_integers) (input) Zp_res_ring:: "nat \<Rightarrow> _ ring" where
	+"(Zp_res_ring n) \<equiv> residue_ring (p^n)"
	+
	+lemma (in padic_integers) p_res_ring_zero:
	+"\<zero>\<^bsub>Zp_res_ring k\<^esub> = 0"
	+ by (simp add: residue_ring_def)
	+
	+lemma (in padic_integers) p_res_ring_one:
	+ assumes "k > 0"
	+ shows "\<one>\<^bsub>Zp_res_ring k\<^esub> = 1"
	+ using assms
	+ by (simp add: residue_ring_def)
	+
	+lemma (in padic_integers) p_res_ring_car:
	+"carrier (Zp_res_ring k) = {0..<p^k}"
	+ using residue_ring_def[of "p^k"]
	+ by auto
	+
	+lemma(in padic_integers) p_residue_range':
	+"p_residue m n \<in> carrier (Zp_res_ring m)"
	+ using p_residue_range residue_ring_def prime prime_gt_0_nat p_residue_def
	+ by fastforce
	+
	+text\<open>First residue ring is a field:\<close>
	+
	+lemma(in padic_integers) p_res_ring_1_field:
	+"field (Zp_res_ring 1)"
	+ by (metis int_nat_eq power_one_right prime prime_ge_0_int prime_nat_int_transfer residues_prime.intro residues_prime.is_field)
	+
	+text\<open>$0^{th}$ residue ring is the zero ring:\<close>
	+
	+lemma(in padic_integers) p_res_ring_0:
	+"carrier (Zp_res_ring 0) = {0}"
	+ by (simp add: residue_ring_def)
	+
	+lemma(in padic_integers) p_res_ring_0':
	+ assumes "x \<in> carrier (Zp_res_ring 0)"
	+ shows "x = 0"
	+ using p_res_ring_0 assms by blast
	+
	+text\<open>If $m>0$ then $Zp\_res\_ring m$ is an instance of the residues locale:\<close>
	+
	+lemma(in padic_integers) p_residues:
	+ assumes "m >0"
	+ shows "residues (p^m)"
	+proof-
	+ have "p^m > 1"
	+ using assms
	+ by (simp add: prime prime_gt_1_int)
	+ then show "residues (p^m)"
	+ using less_imp_of_nat_less residues.intro by fastforce
	+qed
	+
	+text\<open>If $m>0$ then $Zp\_res\_ring m$ is a commutative ring:\<close>
	+
	+lemma(in padic_integers) R_cring:
	+ assumes "m >0"
	+ shows "cring (Zp_res_ring m)"
	+ using p_residues assms residues.cring by auto
	+
	+lemma(in padic_integers) R_comm_monoid:
	+ assumes "m >0"
	+ shows "comm_monoid (Zp_res_ring m)"
	+ by (simp add: assms p_residues residues.comm_monoid)
	+
	+lemma(in padic_integers) zero_rep:
	+"\<zero> = (\<lambda>m. (p_residue m 0))"
	+ unfolding p_residue_def
	+ using Zp_defs(2) padic_zero_simp(1) residue_def residue_ring_def by auto
	+
	+text\<open>The operations on residue rings are just the standard operations on the integers $\mod p^n$. This means that the basic closure properties and algebraic properties of operations on these rings hold for all integers, not just elements of the ring carrier:\<close>
	+
	+lemma(in padic_integers) residue_add:
	+ shows "(x \<oplus>\<^bsub>Zp_res_ring k\<^esub> y) = (x + y) mod p^k"
	+ unfolding residue_ring_def
	+ by simp
	+
	+lemma(in padic_integers) residue_add_closed:
	+ shows "(x \<oplus>\<^bsub>Zp_res_ring k\<^esub> y) \<in> carrier (Zp_res_ring k)"
	+ using p_residue_def p_residue_range residue_def residue_ring_def by auto
	+
	+lemma(in padic_integers) residue_add_closed':
	+ shows "(x \<oplus>\<^bsub>Zp_res_ring k\<^esub> y) \<in> {0..<p^k}"
	+ using residue_add_closed residue_ring_def by auto
	+
	+lemma(in padic_integers) residue_mult:
	+ shows "(x \<otimes>\<^bsub>Zp_res_ring k\<^esub> y) = (x * y) mod p^k"
	+ unfolding residue_ring_def
	+ by simp
	+
	+lemma(in padic_integers) residue_mult_closed:
	+ shows "(x \<otimes>\<^bsub>Zp_res_ring k\<^esub> y) \<in> carrier (Zp_res_ring k)"
	+ using p_residue_def p_residue_range residue_def residue_ring_def by auto
	+
	+lemma(in padic_integers) residue_mult_closed':
	+ shows "(x \<otimes>\<^bsub>Zp_res_ring k\<^esub> y) \<in> {0..<p^k}"
	+ using residue_mult_closed residue_ring_def by auto
	+
	+lemma(in padic_integers) residue_add_assoc:
	+ shows "(x \<oplus>\<^bsub>Zp_res_ring k\<^esub> y) \<oplus>\<^bsub>Zp_res_ring k\<^esub> z = x \<oplus>\<^bsub>Zp_res_ring k\<^esub> (y \<oplus>\<^bsub>Zp_res_ring k\<^esub> z)"
	+ using residue_add
	+ by (simp add: add.commute add.left_commute mod_add_right_eq)
	+
	+lemma(in padic_integers) residue_mult_comm:
	+ shows "x \<otimes>\<^bsub>Zp_res_ring k\<^esub> y = y \<otimes>\<^bsub>Zp_res_ring k\<^esub> x"
	+ using residue_mult
	+ by (simp add: mult.commute)
	+
	+lemma(in padic_integers) residue_mult_assoc:
	+ shows "(x \<otimes>\<^bsub>Zp_res_ring k\<^esub> y) \<otimes>\<^bsub>Zp_res_ring k\<^esub> z = x \<otimes>\<^bsub>Zp_res_ring k\<^esub> (y \<otimes>\<^bsub>Zp_res_ring k\<^esub> z)"
	+ using residue_mult
	+ by (simp add: mod_mult_left_eq mod_mult_right_eq mult.assoc)
	+
	+lemma(in padic_integers) residue_add_comm:
	+ shows "x \<oplus>\<^bsub>Zp_res_ring k\<^esub> y = y \<oplus>\<^bsub>Zp_res_ring k\<^esub> x"
	+ using residue_add
	+ by presburger
	+
	+lemma(in padic_integers) residue_minus_car:
	+ assumes "y \<in> carrier (Zp_res_ring k)"
	+ shows "(x \<ominus>\<^bsub>Zp_res_ring k\<^esub> y) = (x - y) mod p^k"
	+proof(cases "k = 0")
	+ case True
	+ then show ?thesis
	+ using residue_ring_def a_minus_def
	+ by(simp add: a_minus_def residue_ring_def)
	+next
	+ case False
	+ have "(x \<ominus>\<^bsub>Zp_res_ring k\<^esub> y) \<oplus>\<^bsub>Zp_res_ring k\<^esub> y = x \<oplus>\<^bsub>Zp_res_ring k\<^esub> (\<ominus>\<^bsub>Zp_res_ring k\<^esub> y \<oplus>\<^bsub>Zp_res_ring k\<^esub> y)"
	+ by (simp add: a_minus_def residue_add_assoc)
	+ then have 0: "(x \<ominus>\<^bsub>Zp_res_ring k\<^esub> y) \<oplus>\<^bsub>Zp_res_ring k\<^esub> y = x mod p^k"
	+ using assms False
	+ by (smt cring.cring_simprules(9) prime residue_add residues.cring residues.res_zero_eq residues_n)
	+ have 1: "x mod p ^ k = ((x - y) mod p ^ k + y) mod p ^ k"
	+ proof -
	+ have f1: "x - y = x + - 1 * y"
	+ by auto
	+ have "y + (x + - 1 * y) = x"
	+ by simp
	+ then show ?thesis
	+ using f1 by presburger
	+ qed
	+ have "(x \<ominus>\<^bsub>Zp_res_ring k\<^esub> y) \<oplus>\<^bsub>Zp_res_ring k\<^esub> y = (x - y) mod p^k \<oplus>\<^bsub>Zp_res_ring k\<^esub> y"
	+ using residue_add[of k "(x - y) mod p^k" y] 0 1
	+ by linarith
	+ then show ?thesis using assms residue_add_closed
	+ by (metis False a_minus_def cring.cring_simprules(10) cring.cring_simprules(19)
	+ prime residues.cring residues.mod_in_carrier residues_n)
	+qed
	+
	+lemma(in padic_integers) residue_a_inv:
	+ shows "\<ominus>\<^bsub>Zp_res_ring k\<^esub> y = \<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)"
	+proof-
	+ have "y \<oplus>\<^bsub>Zp_res_ring k\<^esub> (\<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)) = (y mod p^k) \<oplus>\<^bsub>Zp_res_ring k\<^esub> (\<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)) "
	+ using residue_minus_car[of "\<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)" k y] residue_add
	+ by (simp add: mod_add_left_eq)
	+ then have 0: "y \<oplus>\<^bsub>Zp_res_ring k\<^esub> (\<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)) = \<zero>\<^bsub>Zp_res_ring k\<^esub>"
	+ by (metis cring.cring_simprules(17) p_res_ring_zero padic_integers.p_res_ring_0'
	+ padic_integers_axioms prime residue_add_closed residues.cring residues.mod_in_carrier residues_n)
	+ have 1: "(\<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)) \<oplus>\<^bsub>Zp_res_ring k\<^esub> y = \<zero>\<^bsub>Zp_res_ring k\<^esub>"
	+ using residue_add_comm 0 by auto
	+ have 2: "\<And>x. x \<in> carrier (Zp_res_ring k) \<and> x \<oplus>\<^bsub>Zp_res_ring k\<^esub> y = \<zero>\<^bsub>Zp_res_ring k\<^esub> \<and> y \<oplus>\<^bsub>Zp_res_ring k\<^esub> x = \<zero>\<^bsub>Zp_res_ring k\<^esub> \<Longrightarrow> x = \<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)"
	+ using 0 1
	+ by (metis cring.cring_simprules(3) cring.cring_simprules(8) mod_by_1 padic_integers.p_res_ring_0'
	+ padic_integers.p_res_ring_zero padic_integers_axioms power_0 prime residue_1_prop
	+ residue_add_assoc residues.cring residues.mod_in_carrier residues_n)
	+ have 3: "carrier (add_monoid (residue_ring (p ^ k))) = carrier (Zp_res_ring k)"
	+ by simp
	+ have 4: "(\<otimes>\<^bsub>add_monoid (residue_ring (p ^ k))\<^esub>) = (\<oplus>\<^bsub>Zp_res_ring k\<^esub>)"
	+ by simp
	+ have 5: "\<And>x. x \<in> carrier (add_monoid (residue_ring (p ^ k))) \<and>
	+ x \<otimes>\<^bsub>add_monoid (residue_ring (p ^ k))\<^esub> y = \<one>\<^bsub>add_monoid (residue_ring (p ^ k))\<^esub> \<and>
	+ y \<otimes>\<^bsub>add_monoid (residue_ring (p ^ k))\<^esub> x = \<one>\<^bsub>add_monoid (residue_ring (p ^ k))\<^esub>
	+ \<Longrightarrow> x = \<ominus>\<^bsub>Zp_res_ring k\<^esub> (y mod p^k)"
	+ using 0 1 2 3 4
	+ by simp
	+ show ?thesis
	+ unfolding a_inv_def m_inv_def
	+ apply(rule the_equality)
	+ using 1 2 3 4 5 unfolding a_inv_def m_inv_def
	+ apply (metis (no_types, lifting) "0" "1" cring.cring_simprules(3) mod_by_1
	+ monoid.select_convs(2) padic_integers.p_res_ring_zero padic_integers_axioms power_0 prime
	+ residue_1_prop residue_add_closed residues.cring residues.mod_in_carrier residues_n)
	+ using 1 2 3 4 5 unfolding a_inv_def m_inv_def
	+ by blast
	+qed
	+
	+lemma(in padic_integers) residue_a_inv_closed:
	+"\<ominus>\<^bsub>Zp_res_ring k\<^esub> y \<in> carrier (Zp_res_ring k)"
	+ apply(cases "k = 0")
	+ apply (metis add.comm_neutral add.commute
	+ atLeastLessThanPlusOne_atLeastAtMost_int
	+ insert_iff mod_by_1 p_res_ring_car p_res_ring_zero padic_integers.p_res_ring_0
	+ padic_integers_axioms power_0 residue_1_prop residue_a_inv)
	+ by (simp add: prime residues.mod_in_carrier residues.res_neg_eq residues_n)
	+
	+lemma(in padic_integers) residue_minus:
	+"(x \<ominus>\<^bsub>Zp_res_ring k\<^esub> y) = (x - y) mod p^k"
	+ using residue_minus_car[of "y mod p^k" k x] residue_a_inv[of k y] unfolding a_minus_def
	+ by (metis a_minus_def mod_diff_right_eq p_residue_alt_def p_residue_range')
	+
	+lemma(in padic_integers) residue_minus_closed:
	+"(x \<ominus>\<^bsub>Zp_res_ring k\<^esub> y) \<in> carrier (Zp_res_ring k)"
	+ by (simp add: a_minus_def residue_add_closed)
	+
	+lemma (in padic_integers) residue_plus_zero_r:
	+"0 \<oplus>\<^bsub>Zp_res_ring k\<^esub> y = y mod p^k"
	+ by (simp add: residue_add)
	+
	+lemma (in padic_integers) residue_plus_zero_l:
	+"y \<oplus>\<^bsub>Zp_res_ring k\<^esub> 0 = y mod p^k"
	+ by (simp add: residue_add)
	+
	+lemma (in padic_integers) residue_times_zero_r:
	+"0 \<otimes>\<^bsub>Zp_res_ring k\<^esub> y = 0"
	+ by (simp add: residue_mult)
	+
	+lemma (in padic_integers) residue_times_zero_l:
	+"y \<otimes>\<^bsub>Zp_res_ring k\<^esub> 0 = 0"
	+ by (simp add: residue_mult)
	+
	+lemma (in padic_integers) residue_times_one_r:
	+"1 \<otimes>\<^bsub>Zp_res_ring k\<^esub> y = y mod p^k"
	+ by (simp add: residue_mult)
	+
	+lemma (in padic_integers) residue_times_one_l:
	+"y \<otimes>\<^bsub>Zp_res_ring k\<^esub> 1 = y mod p^k"
	+ by (simp add: residue_mult_comm residue_times_one_r)
	+
	+text\<open>Similarly to the previous lemmas, many identities about taking residues of $p$-adic integers hold even for elements which lie outside the carrier of $\mathbb{Z}_p$:\<close>
	+
	+lemma (in padic_integers) residue_of_sum:
	+"(a \<oplus> b) k = (a k) \<oplus>\<^bsub>Zp_res_ring k\<^esub> (b k)"
	+ using Zp_def residue_ring_def[of "p^k"] Zp_defs(5) padic_add_res
	+ by auto
	+
	+lemma (in padic_integers) residue_of_sum':
	+ "(a \<oplus> b) k = ((a k) + (b k)) mod p^k"
	+ using residue_add residue_of_sum by auto
	+
	+lemma (in padic_integers) residue_closed[simp]:
	+ assumes "b \<in> carrier Zp"
	+ shows "b k \<in> carrier (Zp_res_ring k)"
	+ using Zp_def assms padic_integers.Zp_defs(3) padic_integers_axioms padic_set_res_closed
	+ by auto
	+
	+lemma (in padic_integers) residue_of_diff:
	+ assumes "b \<in> carrier Zp"
	+ shows "(a \<ominus> b) k = (a k) \<ominus>\<^bsub>Zp_res_ring k\<^esub> (b k)"
	+ unfolding a_minus_def
	+ using Zp_def add.inv_closed assms(1) padic_a_inv prime residue_of_sum by auto
	+
	+lemma (in padic_integers) residue_of_prod:
	+"(a \<otimes> b) k = (a k) \<otimes> \<^bsub>Zp_res_ring k\<^esub> (b k)"
	+ by (simp add: Zp_defs(4) padic_mult_def)
	+
	+lemma (in padic_integers) residue_of_prod':
	+"(a \<otimes> b) k = ((a k) * (b k)) mod (p^k)"
	+ by (simp add: residue_mult residue_of_prod)
	+
	+lemma (in padic_integers) residue_of_one:
	+ assumes "k > 0"
	+ shows "\<one> k = \<one>\<^bsub>Zp_res_ring k\<^esub>"
	+ "\<one> k = 1"
	+ apply (simp add: Zp_defs(1) assms padic_one_simp(1))
	+ by (simp add: Zp_def assms padic_int_simps(1) padic_one_simp(1) residue_ring_def)
	+
	+lemma (in padic_integers) residue_of_zero:
	+ shows "\<zero> k = \<zero>\<^bsub>Zp_res_ring k\<^esub>"
	+ "\<zero> k = 0"
	+ apply (simp add: Zp_defs(2) padic_zero_simp(1))
	+ by (simp add: p_residue_alt_def zero_rep)
	+
	+lemma(in padic_integers) Zp_residue_mult_zero:
	+ assumes "a k = 0"
	+ shows "(a \<otimes> b) k = 0" "(b \<otimes> a) k = 0"
	+ using assms residue_of_prod'
	+ by auto
	+
	+lemma(in padic_integers) Zp_residue_add_zero:
	+ assumes "b \<in> carrier Zp"
	+ assumes "(a:: padic_int) k = 0"
	+ shows "(a \<oplus> b) k = b k" "(b \<oplus> a) k = b k"
	+ apply (metis Zp_def assms(1) assms(2) cring.cring_simprules(8) mod_by_1 padic_int_is_cring power.simps(1)
	+ prime residue_add_closed residue_of_sum residue_of_sum' residues.cring residues.res_zero_eq residues_n)
	+ by (metis Zp_def assms(1) assms(2) cring.cring_simprules(16) mod_by_1 padic_int_is_cring
	+ power.simps(1) prime residue_add_closed residue_of_sum residue_of_sum' residues.cring
	+ residues.res_zero_eq residues_n)
	+
	+text\<open>P-adic addition and multiplication are globally additive and associative:\<close>
	+
	+lemma padic_add_assoc0:
	+assumes "prime p"
	+shows "padic_add p (padic_add p x y) z = padic_add p x (padic_add p y z)"
	+ using assms unfolding padic_add_def
	+ by (simp add: padic_integers.residue_add_assoc padic_integers_def)
	+
	+lemma(in padic_integers) add_assoc:
	+"a \<oplus> b \<oplus> c = a \<oplus> (b \<oplus> c)"
	+ using padic_add_assoc0[of p a b c] prime Zp_defs by auto
	+
	+lemma padic_add_comm0:
	+assumes "prime p"
	+shows "(padic_add p x y)= (padic_add p y x)"
	+ using assms unfolding padic_add_def
	+ using padic_integers.residue_add_comm[of p]
	+ by (simp add: padic_integers_def)
	+
	+lemma(in padic_integers) add_comm:
	+"a \<oplus> b = b \<oplus> a"
	+ using padic_add_comm0[of p a b] prime Zp_defs by auto
	+
	+lemma padic_mult_assoc0:
	+assumes "prime p"
	+shows "padic_mult p (padic_mult p x y) z = padic_mult p x (padic_mult p y z)"
	+ using assms unfolding padic_mult_def
	+ by (simp add: padic_integers.residue_mult_assoc padic_integers_def)
	+
	+lemma(in padic_integers) mult_assoc:
	+"a \<otimes> b \<otimes> c = a \<otimes> (b \<otimes> c)"
	+ using padic_mult_assoc0[of p a b c] prime Zp_defs by auto
	+
	+lemma padic_mult_comm0:
	+assumes "prime p"
	+shows "(padic_mult p x y)= (padic_mult p y x)"
	+ using assms unfolding padic_mult_def
	+ using padic_integers.residue_mult_comm[of p]
	+ by (simp add: padic_integers_def)
	+
	+lemma(in padic_integers) mult_comm:
	+"a \<otimes> b = b \<otimes> a"
	+ using padic_mult_comm0[of p a b] prime Zp_defs by auto
	+
	+lemma(in padic_integers) mult_zero_l:
	+"a \<otimes> \<zero> = \<zero>"
	+proof fix x show "(a \<otimes> \<zero>) x = \<zero> x"
	+ using Zp_residue_mult_zero[of \<zero> x a]
	+ by (simp add: residue_of_zero(2))
	+qed
	+
	+lemma(in padic_integers) mult_zero_r:
	+"\<zero> \<otimes> a = \<zero>"
	+ using mult_zero_l mult_comm by auto
	+
	+lemma (in padic_integers) p_residue_ring_car_memI:
	+ assumes "(m::int) \<ge>0"
	+ assumes "m < p^k"
	+ shows "m \<in> carrier (Zp_res_ring k)"
	+ using residue_ring_def[of "p^k"] assms(1) assms(2)
	+ by auto
	+
	+lemma (in padic_integers) p_residue_ring_car_memE:
	+ assumes "m \<in> carrier (Zp_res_ring k)"
	+ shows "m < p^k" "m \<ge> 0"
	+ using assms residue_ring_def by auto
	+
	+lemma (in padic_integers) residues_closed:
	+ assumes "a \<in> carrier Zp"
	+ shows "a k \<in> carrier (Zp_res_ring k)"
	+ using Zp_def assms padic_integers.Zp_defs(3) padic_integers_axioms padic_set_res_closed by blast
	+
	+lemma (in padic_integers) mod_in_carrier:
	+ "a mod (p^n) \<in> carrier (Zp_res_ring n)"
	+ using p_residue_alt_def p_residue_range' by auto
	+
	+lemma (in padic_integers) Zp_residue_a_inv:
	+ assumes "a \<in> carrier Zp"
	+ shows "(\<ominus> a) k = \<ominus>\<^bsub>Zp_res_ring k\<^esub> (a k)"
	+ "(\<ominus> a) k = (- (a k)) mod (p^k)"
	+ using Zp_def assms padic_a_inv prime apply auto[1]
	+ using residue_a_inv
	+ by (metis Zp_def assms mod_by_1 p_res_ring_zero padic_a_inv padic_integers.prime
	+ padic_integers_axioms power_0 residue_1_prop residues.res_neg_eq residues_n)
	+
	+lemma (in padic_integers) residue_of_diff':
	+ assumes "b \<in> carrier Zp"
	+ shows "(a \<ominus> b) k = ((a k) - (b k)) mod (p^k)"
	+ by (simp add: assms residue_minus_car residue_of_diff residues_closed)
	+
	+lemma (in padic_integers) residue_UnitsI:
	+ assumes "n \<ge> 1"
	+ assumes "(k::int) > 0"
	+ assumes "k < p^n"
	+ assumes "coprime k p"
	+ shows "k \<in> Units (Zp_res_ring n)"
	+ using residues.res_units_eq assms
	+ by (metis (mono_tags, lifting) coprime_power_right_iff mem_Collect_eq not_one_le_zero prime residues_n)
	+
	+lemma (in padic_integers) residue_UnitsE:
	+ assumes "n \<ge> 1"
	+ assumes "k \<in> Units (Zp_res_ring n)"
	+ shows "coprime k p"
	+ using residues.res_units_eq assms
	+ by (simp add: p_residues)
	+
	+lemma(in padic_integers) residue_units_nilpotent:
	+ assumes "m > 0"
	+ assumes "k = card (Units (Zp_res_ring m))"
	+ assumes "x \<in> (Units (Zp_res_ring m))"
	+ shows "x[^]\<^bsub>Zp_res_ring m\<^esub> k = 1"
	+proof-
	+ have 0: "group (units_of (Zp_res_ring m))"
	+ using assms(1) cring_def monoid.units_group padic_integers.R_cring
	+ padic_integers_axioms ring_def
	+ by blast
	+ have 1: "finite (Units (Zp_res_ring m))"
	+ using p_residues assms(1) residues.finite_Units
	+ by auto
	+ have 2: "x[^]\<^bsub>units_of (Zp_res_ring m)\<^esub> (order (units_of (Zp_res_ring m))) = \<one>\<^bsub>units_of (Zp_res_ring m)\<^esub>"
	+ by (metis "0" assms(3) group.pow_order_eq_1 units_of_carrier)
	+ then show ?thesis
	+ by (metis "1" assms(1) assms(2) assms(3) cring.units_power_order_eq_one
	+ padic_integers.R_cring padic_integers.p_residues padic_integers_axioms residues.res_one_eq)
	+qed
	+
	+lemma (in padic_integers) residue_1_unit:
	+ assumes "m > 0"
	+ shows "1 \<in> Units (Zp_res_ring m)"
	+ "\<one>\<^bsub>Zp_res_ring m\<^esub> \<in> Units (Zp_res_ring m)"
	+proof-
	+ have 0: "group (units_of (Zp_res_ring m))"
	+ using assms(1) cring_def monoid.units_group padic_integers.R_cring
	+ padic_integers_axioms ring_def
	+ by blast
	+ have 1: "1 = \<one>\<^bsub>units_of (Zp_res_ring m)\<^esub>"
	+ by (simp add: residue_ring_def units_of_def)
	+ have "\<one>\<^bsub>units_of (Zp_res_ring m)\<^esub> \<in> carrier (units_of (Zp_res_ring m))"
	+ using 0 Group.monoid.intro[of "units_of (Zp_res_ring m)"]
	+ by (simp add: group.is_monoid)
	+ then show "1 \<in> Units (Zp_res_ring m)"
	+ using 1 by (simp add: units_of_carrier)
	+ then show " \<one>\<^bsub>Zp_res_ring m\<^esub> \<in> Units (Zp_res_ring m) "
	+ by (simp add: "1" units_of_one)
	+qed
	+
	+lemma (in padic_integers) zero_not_in_residue_units:
	+ assumes "n \<ge> 1"
	+ shows "(0::int) \<notin> Units (Zp_res_ring n)"
	+ using assms p_residues residues.res_units_eq by auto
	+
	+text\<open>Cardinality bounds on the units of residue rings:\<close>
	+
	+lemma (in padic_integers) residue_units_card_geq_2:
	+ assumes "n \<ge>2"
	+ shows "card (Units (Zp_res_ring n)) \<ge> 2"
	+proof(cases "p = 2")
	+ case True
	+ then have "(3::int) \<in> Units (Zp_res_ring n)"
	+ proof-
	+ have "p \<ge>2"
	+ by (simp add: True)
	+ then have "p^n \<ge> 2^n"
	+ using assms
	+ by (simp add: True)
	+ then have "p^n \<ge> 4"
	+ using assms power_increasing[of 2 n 2]
	+ by (simp add: True)
	+ then have "(3::int) < p^n"
	+ by linarith
	+ then have 0: "(3::int) \<in> carrier (Zp_res_ring n)"
	+ by (simp add: residue_ring_def)
	+ have 1: "coprime 3 p"
	+ by (simp add: True numeral_3_eq_3)
	+ show ?thesis using residue_UnitsI[of n "3::int"]
	+ using "1" \<open>3 < p ^ n\<close> assms by linarith
	+ qed
	+ then have 0: "{(1::int), 3} \<subseteq> Units (Zp_res_ring n)"
	+ using assms padic_integers.residue_1_unit padic_integers_axioms by auto
	+ have 1: "finite (Units (Zp_res_ring n))"
	+ using assms padic_integers.p_residues padic_integers_axioms residues.finite_Units by auto
	+ have 2: "{(1::int),3}\<subseteq>Units (Zp_res_ring n)"
	+ using "0" by auto
	+ have 3: "card {(1::int),3} = 2"
	+ by simp
	+ show ?thesis
	+ using 2 1
	+ by (metis "3" card_mono)
	+next
	+ case False
	+ have "1 \<in> Units (Zp_res_ring n)"
	+ using assms padic_integers.residue_1_unit padic_integers_axioms by auto
	+ have "2 \<in> Units (Zp_res_ring n)"
	+ apply(rule residue_UnitsI)
	+ using assms apply linarith
	+ apply simp
	+ proof-
	+ show "2 < p^n"
	+ proof-
	+ have "p^n > p"
	+ by (metis One_nat_def assms le_simps(3) numerals(2) power_one_right
	+ power_strict_increasing_iff prime prime_gt_1_int)
	+ then show ?thesis using False prime prime_gt_1_int[of p]
	+ by auto
	+ qed
	+ show "coprime 2 p"
	+ using False
	+ by (metis of_nat_numeral prime prime_nat_int_transfer primes_coprime two_is_prime_nat)
	+ qed
	+ then have 0: "{(1::int), 2} \<subseteq> Units (Zp_res_ring n)"
	+ using \<open>1 \<in> Units (Zp_res_ring n)\<close> by blast
	+ have 1: "card {(1::int),2} = 2"
	+ by simp
	+ then show ?thesis
	+ using residues.finite_Units 0
	+ by (metis One_nat_def assms card_mono dual_order.trans
	+ le_simps(3) one_le_numeral padic_integers.p_residues padic_integers_axioms)
	+qed
	+
	+lemma (in padic_integers) residue_ring_card:
	+"finite (carrier (Zp_res_ring n)) \<and> card (carrier (Zp_res_ring n)) = nat (p^n)"
	+ using p_res_ring_car[of n]
	+ by simp
	+
	+lemma(in comm_monoid) UnitsI:
	+ assumes "a \<in> carrier G"
	+ assumes "b \<in> carrier G"
	+ assumes "a \<otimes> b = \<one>"
	+ shows "a \<in> Units G" "b \<in> Units G"
	+ unfolding Units_def using comm_monoid_axioms_def assms m_comm[of a b]
	+ by auto
	+
	+lemma(in comm_monoid) is_invI:
	+ assumes "a \<in> carrier G"
	+ assumes "b \<in> carrier G"
	+ assumes "a \<otimes> b = \<one>"
	+ shows "inv\<^bsub>G\<^esub> b = a" "inv\<^bsub>G\<^esub> a = b"
	+ using assms inv_char m_comm
	+ by auto
	+
	+lemma (in padic_integers) residue_of_Units:
	+ assumes "k > 0"
	+ assumes "a \<in> Units Zp"
	+ shows "a k \<in> Units (Zp_res_ring k)"
	+proof-
	+ have 0: "a k \<otimes>\<^bsub>Zp_res_ring k\<^esub> (inv \<^bsub>Zp\<^esub> a) k = 1"
	+ by (metis R.Units_r_inv assms(1) assms(2) residue_of_one(2) residue_of_prod)
	+ have 1: "a k \<in> carrier (Zp_res_ring k)"
	+ by (simp add: R.Units_closed assms(2) residues_closed)
	+ have 2: "(inv \<^bsub>Zp\<^esub> a) k \<in> carrier (Zp_res_ring k)"
	+ by (simp add: assms(2) residues_closed)
	+ show ?thesis using 0 1 2 comm_monoid.UnitsI[of "Zp_res_ring k"]
	+ using assms(1) p_residues residues.comm_monoid residues.res_one_eq
	+ by presburger
	+qed
	+
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+(********************)section\<open>$int$ and $nat$ inclusions in $\mathbb{Z}_p$.\<close> (**************************)
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+
	+lemma(in ring) int_inc_zero:
	+"[(0::int)]\<cdot> \<one> = \<zero>"
	+ by (simp add: add.int_pow_eq_id)
	+
	+lemma(in ring) int_inc_zero':
	+ assumes "x \<in> carrier R"
	+ shows "[(0::int)] \<cdot> x = \<zero>"
	+ by (simp add: add.int_pow_eq_id assms)
	+
	+lemma(in ring) nat_inc_zero:
	+"[(0::nat)]\<cdot> \<one> = \<zero>"
	+ by auto
	+
	+lemma(in ring) nat_mult_zero:
	+"[(0::nat)]\<cdot> x = \<zero>"
	+ by simp
	+
	+lemma(in ring) nat_inc_closed:
	+ fixes n::nat
	+ shows "[n] \<cdot> \<one> \<in> carrier R"
	+ by simp
	+
	+lemma(in ring) nat_mult_closed:
	+ fixes n::nat
	+ assumes "x \<in> carrier R"
	+ shows "[n] \<cdot> x \<in> carrier R"
	+ by (simp add: assms)
	+
	+lemma(in ring) int_inc_closed:
	+ fixes n::int
	+ shows "[n] \<cdot> \<one> \<in> carrier R"
	+ by simp
	+
	+lemma(in ring) int_mult_closed:
	+ fixes n::int
	+ assumes "x \<in> carrier R"
	+ shows "[n] \<cdot> x \<in> carrier R"
	+ by (simp add: assms)
	+
	+lemma(in ring) nat_inc_prod:
	+ fixes n::nat
	+ fixes m::nat
	+ shows "[m]\<cdot>([n] \<cdot> \<one>) = [(m*n)]\<cdot>\<one>"
	+ by (simp add: add.nat_pow_pow mult.commute)
	+
	+lemma(in ring) nat_inc_prod':
	+ fixes n::nat
	+ fixes m::nat
	+ shows "[(m*n)]\<cdot>\<one> = [m]\<cdot> \<one> \<otimes> ([n] \<cdot> \<one>)"
	+ by (simp add: add.nat_pow_pow add_pow_rdistr)
	+
	+lemma(in padic_integers) Zp_nat_inc_zero:
	+ shows "[(0::nat)] \<cdot> x = \<zero>"
	+ by simp
	+
	+lemma(in padic_integers) Zp_int_inc_zero':
	+ shows "[(0::int)] \<cdot> x = \<zero>"
	+ using Zp_nat_inc_zero[of x]
	+ unfolding add_pow_def int_pow_def by auto
	+
	+lemma(in padic_integers) Zp_nat_inc_closed:
	+ fixes n::nat
	+ shows "[n] \<cdot> \<one> \<in> carrier Zp"
	+ by simp
	+
	+lemma(in padic_integers) Zp_nat_mult_closed:
	+ fixes n::nat
	+ assumes "x \<in> carrier Zp"
	+ shows "[n] \<cdot> x \<in> carrier Zp"
	+ by (simp add: assms)
	+
	+lemma(in padic_integers) Zp_int_inc_closed:
	+ fixes n::int
	+ shows "[n] \<cdot> \<one> \<in> carrier Zp"
	+ by simp
	+
	+lemma(in padic_integers) Zp_int_mult_closed:
	+ fixes n::int
	+ assumes "x \<in> carrier Zp"
	+ shows "[n] \<cdot> x \<in> carrier Zp"
	+ by (simp add: assms)
	+
	+text\<open>The following lemmas give a concrete description of the inclusion of integers and natural numbers into $\mathbb{Z}_p$:\<close>
	+
	+lemma(in padic_integers) Zp_nat_inc_rep:
	+ fixes n::nat
	+ shows "[n] \<cdot> \<one> = (\<lambda> m. p_residue m n)"
	+ apply(induction n)
	+ apply (simp add: zero_rep)
	+proof-
	+ case (Suc n)
	+ fix n
	+ assume A: "[n] \<cdot> \<one> = (\<lambda>m. p_residue m (int n))"
	+ then have 0: "[Suc n] \<cdot> \<one> = [n]\<cdot>\<one> \<oplus> \<one>" by auto
	+ show "[Suc n] \<cdot> \<one> = (\<lambda>m. p_residue m (Suc n))"
	+ proof fix m
	+ show "([Suc n] \<cdot> \<one>) m = p_residue m (int (Suc n)) "
	+ proof(cases "m=0")
	+ case True
	+ have 0: "([Suc n] \<cdot> \<one>) m \<in> carrier (Zp_res_ring m)"
	+ using Zp_nat_inc_closed padic_set_res_closed
	+ by (simp add: residues_closed)
	+ then have "([Suc n] \<cdot> \<one>) m = 0"
	+ using p_res_ring_0 True by blast
	+ then show ?thesis
	+ by (metis True p_res_ring_0' p_residue_range')
	+ next
	+ case False
	+ then have R: "residues (p^m)"
	+ by (simp add: prime residues_n)
	+ have "([Suc n] \<cdot> \<one>) m = ([n]\<cdot>\<one> \<oplus> \<one>) m"
	+ by (simp add: "0")
	+ then have P0: "([Suc n] \<cdot> \<one>) m = p_residue m (int n) \<oplus>\<^bsub>Zp_res_ring m\<^esub> \<one>\<^bsub>Zp_res_ring m\<^esub>"
	+ using A False Zp_def padic_add_res padic_one_def Zp_defs(5)
	+ padic_integers.residue_of_one(1) padic_integers_axioms by auto
	+ then have P1:"([Suc n] \<cdot> \<one>) m = p_residue m (int n) \<oplus>\<^bsub>Zp_res_ring m\<^esub> p_residue m (1::int)"
	+ by (metis R ext p_residue_alt_def residue_add_assoc residue_add_comm residue_plus_zero_r
	+ residue_times_one_r residue_times_zero_l residues.res_one_eq)
	+ have P2: "p_residue m (int n) \<oplus>\<^bsub>Zp_res_ring m\<^esub> p_residue m 1 = ((int n) mod (p^m)) \<oplus>\<^bsub>Zp_res_ring m\<^esub> 1"
	+ using R P0 P1 residue_def residues.res_one_eq
	+ by (simp add: residues.res_one_eq p_residue_alt_def)
	+ have P3:"((int n) mod (p^m)) \<oplus>\<^bsub>Zp_res_ring m\<^esub> 1 = ((int n) + 1) mod (p^m)"
	+ using R residue_ring_def by (simp add: mod_add_left_eq)
	+ have "p_residue m (int n) \<oplus>\<^bsub>Zp_res_ring m\<^esub> p_residue m 1 = (int (Suc n)) mod (p^m)"
	+ by (metis P2 P3 add.commute of_nat_Suc p_residue_alt_def residue_add)
	+ then show ?thesis
	+ using False R P1 p_residue_def p_residue_alt_def
	+ by auto
	+ qed
	+ qed
	+qed
	+
	+lemma(in padic_integers) Zp_nat_inc_res:
	+ fixes n::nat
	+ shows "([n] \<cdot> \<one>) k = n mod (p^k)"
	+ using Zp_nat_inc_rep p_residue_def
	+ by (simp add: p_residue_alt_def)
	+
	+lemma(in padic_integers) Zp_int_inc_rep:
	+ fixes n::int
	+ shows "[n] \<cdot> \<one> = (\<lambda> m. p_residue m n )"
	+proof(induction n)
	+ case (nonneg n)
	+ then show ?case using Zp_nat_inc_rep
	+ by (simp add: add_pow_int_ge)
	+next
	+ case (neg n)
	+ show "\<And>n. [(- int (Suc n))] \<cdot> \<one> = (\<lambda>m. p_residue m (- int (Suc n)))"
	+ proof
	+ fix n
	+ fix m
	+ show "([(- int (Suc n))] \<cdot> \<one>) m = p_residue m (- int (Suc n))"
	+ proof-
	+ have "[(- int (Suc n))] \<cdot> \<one> = \<ominus> ([(int (Suc n))] \<cdot> \<one>)"
	+ using a_inv_def abelian_group.a_group add_pow_def cring.axioms(1) domain_def
	+ negative_zless_0 ring_def R.add.int_pow_neg R.one_closed by blast
	+ then have "([(- int (Suc n))] \<cdot> \<one>) m = (\<ominus> ([(int (Suc n))] \<cdot> \<one>)) m"
	+ by simp
	+ have "\<one> \<in> carrier Zp"
	+ using cring.cring_simprules(6) domain_def by blast
	+ have "([(int (Suc n))] \<cdot> \<one>) = ([(Suc n)] \<cdot> \<one>)"
	+ by (metis add_pow_def int_pow_int)
	+ then have "([(int (Suc n))] \<cdot> \<one>) \<in> carrier Zp" using Zp_nat_inc_closed
	+ by simp
	+ then have P0: "([(- int (Suc n))] \<cdot> \<one>) m = \<ominus>\<^bsub>Zp_res_ring m\<^esub> (([(int (Suc n))] \<cdot> \<one>) m)"
	+ using Zp_def prime
	+ using \<open>[(- int (Suc n))] \<cdot> \<one> = \<ominus> ([int (Suc n)] \<cdot> \<one>)\<close> padic_integers.Zp_residue_a_inv(1)
	+ padic_integers_axioms by auto
	+ have "(([(int (Suc n))] \<cdot> \<one>) m) = (p_residue m (Suc n))"
	+ using Zp_nat_inc_rep by (simp add: add_pow_int_ge)
	+ then have P1: "([(- int (Suc n))] \<cdot> \<one>) m = \<ominus>\<^bsub>Zp_res_ring m\<^esub>(p_residue m (Suc n))"
	+ using P0 by auto
	+ have "\<ominus>\<^bsub>Zp_res_ring m\<^esub>(p_residue m (Suc n)) = p_residue m (- int (Suc n))"
	+ proof(cases "m=0")
	+ case True
	+ then have 0:"\<ominus>\<^bsub>Zp_res_ring m\<^esub>(p_residue m (Suc n)) =\<ominus>\<^bsub>Zp_res_ring 0\<^esub>(p_residue 0 (Suc n))"
	+ by blast
	+ then have 1:"\<ominus>\<^bsub>Zp_res_ring m\<^esub>(p_residue m (Suc n)) =\<ominus>\<^bsub>Zp_res_ring 0\<^esub> (p_residue 1 (Suc n))"
	+ by (metis p_res_ring_0' residue_a_inv_closed)
	+ then have 2:"\<ominus>\<^bsub>Zp_res_ring m\<^esub>(p_residue m (Suc n)) =\<ominus>\<^bsub>Zp_res_ring 0\<^esub> 0"
	+ by (metis p_res_ring_0' residue_a_inv_closed)
	+ then have 3:"\<ominus>\<^bsub>Zp_res_ring m\<^esub>(p_residue m (Suc n)) =0"
	+ using residue_1_prop p_res_ring_0' residue_a_inv_closed by presburger
	+ have 4: "p_residue m (- int (Suc n)) \<in> carrier (Zp_res_ring 0)"
	+ using p_res_ring_0 True residue_1_zero p_residue_range' by blast
	+ then show ?thesis
	+ using "3" True residue_1_zero
	+ by (simp add: p_res_ring_0')
	+ next
	+ case False
	+ then have R: "residues (p^m)"
	+ using padic_integers.p_residues padic_integers_axioms by blast
	+ have "\<ominus>\<^bsub>Zp_res_ring m\<^esub> p_residue m (int (Suc n)) = \<ominus>\<^bsub>Zp_res_ring m\<^esub> (int (Suc n)) mod (p^m) "
	+ using R residue_def residues.neg_cong residues.res_neg_eq p_residue_alt_def
	+ by auto
	+ then have "\<ominus>\<^bsub>Zp_res_ring m\<^esub> p_residue m (int (Suc n)) = (-(int (Suc n))) mod (p^m)"
	+ using R residues.res_neg_eq by auto
	+ then show ?thesis
	+ by (simp add: p_residue_alt_def)
	+ qed
	+ then show ?thesis
	+ using P1 by linarith
	+ qed
	+ qed
	+qed
	+
	+lemma(in padic_integers) Zp_int_inc_res:
	+ fixes n::int
	+ shows "([n] \<cdot> \<one>) k = n mod (p^k)"
	+ using Zp_int_inc_rep p_residue_def
	+ by (simp add: p_residue_alt_def)
	+
	+abbreviation(in padic_integers)(input) \<p> where
	+"\<p> \<equiv> [p] \<cdot> \<one>"
	+
	+lemma(in padic_integers) p_natpow_prod:
	+"\<p>[^](n::nat) \<otimes> \<p>[^](m::nat) = \<p>[^](n + m)"
	+ by (simp add: R.nat_pow_mult)
	+
	+lemma(in padic_integers) p_natintpow_prod:
	+ assumes "(m::int) \<ge> 0"
	+ shows "\<p>[^](n::nat) \<otimes> \<p>[^]m = \<p>[^](n + m)"
	+ using p_natpow_prod[of n "nat m"] assms int_pow_def[of Zp \<p> m] int_pow_def[of Zp \<p> "n + m"]
	+ by (metis (no_types, lifting) int_nat_eq int_pow_int of_nat_add)
	+
	+lemma(in padic_integers) p_intnatpow_prod:
	+ assumes "(n::int) \<ge> 0"
	+ shows "\<p>[^]n \<otimes> \<p>[^](m::nat) = \<p>[^](m + n)"
	+ using p_natintpow_prod[of n m] assms mult_comm[of "\<p>[^]n" "\<p>[^]m"]
	+ by simp
	+
	+lemma(in padic_integers) p_int_pow_prod:
	+ assumes "(n::int) \<ge> 0"
	+ assumes "(m::int) \<ge> 0"
	+ shows "\<p>[^]n \<otimes> \<p>[^]m = \<p>[^](m + n)"
	+proof-
	+ have "nat n + nat m = nat (n + m)"
	+ using assms
	+ by (simp add: nat_add_distrib)
	+ then have "\<p> [^] (nat n + nat m) = \<p>[^](n + m)"
	+ using assms
	+ by (simp add: \<open>nat n + nat m = nat (n + m)\<close>)
	+ then show ?thesis using assms p_natpow_prod[of "nat n" "nat m"]
	+ by (smt pow_nat)
	+qed
	+
	+lemma(in padic_integers) p_natpow_prod_Suc:
	+"\<p> \<otimes> \<p>[^](m::nat) = \<p>[^](Suc m)"
	+"\<p>[^](m::nat) \<otimes> \<p> = \<p>[^](Suc m)"
	+ using R.nat_pow_Suc2 R.nat_pow_Suc by auto
	+
	+lemma(in padic_integers) power_residue:
	+ assumes "a \<in> carrier Zp"
	+ assumes "k > 0"
	+ shows "(a[^]\<^bsub>Zp\<^esub> (n::nat)) k = (a k)^n mod (p^k)"
	+ apply(induction n)
	+ using p_residues assms(2) residue_of_one(1) residues.one_cong apply auto[1]
	+ by (simp add: assms(1) mod_mult_left_eq power_commutes residue_of_prod')
	+
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+(***************************) section\<open>The Valuation on $\mathbb{Z}_p$\<close> (********************************)
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>The Integer-Valued and Extended Integer-Valued Valuations\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+fun fromeint :: "eint \<Rightarrow> int" where
	+ "fromeint (eint x) = x"
	+
	+text\<open>The extended-integer-valued $p$-adic valuation on $\mathbb{Z}_p$:\<close>
	+
	+definition(in padic_integers) val_Zp where
	+"val_Zp = (\<lambda>x. (if (x = \<zero>) then (\<infinity>::eint) else (eint (padic_val p x))))"
	+
	+text\<open>We also define an integer-valued valuation on the nonzero elements of $\mathbb{Z}_p$, for simplified reasoning\<close>
	+
	+definition(in padic_integers) ord_Zp where
	+"ord_Zp = padic_val p"
	+
	+text\<open>Ord of additive inverse\<close>
	+
	+lemma(in padic_integers) ord_Zp_of_a_inv:
	+ assumes "a \<in> nonzero Zp"
	+ shows "ord_Zp a = ord_Zp (\<ominus>a)"
	+ using ord_Zp_def Zp_def assms
	+ padic_val_a_inv prime
	+ by (simp add: domain.nonzero_memE(1) padic_int_is_domain)
	+
	+lemma(in padic_integers) val_Zp_of_a_inv:
	+ assumes "a \<in> carrier Zp"
	+ shows "val_Zp a = val_Zp (\<ominus>a)"
	+ using R.add.inv_eq_1_iff Zp_def assms padic_val_a_inv prime val_Zp_def by auto
	+
	+text\<open>Ord-based criterion for being nonzero:\<close>
	+
	+lemma(in padic_integers) ord_of_nonzero:
	+ assumes "x \<in>carrier Zp"
	+ assumes "ord_Zp x \<ge>0"
	+ shows "x \<noteq> \<zero>"
	+ "x \<in> nonzero Zp"
	+proof-
	+ show "x \<noteq> \<zero>"
	+ proof
	+ assume "x = \<zero>"
	+ then have "ord_Zp x = -1"
	+ using ord_Zp_def padic_val_def Zp_def Zp_defs(2) by auto
	+ then show False using assms(2) by auto
	+ qed
	+ then show "x \<in> nonzero Zp"
	+ using nonzero_def assms(1)
	+ by (simp add: nonzero_def)
	+qed
	+
	+lemma(in padic_integers) not_nonzero_Zp:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<notin> nonzero Zp"
	+ shows "x = \<zero>"
	+ using assms(1) assms(2) nonzero_def by fastforce
	+
	+lemma(in padic_integers) not_nonzero_Qp:
	+ assumes "x \<in> carrier Q\<^sub>p"
	+ assumes "x \<notin> nonzero Q\<^sub>p"
	+ shows "x = \<zero>\<^bsub>Q\<^sub>p\<^esub>"
	+ using assms(1) assms(2) nonzero_def by force
	+
	+text\<open>Relationship between val and ord\<close>
	+
	+lemma(in padic_integers) val_ord_Zp:
	+ assumes "a \<noteq> \<zero>"
	+ shows "val_Zp a = eint (ord_Zp a)"
	+ by (simp add: assms ord_Zp_def val_Zp_def)
	+
	+lemma(in padic_integers) ord_pos:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq> \<zero>"
	+ shows "ord_Zp x \<ge> 0"
	+proof-
	+ have "x \<noteq>padic_zero p"
	+ using Zp_def assms(2) Zp_defs(2) by auto
	+ then have "ord_Zp x = int (LEAST k. x (Suc k) \<noteq> \<zero>\<^bsub>residue_ring (p^Suc k)\<^esub>)"
	+ using ord_Zp_def padic_val_def by auto
	+ then show ?thesis
	+ by linarith
	+qed
	+
	+lemma(in padic_integers) val_pos:
	+ assumes "x \<in> carrier Zp"
	+ shows "val_Zp x \<ge> 0"
	+ unfolding val_Zp_def using assms
	+ by (metis (full_types) eint_0 eint_ord_simps(1) eint_ord_simps(3) ord_Zp_def ord_pos)
	+
	+text\<open>For passing between nat and int castings of ord\<close>
	+
	+lemma(in padic_integers) ord_nat:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ shows "int (nat (ord_Zp x)) = ord_Zp x"
	+ using ord_pos by (simp add: assms(1) assms(2))
	+
	+lemma(in padic_integers) zero_below_ord:
	+ assumes "x \<in> carrier Zp"
	+ assumes "n \<le> ord_Zp x"
	+ shows "x n = 0"
	+proof-
	+ have "x n = \<zero>\<^bsub>residue_ring (p^n)\<^esub>"
	+ using ord_Zp_def zero_below_val Zp_def assms(1) assms(2) prime padic_int_simps(5)
	+ by auto
	+ then show ?thesis using residue_ring_def
	+ by simp
	+qed
	+
	+lemma(in padic_integers) zero_below_val_Zp:
	+ assumes "x \<in> carrier Zp"
	+ assumes "n \<le> val_Zp x"
	+ shows "x n = 0"
	+ by (metis assms(1) assms(2) eint_ord_simps(1) ord_Zp_def residue_of_zero(2) val_Zp_def zero_below_ord)
	+
	+lemma(in padic_integers) below_ord_zero:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x (Suc n) \<noteq> 0"
	+ shows "n \<ge> ord_Zp x"
	+proof-
	+ have 0: "x \<in> padic_set p"
	+ using Zp_def assms(1) Zp_defs(3)
	+ by auto
	+ have 1: "x (Suc n) \<noteq> \<zero>\<^bsub>residue_ring (p^(Suc n))\<^esub>"
	+ using residue_ring_def assms(2) by auto
	+ have "of_nat n \<ge> (padic_val p x )"
	+ using 0 1 below_val_zero prime by auto
	+ then show ?thesis using ord_Zp_def by auto
	+qed
	+
	+lemma(in padic_integers) below_val_Zp_zero:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x (Suc n) \<noteq> 0"
	+ shows "n \<ge> val_Zp x"
	+ by (metis Zp_def assms(1) assms(2) eint_ord_simps(1) padic_integers.below_ord_zero
	+ padic_integers.residue_of_zero(2) padic_integers.val_ord_Zp padic_integers_axioms)
	+
	+lemma(in padic_integers) nonzero_imp_ex_nonzero_res:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq> \<zero>"
	+ shows "\<exists>k. x (Suc k) \<noteq> 0"
	+proof-
	+ have 0: "x 0 = 0"
	+ using Zp_def assms(1) padic_int_simps(5) padic_set_zero_res prime by auto
	+ have "\<exists>k. k > 0 \<and> x k \<noteq> 0"
	+ apply(rule ccontr) using 0 Zp_defs unfolding padic_zero_def
	+ by (metis assms(2) ext neq0_conv)
	+ then show ?thesis
	+ using not0_implies_Suc by blast
	+qed
	+
	+lemma(in padic_integers) ord_suc_nonzero:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ assumes "ord_Zp x = n"
	+ shows "x (Suc n) \<noteq> 0"
	+proof-
	+ obtain k where k_def: "x (Suc k) \<noteq> 0"
	+ using assms(1) nonzero_imp_ex_nonzero_res assms(2) by blast
	+ then show ?thesis
	+ using assms LeastI nonzero_imp_ex_nonzero_res unfolding ord_Zp_def padic_val_def
	+ by (metis (mono_tags, lifting) Zp_defs(2) k_def of_nat_eq_iff padic_zero_def padic_zero_simp(1))
	+qed
	+
	+lemma(in padic_integers) above_ord_nonzero:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ assumes "n > ord_Zp x"
	+ shows "x n \<noteq> 0"
	+proof-
	+ have P0: "n \<ge> (Suc (nat (ord_Zp x)))"
	+ by (simp add: Suc_le_eq assms(1) assms(2) assms(3) nat_less_iff ord_pos)
	+ then have P1: "p_residue (Suc (nat (ord_Zp x))) (x n) = x (Suc (nat (ord_Zp x)))"
	+ using assms(1) p_residue_padic_int by blast
	+ then have P2: "p_residue (Suc (nat (ord_Zp x))) (x n) \<noteq> 0"
	+ using Zp_def assms(1) assms(2) ord_nat padic_integers.ord_suc_nonzero
	+ padic_integers_axioms by auto
	+ then show ?thesis
	+ using P0 P1 assms(1) p_residue_padic_int[of x "(Suc (nat (ord_Zp x)))" n] p_residue_def
	+ by (metis ord_Zp_def padic_int_simps(2) padic_integers.zero_rep padic_integers_axioms padic_zero_simp(2))
	+qed
	+
	+lemma(in padic_integers) ord_Zp_geq:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x n = 0"
	+ assumes "x \<noteq>\<zero>"
	+ shows "ord_Zp x \<ge> n"
	+proof(rule ccontr)
	+ assume "\<not> int n \<le> ord_Zp x"
	+ then show False using assms
	+ using above_ord_nonzero by auto
	+qed
	+
	+lemma(in padic_integers) ord_equals:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x (Suc n) \<noteq> 0"
	+ assumes "x n = 0"
	+ shows "ord_Zp x = n"
	+ using assms(1) assms(2) assms(3) below_ord_zero ord_Zp_geq residue_of_zero(2)
	+ by fastforce
	+
	+lemma(in padic_integers) ord_Zp_p:
	+"ord_Zp \<p> = (1::int)"
	+proof-
	+ have "ord_Zp \<p> = int 1"
	+ apply(rule ord_equals[of \<p>])
	+ using Zp_int_inc_res[of p] prime_gt_1_int prime by auto
	+ then show ?thesis
	+ by simp
	+qed
	+
	+lemma(in padic_integers) ord_Zp_one:
	+"ord_Zp \<one> = 0"
	+proof-
	+ have "ord_Zp ([(1::int)]\<cdot>\<one>) = int 0"
	+ apply(rule ord_equals)
	+ using Zp_int_inc_res[of 1] prime_gt_1_int prime by auto
	+ then show ?thesis
	+ by simp
	+qed
	+
	+text\<open>ord is multiplicative on nonzero elements of Zp\<close>
	+
	+lemma(in padic_integers) ord_Zp_mult:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ shows "(ord_Zp (x \<otimes>\<^bsub>Zp\<^esub> y)) = (ord_Zp x) + (ord_Zp y)"
	+ using val_prod[of p x y] prime assms Zp_defs Zp_def nonzero_memE(2) ord_Zp_def
	+ nonzero_closed nonzero_memE(2)
	+ by auto
	+
	+lemma(in padic_integers) ord_Zp_pow:
	+ assumes "x \<in> nonzero Zp"
	+ shows "ord_Zp (x[^](n::nat)) = n*(ord_Zp x)"
	+proof(induction n)
	+ case 0
	+ have "x[^](0::nat) = \<one>"
	+ using assms(1) nonzero_def by simp
	+ then show ?case
	+ by (simp add: ord_Zp_one)
	+next
	+ case (Suc n)
	+ fix n
	+ assume IH: "ord_Zp (x [^] n) = int n * ord_Zp x "
	+ have N: "(x [^] n) \<in> nonzero Zp"
	+ proof-
	+ have "ord_Zp x \<ge> 0"
	+ using assms
	+ by (simp add: nonzero_closed nonzero_memE(2) ord_pos)
	+ then have "ord_Zp (x [^] n) \<ge> 0"
	+ using IH assms by simp
	+ then have 0: "(x [^] n) \<noteq> \<zero>"
	+ using ord_of_nonzero(1) by force
	+ have 1: "(x [^] n) \<in> carrier Zp"
	+ by (simp add: nonzero_closed assms)
	+ then show ?thesis
	+ using "0" not_nonzero_Zp by blast
	+ qed
	+ have "x[^](Suc n) = x \<otimes>(x[^]n)"
	+ using nonzero_closed assms R.nat_pow_Suc2 by blast
	+ then have "ord_Zp (x[^](Suc n)) =(ord_Zp x) + ord_Zp (x[^]n)"
	+ using N Zp_def assms padic_integers.ord_Zp_mult padic_integers_axioms by auto
	+ then have "ord_Zp (x[^](Suc n)) =(ord_Zp x) +(int n * ord_Zp x)"
	+ by (simp add: IH)
	+ then have "ord_Zp (x[^](Suc n)) =(1(ord_Zp x)) +(int n) (ord_Zp x)"
	+ by simp
	+ then have "ord_Zp (x[^](Suc n)) =(1+ (int n)) * ord_Zp x"
	+ by (simp add: comm_semiring_class.distrib)
	+ then show "ord_Zp (x[^](Suc n)) = int (Suc n)*ord_Zp x"
	+ by simp
	+qed
	+
	+lemma(in padic_integers) val_Zp_pow:
	+ assumes "x \<in> nonzero Zp"
	+ shows "val_Zp (x[^](n::nat)) = (n*(ord_Zp x))"
	+ using Zp_def domain.nat_pow_nonzero[of Zp] domain_axioms nonzero_memE assms ord_Zp_def
	+ padic_integers.ord_Zp_pow padic_integers_axioms val_Zp_def
	+ nonzero_memE(2)
	+ by fastforce
	+
	+lemma(in padic_integers) val_Zp_pow':
	+ assumes "x \<in> nonzero Zp"
	+ shows "val_Zp (x[^](n::nat)) = n*(val_Zp x)"
	+ by (metis Zp_def assms not_nonzero_memI padic_integers.val_Zp_pow padic_integers.val_ord_Zp padic_integers_axioms times_eint_simps(1))
	+
	+lemma(in padic_integers) ord_Zp_p_pow:
	+"ord_Zp (\<p>[^](n::nat)) = n"
	+ using ord_Zp_pow ord_Zp_p Zp_def Zp_nat_inc_closed ord_of_nonzero(2) padic_integers_axioms int_inc_closed
	+ Zp_int_inc_closed by auto
	+
	+lemma(in padic_integers) ord_Zp_p_int_pow:
	+ assumes "n \<ge>0"
	+ shows "ord_Zp (\<p>[^](n::int)) = n"
	+ by (metis assms int_nat_eq int_pow_int ord_Zp_def ord_Zp_p_pow)
	+
	+lemma(in padic_integers) val_Zp_p:
	+"(val_Zp \<p>) = 1"
	+ using Zp_def ord_Zp_def padic_val_def val_Zp_def ord_Zp_p Zp_defs(2) one_eint_def
	+ by auto
	+
	+lemma(in padic_integers) val_Zp_p_pow:
	+"val_Zp (\<p>[^](n::nat)) = eint n"
	+proof-
	+ have "(\<p>[^](n::nat)) \<noteq> \<zero>"
	+ by (metis mult_zero_l n_not_Suc_n of_nat_eq_iff ord_Zp_def ord_Zp_p_pow p_natpow_prod_Suc(1))
	+ then show ?thesis
	+ using ord_Zp_p_pow by (simp add: ord_Zp_def val_Zp_def)
	+qed
	+
	+lemma(in padic_integers) p_pow_res:
	+ assumes "(n::nat) \<ge> m"
	+ shows "(\<p>[^]n) m = 0"
	+ by (simp add: assms ord_Zp_p_pow zero_below_ord)
	+
	+lemma(in padic_integers) p_pow_factor:
	+ assumes "(n::nat) \<ge> m"
	+ shows "(h \<otimes> (\<p>[^]n)) m = 0" "(h \<otimes> (\<p>[^]n)) m = \<zero>\<^bsub>Zp_res_ring n\<^esub>"
	+ using assms p_pow_res p_res_ring_zero
	+ by(auto simp: residue_of_zero Zp_residue_mult_zero(2))
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>The Ultrametric Inequality\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+text\<open>Ultrametric inequality for ord\<close>
	+
	+lemma(in padic_integers) ord_Zp_ultrametric:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "x \<oplus> y \<in> nonzero Zp"
	+ shows "ord_Zp (x \<oplus> y) \<ge> min (ord_Zp x) (ord_Zp y)"
	+ unfolding ord_Zp_def
	+ using padic_val_ultrametric[of p x y] Zp_defs assms nonzero_memE Zp_def prime
	+ nonzero_closed nonzero_memE(2) by auto
	+
	+text\<open>Variants of the ultrametric inequality\<close>
	+
	+lemma (in padic_integers) ord_Zp_ultrametric_diff:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "x \<noteq> y "
	+ shows "ord_Zp (x \<ominus> y) \<ge> min (ord_Zp x) (ord_Zp y)"
	+ using assms ord_Zp_ultrametric[of x "\<ominus> y"]
	+ unfolding a_minus_def
	+ by (metis (no_types, lifting) R.a_transpose_inv R.add.inv_closed R.add.m_closed R.l_neg nonzero_closed ord_Zp_of_a_inv ord_of_nonzero(2) ord_pos)
	+
	+lemma(in padic_integers) ord_Zp_not_equal_imp_notequal:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "ord_Zp x \<noteq> (ord_Zp y)"
	+ shows "x \<noteq> y" "x \<ominus> y \<noteq>\<zero>" "x \<oplus> y \<noteq>\<zero>"
	+ using assms
	+ apply blast
	+ using nonzero_closed assms(1) assms(2) assms(3) apply auto[1]
	+ using nonzero_memE assms
	+ using R.minus_equality nonzero_closed
	+ Zp_def padic_integers.ord_Zp_of_a_inv
	+ padic_integers_axioms by auto
	+
	+lemma(in padic_integers) ord_Zp_ultrametric_eq:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "ord_Zp x > (ord_Zp y)"
	+ shows "ord_Zp (x \<oplus> y) = ord_Zp y"
	+proof-
	+ have 0: "ord_Zp (x \<oplus> y) \<ge> ord_Zp y"
	+ using assms ord_Zp_not_equal_imp_notequal[of x y]
	+ ord_Zp_ultrametric[of x y] nonzero_memE not_nonzero_Zp
	+ nonzero_closed by force
	+ have 1: "ord_Zp y \<ge> min (ord_Zp(x \<oplus> y)) (ord_Zp x)"
	+ proof-
	+ have 0: "x \<oplus> y \<noteq> x"
	+ using assms nonzero_memE
	+ by (simp add: nonzero_closed nonzero_memE(2))
	+ have 1: "x \<oplus> y \<in> nonzero Zp"
	+ using ord_Zp_not_equal_imp_notequal[of x y]
	+ nonzero_closed assms(1) assms(2) assms(3)
	+ not_nonzero_Zp by force
	+ then show ?thesis
	+ using 0 assms(1) assms(2) assms(3) ord_Zp_ultrametric_diff[of "x \<oplus> y" x]
	+ by (simp add: R.minus_eq nonzero_closed R.r_neg1 add_comm)
	+ qed
	+ then show ?thesis
	+ using 0 assms(3)
	+ by linarith
	+qed
	+
	+lemma(in padic_integers) ord_Zp_ultrametric_eq':
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "ord_Zp x > (ord_Zp y)"
	+ shows "ord_Zp (x \<ominus> y) = ord_Zp y"
	+ using assms ord_Zp_ultrametric_eq[of x "\<ominus> y"]
	+ unfolding a_minus_def
	+ by (metis R.add.inv_closed R.add.inv_eq_1_iff nonzero_closed not_nonzero_Zp ord_Zp_of_a_inv)
	+
	+lemma(in padic_integers) ord_Zp_ultrametric_eq'':
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "ord_Zp x > (ord_Zp y)"
	+ shows "ord_Zp (y \<ominus> x) = ord_Zp y"
	+ by (metis R.add.inv_closed R.minus_eq
	+ nonzero_closed Zp_def add_comm
	+ assms(1) assms(2) assms(3)
	+ ord_Zp_of_a_inv ord_of_nonzero(2)
	+ ord_pos padic_integers.ord_Zp_ultrametric_eq padic_integers_axioms)
	+
	+lemma(in padic_integers) ord_Zp_not_equal_ord_plus_minus:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ assumes "ord_Zp x \<noteq> (ord_Zp y)"
	+ shows "ord_Zp (x \<ominus> y) = ord_Zp (x \<oplus> y)"
	+ apply(cases "ord_Zp x > ord_Zp y")
	+ using assms
	+ apply (simp add: ord_Zp_ultrametric_eq ord_Zp_ultrametric_eq')
	+ using assms nonzero_memI
	+ by (smt add_comm ord_Zp_ultrametric_eq ord_Zp_ultrametric_eq'')
	+
	+text\<open>val is multiplicative on nonzero elements\<close>
	+
	+lemma(in padic_integers) val_Zp_mult0:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ assumes "y \<in> carrier Zp"
	+ assumes "y \<noteq>\<zero>"
	+ shows "(val_Zp (x \<otimes>\<^bsub>Zp\<^esub> y)) = (val_Zp x) + (val_Zp y)"
	+ apply(cases "x \<otimes>\<^bsub>Zp\<^esub> y = \<zero>")
	+ using assms(1) assms(2) assms(3) assms(4) integral_iff val_ord_Zp ord_Zp_mult nonzero_memI
	+ apply (simp add: integral_iff)
	+ using assms ord_Zp_mult[of x y] val_ord_Zp
	+ by (simp add: nonzero_memI)
	+
	+text\<open>val is multiplicative everywhere\<close>
	+lemma(in padic_integers) val_Zp_mult:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ shows "(val_Zp (x \<otimes>\<^bsub>Zp\<^esub> y)) = (val_Zp x) + (val_Zp y)"
	+ using assms(1) assms(2) integral_iff val_ord_Zp ord_Zp_mult nonzero_memI val_Zp_mult0 val_Zp_def
	+ by simp
	+
	+lemma(in padic_integers) val_Zp_ultrametric0:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ assumes "y \<in> carrier Zp"
	+ assumes "y \<noteq>\<zero>"
	+ assumes "x \<oplus> y \<noteq> \<zero>"
	+ shows "min (val_Zp x) (val_Zp y) \<le> val_Zp (x \<oplus> y) "
	+ apply(cases "x \<oplus> y = \<zero>")
	+ using assms apply blast
	+ using assms ord_Zp_ultrametric[of x y] nonzero_memI val_ord_Zp[of x] val_ord_Zp[of y] val_ord_Zp[of "x \<oplus> y"]
	+ by simp
	+
	+text\<open>Unconstrained ultrametric inequality\<close>
	+
	+lemma(in padic_integers) val_Zp_ultrametric:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ shows " min (val_Zp x) (val_Zp y) \<le> val_Zp (x \<oplus> y)"
	+ apply(cases "x = \<zero>")
	+ apply (simp add: assms(2))
	+ apply(cases "y = \<zero>")
	+ apply (simp add: assms(1))
	+ apply(cases "x \<oplus> y = \<zero>")
	+ apply (simp add: val_Zp_def)
	+ using assms val_Zp_ultrametric0[of x y]
	+ by simp
	+
	+text\<open>Variants of the ultrametric inequality\<close>
	+
	+lemma (in padic_integers) val_Zp_ultrametric_diff:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ shows "val_Zp (x \<ominus> y) \<ge> min (val_Zp x) (val_Zp y)"
	+ using assms val_Zp_ultrametric[of x "\<ominus>y"] unfolding a_minus_def
	+ by (metis R.add.inv_closed R.add.inv_eq_1_iff nonzero_memI ord_Zp_def ord_Zp_of_a_inv val_Zp_def)
	+
	+lemma(in padic_integers) val_Zp_not_equal_imp_notequal:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "val_Zp x \<noteq> val_Zp y"
	+ shows "x \<noteq> y" "x \<ominus> y \<noteq>\<zero>" "x \<oplus> y \<noteq>\<zero>"
	+ using assms(3) apply auto[1]
	+ using assms(1) assms(2) assms(3) R.r_right_minus_eq apply blast
	+ by (metis R.add.inv_eq_1_iff assms(1) assms(2) assms(3) R.minus_zero R.minus_equality
	+ not_nonzero_Zp ord_Zp_def ord_Zp_of_a_inv val_ord_Zp)
	+
	+lemma(in padic_integers) val_Zp_ultrametric_eq:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "val_Zp x > val_Zp y"
	+ shows "val_Zp (x \<oplus> y) = val_Zp y"
	+ apply(cases "x \<noteq> \<zero> \<and> y \<noteq> \<zero> \<and> x \<noteq> y")
	+ using assms ord_Zp_ultrametric_eq[of x y] val_ord_Zp nonzero_memE
	+ using not_nonzero_memE val_Zp_not_equal_imp_notequal(3) apply force
	+ unfolding val_Zp_def
	+ using assms(2) assms(3) val_Zp_def by force
	+
	+lemma(in padic_integers) val_Zp_ultrametric_eq':
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "val_Zp x > (val_Zp y)"
	+ shows "val_Zp (x \<ominus> y) = val_Zp y"
	+ using assms val_Zp_ultrametric_eq[of x "\<ominus> y"]
	+ unfolding a_minus_def
	+ by (metis R.add.inv_closed R.r_neg val_Zp_not_equal_imp_notequal(3))
	+
	+lemma(in padic_integers) val_Zp_ultrametric_eq'':
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "val_Zp x > (val_Zp y)"
	+ shows "val_Zp (y \<ominus> x) = val_Zp y"
	+proof-
	+ have 0: "y \<ominus> x = \<ominus> (x \<ominus> y)"
	+ using assms(1,2) unfolding a_minus_def
	+ by (simp add: R.add.m_comm R.minus_add)
	+ have 1: "val_Zp (x \<ominus> y) = val_Zp y"
	+ using assms val_Zp_ultrametric_eq' by blast
	+ have 2: "val_Zp (x \<ominus> y) = val_Zp (y \<ominus> x)"
	+ unfolding 0 unfolding a_minus_def
	+ by(rule val_Zp_of_a_inv, rule R.ring_simprules, rule assms, rule R.ring_simprules, rule assms)
	+ show ?thesis using 1 unfolding 2 by blast
	+qed
	+
	+lemma(in padic_integers) val_Zp_not_equal_ord_plus_minus:
	+ assumes "x \<in> carrier Zp"
	+ assumes "y \<in> carrier Zp"
	+ assumes "val_Zp x \<noteq> (val_Zp y)"
	+ shows "val_Zp (x \<ominus> y) = val_Zp (x \<oplus> y)"
	+ by (metis R.add.inv_closed R.minus_eq R.r_neg R.r_zero add_comm assms(1) assms(2) assms(3) not_nonzero_Zp ord_Zp_def ord_Zp_not_equal_ord_plus_minus val_Zp_def val_Zp_not_equal_imp_notequal(3))
	+
	+ (**********************************************************************)
	+ (**********************************************************************)
	+ subsection\<open>Units of $\mathbb{Z}_p$\<close>
	+ (**********************************************************************)
	+ (**********************************************************************)
	+text\<open>Elements with valuation 0 in Zp are the units\<close>
	+
	+lemma(in padic_integers) val_Zp_0_criterion:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x 1 \<noteq> 0"
	+ shows "val_Zp x = 0"
	+ unfolding val_Zp_def
	+ using Zp_def assms(1) assms(2) ord_equals padic_set_zero_res prime
	+ by (metis One_nat_def Zp_defs(3) of_nat_0 ord_Zp_def residue_of_zero(2) zero_eint_def)
	+
	+text\<open>Units in Zp have val 0\<close>
	+
	+lemma(in padic_integers) unit_imp_val_Zp0:
	+ assumes "x \<in> Units Zp"
	+ shows "val_Zp x = 0"
	+ apply(rule val_Zp_0_criterion)
	+ apply (simp add: R.Units_closed assms)
	+ using assms residue_of_prod[of x "inv x" 1] residue_of_one(2)[of 1] R.Units_r_inv[of x]
	+ comm_monoid.UnitsI[of "R 1"] p_res_ring_1_field
	+ by (metis le_eq_less_or_eq residue_of_prod residue_times_zero_r zero_le_one zero_neq_one)
	+
	+text\<open>Elements in Zp with ord 0 are units\<close>
	+
	+lemma(in padic_integers) val_Zp0_imp_unit0:
	+ assumes "val_Zp x = 0"
	+ assumes "x \<in> carrier Zp"
	+ fixes n::nat
	+ shows "(x (Suc n)) \<in> Units (Zp_res_ring (Suc n))"
	+ unfolding val_Zp_def
	+proof-
	+ have p_res_ring: "residues (p^(Suc n))"
	+ using p_residues by blast
	+ have "\<And> n. coprime (x (Suc n)) p"
	+ proof-
	+ fix n
	+ show "coprime (x (Suc n)) p"
	+ proof-
	+ have "\<not> \<not> coprime (x (Suc n)) p"
	+ proof
	+ assume "\<not> coprime (x (Suc n)) p"
	+ then have "p dvd (x (Suc n))" using prime
	+ by (meson coprime_commute prime_imp_coprime prime_nat_int_transfer)
	+ then obtain k where "(x (Suc n)) = k*p"
	+ by fastforce
	+ then have S:"x (Suc n) mod p = 0"
	+ by simp
	+ have "x 1 = 0"
	+ proof-
	+ have "Suc n \<ge> 1"
	+ by simp
	+ then have "x 1 = p_residue 1 (x (Suc n))"
	+ using p_residue_padic_int assms(2) by presburger
	+ then show ?thesis using S
	+ by (simp add: p_residue_alt_def)
	+ qed
	+ have "x \<noteq>\<zero>"
	+ proof-
	+ have "ord_Zp x \<noteq> ord_Zp \<zero>"
	+ using Zp_def ord_Zp_def padic_val_def assms(1) ord_of_nonzero(1) R.zero_closed
	+ Zp_defs(2) val_Zp_def
	+ by auto
	+ then show ?thesis
	+ by blast
	+ qed
	+ then have "x 1 \<noteq> 0"
	+ using assms(1) assms(2) ord_suc_nonzero
	+ unfolding val_Zp_def
	+ by (simp add: ord_Zp_def zero_eint_def)
	+ then show False
	+ using \<open>x 1 = 0\<close> by blast
	+ qed
	+ then show ?thesis
	+ by auto
	+ qed
	+ qed
	+ then have "\<And> n. coprime (x (Suc n)) (p^(Suc n))"
	+ by simp
	+ then have "coprime (x (Suc n)) (p^(Suc n))"
	+ by blast
	+ then show ?thesis using assms residues.res_units_eq p_res_ring
	+ by (metis (no_types, lifting) mod_pos_pos_trivial p_residue_ring_car_memE(1)
	+ p_residue_ring_car_memE(2) residues.m_gt_one residues.mod_in_res_units residues_closed)
	+qed
	+
	+lemma(in padic_integers) val_Zp0_imp_unit0':
	+ assumes "val_Zp x = 0"
	+ assumes "x \<in> carrier Zp"
	+ assumes "(n::nat) > 0"
	+ shows "(x n) \<in> Units (Zp_res_ring n)"
	+ using assms val_Zp0_imp_unit0 gr0_implies_Suc by blast
	+
	+lemma(in cring) ring_hom_Units_inv:
	+ assumes "a \<in> Units R"
	+ assumes "cring S"
	+ assumes "h \<in> ring_hom R S"
	+ shows "h (inv a) = inv\<^bsub>S\<^esub> h a" "h a \<in> Units S"
	+proof-
	+ have 0:"h (inv a) \<otimes>\<^bsub>S\<^esub> h a = \<one>\<^bsub>S\<^esub>"
	+ using assms Units_closed Units_inv_closed
	+ by (metis (no_types, lifting) Units_l_inv ring_hom_mult ring_hom_one)
	+ then show 1: "h (inv a) = inv\<^bsub>S\<^esub> h a"
	+ by (metis Units_closed Units_inv_closed assms(1) assms(2) assms(3) comm_monoid.is_invI(1) cring_def ring_hom_closed)
	+ show "h a \<in> Units S"
	+ apply(rule comm_monoid.UnitsI[of S "inv\<^bsub>S\<^esub> h a"]) using 0 1 assms
	+ using cring.axioms(2) apply blast
	+ apply (metis "1" Units_inv_closed assms(1) assms(3) ring_hom_closed)
	+ apply (meson Units_closed assms(1) assms(3) ring_hom_closed)
	+ using "0" "1" by auto
	+qed
	+
	+lemma(in padic_integers) val_Zp_0_imp_unit:
	+ assumes "val_Zp x = 0"
	+ assumes "x \<in> carrier Zp"
	+ shows "x \<in> Units Zp"
	+proof-
	+ obtain y where y_def: " y= (\<lambda>n. (if n=0 then 0 else (m_inv (Zp_res_ring n) (x n))))"
	+ by blast
	+ have 0: "\<And>m. m > 0 \<Longrightarrow> y m = inv \<^bsub>Zp_res_ring m\<^esub> (x m)"
	+ using y_def by auto
	+ have 1: "\<And>m. m > 0 \<Longrightarrow> inv\<^bsub>Zp_res_ring m\<^esub> (x m) \<in> carrier (Zp_res_ring m)"
	+ proof- fix m::nat assume A: "m > 0" then show "inv\<^bsub>Zp_res_ring m\<^esub> (x m) \<in> carrier (Zp_res_ring m)"
	+ using assms val_Zp0_imp_unit0' monoid.Units_inv_closed[of "Zp_res_ring m" "x m"]
	+ by (smt One_nat_def Zp_def Zp_defs(2) cring.axioms(1) of_nat_0 ord_Zp_def
	+ padic_integers.R_cring padic_integers.ord_suc_nonzero padic_integers.val_Zp_0_criterion padic_integers_axioms padic_val_def ring_def)
	+ qed
	+ have 2: "y \<in> padic_set p"
	+ proof(rule padic_set_memI)
	+ show 20: "\<And>m. y m \<in> carrier (residue_ring (p ^ m))"
	+ proof- fix m show "y m \<in> carrier (residue_ring (p ^ m))"
	+ apply(cases "m = 0")
	+ using y_def 0[of m] 1[of m]
	+ by(auto simp: residue_ring_def y_def)
	+ qed
	+ show "\<And>m n. m < n \<Longrightarrow> residue (p ^ m) (y n) = y m"
	+ proof- fix m n::nat assume A: "m < n"
	+ show "residue (p ^ m) (y n) = y m"
	+ proof(cases "m = 0")
	+ case True
	+ then show ?thesis
	+ by (simp add: residue_1_zero y_def)
	+ next
	+ case False
	+ have hom: "residue (p ^ m) \<in> ring_hom (Zp_res_ring n) (Zp_res_ring m)"
	+ using A False prime residue_hom_p by auto
	+ have inv: "y n = inv\<^bsub>Zp_res_ring n\<^esub> x n" using A
	+ by (simp add: False y_def)
	+ have unit: "x n \<in> Units (Zp_res_ring n)"
	+ using A False Zp_def assms(1) assms(2) val_Zp0_imp_unit0' prime
	+ by (metis gr0I gr_implies_not0)
	+ have F0: "residue (p ^ m) (x n) = x m"
	+ using A Zp_defs(3) assms(2) padic_set_res_coherent prime by auto
	+ have F1: "residue (p ^ m) (y n) = inv\<^bsub>Zp_res_ring m\<^esub> x m"
	+ using F0 R_cring A hom inv unit cring.ring_hom_Units_inv[of "Zp_res_ring n" "x n" "Zp_res_ring m" "residue (p ^ m)"]
	+ False
	+ by auto
	+ then show ?thesis
	+ by (simp add: False y_def)
	+ qed
	+ qed
	+ qed
	+ have 3: "y \<otimes> x = \<one>"
	+ proof
	+ fix m
	+ show "(y \<otimes> x) m = \<one> m"
	+ proof(cases "m=0")
	+ case True
	+ then have L: "(y \<otimes> x) m = 0"
	+ using Zp_def "1" assms(2) Zp_residue_mult_zero(1) y_def
	+ by auto
	+ have R: "\<one> m = 0"
	+ by (simp add: True cring.cring_simprules(6) domain.axioms(1) ord_Zp_one zero_below_ord)
	+ then show ?thesis using L R by auto
	+ next
	+ case False
	+ have P: "(y \<otimes> x) m = (y m) \<otimes>\<^bsub>residue_ring (p^m)\<^esub> (x m)"
	+ using Zp_def residue_of_prod by auto
	+ have "(y m) \<otimes>\<^bsub>residue_ring (p^m)\<^esub> (x m) = 1"
	+ proof-
	+ have "p^m > 1"
	+ using False prime prime_gt_1_int by auto
	+ then have "residues (p^m)"
	+ using less_imp_of_nat_less residues.intro by fastforce
	+ have "cring (residue_ring (p^m))"
	+ using residues.cring \<open>residues (p ^ m)\<close>
	+ by blast
	+ then have M: "monoid (residue_ring (p^m))"
	+ using cring_def ring_def by blast
	+ have U: "(x m) \<in> Units (residue_ring (p^m))"
	+ using False Zp_def assms(1) assms(2) padic_integers.val_Zp0_imp_unit0' padic_integers_axioms by auto
	+ have I: "y m = m_inv (residue_ring (p^m)) (x m)"
	+ by (simp add: False y_def)
	+ have "(y m) \<otimes>\<^bsub>residue_ring (p^m)\<^esub> (x m) = \<one>\<^bsub>residue_ring (p^m)\<^esub>"
	+ using M U I by (simp add: monoid.Units_l_inv)
	+ then show ?thesis
	+ using residue_ring_def by simp
	+ qed
	+ then show ?thesis
	+ using P Zp_def False residue_of_one(2) by auto
	+ qed
	+ qed
	+ have 4: "y \<in> carrier Zp"
	+ using 2 Zp_defs by auto
	+ show ?thesis
	+ apply(rule R.UnitsI[of y])
	+ using assms 4 3 by auto
	+qed
	+
	+text\<open>Definition of ord on a fraction is independent of the choice of representatives\<close>
	+
	+lemma(in padic_integers) ord_Zp_eq_frac:
	+ assumes "a \<in> nonzero Zp"
	+ assumes "b \<in> nonzero Zp"
	+ assumes "c \<in> nonzero Zp"
	+ assumes "d \<in> nonzero Zp"
	+ assumes "a \<otimes> d = b \<otimes> c"
	+ shows "(ord_Zp a) - (ord_Zp b) = (ord_Zp c) - (ord_Zp d)"
	+proof-
	+ have "ord_Zp (a \<otimes> d) = ord_Zp (b \<otimes> c)"
	+ using assms
	+ by presburger
	+ then have "(ord_Zp a) + (ord_Zp d) = (ord_Zp b) + (ord_Zp c)"
	+ using assms(1) assms(2) assms(3) assms(4) ord_Zp_mult by metis
	+ then show ?thesis
	+ by linarith
	+qed
	+
	+lemma(in padic_integers) val_Zp_eq_frac_0:
	+ assumes "a \<in> nonzero Zp"
	+ assumes "b \<in> nonzero Zp"
	+ assumes "c \<in> nonzero Zp"
	+ assumes "d \<in> nonzero Zp"
	+ assumes "a \<otimes> d = b \<otimes> c"
	+ shows "(val_Zp a) - (val_Zp b) = (val_Zp c) - (val_Zp d)"
	+proof-
	+ have 0:"(val_Zp a) - (val_Zp b) = (ord_Zp a) - (ord_Zp b)"
	+ using assms nonzero_memE Zp_defs(2) ord_Zp_def val_Zp_def by auto
	+ have 1: "(val_Zp c) - (val_Zp d) = (ord_Zp c) - (ord_Zp d)"
	+ using assms nonzero_memE val_ord_Zp[of c] val_ord_Zp[of d]
	+ by (simp add: nonzero_memE(2))
	+ then show ?thesis
	+ using "0" assms(1) assms(2) assms(3) assms(4) assms(5) ord_Zp_eq_frac
	+ by presburger
	+qed
	+
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+(***************) section\<open>Angular Component Maps on $\mathbb{Z}_p$\<close> (*******************)
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+text\<open>The angular component map on $\mathbb{Z}_p$ is just the map which normalizes a point $x \in \mathbb{Z}_p$ by mapping it to a point with valuation $0$. It is explicitly defined as the mapping $x \mapsto p^{-ord (p)}*x$ for nonzero $x$, and $0 \mapsto 0$. By composing these maps with reductions mod $p^n$ we get maps which are equal to the standard residue maps on units of $\mathbb{Z}_p$, but in general unequal elsewhere. Both the angular component map and the angular component map mod $p^n$ are homomorpshims from the multiplicative group of units of $\mathbb{Z}_p$ to the multiplicative group of units of the residue rings, and play a key role in first-order model-theoretic formalizations of the $p$-adics (see, for example \cite{10.2307/2274477}, or \cite{Denef1986}). \<close>
	+
	+
	+lemma(in cring) int_nat_pow_rep:
	+"[(k::int)]\<cdot>\<one> [^] (n::nat) = [(k^n)]\<cdot>\<one>"
	+ apply(induction n)
	+ by (auto simp: add.int_pow_pow add_pow_rdistr_int mult.commute)
	+
	+lemma(in padic_integers) p_pow_rep0:
	+ fixes n::nat
	+ shows "\<p>[^]n = [(p^n)]\<cdot>\<one>"
	+ using R.int_nat_pow_rep by auto
	+
	+lemma(in padic_integers) p_pow_nonzero:
	+ shows "(\<p>[^](n::nat)) \<in> carrier Zp"
	+ "(\<p>[^](n::nat)) \<noteq> \<zero>"
	+ apply simp
	+ using Zp_def nat_pow_nonzero domain_axioms nonzero_memE int_inc_closed ord_Zp_p
	+ padic_integers.ord_of_nonzero(2) padic_integers_axioms Zp_int_inc_closed
	+ nonzero_memE(2)
	+ by (metis ord_of_nonzero(2) zero_le_one)
	+
	+lemma(in padic_integers) p_pow_nonzero':
	+ shows "(\<p>[^](n::nat)) \<in> nonzero Zp"
	+ using nonzero_def p_pow_nonzero
	+ by (simp add: nonzero_def)
	+
	+lemma(in padic_integers) p_pow_rep:
	+ fixes n::nat
	+ shows "(\<p>[^]n) k = (p^n) mod (p^k)"
	+ by (simp add: R.int_nat_pow_rep Zp_int_inc_res)
	+
	+lemma(in padic_integers) p_pow_car:
	+ assumes " (n::int)\<ge> 0"
	+ shows "(\<p>[^]n) \<in> carrier Zp"
	+proof-
	+ have "(\<p>[^]n) = (\<p>[^](nat n))"
	+ by (metis assms int_nat_eq int_pow_int)
	+ then show ?thesis
	+ by simp
	+qed
	+
	+lemma(in padic_integers) p_int_pow_nonzero:
	+ assumes "(n::int) \<ge>0"
	+ shows "(\<p>[^]n) \<in> nonzero Zp"
	+ by (metis assms not_nonzero_Zp ord_Zp_p_int_pow ord_of_nonzero(1) p_pow_car)
	+
	+lemma(in padic_integers) p_nonzero:
	+ shows "\<p> \<in> nonzero Zp"
	+ using p_int_pow_nonzero[of 1]
	+ by (simp add: ord_Zp_p ord_of_nonzero(2))
	+
	+text\<open>Every element of Zp is a unit times a power of p.\<close>
	+
	+lemma(in padic_integers) residue_factor_unique:
	+ assumes "k>0"
	+ assumes "x \<in> carrier Zp"
	+ assumes "u \<in> carrier (Zp_res_ring k) \<and> (u* p^m) = (x (m+k))"
	+ shows "u = (THE u. u \<in> carrier (Zp_res_ring k) \<and> (u* p^m) = (x (m+k)))"
	+proof-
	+ obtain P where
	+ P_def: "P = (\<lambda> u. u \<in> carrier (Zp_res_ring k) \<and> (u* p^m) = (x (m+k)))"
	+ by simp
	+ have 0: "P u"
	+ using P_def assms(3) by blast
	+ have 1: "\<And> v. P v \<Longrightarrow> v = u"
	+ by (metis P_def assms(3) mult_cancel_right
	+ not_prime_0 power_not_zero prime)
	+ have "u = (THE u. P u)"
	+ by (metis 0 1 the_equality)
	+ then show ?thesis using P_def
	+ by blast
	+qed
	+
	+lemma(in padic_integers) residue_factor_exists:
	+ assumes "m = nat (ord_Zp x)"
	+ assumes "k > 0"
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ obtains u where "u \<in> carrier (Zp_res_ring k) \<and> (u* p^m) = (x (m+k))"
	+proof-
	+ have X0: "(x (m+k)) \<in> carrier (Zp_res_ring (m+k)) "
	+ using Zp_def assms(3) padic_set_res_closed residues_closed
	+ by blast
	+ then have X1: "(x (m+k)) \<ge> 0"
	+ using p_residues assms(2) residues.res_carrier_eq by simp
	+ then have X2: "(x (m+k)) > 0"
	+ using assms(1) assms(2) assms(3) assms(4) above_ord_nonzero
	+ by (metis add.right_neutral add_cancel_right_right
	+ add_gr_0 int_nat_eq less_add_same_cancel1
	+ less_imp_of_nat_less not_gr_zero of_nat_0_less_iff of_nat_add ord_pos)
	+ have 0: "x m = 0"
	+ using Zp_def assms(1) assms(3) zero_below_val ord_nat zero_below_ord[of x m]
	+ assms(4) ord_Zp_def by auto
	+ then have 1: "x (m +k) mod p^m = 0"
	+ using assms(2) assms(3) p_residue_padic_int residue_def
	+ by (simp add: p_residue_alt_def)
	+ then have "\<exists> u. u*(p^m) = (x (m+k))"
	+ by auto
	+ then obtain u where U0: " u*(p^m) = (x (m+k))"
	+ by blast
	+ have I: "(p^m) > 0 "
	+ using prime
	+ by (simp add: prime_gt_0_int)
	+ then have U1: "(u* p^m) = (x (m+k))"
	+ by (simp add: U0)
	+ have U2: "u \<ge> 0"
	+ using I U1 X1
	+ by (metis U0 less_imp_triv mult.right_neutral mult_less_cancel_left
	+ of_nat_zero_less_power_iff power.simps(1) times_int_code(1))
	+ have X3: "(x (m+k)) < p^(m+k)"
	+ using assms(3) X0 p_residues assms(2) residues.res_carrier_eq by auto
	+ have U3: "u < p^k"
	+ proof(rule ccontr)
	+ assume "\<not> u < (p ^ k)"
	+ then have "(p^k) \<le> u"
	+ by simp
	+ then have " (p^k * p^m) \<le> u*(p^m)"
	+ using I by simp
	+ then have "p^(m + k) \<le> (x (m+k))"
	+ by (simp add: U0 add.commute semiring_normalization_rules(26))
	+ then show False
	+ using X3 by linarith
	+ qed
	+ then have "u \<in> carrier (Zp_res_ring k)"
	+ using assms(2) p_residues residues.res_carrier_eq U3 U2 by auto
	+ then show ?thesis using U1 that by blast
	+qed
	+
	+definition(in padic_integers) normalizer where
	+"normalizer m x = (\<lambda>k. if (k=0) then 0 else (THE u. u \<in> carrier (Zp_res_ring k) \<and> (u* p^m) = (x (m + k)) ) )"
	+
	+definition(in padic_integers) ac_Zp where
	+"ac_Zp x = normalizer (nat (ord_Zp x)) x"
	+
	+lemma(in padic_integers) ac_Zp_equation:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ assumes "k > 0"
	+ assumes "m = nat (ord_Zp x)"
	+ shows "(ac_Zp x k) \<in> carrier (Zp_res_ring k) \<and> (ac_Zp x k)*(p^m) = (x (m+k))"
	+proof-
	+ have K0: "k >0"
	+ using assms nat_neq_iff by blast
	+ have KM: "m+ k > m"
	+ using assms(3) assms(4) by linarith
	+ obtain u where U0: "u \<in> carrier (Zp_res_ring k) \<and> (u* p^m) = (x (m+k))"
	+ using assms(1) assms(2) assms(3) assms(4) residue_factor_exists by blast
	+ have RHS: "ac_Zp x k = (THE u. u \<in> carrier (Zp_res_ring k) \<and> u*(p^m) = (x (m+k)))"
	+ proof-
	+ have K: "k \<noteq>0"
	+ by (simp add: K0)
	+ have "ac_Zp x k = normalizer (nat (ord_Zp x)) x k"
	+ using ac_Zp_def by presburger
	+ then have "ac_Zp x k = normalizer m x k"
	+ using assms by blast
	+ then show "ac_Zp x k = (THE u. u \<in> carrier (Zp_res_ring k) \<and> (u* p^m) = (x (m + k)) ) "
	+ using K unfolding normalizer_def p_residue_def
	+ by simp
	+ qed
	+ have LHS:"u = (THE u. u \<in> carrier (Zp_res_ring k) \<and> u*(p^m) = (x (m+k)))"
	+ using assms U0 K0 assms(1) residue_factor_unique[of k x u m] by metis
	+ then have "u = ac_Zp x k"
	+ by (simp add: RHS)
	+ then show ?thesis using U0 by auto
	+qed
	+
	+lemma(in padic_integers) ac_Zp_res:
	+ assumes "m >k"
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ shows "p_residue k (ac_Zp x m) = (ac_Zp x k)"
	+proof(cases "k =0")
	+ case True
	+ then show ?thesis
	+ unfolding ac_Zp_def normalizer_def
	+ by (meson p_res_ring_0' p_residue_range')
	+next
	+ case False
	+ obtain n where n_def: "n = nat (ord_Zp x)"
	+ by blast
	+ have K0: "k >0" using False by simp
	+ obtain uk where Uk0: "uk = (ac_Zp x k)"
	+ by simp
	+ obtain um where Um0: "um = (ac_Zp x m)"
	+ by simp
	+ have Uk1: "uk \<in> carrier (Zp_res_ring k) \<and> uk*(p^n) = (x (n+k))"
	+ using K0 Uk0 ac_Zp_equation assms(2) assms(3) n_def by metis
	+ have Um1: "um \<in> carrier (Zp_res_ring m) \<and> um*(p^n) = (x (n+m))"
	+ using Uk1 Um0 ac_Zp_equation assms(1) assms(3) n_def assms(2)
	+ by (metis neq0_conv not_less0)
	+ have "um mod (p^k) = uk"
	+ proof-
	+ have "(x (n+m)) mod (p^(n + k)) = (x (n+k))"
	+ using assms(1) assms(3) p_residue_padic_int p_residue_def n_def
	+ by (simp add: assms(2) p_residue_alt_def)
	+ then have "(p^(n + k)) dvd (x (n+m)) - (x (n+k))"
	+ by (metis dvd_minus_mod)
	+ then obtain d where "(x (n+m)) - (x (n+k)) = (p^(n+k))*d"
	+ using dvd_def by blast
	+ then have "((um(p^n)) - (uk(p^n))) = p^(n+k)*d"
	+ using Uk1 Um1 by auto
	+ then have "((um - uk)(p^n)) = p^(n+k)d"
	+ by (simp add: left_diff_distrib)
	+ then have "((um - uk)(p^n)) = ((p^k)d)*(p^n)"
	+ by (simp add: power_add)
	+ then have "(um - uk) = ((p^k)*d)"
	+ using prime by auto
	+ then have "um mod p^k = uk mod p^k"
	+ by (simp add: mod_eq_dvd_iff)
	+ then show ?thesis using Uk1
	+ by (metis mod_pos_pos_trivial p_residue_ring_car_memE(1) p_residue_ring_car_memE(2))
	+ qed
	+ then show ?thesis
	+ by (simp add: Uk0 Um0 p_residue_alt_def)
	+qed
	+
	+lemma(in padic_integers) ac_Zp_in_Zp:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ shows "ac_Zp x \<in> carrier Zp"
	+proof-
	+ have "ac_Zp x \<in> padic_set p"
	+ proof(rule padic_set_memI)
	+ show "\<And>m. ac_Zp x m \<in> carrier (residue_ring (p ^ m))"
	+ proof-
	+ fix m
	+ show "ac_Zp x m \<in> carrier (residue_ring (p ^ m))"
	+ proof(cases "m = 0")
	+ case True
	+ then have "ac_Zp x m = 0"
	+ unfolding ac_Zp_def normalizer_def by auto
	+ then show ?thesis
	+ by (simp add: True residue_ring_def)
	+ next
	+ case False
	+ then have "m>0"
	+ by blast
	+ then show ?thesis
	+ using ac_Zp_equation
	+ by (metis assms(1) assms(2))
	+ qed
	+ qed
	+ show "\<And>m n. m < n \<Longrightarrow> residue (p ^ m) (ac_Zp x n) = ac_Zp x m"
	+ using ac_Zp_res
	+ by (simp add: assms(1) assms(2) p_residue_def)
	+ qed
	+ then show ?thesis
	+ by (simp add: Zp_defs(3))
	+qed
	+
	+lemma(in padic_integers) ac_Zp_is_Unit:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ shows "ac_Zp x \<in> Units Zp"
	+proof(rule val_Zp_0_imp_unit)
	+ show "ac_Zp x \<in> carrier Zp"
	+ by (simp add: ac_Zp_in_Zp assms(1) assms(2))
	+ obtain m where M: "m = nat (ord_Zp x)"
	+ by blast
	+ have AC1: "(ac_Zp x 1)*(p^m) = (x (m+1))"
	+ using M ac_Zp_equation assms(1) assms(2)
	+ by (metis One_nat_def lessI)
	+ have "(x (m+1)) \<noteq>0"
	+ using M assms
	+ by (metis Suc_eq_plus1 Suc_le_eq nat_int nat_mono nat_neq_iff ord_Zp_geq)
	+ then have "(ac_Zp x 1) \<noteq> 0"
	+ using AC1 by auto
	+ then show "val_Zp (ac_Zp x) = 0"
	+ using \<open>ac_Zp x \<in> carrier Zp\<close> val_Zp_0_criterion
	+ by blast
	+qed
	+
	+text\<open>The typical defining equation for the angular component map.\<close>
	+
	+lemma(in padic_integers) ac_Zp_factors_x:
	+ assumes "x \<in> carrier Zp"
	+ assumes "x \<noteq>\<zero>"
	+ shows "x = (\<p>[^](nat (ord_Zp x))) \<otimes> (ac_Zp x)" "x = (\<p>[^](ord_Zp x)) \<otimes> (ac_Zp x)"
	+proof-
	+ show "x = (\<p>[^](nat (ord_Zp x)))\<otimes> (ac_Zp x)"
	+ proof
	+ fix k
	+ show "x k = ((\<p>[^](nat (ord_Zp x))) \<otimes> (ac_Zp x)) k"
	+ proof(cases "k=0")
	+ case True
	+ then show ?thesis
	+ using Zp_def Zp_defs(3) Zp_residue_mult_zero(1) ac_Zp_in_Zp
	+ assms(1) assms(2) mult_comm padic_set_zero_res prime by auto
	+ next
	+ case False
	+ show ?thesis
	+ proof(cases "k \<le> ord_Zp x")
	+ case True
	+ have 0: "x k = 0"
	+ using True assms(1) zero_below_ord by blast
	+ have 1: "(\<p>[^](nat (ord_Zp x))) k = 0"
	+ using True assms(1) assms(2) ord_Zp_p_pow ord_nat p_pow_nonzero(1) zero_below_ord
	+ by presburger
	+ have "((\<p>[^](nat (ord_Zp x))) \<otimes> (ac_Zp x)) k = (\<p>[^](nat (ord_Zp x))) k * (ac_Zp x) k mod p^k"
	+ using Zp_def padic_mult_res residue_ring_def
	+ using residue_of_prod' by blast
	+ then have "((\<p>[^](nat (ord_Zp x))) \<otimes> (ac_Zp x)) k = 0"
	+ by (simp add: "1")
	+ then show ?thesis using 0
	+ by metis
	+ next
	+ case False
	+ obtain n where N: "n = nat (ord_Zp x)"
	+ by metis
	+ obtain m where M0: "k = n + m"
	+ using False N le_Suc_ex ord_Zp_def by fastforce
	+ have M1: "m >0"
	+ using M0 False N assms(1) assms(2) ord_nat
	+ by (metis Nat.add_0_right gr0I le_refl less_eq_int_code(1)
	+ nat_eq_iff2 neq0_conv of_nat_eq_0_iff of_nat_mono)
	+ have E1: "(ac_Zp x m)*(p^n) = (x k)"
	+ using M0 M1 N ac_Zp_equation assms(1) assms(2) by blast
	+ have E2: "(ac_Zp x k)*(p^n) = (x (n + k))"
	+ using M0 M1 N ac_Zp_equation assms(1) assms(2) add_gr_0
	+ by presburger
	+ have E3: "((ac_Zp x k) mod (p^k))*((p^n) mod p^k) mod (p^k) = (x (n + k)) mod (p^k)"
	+ by (metis E2 mod_mult_left_eq mod_mult_right_eq)
	+ have E4: "((ac_Zp x k) mod (p^k))*(p^n) mod (p^k) = (x k)"
	+ using E2 assms(1) le_add2 mod_mult_left_eq p_residue_padic_int p_residue_def
	+ by (metis Zp_int_inc_rep Zp_int_inc_res)
	+
	+ have E5: "(ac_Zp x k)*((p^n) mod p^k) mod (p^k) = (x k)"
	+ using E2 assms(1) p_residue_padic_int p_residue_def by (metis E3 E4 mod_mult_left_eq)
	+ have E6: "(ac_Zp x k) \<otimes>\<^bsub>(Zp_res_ring k)\<^esub> ((p^n) mod p^k) = (x k)"
	+ using E5 M0 M1 p_residues residues.res_mult_eq by auto
	+ have E7: " ((p^n) mod p^k) \<otimes>\<^bsub>(Zp_res_ring k)\<^esub>(ac_Zp x k) = (x k)"
	+ by (simp add: E6 residue_mult_comm)
	+ have E8: "((\<p>[^](nat (ord_Zp x))) k) \<otimes>\<^bsub>(Zp_res_ring k)\<^esub> (ac_Zp x k) = (x k)"
	+ using E7 N p_pow_rep
	+ by metis
	+ then show ?thesis
	+ by (simp add: residue_of_prod)
	+ qed
	+ qed
	+ qed
	+ then show "x = (\<p>[^](ord_Zp x)) \<otimes> (ac_Zp x)"
	+ by (metis assms(1) assms(2) int_pow_int ord_nat)
	+qed
	+
	+lemma(in padic_integers) ac_Zp_factors':
	+ assumes "x \<in> nonzero Zp"
	+ shows "x = [p] \<cdot> \<one> [^] ord_Zp x \<otimes> ac_Zp x"
	+ using assms nonzero_memE
	+ by (simp add: nonzero_closed nonzero_memE(2) ac_Zp_factors_x(2))
	+
	+lemma(in padic_integers) ac_Zp_mult:
	+ assumes "x \<in> nonzero Zp"
	+ assumes "y \<in> nonzero Zp"
	+ shows "ac_Zp (x \<otimes> y) = (ac_Zp x) \<otimes> (ac_Zp y)"
	+proof-
	+ have P0: "x = (\<p>[^](nat (ord_Zp x))) \<otimes> (ac_Zp x)"
	+ using nonzero_memE ac_Zp_factors_x assms(1)
	+ by (simp add: nonzero_closed nonzero_memE(2))
	+ have P1: "y = (\<p>[^](nat (ord_Zp y))) \<otimes> (ac_Zp y)"
	+ using nonzero_memE ac_Zp_factors_x assms(2)
	+ by (simp add: nonzero_closed nonzero_memE(2))
	+
	+ have "x \<otimes> y = (\<p>[^](nat (ord_Zp (x \<otimes> y)))) \<otimes> (ac_Zp (x \<otimes> y))"
	+ proof-
	+ have "x \<otimes> y \<in> nonzero Zp"
	+ by (simp add: assms(1) assms(2) nonzero_mult_closed)
	+ then show ?thesis
	+ using nonzero_closed nonzero_memE(2) Zp_def
	+ padic_integers.ac_Zp_factors_x(1) padic_integers_axioms
	+ by blast
	+ qed
	+ then have "x \<otimes> y = (\<p>[^](nat ((ord_Zp x) + (ord_Zp y)))) \<otimes> (ac_Zp (x \<otimes> y))"
	+ using assms ord_Zp_mult[of x y]
	+ by (simp add: Zp_def)
	+ then have "x \<otimes> y = (\<p>[^]((nat (ord_Zp x)) + nat (ord_Zp y))) \<otimes> (ac_Zp (x \<otimes> y))"
	+ using nonzero_closed nonzero_memE(2) assms(1) assms(2)
	+ nat_add_distrib ord_pos by auto
	+ then have "x \<otimes> y = (\<p>[^](nat (ord_Zp x))) \<otimes> (\<p>[^](nat(ord_Zp y))) \<otimes> (ac_Zp (x \<otimes> y))"
	+ using p_natpow_prod
	+ by metis
	+ then have P2: "(\<p>[^](nat (ord_Zp x))) \<otimes> (\<p>[^](nat(ord_Zp y))) \<otimes> (ac_Zp (x \<otimes> y))
	+ = ((\<p>[^](nat (ord_Zp x))) \<otimes> (ac_Zp x)) \<otimes> ((\<p>[^](nat (ord_Zp y))) \<otimes> (ac_Zp y))"
	+ using P0 P1
	+ by metis
	+ have "(\<p>[^](nat (ord_Zp x))) \<otimes> (\<p>[^](nat(ord_Zp y))) \<otimes> (ac_Zp (x \<otimes> y))
	+ = ((\<p>[^](nat (ord_Zp x))) \<otimes> ((\<p>[^](nat (ord_Zp y))) \<otimes> (ac_Zp x)) \<otimes> (ac_Zp y))"
	+ by (metis P0 P1 Zp_def \<open>x \<otimes> y = [p] \<cdot> \<one> [^] nat (ord_Zp x) \<otimes> [p] \<cdot> \<one> [^] nat (ord_Zp y) \<otimes> ac_Zp (x \<otimes> y)\<close>
	+ mult_comm padic_integers.mult_assoc padic_integers_axioms)
	+ then have "((\<p>[^](nat (ord_Zp x))) \<otimes> (\<p>[^](nat(ord_Zp y)))) \<otimes> (ac_Zp (x \<otimes> y))
	+ =((\<p>[^](nat (ord_Zp x))) \<otimes> (\<p>[^](nat(ord_Zp y)))) \<otimes> ((ac_Zp x) \<otimes> (ac_Zp y))"
	+ using Zp_def mult_assoc by auto
	+ then show ?thesis
	+ by (metis (no_types, lifting) R.m_closed
	+ \<open>x \<otimes> y = [p] \<cdot> \<one> [^] nat (ord_Zp x) \<otimes> [p] \<cdot> \<one> [^] nat (ord_Zp y) \<otimes> ac_Zp (x \<otimes> y)\<close>
	+ ac_Zp_in_Zp assms(1) assms(2) integral_iff m_lcancel
	+ nonzero_closed nonzero_memE(2) p_pow_nonzero(1))
	+qed
	+
	+lemma(in padic_integers) ac_Zp_one:
	+"ac_Zp \<one> = \<one>"
	+ by (metis R.one_closed Zp_def ac_Zp_factors_x(2) int_pow_0 ord_Zp_one padic_integers.ac_Zp_in_Zp padic_integers_axioms padic_one_id prime zero_not_one)
	+
	+lemma(in padic_integers) ac_Zp_inv:
	+ assumes "x \<in> Units Zp"
	+ shows "ac_Zp (inv\<^bsub>Zp\<^esub> x) = inv\<^bsub>Zp\<^esub> (ac_Zp x)"
	+proof-
	+ have "x \<otimes> (inv\<^bsub>Zp\<^esub> x) = \<one>"
	+ using assms by simp
	+ then have "(ac_Zp x) \<otimes> (ac_Zp (inv\<^bsub>Zp\<^esub> x)) = ac_Zp \<one>"
	+ using ac_Zp_mult[of x "(inv x)"] R.Units_nonzero
	+ assms zero_not_one by auto
	+ then show ?thesis
	+ using R.invI(2)[of "(ac_Zp x)" "(ac_Zp (inv\<^bsub>Zp\<^esub> x))"] assms ac_Zp_in_Zp ac_Zp_one
	+ by (metis (no_types, lifting) R.Units_closed R.Units_inv_closed
	+ R.Units_r_inv integral_iff R.inv_unique ac_Zp_is_Unit)
	+qed
	+
	+lemma(in padic_integers) ac_Zp_of_Unit:
	+ assumes "val_Zp x = 0"
	+ assumes "x \<in> carrier Zp"
	+ shows "ac_Zp x = x"
	+ using assms unfolding val_Zp_def
	+ by (metis R.one_closed Zp_def ac_Zp_factors_x(2) ac_Zp_one eint.inject infinity_ne_i0 mult_assoc
	+ ord_Zp_def ord_Zp_one padic_integers.ac_Zp_in_Zp padic_integers_axioms padic_one_id prime zero_eint_def zero_not_one)
	+
	+lemma(in padic_integers) ac_Zp_p:
	+"(ac_Zp \<p>) = \<one>"
	+proof-
	+ have 0: "\<p> = \<p> [^] nat (ord_Zp \<p>) \<otimes> ac_Zp \<p>"
	+ using ac_Zp_factors_x[of \<p>] ord_Zp_p ord_of_nonzero(1)
	+ by auto
	+ have 1: "\<p> [^] nat (ord_Zp \<p>) = \<p>"
	+ by (metis One_nat_def nat_1 ord_Zp_p p_pow_rep0 power_one_right)
	+ then have 2: "\<p> = \<p> \<otimes> ac_Zp \<p>"
	+ using "0" by presburger
	+ have "ac_Zp \<p> \<in> carrier Zp"
	+ using ac_Zp_in_Zp[of \<p>]
	+ by (simp add: ord_Zp_p ord_of_nonzero(1))
	+ then show ?thesis
	+ by (metis "1" "2" m_lcancel R.one_closed R.r_one
	+ Zp_int_inc_closed p_pow_nonzero(2))
	+qed
	+
	+lemma(in padic_integers) ac_Zp_p_nat_pow:
	+"(ac_Zp (\<p> [^] (n::nat))) = \<one>"
	+ apply(induction n)
	+ apply (simp add: ac_Zp_one)
	+ using ac_Zp_mult ac_Zp_p int_nat_pow_rep nat_pow_Suc2 R.nat_pow_one
	+ R.one_closed p_natpow_prod_Suc(1) p_nonzero p_pow_nonzero' p_pow_rep0
	+ by auto
	+
	+text\<open>Facts for reasoning about integer powers in an arbitrary commutative monoid:\<close>
	+
	+lemma(in monoid) int_pow_add:
	+ fixes n::int
	+ fixes m::int
	+ assumes "a \<in> Units G"
	+ shows "a [^] (n + m) = (a [^] n) \<otimes> (a [^] m)"
	+proof-
	+ have 0: "group (units_of G)"
	+ by (simp add: units_group)
	+ have 1: "a \<in> carrier (units_of G)"
	+ by (simp add: assms units_of_carrier)
	+ have "\<And>n::int. a [^] n = a [^]\<^bsub>units_of G\<^esub> n"
	+ proof- fix k::int show "a [^] k = a [^]\<^bsub>units_of G\<^esub> k" using 1 assms units_of_pow
	+ by (metis Units_pow_closed int_pow_def nat_pow_def units_of_inv units_of_pow)
	+ qed
	+ have 2: "a [^]\<^bsub>units_of G\<^esub> (n + m) = (a [^]\<^bsub>units_of G\<^esub> n) \<otimes>\<^bsub>units_of G\<^esub> (a [^]\<^bsub>units_of G\<^esub> m)"
	+ by (simp add: "1" group.int_pow_mult units_group)
	+ show ?thesis using 0 1 2
	+ by (simp add: \<open>\<And>n. a [^] n = a [^]\<^bsub>units_of G\<^esub> n\<close> units_of_mult)
	+qed
	+
	+lemma(in monoid) int_pow_unit_closed:
	+ fixes n::int
	+ assumes "a \<in> Units G"
	+ shows "a[^] n \<in> Units G"
	+ apply(cases "n \<ge> 0")
	+ using units_of_def[of G] units_group Units_inv_Units[of a]
	+ Units_pow_closed[of "inv a"] Units_pow_closed[of a]
	+ apply (metis assms pow_nat)
	+ using units_of_def[of G] units_group Units_inv_Units[of a]
	+ Units_pow_closed[of "inv a"] Units_pow_closed[of a]
	+ by (simp add: assms int_pow_def nat_pow_def)
	+
	+lemma(in monoid) nat_pow_of_inv:
	+ fixes n::nat
	+ assumes "a \<in> Units G"
	+ shows "inv a[^] n = inv (a[^] n)"
	+ by (metis (no_types, hide_lams) Units_inv_Units Units_inv_closed Units_inv_inv Units_pow_closed
	+ Units_r_inv assms inv_unique' nat_pow_closed nat_pow_one pow_mult_distrib)
	+
	+lemma(in monoid) int_pow_of_inv:
	+ fixes n::int
	+ assumes "a \<in> Units G"
	+ shows "inv a[^] n = inv (a[^] n)"
	+ apply(cases "n \<ge>0")
	+ apply (metis assms nat_pow_of_inv pow_nat)
	+ by (metis assms int_pow_def2 nat_pow_of_inv)
	+
	+lemma(in monoid) int_pow_inv:
	+ fixes n::int
	+ assumes "a \<in> Units G"
	+ shows "a[^] -n = inv a[^] n"
	+ apply(cases "n =0")
	+ apply simp
	+ apply(cases "n > 0")
	+ using int_pow_def2[of G a "-n"] int_pow_of_inv
	+ apply (simp add: assms)
	+ using assms int_pow_def2[of G a "-n"] int_pow_def2[of G a "n"] int_pow_def2[of G "inv a"]
	+ int_pow_of_inv[of a n] Units_inv_Units[of a] Units_inv_inv Units_pow_closed[of a]
	+ by (metis linorder_not_less nat_0_iff nat_eq_iff2 nat_zero_as_int neg_0_less_iff_less)
	+
	+lemma(in monoid) int_pow_inv':
	+ fixes n::int
	+ assumes "a \<in> Units G"
	+ shows "a[^] -n = inv (a[^] n)"
	+ by (simp add: assms int_pow_inv int_pow_of_inv)
	+
	+lemma(in comm_monoid) inv_of_prod:
	+ assumes "a \<in> Units G"
	+ assumes "b \<in> Units G"
	+ shows "inv (a \<otimes> b) = (inv a) \<otimes> (inv b)"
	+ by (metis Units_m_closed assms(1) assms(2) comm_monoid.m_comm comm_monoid_axioms
	+ group.inv_mult_group monoid.Units_inv_closed monoid_axioms units_group
	+ units_of_carrier units_of_inv units_of_mult)
	+
	+
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+(**********)section\<open>Behaviour of $val\_Zp$ and $ord\_Zp$ on Natural Numbers and Integers\<close> (*********)
	+(*************************************************************************************************)
	+(*************************************************************************************************)
	+
	+text\<open>If f and g have an equal residue at k, then they differ by a multiple of $p^k$.\<close>
	+lemma(in padic_integers) eq_residue_mod:
	+ assumes "f \<in> carrier Zp"
	+ assumes "g \<in> carrier Zp"
	+ assumes "f k = g k"
	+ shows "\<exists>h. h \<in> carrier Zp \<and> f = g \<oplus> (\<p>[^]k)\<otimes>h"
	+proof(cases "f = g")
	+ case True
	+ then show ?thesis
	+ using Zp_int_inc_zero' assms(1) by auto
	+next
	+ case False
	+ have "(f \<ominus> g) k = 0"
	+ using assms
	+ by (metis R.r_right_minus_eq residue_of_diff residue_of_zero(2))
	+ then have "ord_Zp (f \<ominus> g) \<ge> k"
	+ using False assms
	+ by (simp add: ord_Zp_geq)
	+ then obtain m::int where m_def: "m \<ge> 0 \<and> ord_Zp (f \<ominus> g) = k + m"
	+ using zle_iff_zadd by auto
	+ have "f \<ominus> g = \<p>[^](k + m) \<otimes> ac_Zp (f \<ominus> g)"
	+ using ac_Zp_factors_x(2)[of "f \<ominus> g"] False m_def assms(1) assms(2) by auto
	+ then have 0: "f \<ominus> g = \<p>[^]k \<otimes> \<p> [^] m \<otimes> ac_Zp (f \<ominus> g)"
	+ by (simp add: Zp_def m_def padic_integers.p_natintpow_prod padic_integers_axioms)
	+ have "\<p>[^]k \<otimes> \<p> [^] m \<otimes> ac_Zp (f \<ominus> g) \<in> carrier Zp"
	+ using assms "0" by auto
	+ then have "f = g \<oplus> \<p>[^]k \<otimes> \<p> [^] m \<otimes> ac_Zp (f \<ominus> g)"
	+ using 0 assms R.ring_simprules
	+ by simp
	+ then show ?thesis using mult_assoc
	+ by (metis "0" False R.m_closed R.r_right_minus_eq \<open>[p] \<cdot> \<one> [^] k \<otimes> [p] \<cdot> \<one> [^] m \<otimes> ac_Zp (f \<ominus> g) \<in> carrier Zp\<close> ac_Zp_in_Zp assms(1) assms(2) m_def p_pow_car)
	+qed
	+
	+lemma(in padic_integers) eq_residue_mod':
	+ assumes "f \<in> carrier Zp"
	+ assumes "g \<in> carrier Zp"
	+ assumes "f k = g k"
	+ obtains h where "h \<in> carrier Zp \<and> f = g \<oplus> (\<p>[^]k)\<otimes>h"
	+ using assms eq_residue_mod by meson
	+
	+text\<open>Valuations of integers which do not divide $p$:\<close>
	+
	+lemma(in padic_integers) ord_Zp_p_nat_unit:
	+ assumes "(n::nat) mod p \<noteq> 0"
	+ shows "ord_Zp ([n]\<cdot>\<one>) = 0"
	+ using ord_equals[of "[n]\<cdot>\<one>" "0::nat"]
	+ by (simp add: Zp_nat_inc_res assms)
	+
	+lemma(in padic_integers) val_Zp_p_nat_unit:
	+ assumes "(n::nat) mod p \<noteq> 0"
	+ shows "val_Zp ([n]\<cdot>\<one>) = 0"
	+ unfolding val_Zp_def
	+ using assms ord_Zp_def ord_Zp_p_nat_unit ord_of_nonzero(1) zero_eint_def by auto
	+
	+lemma(in padic_integers) nat_unit:
	+ assumes "(n::nat) mod p \<noteq> 0"
	+ shows "([n]\<cdot>\<one>) \<in> Units Zp "
	+ using Zp_nat_mult_closed val_Zp_p_nat_unit
	+ by (simp add: assms val_Zp_0_imp_unit ord_Zp_p_nat_unit)
	+
	+lemma(in padic_integers) ord_Zp_p_int_unit:
	+ assumes "(n::int) mod p \<noteq> 0"
	+ shows "ord_Zp ([n]\<cdot>\<one>) = 0"
	+ by (metis One_nat_def Zp_int_inc_closed Zp_int_inc_res assms mod_by_1 of_nat_0 ord_equals power_0 power_one_right)
	+
	+lemma(in padic_integers) val_Zp_p_int_unit:
	+ assumes "(n::int) mod p \<noteq> 0"
	+ shows "val_Zp ([n]\<cdot>\<one>) = 0"
	+ unfolding val_Zp_def
	+ using assms ord_Zp_def ord_Zp_p_int_unit ord_of_nonzero(1) zero_eint_def by auto
	+
	+lemma(in padic_integers) int_unit:
	+ assumes "(n::int) mod p \<noteq> 0"
	+ shows "([n]\<cdot>\<one>) \<in> Units Zp "
	+ by (simp add: assms val_Zp_0_imp_unit val_Zp_p_int_unit)
	+
	+lemma(in padic_integers) int_decomp_ord:
	+ assumes "n = l*(p^k)"
	+ assumes "l mod p \<noteq> 0"
	+ shows "ord_Zp ([n]\<cdot>\<one>) = k"
	+proof-
	+ have 0: "n = l * (p^k)"
	+ using assms(1)
	+ by simp
	+ then have "(l * (p ^ k) mod (p ^ (Suc k))) \<noteq> 0"
	+ using Zp_def Zp_nat_inc_zero assms(2) p_nonzero nonzero_memE
	+ padic_integers_axioms R.int_inc_zero nonzero_memE(2) by auto
	+ then have 3: "(l * p ^ k) mod (p ^ (Suc k)) \<noteq> 0"
	+ by presburger
	+ show ?thesis
	+ using "0" "3" Zp_int_inc_res ord_equals by auto
	+qed
	+
	+lemma(in padic_integers) int_decomp_val:
	+ assumes "n = l*(p^k)"
	+ assumes "l mod p \<noteq> 0"
	+ shows "val_Zp ([n]\<cdot>\<one>) = k"
	+ using Zp_def assms(1) assms(2) R.int_inc_closed ord_of_nonzero(1) int_decomp_ord padic_integers_axioms val_ord_Zp
	+ by auto
	+
	+text\<open>$\mathbb{Z}_p$ has characteristic zero:\<close>
	+
	+lemma(in padic_integers) Zp_char_0:
	+ assumes "(n::int) > 0"
	+ shows "[n]\<cdot>\<one> \<noteq> \<zero>"
	+proof-
	+ have "prime (nat p)"
	+ using prime prime_nat_iff_prime
	+ by blast
	+ then obtain l0 k where 0: "nat n = l0*((nat p)^k) \<and> \<not> (nat p) dvd l0 "
	+ using prime assms prime_power_canonical[of "nat p" "nat n"]
	+ by auto
	+ obtain l where l_def: "l = int l0"
	+ by blast
	+ have 1: "n = l*(p^k) \<and> \<not> p dvd l "
	+ using 0 l_def
	+ by (smt assms int_dvd_int_iff int_nat_eq of_nat_mult of_nat_power prime prime_gt_0_int)
	+ show ?thesis
	+ apply(cases "l = 1")
	+ using 1 p_pow_nonzero(2) p_pow_rep0 apply auto[1]
	+ using 1 by (simp add: dvd_eq_mod_eq_0 int_decomp_ord ord_of_nonzero(1))
	+qed
	+
	+lemma(in padic_integers) Zp_char_0':
	+ assumes "(n::nat) > 0"
	+ shows "[n]\<cdot>\<one> \<noteq> \<zero>"
	+proof-
	+ have "[n]\<cdot>\<one> = [(int n)]\<cdot>\<one>"
	+ using assms
	+ by (simp add: add_pow_def int_pow_int)
	+ then show ?thesis using assms Zp_char_0[of "int n"]
	+ by simp
	+qed
	+
	+lemma (in domain) not_eq_diff_nonzero:
	+ assumes "a \<noteq> b"
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in>carrier R"
	+ shows "a \<ominus> b \<in> nonzero R"
	+ by (simp add: nonzero_def assms(1) assms(2) assms(3))
	+
	+lemma (in domain) minus_a_inv:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ shows "a \<ominus> b = \<ominus> (b \<ominus> a)"
	+ by (simp add: add.inv_mult_group assms(1) assms(2) minus_eq)
	+
	+lemma(in ring) plus_diff_simp:
	+ assumes "a \<in> carrier R"
	+ assumes "b \<in> carrier R"
	+ assumes "c \<in> carrier R"
	+ assumes "X = a \<ominus> b"
	+ assumes "Y = c \<ominus> a"
	+ shows "X \<oplus> Y = c \<ominus> b"
	+ using assms
	+ unfolding a_minus_def
	+ using ring_simprules
	+ by (simp add: r_neg r_neg2)
	+
	+lemma (in padic_integers) Zp_residue_eq:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "val_Zp (a \<ominus> b) > k"
	+ shows "(a k) = (b k)"
	+proof-
	+ have 0: "(a \<ominus> b) k = a k \<ominus>\<^bsub>Zp_res_ring k\<^esub> b k"
	+ using assms
	+ by (simp add: residue_of_diff)
	+ have 1: "(a \<ominus> b) k = 0"
	+ using assms zero_below_val
	+ by (smt R.minus_closed Zp_def eint_ord_simps(2) padic_integers.p_res_ring_zero
	+ padic_integers.residue_of_zero(1) padic_integers.val_ord_Zp padic_integers.zero_below_ord padic_integers_axioms)
	+ show ?thesis
	+ apply(cases "k = 0")
	+ apply (metis assms(1) assms(2) p_res_ring_0' residues_closed)
	+ using 0 1 assms p_residues R_cring Zp_def assms(1) assms(2) cring_def padic_set_res_closed
	+ residues.res_zero_eq ring.r_right_minus_eq
	+ by (metis Zp_defs(3) linorder_neqE_nat not_less0 p_res_ring_zero)
	+qed
	+
	+lemma (in padic_integers) Zp_residue_eq2:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "(a k) = (b k)"
	+ assumes "a \<noteq> b"
	+ shows "val_Zp (a \<ominus> b) \<ge> k"
	+proof-
	+ have "(a \<ominus> b) k = 0"
	+ using assms residue_of_diff
	+ by (simp add: Zp_def padic_integers.residue_of_diff' padic_integers_axioms)
	+ then show ?thesis
	+ using assms(1) assms(2) ord_Zp_def ord_Zp_geq val_Zp_def by auto
	+qed
	+
	+lemma (in padic_integers) equal_val_Zp:
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "c \<in> carrier Zp"
	+ assumes "val_Zp a = val_Zp b"
	+ assumes "val_Zp (c \<ominus> a) > val_Zp b"
	+ shows "val_Zp c = val_Zp b"
	+proof-
	+ have 0: "val_Zp c = val_Zp (c \<ominus> a \<oplus> a)"
	+ using assms
	+ by (simp add: R.l_neg R.minus_eq add_assoc)
	+ have "val_Zp c \<ge> min (val_Zp (c \<ominus> a)) (val_Zp a)"
	+ using val_Zp_ultrametric[of "(c \<ominus> a)" a] assms(1)
	+ assms(3) ord_Zp_ultrametric_eq''
	+ by (simp add: "0")
	+ then have 1: "val_Zp c \<ge> (val_Zp a)"
	+ by (metis assms(4) assms(5) dual_order.order_iff_strict less_le_trans min_le_iff_disj)
	+ have "val_Zp c = (val_Zp a)"
	+ proof(rule ccontr)
	+ assume A: "val_Zp c \<noteq> val_Zp a"
	+ then have 0: "val_Zp c > val_Zp a"
	+ using 1 A by auto
	+ then have "val_Zp (c \<oplus> (a \<ominus> c)) \<ge> min (val_Zp c) (val_Zp (a \<ominus> c))"
	+ by (simp add: assms(1) assms(3) val_Zp_ultrametric)
	+ then have 1: "val_Zp a \<ge> min (val_Zp c) (val_Zp (a \<ominus> c))"
	+ using assms(1) assms(3) assms(4) assms(5) val_Zp_ultrametric_eq' 0 by auto
	+ have 2: "val_Zp (a \<ominus> c) > val_Zp a"
	+ using "0" assms(1) assms(3) assms(4) assms(5)
	+ val_Zp_ultrametric_eq' by auto
	+ then have "val_Zp a > val_Zp a"
	+ using 0 1 2 val_Zp_of_a_inv
	+ by (metis assms(1) assms(3) assms(4) assms(5) val_Zp_ultrametric_eq')
	+ then show False
	+ by blast
	+ qed
	+ then show ?thesis
	+ using assms(4)
	+ by simp
	+qed
	+
	+lemma (in padic_integers) equal_val_Zp':
	+ assumes "a \<in> carrier Zp"
	+ assumes "b \<in> carrier Zp"
	+ assumes "c \<in> carrier Zp"
	+ assumes "val_Zp a = val_Zp b"
	+ assumes "val_Zp c > val_Zp b"
	+ shows "val_Zp (a \<oplus> c) = val_Zp b"
	+proof-
	+ have 0: "val_Zp b < val_Zp (a \<oplus> c \<ominus> a)"
	+ by (simp add: R.minus_eq nonzero_closed R.r_neg1 add_comm assms(1) assms(3) assms(5))
	+ have 1: "val_Zp a \<noteq> val_Zp (\<ominus> c)"
	+ using assms(3) assms(4) assms(5)
	+ by (metis eq_iff not_less val_Zp_of_a_inv)
	+ then show ?thesis
	+ by (meson "0" R.semiring_axioms assms(1) assms(2) assms(3) assms(4) equal_val_Zp semiring.semiring_simprules(1))
	+qed
	+
	+lemma (in padic_integers) val_Zp_of_minus:
	+ assumes "a \<in> carrier Zp"
	+ shows "val_Zp a = val_Zp (\<ominus> a)"
	+ using assms not_nonzero_Zp ord_Zp_def ord_Zp_of_a_inv val_Zp_def
	+ by auto
	+
	+end
	diff --git a/thys/Padic_Ints/ROOT b/thys/Padic_Ints/ROOT
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/ROOT
	@@ -0,0 +1,21 @@
	+chapter AFP
	+
	+session Padic_Ints (AFP) = "HOL-Algebra" +
	+ options [timeout = 1200]
	+ sessions
	+ "HOL-Number_Theory"
	+ theories
	+ Function_Ring
	+ Cring_Poly
	+ Supplementary_Ring_Facts
	+ Extended_Int
	+ Padic_Construction
	+ Padic_Integers
	+ Padic_Int_Topology
	+ Padic_Int_Polynomials
	+ Hensels_Lemma
	+ Zp_Compact
	+ document_files
	+ "root.tex"
	+ "root.bib"
	+
	diff --git a/thys/Padic_Ints/Supplementary_Ring_Facts.thy b/thys/Padic_Ints/Supplementary_Ring_Facts.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Supplementary_Ring_Facts.thy
	@@ -0,0 +1,160 @@
	+theory Supplementary_Ring_Facts
	+imports "HOL-Algebra.Ring"
	+ "HOL-Algebra.UnivPoly"
	+ "HOL-Algebra.Subrings"
	+
	+begin
	+
	+section\<open>Supplementary Ring Facts\<close>
	+
	+text\<open>The nonzero elements of a ring.\<close>
	+
	+definition nonzero :: "('a, 'b) ring_scheme \<Rightarrow> 'a set" where
	+"nonzero R = {a \<in> carrier R. a \<noteq> \<zero>\<^bsub>R\<^esub>}"
	+
	+
	+lemma zero_not_in_nonzero:
	+"\<zero>\<^bsub>R\<^esub> \<notin> nonzero R"
	+ unfolding nonzero_def by blast
	+
	+lemma(in domain) nonzero_memI:
	+ assumes "a \<in> carrier R"
	+ assumes "a \<noteq> \<zero>"
	+ shows "a \<in> nonzero R"
	+ using assms by(simp add: nonzero_def)
	+
	+lemma(in domain) nonzero_memE:
	+ assumes "a \<in> nonzero R"
	+ shows "a \<in> carrier R" "a \<noteq>\<zero>"
	+ using assms by(auto simp: nonzero_def)
	+
	+lemma(in domain) not_nonzero_memE:
	+ assumes "a \<notin> nonzero R"
	+ assumes "a \<in> carrier R"
	+ shows "a = \<zero>"
	+ using assms
	+ by (simp add: nonzero_def)
	+
	+lemma(in domain) not_nonzero_memI:
	+ assumes "a = \<zero>"
	+ shows "a \<notin> nonzero R"
	+ using assms nonzero_memE(2) by auto
	+
	+lemma(in domain) nonzero_closed:
	+ assumes "a \<in> nonzero R"
	+ shows "a \<in> carrier R"
	+ using assms
	+ by (simp add: nonzero_def)
	+
	+lemma(in domain) nonzero_mult_in_car:
	+ assumes "a \<in> nonzero R"
	+ assumes "b \<in> nonzero R"
	+ shows "a \<otimes> b \<in> carrier R"
	+ using assms
	+ by (simp add: nonzero_def)
	+
	+lemma(in domain) nonzero_mult_closed:
	+ assumes "a \<in> nonzero R"
	+ assumes "b \<in> nonzero R"
	+ shows "a \<otimes> b \<in> nonzero R"
	+ apply(rule nonzero_memI)
	+ using assms nonzero_memE apply blast
	+ using assms nonzero_memE
	+ by (simp add: integral_iff)
	+
	+lemma(in domain) nonzero_one_closed:
	+"\<one> \<in> nonzero R"
	+ by (simp add: nonzero_def)
	+
	+lemma(in domain) one_nonzero:
	+"\<one> \<in> nonzero R"
	+ by (simp add: nonzero_one_closed)
	+
	+lemma(in domain) nat_pow_nonzero:
	+ assumes "x \<in>nonzero R"
	+ shows "x[^](n::nat) \<in> nonzero R"
	+ unfolding nonzero_def
	+ apply(induction n)
	+ using assms integral_iff nonzero_closed zero_not_in_nonzero by auto
	+
	+lemma(in monoid) Units_int_pow_closed:
	+ assumes "x \<in> Units G"
	+ shows "x[^](n::int) \<in> Units G"
	+ by (metis Units_pow_closed assms int_pow_def2 monoid.Units_inv_Units monoid_axioms)
	+
	+lemma(in comm_monoid) UnitsI:
	+ assumes "a \<in> carrier G"
	+ assumes "b \<in> carrier G"
	+ assumes "a \<otimes> b = \<one>"
	+ shows "a \<in> Units G" "b \<in> Units G"
	+ unfolding Units_def using comm_monoid_axioms_def assms m_comm[of a b]
	+ by auto
	+
	+lemma(in comm_monoid) is_invI:
	+ assumes "a \<in> carrier G"
	+ assumes "b \<in> carrier G"
	+ assumes "a \<otimes> b = \<one>"
	+ shows "inv\<^bsub>G\<^esub> b = a" "inv\<^bsub>G\<^esub> a = b"
	+ using assms inv_char m_comm
	+ by auto
	+
	+lemma(in ring) ring_in_Units_imp_not_zero:
	+ assumes "\<one> \<noteq> \<zero>"
	+ assumes "a \<in> Units R"
	+ shows "a \<noteq> \<zero>"
	+ using assms monoid.Units_l_cancel
	+ by (metis l_null monoid_axioms one_closed zero_closed)
	+
	+lemma(in ring) Units_nonzero:
	+ assumes "u \<in> Units R"
	+ assumes "\<one>\<^bsub>R\<^esub> \<noteq> \<zero>\<^bsub>R\<^esub>"
	+ shows "u \<in> nonzero R"
	+proof-
	+ have "u \<in>carrier R"
	+ using Units_closed assms by auto
	+ have "u \<noteq>\<zero>"
	+ using Units_r_inv_ex assms(1) assms(2)
	+ by force
	+ thus ?thesis
	+ by (simp add: \<open>u \<in> carrier R\<close> nonzero_def)
	+qed
	+
	+
	+lemma(in ring) Units_inverse:
	+ assumes "u \<in> Units R"
	+ shows "inv u \<in> Units R"
	+ by (simp add: assms)
	+
	+lemma(in cring) invI:
	+ assumes "x \<in> carrier R"
	+ assumes "y \<in> carrier R"
	+ assumes "x \<otimes>\<^bsub>R\<^esub> y = \<one>\<^bsub>R\<^esub>"
	+ shows "y = inv \<^bsub>R\<^esub> x"
	+ "x = inv \<^bsub>R\<^esub> y"
	+ using assms(1) assms(2) assms(3) is_invI
	+ by auto
	+
	+lemma(in cring) inv_cancelR:
	+ assumes "x \<in> Units R"
	+ assumes "y \<in> carrier R"
	+ assumes "z \<in> carrier R"
	+ assumes "y = x \<otimes>\<^bsub>R\<^esub> z"
	+ shows "inv\<^bsub>R\<^esub> x \<otimes>\<^bsub>R\<^esub> y = z"
	+ "y \<otimes>\<^bsub>R\<^esub> (inv\<^bsub>R\<^esub> x) = z"
	+ apply (metis Units_closed assms(1) assms(3) assms(4) cring.cring_simprules(12)
	+ is_cring m_assoc monoid.Units_inv_closed monoid.Units_l_inv monoid_axioms)
	+ by (metis Units_closed assms(1) assms(3) assms(4) m_assoc m_comm monoid.Units_inv_closed
	+ monoid.Units_r_inv monoid.r_one monoid_axioms)
	+
	+lemma(in cring) inv_cancelL:
	+ assumes "x \<in> Units R"
	+ assumes "y \<in> carrier R"
	+ assumes "z \<in> carrier R"
	+ assumes "y = z \<otimes>\<^bsub>R\<^esub> x"
	+ shows "inv\<^bsub>R\<^esub> x \<otimes>\<^bsub>R\<^esub> y = z"
	+ "y \<otimes>\<^bsub>R\<^esub> (inv\<^bsub>R\<^esub> x) = z"
	+ apply (simp add: Units_closed assms(1) assms(3) assms(4) m_lcomm)
	+ by (simp add: Units_closed assms(1) assms(3) assms(4) m_assoc)
	+
	+
	+end
	diff --git a/thys/Padic_Ints/Zp_Compact.thy b/thys/Padic_Ints/Zp_Compact.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/Zp_Compact.thy
	@@ -0,0 +1,767 @@
	+theory Zp_Compact
	+imports Padic_Int_Topology
	+begin
	+
	+context padic_integers
	+begin
	+
	+lemma res_ring_car:
	+"carrier (Zp_res_ring k) = {0..p ^ k - 1}"
	+ unfolding residue_ring_def by simp
	+
	+text\<open>The refinement of a sequence by a function $nat \Rightarrow nat$\<close>
	+definition take_subseq :: "(nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow> 'a)" where
	+"take_subseq s f = (\<lambda>k. s (f k))"
	+
	+text\<open>Predicate for increasing function on the natural numbers\<close>
	+definition is_increasing :: "(nat \<Rightarrow> nat) \<Rightarrow> bool" where
	+"is_increasing f = (\<forall> n m::nat. n>m \<longrightarrow> (f n) > (f m))"
	+
	+text\<open>Elimination and introduction lemma for increasing functions\<close>
	+lemma is_increasingI:
	+ assumes "\<And> n m::nat. n>m \<Longrightarrow> (f n) > (f m)"
	+ shows "is_increasing f"
	+ unfolding is_increasing_def
	+ using assms
	+ by blast
	+
	+lemma is_increasingE:
	+ assumes "is_increasing f"
	+ assumes " n> m"
	+ shows "f n > f m"
	+ using assms
	+ unfolding is_increasing_def
	+ by blast
	+
	+text\<open>The subsequence predicate\<close>
	+definition is_subseq_of :: "(nat \<Rightarrow> 'a) \<Rightarrow> (nat \<Rightarrow> 'a) \<Rightarrow> bool" where
	+"is_subseq_of s s' = (\<exists>(f::nat \<Rightarrow> nat). is_increasing f \<and> s' = take_subseq s f)"
	+
	+text\<open>Subsequence introduction lemma\<close>
	+lemma is_subseqI:
	+ assumes "is_increasing f"
	+ assumes "s' = take_subseq s f"
	+ shows "is_subseq_of s s'"
	+ using assms
	+ unfolding is_subseq_of_def
	+ by auto
	+
	+lemma is_subseq_ind:
	+ assumes "is_subseq_of s s'"
	+ shows "\<exists> l. s' k = s l"
	+ using assms
	+ unfolding is_subseq_of_def take_subseq_def by blast
	+
	+lemma is_subseq_closed:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "is_subseq_of s s'"
	+ shows "s' \<in> closed_seqs Zp"
	+ apply(rule closed_seqs_memI)
	+ using is_subseq_ind assms closed_seqs_memE
	+ by metis
	+
	+text\<open>Given a sequence and a predicate, returns the function from nat to nat which represents
	+the increasing sequences of indices n on which P (s n) holds.\<close>
	+
	+primrec seq_filter :: "(nat \<Rightarrow>'a) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat" where
	+"seq_filter s P (0::nat) = (LEAST k::nat. P (s k))"\|
	+"seq_filter s P (Suc n) = (LEAST k:: nat. (P (s k)) \<and> k > (seq_filter s P n))"
	+
	+lemma seq_filter_pre_increasing:
	+ assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
	+ shows "seq_filter s P n < seq_filter s P (Suc n)"
	+ apply(auto)
	+proof(induction n)
	+ case 0
	+ have "\<exists>k. P (s k)" using assms(1) by blast
	+ then have "\<exists>k::nat. (LEAST k::nat. (P (s k))) \<ge> 0"
	+ by blast
	+ obtain k where "(LEAST k::nat. (P (s k))) = k" by simp
	+ have "\<exists>l. l = (LEAST l::nat. (P (s l) \<and> l > k))"
	+ by simp
	+ thus ?case
	+ by (metis (no_types, lifting) LeastI assms)
	+next
	+ case (Suc n)
	+ then show ?case
	+ by (metis (no_types, lifting) LeastI assms)
	+qed
	+
	+lemma seq_filter_increasing:
	+ assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
	+ shows "is_increasing (seq_filter s P)"
	+ by (metis assms seq_filter_pre_increasing is_increasingI lift_Suc_mono_less)
	+
	+definition filtered_seq :: "(nat \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> 'a)" where
	+"filtered_seq s P = take_subseq s (seq_filter s P)"
	+
	+lemma filter_exist:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
	+ shows "\<And>m. n\<le>m \<Longrightarrow> P (s (seq_filter s P n))"
	+proof(induct n)
	+ case 0
	+ then show ?case
	+ using LeastI assms(2) by force
	+next
	+ case (Suc n)
	+ then show ?case
	+ by (smt LeastI assms(2) seq_filter.simps(2))
	+qed
	+
	+text\<open>In a filtered sequence, every element satisfies the filtering predicate \<close>
	+
	+lemma fil_seq_pred:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "s' = filtered_seq s P"
	+ assumes "\<forall>n::nat. \<exists>m. m > n \<and> P (s m)"
	+ shows "\<And>m::nat. P (s' m)"
	+proof-
	+ have "\<exists>k. P (s k)" using assms(3)
	+ by blast
	+ fix m
	+ obtain k where kdef: "k = seq_filter s P m" by auto
	+ have "\<exists>k. P (s k)"
	+ using assms(3) by auto
	+ then have "P (s k)"
	+ by (metis (full_types) assms(1) assms(3) kdef le_refl less_imp_triv not_less_eq filter_exist )
	+ then have "s' m = s k"
	+ by (simp add: assms(2) filtered_seq_def kdef take_subseq_def)
	+ hence "P (s' m)"
	+ by (simp add: \<open>P (s k)\<close>)
	+ thus "\<And>m. P (s' m)" using assms(2) assms(3) dual_order.strict_trans filter_exist filtered_seq_def
	+ lessI less_Suc_eq_le take_subseq_def
	+ by (metis (mono_tags, hide_lams) assms(1))
	+qed
	+
	+definition kth_res_equals :: "nat \<Rightarrow> int \<Rightarrow> (padic_int \<Rightarrow> bool)" where
	+"kth_res_equals k n a = (a k = n)"
	+
	+(The characteristic function of the underlying set of a sequence)
	+definition indicator:: "(nat \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> bool)" where
	+"indicator s a = (\<exists>n::nat. s n = a)"
	+
	+
	+text\<open>Choice function for a subsequence with constant kth residue. Could be made constructive by
	+choosing the LEAST n if we wanted.\<close>
	+
	+definition const_res_subseq :: "nat \<Rightarrow> padic_int_seq \<Rightarrow> padic_int_seq" where
	+"const_res_subseq k s = (SOME s'::(padic_int_seq). (\<exists> n. is_subseq_of s s' \<and> s'
	+ = (filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. s' m k = n)))"
	+
	+text\<open>The constant kth residue value for the sequence obtained by the previous function\<close>
	+
	+definition const_res :: "nat \<Rightarrow> padic_int_seq \<Rightarrow> int" where
	+"const_res k s = (THE n. (\<forall> m. (const_res_subseq k s) m k = n))"
	+
	+definition maps_to_n:: "int \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> bool" where
	+"maps_to_n n f = (\<forall>(k::nat). f k \<in> {0..n})"
	+
	+definition drop_res :: "int \<Rightarrow> (nat \<Rightarrow> int) \<Rightarrow> (nat \<Rightarrow> int)" where
	+"drop_res k f n = (if (f n) = k then 0 else f n)"
	+
	+lemma maps_to_nE:
	+ assumes "maps_to_n n f"
	+ shows "(f k) \<in> {0..n}"
	+ using assms
	+ unfolding maps_to_n_def
	+ by blast
	+
	+lemma maps_to_nI:
	+ assumes "\<And>n. f n \<in>{0 .. k}"
	+ shows "maps_to_n k f"
	+ using assms maps_to_n_def by auto
	+
	+
	+lemma maps_to_n_drop_res:
	+ assumes "maps_to_n (Suc n) f"
	+ shows "maps_to_n n (drop_res (Suc n) f)"
	+proof-
	+ fix k
	+ have "drop_res (Suc n) f k \<in> {0..n}"
	+ proof(cases "f k = Suc n")
	+ case True
	+ then have "drop_res (Suc n) f k = 0"
	+ unfolding drop_res_def by auto
	+ then show ?thesis
	+ using assms local.drop_res_def maps_to_n_def by auto
	+ next
	+ case False
	+ then show ?thesis
	+ using assms atLeast0_atMost_Suc maps_to_n_def drop_res_def
	+ by auto
	+ qed
	+ then have "\<And>k. drop_res (Suc n) f k \<in> {0..n}"
	+ using assms local.drop_res_def maps_to_n_def by auto
	+ then show "maps_to_n n (drop_res (Suc n) f)" using maps_to_nI
	+ using maps_to_n_def by blast
	+qed
	+
	+lemma drop_res_eq_f:
	+ assumes "maps_to_n (Suc n) f"
	+ assumes "\<not> (\<forall>m. \<exists>n. n>m \<and> (f n = (Suc k)))"
	+ shows "\<exists>N. \<forall>n. n>N \<longrightarrow> f n = drop_res (Suc k) f n"
	+proof-
	+ have "\<exists>m. \<forall>n. n \<le> m \<or> (f n) \<noteq> (Suc k)"
	+ using assms
	+ by (meson Suc_le_eq nat_le_linear)
	+ then have "\<exists>m. \<forall>n. n \<le> m \<or> (f n) = drop_res (Suc k) f n"
	+ using drop_res_def by auto
	+ then show ?thesis
	+ by (meson less_Suc_eq_le order.asym)
	+qed
	+
	+lemma maps_to_n_infinite_seq:
	+ shows "\<And>f. maps_to_n (k::nat) f \<Longrightarrow> \<exists>l::int. \<forall>m. \<exists>n. n>m \<and> (f n = l)"
	+proof(induction k)
	+ case 0
	+ then have "\<And>n. f n \<in> {0}"
	+ using maps_to_nE[of 0 f] by auto
	+ then show " \<exists>l. \<forall>m. \<exists>n. m < n \<and> f n = l"
	+ by blast
	+next
	+ case (Suc k)
	+ assume IH: "\<And>f. maps_to_n k f \<Longrightarrow> \<exists>l. \<forall>m. \<exists>n. m < n \<and> f n = l"
	+ fix f
	+ assume A: "maps_to_n (Suc k) f"
	+ show "\<exists>l. \<forall>m. \<exists>n. n>m \<and> (f n = l)"
	+ proof(cases " \<forall>m. \<exists>n. n>m \<and> (f n = (Suc k))")
	+ case True
	+ then show ?thesis by blast
	+ next
	+ case False
	+ then obtain N where N_def: "\<forall>n. n>N \<longrightarrow> f n = drop_res (Suc k) f n"
	+ using drop_res_eq_f drop_res_def
	+ by fastforce
	+ have " maps_to_n k (drop_res (Suc k) f) "
	+ using A maps_to_n_drop_res by blast
	+ then have " \<exists>l. \<forall>m. \<exists>n. m < n \<and> (drop_res (Suc k) f) n = l"
	+ using IH by blast
	+ then obtain l where l_def: "\<forall>m. \<exists>n. m < n \<and> (drop_res (Suc k) f) n = l"
	+ by blast
	+ have "\<forall>m. \<exists>n. n>m \<and> (f n = l)"
	+ apply auto
	+ proof-
	+ fix m
	+ show "\<exists>n>m. f n = l"
	+ proof-
	+ obtain n where N'_def: "(max m N) < n \<and> (drop_res (Suc k) f) n = l"
	+ using l_def by blast
	+ have "f n = (drop_res (Suc k) f) n"
	+ using N'_def N_def
	+ by simp
	+ then show ?thesis
	+ using N'_def by auto
	+ qed
	+ qed
	+ then show ?thesis
	+ by blast
	+ qed
	+qed
	+
	+lemma int_nat_p_pow_minus:
	+"int (nat (p ^ k - 1)) = p ^ k - 1"
	+ by (simp add: prime prime_gt_0_int)
	+
	+lemma maps_to_n_infinite_seq_res_ring:
	+"\<And>f. f \<in> (UNIV::nat set) \<rightarrow> carrier (Zp_res_ring k) \<Longrightarrow> \<exists>l. \<forall>m. \<exists>n. n>m \<and> (f n = l)"
	+apply(rule maps_to_n_infinite_seq[of "nat (p^k - 1)"])
	+ unfolding maps_to_n_def res_ring_car int_nat_p_pow_minus by blast
	+
	+definition index_to_residue :: "padic_int_seq \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> int" where
	+"index_to_residue s k m = ((s m) k)"
	+
	+lemma seq_maps_to_n:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "(index_to_residue s k) \<in> UNIV \<rightarrow> carrier (Zp_res_ring k)"
	+proof-
	+ have A1: "\<And>m. (s m) \<in> carrier Zp"
	+ using assms closed_seqs_memE by auto
	+ have A2: "\<And>m. (s m k) \<in> carrier (Zp_res_ring k)"
	+ using assms by (simp add: A1)
	+ have "\<And>m. index_to_residue s k m = s m k"
	+ using index_to_residue_def
	+ by auto
	+ thus "index_to_residue s k \<in> UNIV \<rightarrow> carrier (residue_ring (p ^ k))"
	+ using A2 by simp
	+qed
	+
	+lemma seq_pr_inc:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "\<exists>l. \<forall>m. \<exists>n > m. (kth_res_equals k l) (s n)"
	+proof-
	+ fix k l m
	+ have 0: "(kth_res_equals k l) (s m) \<Longrightarrow> (s m) k = l"
	+ by (simp add: kth_res_equals_def)
	+ have 1: "\<And>k m. s m k = index_to_residue s k m"
	+ by (simp add: index_to_residue_def)
	+ have 2: "(index_to_residue s k) \<in> UNIV \<rightarrow> carrier (Zp_res_ring k)"
	+ using seq_maps_to_n assms by blast
	+ have 3: "\<And>m. s m k \<in> carrier (Zp_res_ring k)"
	+ proof-
	+ fix m have 30: "s m k = index_to_residue s k m"
	+ using 1 by blast
	+ show " s m k \<in> carrier (Zp_res_ring k)"
	+ unfolding 30 using 2 by blast
	+ qed
	+ obtain j where j_def: "j = nat (p^k - 1)"
	+ by blast
	+ have j_to_int: "int j = p^k - 1"
	+ using j_def
	+ by (simp add: prime prime_gt_0_int)
	+ have "\<exists>l. \<forall>m. \<exists>n. n > m \<and> (index_to_residue s k n = l)"
	+ by(rule maps_to_n_infinite_seq_res_ring[of _ k], rule seq_maps_to_n, rule assms)
	+ hence "\<exists>l. \<forall>m. \<exists>n. n > m \<and> (s n k = l)"
	+ by (simp add: index_to_residue_def)
	+ thus "\<exists>l. \<forall>m. \<exists>n > m. (kth_res_equals k l) (s n)"
	+ using kth_res_equals_def by auto
	+qed
	+
	+lemma kth_res_equals_subseq:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "\<exists>n. is_subseq_of s (filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. (filtered_seq s (kth_res_equals k n)) m k = n)"
	+proof-
	+ obtain l where l_def: " \<forall> m. \<exists>n > m. (kth_res_equals k l) (s n)"
	+ using assms seq_pr_inc by blast
	+ have 0: "is_subseq_of s (filtered_seq s (kth_res_equals k l))"
	+ unfolding filtered_seq_def
	+ apply(rule is_subseqI[of "seq_filter s (kth_res_equals k l)"])
	+ apply(rule seq_filter_increasing, rule l_def)
	+ by blast
	+ have 1: " (\<forall>m. (filtered_seq s (kth_res_equals k l)) m k = l)"
	+ using l_def
	+ by (meson assms kth_res_equals_def fil_seq_pred padic_integers_axioms)
	+ show ?thesis using 0 1 by blast
	+qed
	+
	+lemma const_res_subseq_prop_0:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "\<exists>l. (((const_res_subseq k s) = filtered_seq s (kth_res_equals k l)) \<and> (is_subseq_of s (const_res_subseq k s)) \<and> (\<forall>m.(const_res_subseq k s) m k = l))"
	+proof-
	+ have " \<exists>n. (is_subseq_of s (filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. (filtered_seq s (kth_res_equals k n)) m k = n))"
	+ by (simp add: kth_res_equals_subseq assms)
	+ then have "\<exists>s'. (\<exists>n. (is_subseq_of s s') \<and> (s' = filtered_seq s (kth_res_equals k n)) \<and> (\<forall>m. s' m k = n))"
	+ by blast
	+ then show ?thesis
	+ using const_res_subseq_def[of k s] const_res_subseq_def someI_ex
	+ by (smt const_res_subseq_def someI_ex)
	+qed
	+
	+lemma const_res_subseq_prop_1:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "(\<forall>m.(const_res_subseq k s) m k = (const_res k s) )"
	+ using const_res_subseq_prop_0[of s] const_res_def[of k s]
	+ by (smt assms const_res_subseq_def const_res_def the_equality)
	+
	+lemma const_res_subseq:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "is_subseq_of s (const_res_subseq k s)"
	+ using assms const_res_subseq_prop_0[of s k] by blast
	+
	+lemma const_res_range:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "k > 0"
	+ shows "const_res k s \<in> carrier (Zp_res_ring k)"
	+proof-
	+ have 0: "(const_res_subseq k s) 0 \<in> carrier Zp"
	+ using const_res_subseq[of s k] is_subseq_closed[of s "const_res_subseq k s"]
	+ assms(1) closed_seqs_memE by blast
	+ have 1: "(const_res_subseq k s) 0 k \<in> carrier (Zp_res_ring k)"
	+ using 0 by simp
	+ then show ?thesis
	+ using assms const_res_subseq_prop_1[of s k]
	+ by (simp add: \<open>s \<in> closed_seqs Zp\<close>)
	+qed
	+
	+fun res_seq ::"padic_int_seq \<Rightarrow> nat \<Rightarrow> padic_int_seq" where
	+"res_seq s 0 = s"\|
	+"res_seq s (Suc k) = const_res_subseq (Suc k) (res_seq s k)"
	+
	+lemma res_seq_res:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "(res_seq s k) \<in> closed_seqs Zp"
	+ apply(induction k)
	+ apply (simp add: assms)
	+ by (simp add: const_res_subseq is_subseq_closed)
	+
	+lemma res_seq_res':
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "\<And>n. res_seq s (Suc k) n (Suc k) = const_res (Suc k) (res_seq s k)"
	+ using assms res_seq_res[of s k] const_res_subseq_prop_1[of "(res_seq s k)" "Suc k" ]
	+ by simp
	+
	+lemma res_seq_subseq:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "is_subseq_of (res_seq s k) (res_seq s (Suc k))"
	+ by (metis assms const_res_subseq_prop_0 res_seq_res
	+ res_seq.simps(2))
	+
	+lemma is_increasing_id:
	+"is_increasing (\<lambda> n. n)"
	+ by (simp add: is_increasingI)
	+
	+lemma is_increasing_comp:
	+ assumes "is_increasing f"
	+ assumes "is_increasing g"
	+ shows "is_increasing (f \<circ> g)"
	+ using assms(1) assms(2) is_increasing_def
	+ by auto
	+
	+lemma is_increasing_imp_geq_id[simp]:
	+ assumes "is_increasing f"
	+ shows "f n \<ge>n"
	+ apply(induction n)
	+ apply simp
	+ by (metis (mono_tags, lifting) assms is_increasing_def
	+ leD lessI not_less_eq_eq order_less_le_subst2)
	+
	+lemma is_subseq_ofE:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "is_subseq_of s s'"
	+ shows "\<exists>k. k \<ge> n \<and> s' n = s k"
	+proof-
	+ obtain f where "is_increasing f \<and> s' = take_subseq s f"
	+ using assms(2) is_subseq_of_def by blast
	+ then have " f n \<ge> n \<and> s' n = s (f n)"
	+ unfolding take_subseq_def
	+ by simp
	+ then show ?thesis by blast
	+qed
	+
	+
	+lemma is_subseq_of_id:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "is_subseq_of s s"
	+proof-
	+ have "s = take_subseq s (\<lambda>n. n)"
	+ unfolding take_subseq_def
	+ by auto
	+ then show ?thesis using is_increasing_id
	+ using is_subseqI
	+ by blast
	+qed
	+
	+lemma is_subseq_of_trans:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "is_subseq_of s s'"
	+ assumes "is_subseq_of s' s''"
	+ shows "is_subseq_of s s''"
	+proof-
	+ obtain f where f_def: "is_increasing f \<and> s' = take_subseq s f"
	+ using assms(2) is_subseq_of_def
	+ by blast
	+ obtain g where g_def: "is_increasing g \<and> s'' = take_subseq s' g"
	+ using assms(3) is_subseq_of_def
	+ by blast
	+ have "s'' = take_subseq s (f \<circ> g)"
	+ proof
	+ fix x
	+ show "s'' x = take_subseq s (f \<circ> g) x"
	+ using f_def g_def unfolding take_subseq_def
	+ by auto
	+ qed
	+ then show ?thesis
	+ using f_def g_def is_increasing_comp is_subseq_of_def
	+ by blast
	+qed
	+
	+lemma res_seq_subseq':
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "is_subseq_of s (res_seq s k)"
	+proof(induction k)
	+ case 0
	+ then show ?case using is_subseq_of_id
	+ by (simp add: assms)
	+next
	+ case (Suc k)
	+ fix k
	+ assume "is_subseq_of s (res_seq s k)"
	+ then show "is_subseq_of s (res_seq s (Suc k)) "
	+ using assms is_subseq_of_trans res_seq_subseq
	+ by blast
	+qed
	+
	+lemma res_seq_subseq'':
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "is_subseq_of (res_seq s n) (res_seq s (n + k))"
	+ apply(induction k)
	+ apply (simp add: assms is_subseq_of_id res_seq_res)
	+ using add_Suc_right assms is_subseq_of_trans res_seq_res res_seq_subseq by presburger
	+(**)
	+
	+definition acc_point :: "padic_int_seq \<Rightarrow> padic_int" where
	+"acc_point s k = (if (k = 0) then (0::int) else ((res_seq s k) 0 k))"
	+
	+lemma res_seq_res_1:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "res_seq s (Suc k) 0 k = res_seq s k 0 k"
	+proof-
	+ obtain n where n_def: "res_seq s (Suc k) 0 = res_seq s k n"
	+ by (metis assms is_subseq_of_def res_seq_subseq take_subseq_def)
	+ have "res_seq s (Suc k) 0 k = res_seq s k n k"
	+ using n_def by auto
	+ thus ?thesis
	+ using assms padic_integers.p_res_ring_0'
	+ padic_integers_axioms res_seq.elims residues_closed
	+ proof -
	+ have "\<forall>n. s n \<in> carrier Zp"
	+ by (simp add: assms closed_seqs_memE)
	+ then show ?thesis
	+ by (metis \<open>res_seq s (Suc k) 0 k = res_seq s k n k\<close> assms padic_integers.p_res_ring_0' padic_integers_axioms res_seq.elims res_seq_res' residues_closed)
	+ qed
	+qed
	+
	+lemma acc_point_cres:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "(acc_point s (Suc k)) = (const_res (Suc k) (res_seq s k))"
	+proof-
	+ have "Suc k > 0" by simp
	+ have "(res_seq s (Suc k)) = const_res_subseq (Suc k) (res_seq s k)"
	+ by simp
	+ then have "(const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k) = const_res (Suc k) (res_seq s k)"
	+ using assms res_seq_res' padic_integers_axioms by auto
	+ have "acc_point s (Suc k) = res_seq s (Suc k) 0 (Suc k)" using acc_point_def by simp
	+ then have "acc_point s (Suc k) = (const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k)"
	+ by simp
	+ thus ?thesis
	+ by (simp add: \<open>(const_res_subseq (Suc k) (res_seq s k)) 0 (Suc k) = const_res (Suc k) (res_seq s k)\<close>)
	+qed
	+
	+lemma acc_point_res:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "residue (p ^ k) (acc_point s (Suc k)) = acc_point s k"
	+proof(cases "k = 0")
	+ case True
	+ then show ?thesis
	+ by (simp add: acc_point_def residue_1_zero)
	+next
	+ case False
	+ assume "k \<noteq> 0" show "residue (p ^ k) (acc_point s (Suc k)) = acc_point s k"
	+ using False acc_point_def assms lessI less_imp_le nat.distinct(1) res_seq_res_1 res_seq_res
	+ Zp_defs(3) closed_seqs_memE prime by (metis padic_set_res_coherent)
	+qed
	+
	+lemma acc_point_closed:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "acc_point s \<in> carrier Zp"
	+proof-
	+ have "acc_point s \<in> padic_set p"
	+ proof(rule padic_set_memI)
	+ show "\<And>m. acc_point s m \<in> carrier (residue_ring (p ^ m))"
	+ proof-
	+ fix m
	+ show "acc_point s m \<in> carrier (residue_ring (p ^ m))"
	+ proof(cases "m = 0")
	+ case True
	+ then show ?thesis
	+ by (simp add: acc_point_def residue_ring_def)
	+ next
	+ case False
	+ assume "m \<noteq> 0"
	+ then have "acc_point s m = res_seq s m 0 m" ("res_seq s (Suc k) = const_res_subseq (Suc k) (res_seq s k)")
	+ by (simp add: acc_point_def)
	+ then show ?thesis using const_res_range[of "(const_res_subseq (m-1) s)" m] acc_point_def[of s m]
	+ by (metis False Suc_pred acc_point_cres assms const_res_range neq0_conv res_seq_res)
	+ qed
	+ qed
	+ show "\<And>m n. m < n \<Longrightarrow> residue (p ^ m) (acc_point s n) = acc_point s m"
	+ proof-
	+ fix m n::nat
	+ assume A: "m < n"
	+ show "residue (p ^ m) (acc_point s n) = acc_point s m"
	+ proof-
	+ obtain l where l_def: "l = n - m - 1"
	+ by simp
	+ have "residue (p ^ m) (acc_point s (Suc (m + l))) = acc_point s m"
	+ proof(induction l)
	+ case 0
	+ then show ?case
	+ by (simp add: acc_point_res assms)
	+ next
	+ case (Suc l)
	+ then show ?case
	+ using Zp_defs(3) acc_point_def add_Suc_right assms le_add1 closed_seqs_memE nat.distinct(1)
	+ padic_integers.prime padic_integers_axioms res_seq_res res_seq_res_1
	+ by (metis padic_set_res_coherent)
	+ qed
	+ then show ?thesis
	+ by (metis A Suc_diff_Suc Suc_eq_plus1 add_Suc_right add_diff_inverse_nat diff_diff_left
	+ l_def le_less_trans less_not_refl order_less_imp_le)
	+ qed
	+ qed
	+ qed
	+ then show ?thesis
	+ by (simp add: Zp_defs(3))
	+qed
	+
	+text\<open>Choice function for a subsequence of s which converges to a, if it exists\<close>
	+fun convergent_subseq_fun :: "padic_int_seq \<Rightarrow> padic_int \<Rightarrow> (nat \<Rightarrow> nat)" where
	+"convergent_subseq_fun s a 0 = 0"\|
	+"convergent_subseq_fun s a (Suc n) = (SOME k. k > (convergent_subseq_fun s a n)
	+ \<and> (s k (Suc n)) = a (Suc n))"
	+
	+definition convergent_subseq :: "padic_int_seq \<Rightarrow> padic_int_seq" where
	+"convergent_subseq s = take_subseq s (convergent_subseq_fun s (acc_point s))"
	+
	+lemma increasing_conv_induction_0_pre:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a = acc_point s"
	+ shows "\<exists>k > convergent_subseq_fun s a n. (s k (Suc n)) = a (Suc n)"
	+proof-
	+ obtain l::nat where "l > 0 " by blast
	+ have "is_subseq_of s (res_seq s (Suc n))"
	+ using assms(1) res_seq_subseq' by blast
	+ then obtain m where "s m = res_seq s (Suc n) l \<and> m \<ge> l"
	+ by (metis is_increasing_imp_geq_id is_subseq_of_def take_subseq_def )
	+ have "a (Suc n) = res_seq s (Suc n) 0 (Suc n)"
	+ by (simp add: acc_point_def assms(2))
	+ have "s m (Suc n) = a (Suc n)"
	+ by (metis \<open>a (Suc n) = res_seq s (Suc n) 0 (Suc n)\<close> \<open>s m = res_seq s (Suc n) l \<and> l \<le> m\<close> assms(1) res_seq_res')
	+ thus ?thesis
	+ using \<open>0 < l\<close> \<open>s m = res_seq s (Suc n) l \<and> l \<le> m\<close> less_le_trans \<open>s m (Suc n) = a (Suc n)\<close>
	+ by (metis \<open>a (Suc n) = res_seq s (Suc n) 0 (Suc n)\<close> \<open>is_subseq_of s (res_seq s (Suc n))\<close>
	+ assms(1) lessI is_subseq_ofE res_seq_res' )
	+qed
	+
	+lemma increasing_conv_subseq_fun_0:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "\<exists>s'. s' = convergent_subseq s"
	+ assumes "a = acc_point s"
	+ shows "convergent_subseq_fun s a (Suc n) > convergent_subseq_fun s a n"
	+ apply(auto)
	+proof(induction n)
	+ case 0
	+ have "convergent_subseq_fun s a 0 = 0" by simp
	+ then show ?case
	+ by (smt assms(1) assms(3) less_Suc_eq less_Suc_eq_0_disj increasing_conv_induction_0_pre padic_integers_axioms someI_ex)
	+next
	+ case (Suc k)
	+ then show ?case
	+ by (metis (mono_tags, lifting) assms(1) assms(3) increasing_conv_induction_0_pre someI_ex)
	+qed
	+
	+lemma increasing_conv_subseq_fun:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a = acc_point s"
	+ assumes "\<exists>s'. s' = convergent_subseq s"
	+ shows "is_increasing (convergent_subseq_fun s a)"
	+ by (metis assms(1) assms(2) increasing_conv_subseq_fun_0 is_increasingI lift_Suc_mono_less)
	+
	+lemma convergent_subseq_is_subseq:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "is_subseq_of s (convergent_subseq s)"
	+ using assms convergent_subseq_def increasing_conv_subseq_fun is_subseqI by blast
	+
	+lemma is_closed_seq_conv_subseq:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "(convergent_subseq s) \<in> closed_seqs Zp"
	+ by (simp add: assms convergent_subseq_def closed_seqs_memI closed_seqs_memE take_subseq_def)
	+
	+lemma convergent_subseq_res:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a = acc_point s"
	+ shows "convergent_subseq s l l = residue (p ^ l) (acc_point s l)"
	+proof-
	+ have "\<exists>k. convergent_subseq s l = s k \<and> s k l = a l"
	+ proof-
	+ have "convergent_subseq s l = s (convergent_subseq_fun s a l)"
	+ by (simp add: assms(2) convergent_subseq_def take_subseq_def)
	+ obtain k where kdef: "(convergent_subseq_fun s a l) = k"
	+ by simp
	+ have "convergent_subseq s l = s k"
	+ by (simp add: \<open>convergent_subseq s l = s (convergent_subseq_fun s a l)\<close> kdef)
	+ have "s k l = a l"
	+ proof(cases "l = 0")
	+ case True
	+ then show ?thesis
	+ using acc_point_def assms(1) assms(2)
	+ by (metis closed_seqs_memE p_res_ring_0' residues_closed)
	+ next
	+ case False
	+ have "0 < l"
	+ using False by blast
	+ then have "k > convergent_subseq_fun s a (l-1)"
	+ by (metis One_nat_def Suc_pred assms(1) assms(2) increasing_conv_subseq_fun_0 kdef)
	+ then have "s k l = a l" using kdef
	+ assms(1) assms(2) convergent_subseq_fun.simps(2) increasing_conv_induction_0_pre
	+ padic_integers_axioms someI_ex One_nat_def \<open>0 < l\<close> increasing_conv_induction_0_pre
	+ by (smt Suc_pred)
	+ then show ?thesis
	+ by simp
	+ qed
	+ then have "convergent_subseq s l = s k \<and> s k l = a l"
	+ using \<open>convergent_subseq s l = s k\<close> by blast
	+ thus ?thesis
	+ by blast
	+ qed
	+ thus ?thesis
	+ using acc_point_closed assms(1) assms(2) Zp_defs(3) prime padic_set_res_coherent by force
	+qed
	+
	+lemma convergent_subseq_res':
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "n > l"
	+ shows "convergent_subseq s n l = convergent_subseq s l l "
	+proof-
	+ have 0: "convergent_subseq s l l = residue (p ^ l) (acc_point s l)"
	+ using assms(1) convergent_subseq_res by auto
	+ have 1: "convergent_subseq s n n = residue (p ^ n) (acc_point s n)"
	+ by (simp add: assms(1) convergent_subseq_res)
	+ have 2: "convergent_subseq s n l = residue (p ^ l) (convergent_subseq s l l)"
	+ using 0 assms 1 Zp_defs(3) acc_point_closed is_closed_seq_conv_subseq
	+ closed_seqs_memE le_refl less_imp_le_nat prime
	+ by (metis padic_set_res_coherent)
	+ show ?thesis using 0 1 2 Zp_defs(3) assms(1) is_closed_seq_conv_subseq closed_seqs_memE le_refl prime
	+ by (metis padic_set_res_coherent)
	+qed
	+
	+lemma convergent_subsequence_is_convergent:
	+ assumes "s \<in> closed_seqs Zp"
	+ assumes "a = acc_point s"
	+ shows "Zp_converges_to (convergent_subseq s) (acc_point s)" (\<And>n. \<exists>N. \<forall>k > N. s k n = a n")
	+proof(rule Zp_converges_toI)
	+ show "acc_point s \<in> carrier Zp"
	+ using acc_point_closed assms by blast
	+ show "convergent_subseq s \<in> carrier (Zp\<^bsup>\<omega>\<^esup>)"
	+ using is_closed_seq_conv_subseq assms by simp
	+ show "\<And>n. \<exists>N. \<forall>k>N. convergent_subseq s k n = acc_point s n"
	+ proof-
	+ fix n
	+ show "\<exists>N. \<forall>k>N. convergent_subseq s k n = acc_point s n"
	+ proof(induction n)
	+ case 0
	+ then show ?case
	+ using acc_point_closed[of s] assms convergent_subseq_def closed_seqs_memE of_nat_0
	+ ord_pos take_subseq_def zero_below_ord is_closed_seq_conv_subseq[of s]
	+ by (metis residue_of_zero(2))
	+ next
	+ case (Suc n)
	+ have "acc_point s (Suc n) = res_seq s (Suc n) 0 (Suc n)"
	+ by (simp add: acc_point_def)
	+ obtain k where kdef: "convergent_subseq_fun s a (Suc n) = k" by simp
	+ have "Suc n > 0" by simp
	+ then have "k > (convergent_subseq_fun s a n)"
	+ using assms(1) assms(2) increasing_conv_subseq_fun_0 kdef by blast
	+ then have " k > (convergent_subseq_fun s a n) \<and> (s k (Suc n)) = a (Suc n)" using kdef
	+ by (metis (mono_tags, lifting) assms(1) assms(2) convergent_subseq_fun.simps(2) increasing_conv_induction_0_pre someI_ex)
	+ have "s k (Suc n) = a (Suc n)"
	+ using \<open>convergent_subseq_fun s a n < k \<and> s k (Suc n) = a (Suc n)\<close> by blast
	+ then have "convergent_subseq s (Suc n) (Suc n) = a (Suc n)"
	+ by (metis assms(2) convergent_subseq_def kdef take_subseq_def)
	+ then have "\<forall>l > n. convergent_subseq s l (Suc n) = a (Suc n)"
	+ using convergent_subseq_res'
	+ by (metis Suc_lessI assms(1))
	+ then show ?case
	+ using assms(2) by blast
	+ qed
	+ qed
	+qed
	+
	+theorem Zp_is_compact:
	+ assumes "s \<in> closed_seqs Zp"
	+ shows "\<exists>s'. is_subseq_of s s' \<and> (Zp_converges_to s' (acc_point s))"
	+ using assms convergent_subseq_is_subseq convergent_subsequence_is_convergent
	+ by blast
	+
	+end
	+end
	diff --git a/thys/Padic_Ints/document/root.bib b/thys/Padic_Ints/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Padic_Ints/document/root.bib
	@@ -0,0 +1,62 @@
	+
	+@Book{dummit2004abstract,
	+ author = {Dummit, David},
	+ title = {Abstract algebra},
	+ publisher = {John Wiley \& Sons, Inc},
	+ year = {2004},
	+ address = {Hoboken, NJ},
	+ isbn = {0471433349}
	+ }
	+
	+@Book{engler2005valued,
	+ author = {Engler, Antonio},
	+ title = {Valued fields},
	+ publisher = {Springer},
	+ year = {2005},
	+ address = {Berlin New York},
	+ isbn = {354024221X}
	+ }
	+
	+@misc{keithconrad, title={Hensel's Lemma}, url={https://kconrad.math.uconn.edu/blurbs/gradnumthy/hensel.pdf}, author={Conrad, Keith}}
	+
	+@inproceedings{Thi,
	+author = {Lewis, Robert Y.},
	+title = {A Formal Proof of Hensel's Lemma over the p-Adic Integers},
	+year = {2019},
	+isbn = {9781450362221},
	+publisher = {Association for Computing Machinery},
	+address = {New York, NY, USA},
	+url = {https://doi.org/10.1145/3293880.3294089},
	+doi = {10.1145/3293880.3294089},
	+abstract = {The field of p-adic numbers ℚp and the ring of p-adic integers ℤp are essential constructions of modern number theory. Hensel’s lemma, described by Gouv\^{e}a as the “most important algebraic property of the p-adic numbers,” shows the existence of roots of polynomials over ℤp provided an initial seed point. The theorem can be proved for the p-adics with significantly weaker hypotheses than for general rings. We construct ℚp and ℤp in the Lean proof assistant, with various associated algebraic properties, and formally prove a strong form of Hensel’s lemma. The proof lies at the intersection of algebraic and analytic reasoning and demonstrates how the Lean mathematical library handles such a heterogeneous topic.},
	+booktitle = {Proceedings of the 8th ACM SIGPLAN International Conference on Certified Programs and Proofs},
	+pages = {15–26},
	+numpages = {12},
	+keywords = {Hensel's lemma, formal proof, Lean, p-adic},
	+location = {Cascais, Portugal},
	+series = {CPP 2019}
	+}
	+
	+@article{10.2307/2274477,
	+ ISSN = {00224812},
	+ URL = {http://www.jstor.org/stable/2274477},
	+ author = {Johan Pas},
	+ journal = {The Journal of Symbolic Logic},
	+ number = {3},
	+ pages = {1125--1129},
	+ publisher = {Association for Symbolic Logic},
	+ title = {On the Angular Component Map Modulo P},
	+ volume = {55},
	+ year = {1990}
	+}
	+
	+@article{Denef1986,
	+author = {Denef, Jan},
	+journal = {Journal für die reine und angewandte Mathematik},
	+keywords = {rationality of Poincaré series; Macintyre's theorem; elimination of quantifiers; p-adic fields; cell decomposition theorem},
	+pages = {154-166},
	+title = {p-adic Semi-Algebraic Sets and Cell Decomposition.},
	+url = {http://eudml.org/doc/152854},
	+volume = {369},
	+year = {1986},
	+}
	diff --git a/thys/Padic_Ints/document/root.tex b/thys/Padic_Ints/document/root.tex
	new file mode 100755
	--- /dev/null
	+++ b/thys/Padic_Ints/document/root.tex
	@@ -0,0 +1,62 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym, amsmath, amssymb, amsfonts}
	+
	+% further packages required for unusual symbols (see also
	+% isabellesym.sty), use only when needed
	+
	+%\usepackage{amssymb}
	+ %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
	+ %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
	+ %\<triangleq>, \<yen>, \<lozenge>
	+
	+%\usepackage{eurosym}
	+ %for \<euro>
	+
	+%\usepackage[only,bigsqcap]{stmaryrd}
	+ %for \<Sqinter>
	+
	+%\usepackage{eufrak}
	+ %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
	+
	+%\usepackage{textcomp}
	+ %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
	+ %\<currency>
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+
	+
	+\begin{document}
	+
	+\title{$p$-adic Hensel's Lemma}
	+\author{Aaron Crighton}
	+\maketitle
	+
	+\tableofcontents
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+\begin{abstract}
	+We formalize the ring of $p$-adic integers within the framework of the HOL-Algebra library. The carrier of the ring $\mathbb{Z}_p$ is formalized as the inverse limit of the residue rings $\mathbb{Z}/p^n\mathbb{Z}$ for a fixed prime $p$. We define a locale for reasoning about $\mathbb{Z}_p$ for a fixed prime $p$, and define an integer-valued valuation, as well as an extended-integer valued valuation on $\mathbb{Z}_p$ (where $0 \in \mathbb{Z}_p$ is the unique ring element mapped to $\infty$). Basic topological facts about the $p$-adic integers are formalized, including the completeness and sequential compactness of $\mathbb{Z}_p$. Taylor expansions of polynomials over a commutative ring are defined, culminating in the formalization of Hensel's Lemma based on a proof due to Keith Conrad \cite{keithconrad}.
	+\end{abstract}
	+% generated text of all theories
	+\input{session}
	+
	+% optional bibliography
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/Progress_Tracking/Antichain.thy b/thys/Progress_Tracking/Antichain.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/Antichain.thy
	@@ -0,0 +1,150 @@
	+section\<open>Antichains\<close>
	+
	+(<)
	+theory Antichain
	+ imports
	+ Auxiliary
	+begin
	+(>)
	+
	+definition incomparable where
	+ "incomparable A = (\<forall>x \<in> A. \<forall>y \<in> A. x \<noteq> y \<longrightarrow> \<not> x < y \<and> \<not> y < x)"
	+
	+lemma incomparable_empty[simp, intro]: "incomparable {}"
	+ unfolding incomparable_def by auto
	+
	+typedef (overloaded) 'a :: order antichain =
	+ "{A :: 'a set. finite A \<and> incomparable A}"
	+ morphisms set_antichain antichain
	+ by auto
	+
	+setup_lifting type_definition_antichain
	+
	+lift_definition member_antichain :: "'a :: order \<Rightarrow> 'a antichain \<Rightarrow> bool" ("(_/ \<in>\<^sub>A _)" [51, 51] 50) is "Set.member" .
	+
	+abbreviation not_member_antichain :: "'a :: order \<Rightarrow> 'a antichain \<Rightarrow> bool" ("(_/ \<notin>\<^sub>A _)" [51, 51] 50) where
	+ "x \<notin>\<^sub>A A \<equiv> \<not> x \<in>\<^sub>A A"
	+
	+lift_definition empty_antichain :: "'a :: order antichain" ("{}\<^sub>A") is "{}" by simp
	+
	+lemma mem_antichain_nonempty[simp]: "s \<in>\<^sub>A A \<Longrightarrow> A \<noteq> {}\<^sub>A"
	+ by transfer auto
	+
	+definition "minimal_antichain A = {x \<in> A. \<not>(\<exists>y \<in> A. y < x)}"
	+
	+lemma in_minimal_antichain: "x \<in> minimal_antichain A \<longleftrightarrow> x \<in> A \<and> \<not>(\<exists>y \<in> A. y < x)"
	+ unfolding minimal_antichain_def by auto
	+
	+lemma in_antichain_minimal_antichain[simp]: "finite M \<Longrightarrow> x \<in>\<^sub>A antichain (minimal_antichain M) \<longleftrightarrow> x \<in> minimal_antichain M"
	+ apply (clarsimp simp: minimal_antichain_def member_antichain.rep_eq)
	+ apply (intro conjI iffI)
	+ apply (subst (asm) antichain_inverse)
	+ apply (simp add: incomparable_def)
	+ apply simp
	+ apply (subst (asm) antichain_inverse)
	+ apply (simp add: incomparable_def)
	+ apply simp
	+ apply (subst antichain_inverse)
	+ apply (simp add: incomparable_def)
	+ apply simp
	+ done
	+
	+lemma incomparable_minimal_antichain[simp]: "incomparable (minimal_antichain A)"
	+ unfolding incomparable_def minimal_antichain_def
	+ by auto
	+
	+lemma finite_minimal_antichain[simp]: "finite A \<Longrightarrow> finite (minimal_antichain A)"
	+ unfolding minimal_antichain_def by auto
	+
	+lemma finite_set_antichain[simp, intro]: "finite (set_antichain A)"
	+ by transfer auto
	+
	+lemma minimal_antichain_subset: "minimal_antichain A \<subseteq> A"
	+ unfolding minimal_antichain_def by auto
	+
	+lift_definition frontier :: "'t :: order zmultiset \<Rightarrow> 't antichain" is
	+ "\<lambda>M. minimal_antichain {t. zcount M t > 0}"
	+ by (auto simp: finite_subset[OF minimal_antichain_subset finite_zcount_pos])
	+
	+lemma member_frontier_pos_zmset: "t \<in>\<^sub>A frontier M \<Longrightarrow> 0 < zcount M t"
	+ by (simp add: frontier_def in_minimal_antichain)
	+
	+lemma frontier_comparable_False[simp]: "x \<in>\<^sub>A frontier M \<Longrightarrow> y \<in>\<^sub>A frontier M \<Longrightarrow> x < y \<Longrightarrow> False"
	+ by transfer (auto simp: minimal_antichain_def)
	+
	+lemma minimal_antichain_idempotent[simp]: "minimal_antichain (minimal_antichain A) = minimal_antichain A"
	+ by (auto simp: minimal_antichain_def)
	+
	+instantiation antichain :: (order) minus begin
	+lift_definition minus_antichain :: "'a antichain \<Rightarrow> 'a antichain \<Rightarrow> 'a antichain" is "(-)"
	+ by (auto simp: incomparable_def)
	+instance ..
	+end
	+
	+instantiation antichain :: (order) plus begin
	+lift_definition plus_antichain :: "'a antichain \<Rightarrow> 'a antichain \<Rightarrow> 'a antichain" is "\<lambda>M N. minimal_antichain (M \<union> N)"
	+ by (auto simp: incomparable_def minimal_antichain_def)
	+instance ..
	+end
	+
	+lemma antichain_add_commute: "(M :: 'a :: order antichain) + N = N + M"
	+ by transfer (auto simp: incomparable_def sup_commute)
	+
	+
	+lift_definition filter_antichain :: "('a :: order \<Rightarrow> bool) \<Rightarrow> 'a antichain \<Rightarrow> 'a antichain" is "Set.filter"
	+ by (auto simp: incomparable_def)
	+
	+syntax (ASCII)
	+ "_ACCollect" :: "pttrn \<Rightarrow> 'a :: order antichain \<Rightarrow> bool \<Rightarrow> 'a antichain" ("(1{_ :\<^sub>A _./ _})")
	+syntax
	+ "_ACCollect" :: "pttrn \<Rightarrow> 'a :: order antichain \<Rightarrow> bool \<Rightarrow> 'a antichain" ("(1{_ \<in>\<^sub>A _./ _})")
	+translations
	+ "{x \<in>\<^sub>A M. P}" == "CONST filter_antichain (\<lambda>x. P) M"
	+
	+
	+declare empty_antichain.rep_eq[simp]
	+
	+lemma minimal_antichain_empty[simp]: "minimal_antichain {} = {}"
	+ by (simp add: minimal_antichain_def)
	+
	+lemma minimal_antichain_singleton[simp]: "minimal_antichain {x::_ ::order} = {x}"
	+ by (auto simp: minimal_antichain_def)
	+
	+lemma minimal_antichain_nonempty:
	+ "finite A \<Longrightarrow> (t::_::order) \<in> A \<Longrightarrow> minimal_antichain A \<noteq> {}"
	+ by (auto simp: minimal_antichain_def dest: order_finite_set_exists_foundation[of _ t])
	+
	+lemma minimal_antichain_member:
	+ "finite A \<Longrightarrow> (t::_::order) \<in> A \<Longrightarrow> \<exists>t'. t' \<in> minimal_antichain A \<and> t' \<le> t"
	+ by (auto simp: minimal_antichain_def dest: order_finite_set_exists_foundation[of _ t])
	+
	+lemma minimal_antichain_union: "minimal_antichain ((A::(_ :: order) set) \<union> B) \<subseteq> minimal_antichain (minimal_antichain A \<union> minimal_antichain B)"
	+ by (auto simp: minimal_antichain_def)
	+
	+lemma ac_Diff_iff: "c \<in>\<^sub>A A - B \<longleftrightarrow> c \<in>\<^sub>A A \<and> c \<notin>\<^sub>A B"
	+ by transfer simp
	+
	+lemma ac_DiffD2: "c \<in>\<^sub>A A - B \<Longrightarrow> c \<in>\<^sub>A B \<Longrightarrow> P"
	+ by transfer simp
	+
	+lemma ac_notin_Diff: "\<not> x \<in>\<^sub>A A - B \<Longrightarrow> \<not> x \<in>\<^sub>A A \<or> x \<in>\<^sub>A B"
	+ by transfer simp
	+
	+lemma ac_eq_iff: "A = B \<longleftrightarrow> (\<forall>x. x \<in>\<^sub>A A \<longleftrightarrow> x \<in>\<^sub>A B)"
	+ by transfer auto
	+
	+lemma antichain_obtain_foundation:
	+ assumes "t \<in>\<^sub>A M"
	+ obtains s where "s \<in>\<^sub>A M \<and> s \<le> t \<and> (\<forall>u. u\<in>\<^sub>AM \<longrightarrow> \<not> u < s)"
	+ using assms unfolding member_antichain.rep_eq
	+ by - (rule order_finite_set_obtain_foundation[of "set_antichain M" t]; auto)
	+
	+lemma set_antichain1[simp]: "x \<in> set_antichain X \<Longrightarrow> x \<in>\<^sub>A X"
	+ by transfer simp
	+
	+lemma set_antichain2[simp]: "x \<in>\<^sub>A X \<Longrightarrow> x \<in> set_antichain X"
	+ by transfer simp
	+
	+(<)
	+end
	+(>)
	\ No newline at end of file
	diff --git a/thys/Progress_Tracking/Auxiliary.thy b/thys/Progress_Tracking/Auxiliary.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/Auxiliary.thy
	@@ -0,0 +1,406 @@
	+section \<open>Auxiliary Lemmas\<close>
	+
	+(<)
	+theory Auxiliary
	+ imports
	+ "HOL-Library.Multiset"
	+ "Nested_Multisets_Ordinals.Signed_Multiset"
	+ "HOL-Library.Linear_Temporal_Logic_on_Streams"
	+begin
	+(>)
	+
	+subsection\<open>General\<close>
	+
	+lemma sum_list_hd_tl:
	+ fixes xs :: "(_ :: group_add) list"
	+ shows "xs \<noteq> [] \<Longrightarrow> sum_list (tl xs) = (- hd xs) + sum_list xs"
	+ by (cases xs) simp_all
	+
	+lemma finite_distinct_bounded: "finite A \<Longrightarrow> finite {xs. distinct xs \<and> set xs \<subseteq> A}"
	+ apply (rule finite_subset[of _ "\<Union>n \<in> {0 .. card A}. {xs. length xs = n \<and> distinct xs \<and> set xs \<subseteq> A}"])
	+ subgoal by clarsimp (metis card_mono distinct_card)
	+ subgoal by auto
	+ done
	+
	+
	+subsection\<open>Sums\<close>
	+
	+lemma Sum_eq_pick_changed_elem:
	+ assumes "finite M"
	+ and "m \<in> M" "f m = g m + \<Delta>"
	+ and "\<And>n. n \<noteq> m \<and> n \<in> M \<Longrightarrow> f n = g n"
	+ shows "(\<Sum>x\<in>M. f x) = (\<Sum>x\<in>M. g x) + \<Delta>"
	+ using assms
	+proof (induct M arbitrary: m rule: finite_induct)
	+ case empty
	+ then show ?case by simp
	+next
	+ case (insert x F)
	+ then show ?case
	+ proof (cases "x=m")
	+ case True
	+ with insert have "sum f F = sum g F"
	+ by (intro sum.cong[OF refl]) force
	+ with insert True show ?thesis
	+ by (auto simp: add.commute add.left_commute)
	+ next
	+ case False
	+ with insert show ?thesis
	+ by (auto simp: add.assoc)
	+ qed
	+qed
	+
	+lemma sum_pos_ex_elem_pos: "(0::int) < (\<Sum>m\<in>M. f m) \<Longrightarrow> \<exists>m\<in>M. 0 < f m"
	+ by (meson not_le sum_nonpos)
	+
	+lemma sum_if_distrib_add: "finite A \<Longrightarrow> b \<in> A \<Longrightarrow> (\<Sum>a\<in>A. if a=b then X b + Y a else X a) = (\<Sum>a\<in>A. X a) + Y b"
	+ by (simp add: Sum_eq_pick_changed_elem)
	+
	+subsection\<open>Partial Orders\<close>
	+
	+lemma (in order) order_finite_set_exists_foundation:
	+ fixes t :: 'a
	+ assumes "finite M"
	+ and "t \<in> M"
	+ shows "\<exists>s\<in>M. s \<le> t \<and> (\<forall>u\<in>M. \<not> u < s)"
	+ using assms
	+ by (simp add: dual_order.strict_iff_order finite_has_minimal2)
	+
	+lemma order_finite_set_obtain_foundation:
	+ fixes t :: "_ :: order"
	+ assumes "finite M"
	+ and "t \<in> M"
	+ obtains s where "s \<in> M" "s \<le> t" "\<forall>u\<in>M. \<not> u < s"
	+ using assms order_finite_set_exists_foundation by blast
	+
	+subsection\<open>Multisets\<close>
	+
	+lemma finite_nonzero_count: "finite {t. count M t > 0}"
	+ using count unfolding multiset_def by auto
	+
	+lemma finite_count[simp]: "finite {t. count M t > i}"
	+ by (rule finite_subset[OF _ finite_nonzero_count[of M]]) (auto simp only: set_mset_def)
	+
	+subsection\<open>Signed Multisets\<close>
	+
	+lemma zcount_zmset_of_nonneg[simp]: "0 \<le> zcount (zmset_of M) t"
	+ by simp
	+
	+lemma finite_zcount_pos[simp]: "finite {t. zcount M t > 0}"
	+ apply transfer
	+ subgoal for M
	+ apply (rule finite_subset[OF _ finite_Un[THEN iffD2, OF conjI[OF finite_nonzero_count finite_nonzero_count]], of _ "fst M" "snd M"])
	+ apply (auto simp only: set_mset_def fst_conv snd_conv split: prod.splits)
	+ done
	+ done
	+
	+lemma finite_zcount_neg[simp]: "finite {t. zcount M t < 0}"
	+ apply transfer
	+ subgoal for M
	+ apply (rule finite_subset[OF _ finite_Un[THEN iffD2, OF conjI[OF finite_nonzero_count finite_nonzero_count]], of _ "fst M" "snd M"])
	+ apply (auto simp only: set_mset_def fst_conv snd_conv split: prod.splits)
	+ done
	+ done
	+
	+lemma pos_zcount_in_zmset: "0 < zcount M x \<Longrightarrow> x \<in>#\<^sub>z M"
	+ by (simp add: zcount_inI)
	+
	+lemma zmset_elem_nonneg: "x \<in>#\<^sub>z M \<Longrightarrow> (\<And>x. x \<in>#\<^sub>z M \<Longrightarrow> 0 \<le> zcount M x) \<Longrightarrow> 0 < zcount M x"
	+ by (simp add: order.order_iff_strict zcount_eq_zero_iff)
	+
	+lemma zero_le_sum_single: "0 \<le> zcount (\<Sum>x\<in>M. {#f x#}\<^sub>z) t"
	+ by (induct M rule: infinite_finite_induct) auto
	+
	+lemma mem_zmset_of[simp]: "x \<in>#\<^sub>z zmset_of M \<longleftrightarrow> x \<in># M"
	+ by (simp add: set_zmset_def)
	+
	+lemma mset_neg_minus: "mset_neg (abs_zmultiset (Mp,Mn)) = Mn-Mp"
	+ by (simp add: mset_neg.abs_eq)
	+
	+lemma mset_pos_minus: "mset_pos (abs_zmultiset (Mp,Mn)) = Mp-Mn"
	+ by (simp add: mset_pos.abs_eq)
	+
	+lemma mset_neg_sum_set: "(\<And>m. m \<in> M \<Longrightarrow> mset_neg (f m) = {#}) \<Longrightarrow> mset_neg (\<Sum>m\<in>M. f m) = {#}"
	+ by (induct M rule: infinite_finite_induct) auto
	+
	+lemma mset_neg_empty_iff: "mset_neg M = {#} \<longleftrightarrow> (\<forall>t. 0 \<le> zcount M t)"
	+ apply rule
	+ subgoal
	+ by (metis add.commute add.right_neutral mset_pos_as_neg zcount_zmset_of_nonneg zmset_of_empty)
	+ subgoal
	+ apply (induct rule: zmultiset.abs_induct)
	+ subgoal for y
	+ apply (induct y)
	+ apply (subst mset_neg_minus)
	+ apply transfer
	+ apply (simp add: Diff_eq_empty_iff_mset mset_subset_eqI)
	+ done
	+ done
	+ done
	+
	+lemma mset_neg_zcount_nonneg: "mset_neg M = {#} \<Longrightarrow> 0 \<le> zcount M t"
	+ by (subst (asm) mset_neg_empty_iff) simp
	+
	+lemma in_zmset_conv_pos_neg_disj: "x \<in>#\<^sub>z M \<longleftrightarrow> x \<in># mset_pos M \<or> x \<in># mset_neg M"
	+ by (metis count_mset_pos in_diff_zcount mem_zmset_of mset_pos_neg_partition nat_code(2) not_in_iff zcount_ne_zero_iff)
	+
	+lemma in_zmset_notin_mset_pos[simp]: "x \<in>#\<^sub>z M \<Longrightarrow> x \<notin># mset_pos M \<Longrightarrow> x \<in># mset_neg M"
	+ by (auto simp: in_zmset_conv_pos_neg_disj)
	+
	+lemma in_zmset_notin_mset_neg[simp]: "x \<in>#\<^sub>z M \<Longrightarrow> x \<notin># mset_neg M \<Longrightarrow> x \<in># mset_pos M"
	+ by (auto simp: in_zmset_conv_pos_neg_disj)
	+
	+lemma in_mset_pos_in_zmset: "x \<in># mset_pos M \<Longrightarrow> x \<in>#\<^sub>z M"
	+ by (auto intro: iffD2[OF in_zmset_conv_pos_neg_disj])
	+
	+lemma in_mset_neg_in_zmset: "x \<in># mset_neg M \<Longrightarrow> x \<in>#\<^sub>z M"
	+ by (auto intro: iffD2[OF in_zmset_conv_pos_neg_disj])
	+
	+lemma set_zmset_eq_set_mset_union: "set_zmset M = set_mset (mset_pos M) \<union> set_mset (mset_neg M)"
	+ by (auto dest: in_mset_pos_in_zmset in_mset_neg_in_zmset)
	+
	+lemma member_mset_pos_iff_zcount: "x \<in># mset_pos M \<longleftrightarrow> 0 < zcount M x"
	+ using not_in_iff pos_zcount_in_zmset by force
	+
	+lemma member_mset_neg_iff_zcount: "x \<in># mset_neg M \<longleftrightarrow> zcount M x < 0"
	+ by (metis member_mset_pos_iff_zcount mset_pos_uminus neg_le_0_iff_le not_le zcount_uminus)
	+
	+lemma mset_pos_mset_neg_disjoint[simp]: "set_mset (mset_pos \<Delta>) \<inter> set_mset (mset_neg \<Delta>) = {}"
	+ by (auto simp: member_mset_pos_iff_zcount member_mset_neg_iff_zcount)
	+
	+lemma zcount_sum: "zcount (\<Sum>M\<in>MM. f M) t = (\<Sum>M\<in>MM. zcount (f M) t)"
	+ by (induct MM rule: infinite_finite_induct) auto
	+
	+lemma zcount_filter_invariant: "zcount {# t'\<in>#\<^sub>zM. t'=t #} t = zcount M t"
	+ by auto
	+
	+lemma in_filter_zmset_in_zmset[simp]: "x \<in>#\<^sub>z filter_zmset P M \<Longrightarrow> x \<in>#\<^sub>z M"
	+ by (metis count_filter_zmset zcount_ne_zero_iff)
	+
	+lemma pos_filter_zmset_pos_zmset[simp]: "0 < zcount (filter_zmset P M) x \<Longrightarrow> 0 < zcount M x"
	+ by (metis (full_types) count_filter_zmset less_irrefl)
	+
	+lemma neg_filter_zmset_neg_zmset[simp]: "0 > zcount (filter_zmset P M) x \<Longrightarrow> 0 > zcount M x"
	+ by (metis (full_types) count_filter_zmset less_irrefl)
	+
	+
	+lift_definition update_zmultiset :: "'t zmultiset \<Rightarrow> 't \<Rightarrow> int \<Rightarrow> 't zmultiset" is
	+ "\<lambda>(A,B) T D.(if D>0 then (A + replicate_mset (nat D) T, B)
	+ else (A,B + replicate_mset (nat (-D)) T))"
	+ by (auto simp: equiv_zmset_def if_split)
	+
	+lemma zcount_update_zmultiset: "zcount (update_zmultiset M t n) t' = zcount M t' + (if t = t' then n else 0)"
	+ by transfer auto
	+
	+lemma (in order) order_zmset_exists_foundation:
	+ fixes t :: 'a
	+ assumes "0 < zcount M t"
	+ shows "\<exists>s. s \<le> t \<and> 0 < zcount M s \<and> (\<forall>u. 0 < zcount M u \<longrightarrow> \<not> u < s)"
	+ using assms
	+proof -
	+ let ?M = "{t. 0 < zcount M t}"
	+ from assms have "t \<in> ?M"
	+ by simp
	+ then have "\<exists>s\<in>?M. s \<le> t \<and> (\<forall>u\<in>?M. \<not> u < s)"
	+ by - (drule order_finite_set_exists_foundation[rotated 1], auto)
	+ then show ?thesis by auto
	+qed
	+
	+lemma (in order) order_zmset_exists_foundation':
	+ fixes t :: 'a
	+ assumes "0 < zcount M t"
	+ shows "\<exists>s. s \<le> t \<and> 0 < zcount M s \<and> (\<forall>u<s. zcount M u \<le> 0)"
	+ using assms order_zmset_exists_foundation
	+ by (meson le_less_linear)
	+
	+lemma (in order) order_zmset_exists_foundation_neg:
	+ fixes t :: 'a
	+ assumes "zcount M t < 0"
	+ shows "\<exists>s. s \<le> t \<and> zcount M s < 0 \<and> (\<forall>u. zcount M u < 0 \<longrightarrow> \<not> u < s)"
	+ using assms
	+proof -
	+ let ?M = "{t. zcount M t < 0}"
	+ from assms have "t \<in> ?M"
	+ by simp
	+ then have "\<exists>s\<in>?M. s \<le> t \<and> (\<forall>u\<in>?M. \<not> u < s)"
	+ by - (drule order_finite_set_exists_foundation[rotated 1], auto)
	+ then show ?thesis by auto
	+qed
	+
	+lemma (in order) order_zmset_exists_foundation_neg':
	+ fixes t :: 'a
	+ assumes "zcount M t < 0"
	+ shows "\<exists>s. s \<le> t \<and> zcount M s < 0 \<and> (\<forall>u<s. 0 \<le> zcount M u)"
	+ using assms order_zmset_exists_foundation_neg
	+ by (meson le_less_linear)
	+
	+lemma (in order) elem_order_zmset_exists_foundation:
	+ fixes x :: 'a
	+ assumes "x \<in>#\<^sub>z M"
	+ shows "\<exists>s\<in>#\<^sub>zM. s \<le> x \<and> (\<forall>u\<in>#\<^sub>zM. \<not> u < s)"
	+ by (rule order_finite_set_exists_foundation[OF finite_set_zmset, OF assms(1)])
	+
	+subsubsection\<open>Image of a Signed Multiset\<close>
	+
	+lift_definition image_zmset :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a zmultiset \<Rightarrow> 'b zmultiset" is
	+ "\<lambda>f (M, N). (image_mset f M, image_mset f N)"
	+ by (auto simp: equiv_zmset_def simp flip: image_mset_union)
	+
	+syntax (ASCII)
	+ "_comprehension_zmset" :: "'a \<Rightarrow> 'b \<Rightarrow> 'b zmultiset \<Rightarrow> 'a zmultiset" ("({#_/. _ :#z _#})")
	+syntax
	+ "_comprehension_zmset" :: "'a \<Rightarrow> 'b \<Rightarrow> 'b zmultiset \<Rightarrow> 'a zmultiset" ("({#_/. _ \<in>#\<^sub>z _#})")
	+translations
	+ "{#e. x \<in>#\<^sub>z M#}" \<rightleftharpoons> "CONST image_zmset (\<lambda>x. e) M"
	+
	+lemma image_zmset_empty[simp]: "image_zmset f {#}\<^sub>z = {#}\<^sub>z"
	+ by transfer (auto simp: equiv_zmset_def)
	+
	+lemma image_zmset_single[simp]: "image_zmset f {#x#}\<^sub>z = {#f x#}\<^sub>z"
	+ by transfer (simp add: equiv_zmset_def)
	+
	+lemma image_zmset_union[simp]: "image_zmset f (M + N) = image_zmset f M + image_zmset f N"
	+ by transfer (auto simp: equiv_zmset_def)
	+
	+lemma image_zmset_Diff[simp]: "image_zmset f (A - B) = image_zmset f A - image_zmset f B"
	+proof -
	+ have "image_zmset f (A - B + B) = image_zmset f (A - B) + image_zmset f B"
	+ using image_zmset_union by blast
	+ then show ?thesis by simp
	+qed
	+
	+lemma mset_neg_image_zmset: "mset_neg M = {#} \<Longrightarrow> mset_neg (image_zmset f M) = {#}"
	+ unfolding multiset_eq_iff count_empty
	+ by transfer (auto simp add: image_mset_subseteq_mono mset_subset_eqI mset_subset_eq_count)
	+
	+lemma nonneg_zcount_image_zmset[simp]: "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 \<le> zcount (image_zmset f M) t"
	+ by (meson mset_neg_empty_iff mset_neg_image_zmset)
	+
	+lemma image_zmset_add_zmset[simp]: "image_zmset f (add_zmset t M) = add_zmset (f t) (image_zmset f M)"
	+ by transfer (auto simp: equiv_zmset_def)
	+
	+lemma pos_zcount_image_zmset[simp]: "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 < zcount M t \<Longrightarrow> 0 < zcount (image_zmset f M) (f t)"
	+ apply transfer
	+ subgoal for M t f
	+ apply (induct M)
	+ subgoal for Mp Mn
	+ apply simp
	+ apply (metis count_diff count_image_mset_ge_count image_mset_Diff less_le_trans subseteq_mset_def zero_less_diff)
	+ done
	+ done
	+ done
	+
	+lemma set_zmset_transfer[transfer_rule]:
	+ "(rel_fun (pcr_zmultiset (=)) (rel_set (=)))
	+ (\<lambda>(Mp, Mn). set_mset Mp \<union> set_mset Mn - {x. count Mp x = count Mn x}) set_zmset"
	+ by (auto simp: rel_fun_def pcr_zmultiset_def cr_zmultiset_def
	+ rel_set_eq multiset.rel_eq set_zmset_def zcount.abs_eq count_eq_zero_iff[symmetric]
	+ simp del: zcount_ne_zero_iff)
	+
	+lemma zcount_image_zmset:
	+ "zcount (image_zmset f M) x = (\<Sum>y \<in> f -` {x} \<inter> set_zmset M. zcount M y)"
	+ apply (transfer fixing: f x)
	+ subgoal for M
	+ apply (cases M; clarify)
	+ subgoal for Mp Mn
	+ unfolding count_image_mset int_sum
	+ proof -
	+ have "(\<Sum>x\<in>f -` {x} \<inter> set_mset Mp. int (count Mp x)) =
	+ (\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn). int (count Mp x))" (is "?S1 = _")
	+ by (subst sum.same_carrier[where C="f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn)"])
	+ (auto simp: count_eq_zero_iff)
	+ moreover
	+ have "(\<Sum>x\<in>f -` {x} \<inter> set_mset Mn. int (count Mn x)) =
	+ (\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn). int (count Mn x))"(is "?S2 = _")
	+ by (subst sum.same_carrier[where C="f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn)"])
	+ (auto simp: count_eq_zero_iff)
	+ moreover
	+ have "(\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn - {x. count Mp x = count Mn x}). int (count Mp x) - int (count Mn x))
	+ = (\<Sum>x\<in>f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn). int (count Mp x) - int (count Mn x))"
	+ (is "?S = _")
	+ by (subst sum.same_carrier[where C="f -` {x} \<inter> (set_mset Mp \<union> set_mset Mn)"]) auto
	+ ultimately show "?S1 - ?S2 = ?S"
	+ by (auto simp: sum_subtractf)
	+ qed
	+ done
	+ done
	+
	+lemma zmset_empty_image_zmset_empty: "(\<And>t. zcount M t = 0) \<Longrightarrow> zcount (image_zmset f M) t = 0"
	+ by (auto simp: zcount_image_zmset)
	+
	+lemma in_image_zmset_in_zmset: "t \<in>#\<^sub>z image_zmset f M \<Longrightarrow> \<exists>t. t \<in>#\<^sub>z M"
	+ by (rule ccontr) simp
	+
	+lemma zcount_image_zmset_zero: "(\<And>m. m \<in>#\<^sub>z M \<Longrightarrow> f m \<noteq> x) \<Longrightarrow> x \<notin>#\<^sub>z image_zmset f M"
	+ unfolding set_zmset_def
	+ by (simp add: zcount_image_zmset) (metis Int_emptyI sum.empty vimage_singleton_eq)
	+
	+lemma image_zmset_pre: "t \<in>#\<^sub>z image_zmset f M \<Longrightarrow> \<exists>m. m \<in>#\<^sub>z M \<and> f m = t"
	+proof (rule ccontr)
	+ assume t: "t \<in>#\<^sub>z image_zmset f M"
	+ assume "\<nexists>m. m \<in>#\<^sub>z M \<and> f m = t"
	+ then have "m \<in>#\<^sub>z M \<Longrightarrow> \<not> f m = t" for m
	+ by blast
	+ then have "zcount (image_zmset f M) t = 0"
	+ by (meson t zcount_image_zmset_zero)
	+ with t show False
	+ by (meson zcount_ne_zero_iff)
	+qed
	+
	+lemma pos_image_zmset_obtain_pre:
	+ "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 < zcount (image_zmset f M) t \<Longrightarrow> \<exists>m. 0 < zcount M m \<and> f m = t"
	+proof -
	+ assume nonneg: "0 \<le> zcount M t" for t
	+ assume "0 < zcount (image_zmset f M) t"
	+ then have "t \<in>#\<^sub>z image_zmset f M"
	+ by (simp add: pos_zcount_in_zmset)
	+ then obtain x where x: "x \<in>#\<^sub>z M" "f x = t"
	+ by (auto dest: image_zmset_pre)
	+ with nonneg have "0 < zcount M x"
	+ by (meson zmset_elem_nonneg)
	+ with x show ?thesis
	+ by auto
	+qed
	+
	+subsection\<open>Streams\<close>
	+
	+definition relates :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a stream \<Rightarrow> bool" where
	+ "relates \<phi> s = \<phi> (shd s) (shd (stl s))"
	+
	+lemma relatesD[dest]: "relates P s \<Longrightarrow> P (shd s) (shd (stl s))"
	+ unfolding relates_def by simp
	+
	+lemma alw_relatesD[dest]: "alw (relates P) s \<Longrightarrow> P (shd s) (shd (stl s))"
	+ by auto
	+
	+lemma relatesI[intro]: "P (shd s) (shd (stl s)) \<Longrightarrow> relates P s"
	+ by (auto simp: relates_def)
	+
	+lemma alw_holds_smap_conv_comp: "alw (holds P) (smap f s) = alw (\<lambda>s. (P o f) (shd s)) s"
	+ apply (rule iffI)
	+ apply (coinduction arbitrary: s)
	+ apply auto []
	+ apply (coinduction arbitrary: s)
	+ apply auto
	+ done
	+
	+lemma alw_relates: "alw (relates P) s \<longleftrightarrow> P (shd s) (shd (stl s)) \<and> alw (relates P) (stl s)"
	+ apply (rule iffI)
	+ apply (auto simp: relates_def dest: alwD) []
	+ apply (coinduction arbitrary: s)
	+ apply (auto simp: relates_def)
	+ done
	+
	+subsection\<open>Notation\<close>
	+
	+no_notation AND (infix "aand" 60)
	+no_notation OR (infix "or" 60)
	+no_notation IMPL (infix "imp" 60)
	+
	+notation AND (infixr "aand" 70)
	+notation OR (infixr "or" 65)
	+notation IMPL (infixr "imp" 60)
	+
	+(<)
	+end
	+(>)
	\ No newline at end of file
	diff --git a/thys/Progress_Tracking/Combined.thy b/thys/Progress_Tracking/Combined.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/Combined.thy
	@@ -0,0 +1,1221 @@
	+section \<open>Combined Progress Tracking Protocol\label{sec:combined}\<close>
	+
	+(<)
	+theory Combined
	+ imports
	+ Exchange
	+ Propagate
	+begin
	+(>)
	+
	+lemma fold_invar:
	+ assumes "finite M"
	+ and "P z"
	+ and "\<forall>z. \<forall>x\<in>M. P z \<longrightarrow> P (f x z)"
	+ and "comp_fun_commute f"
	+ shows "P (Finite_Set.fold f z M)"
	+ using assms by (induct M arbitrary: z rule: finite_induct) (auto simp: comp_fun_commute.fold_insert)
	+
	+subsection\<open>Could-result-in Relation\<close>
	+
	+context dataflow_topology begin
	+
	+definition cri_less_eq :: "('loc \<times> 't) \<Rightarrow> ('loc \<times> 't) \<Rightarrow> bool" ("_\<le>\<^sub>p_" [51,51] 50) where
	+ "cri_less_eq =
	+ (\<lambda>(loc1,t1) (loc2,t2). (\<exists>s. s \<in>\<^sub>A path_summary loc1 loc2 \<and> results_in t1 s \<le> t2))"
	+
	+definition cri_less :: "('loc \<times> 't) \<Rightarrow> ('loc \<times> 't) \<Rightarrow> bool" ("_<\<^sub>p_" [51,51] 50) where
	+ "cri_less x y = (x \<le>\<^sub>p y \<and> x \<noteq> y)"
	+
	+lemma cri_asym1: "x <\<^sub>p y \<longrightarrow> \<not> y <\<^sub>p x"
	+ for x y apply (cases x; cases y)
	+proof (rule ccontr)
	+ fix loc1 t1 loc2 t2
	+ assume as: "\<not> (x <\<^sub>p y \<longrightarrow> \<not> y <\<^sub>p x)" "x = (loc1, t1)" "y = (loc2, t2)"
	+ then have as1: "loc1 \<noteq> loc2"
	+ unfolding cri_less_def cri_less_eq_def
	+ by clarsimp
	+ (metis add.right_neutral order.antisym order.trans le_plus(2) results_in_mono(2) results_in_zero)
	+ from as obtain s1 where s1: "s1 \<in>\<^sub>A path_summary loc1 loc2"
	+ "results_in t1 s1 \<le> t2"
	+ using cri_less_def cri_less_eq_def by auto
	+ then obtain path1 where path1: "flow.path loc1 loc2 path1"
	+ "s1 = flow.sum_path_weights path1"
	+ "path1 \<noteq> []"
	+ using as1 flow.path_weight_conv_path flow.path0E by blast
	+ from as obtain s2 where s2: "s2 \<in>\<^sub>A path_summary loc2 loc1"
	+ "results_in t2 s2 \<le> t1"
	+ using cri_less_def cri_less_eq_def by auto
	+ then obtain path2 where path2: "flow.path loc2 loc1 path2"
	+ "s2 = flow.sum_path_weights path2"
	+ "path2 \<noteq> []"
	+ using as1 flow.path_weight_conv_path flow.path0E by blast
	+ with path1 have path_total: "flow.path loc1 loc1 (path1@path2)"
	+ using flow.path_trans path2(3) by blast
	+ then obtain s3 where s3: "s3 = flow.sum_path_weights (path1@path2)" by auto
	+ then have s3_sum: "s3 = followed_by s1 s2"
	+ using path1 path2 flow.sum_weights_append by auto
	+ have "\<not> t1 < results_in t1 s3"
	+ using s3_sum s1(2) s2(2) followed_by_summary
	+ by (metis le_less_trans less_le_not_le results_in_mono(1))
	+ then show False using path_total no_zero_cycle s3 path1(3) path2(3) by blast
	+qed
	+
	+lemma cri_asym2: "x <\<^sub>p y \<longrightarrow> x \<noteq> y"
	+ by (simp add: cri_less_def)
	+
	+sublocale cri: order cri_less_eq cri_less
	+ apply standard
	+ subgoal
	+ using cri_asym1 cri_asym2 cri_less_def by blast
	+ subgoal for x
	+ unfolding cri_less_eq_def
	+ using flow.path_weight_refl results_in_zero by fastforce
	+ subgoal
	+ for x y z apply (cases x; cases y; cases z)
	+ proof -
	+ fix a b aa ba ab bb
	+ assume as: "x \<le>\<^sub>p y" "y \<le>\<^sub>p z" "x = (a, b)" "y = (aa, ba)" "z = (ab, bb)"
	+ then obtain s1 where s1: "s1 \<in>\<^sub>A path_summary a aa" "results_in b s1 \<le> ba"
	+ using cri_less_eq_def by auto
	+ from as(2,4,5) obtain s2 where s2: "s2 \<in>\<^sub>A path_summary aa ab" "results_in ba s2 \<le> bb"
	+ using cri_less_eq_def by auto
	+ with s1 obtain s3 where s3: "s3 \<in>\<^sub>A path_summary a ab" "s3 \<le> followed_by s1 s2"
	+ using flow.path_weight_elem_trans by blast
	+ with s1 s2 have "results_in b s3 \<le> bb"
	+ proof -
	+ have "\<forall>s. results_in (results_in b s1) s \<le> results_in ba s"
	+ by (meson results_in_mono(1) s1(2))
	+ then show ?thesis
	+ by (metis (no_types) results_in_mono(2) followed_by_summary order_trans s2(2) s3(2))
	+ qed
	+ with as s3 show ?thesis unfolding cri_less_eq_def by blast
	+ qed
	+ using cri_asym1 cri_asym2 cri_less_def by blast
	+
	+lemma wf_cri: "wf {(l, l'). (l, t) <\<^sub>p (l', t)}"
	+ by (rule finite_acyclic_wf)
	+ (auto intro: cri.acyclicI_order[THEN acyclic_converse[THEN iffD1]])
	+
	+end
	+
	+subsection\<open>Specification\<close>
	+
	+subsubsection\<open>Configuration\<close>
	+
	+record ('p::finite, 't::order, 'loc) configuration =
	+ exchange_config :: "('p, ('loc \<times> 't)) Exchange.configuration"
	+ prop_config :: "'p \<Rightarrow> ('loc, 't) Propagate.configuration"
	+ init :: "'p \<Rightarrow> bool" (* True = initialization finished *)
	+
	+type_synonym ('p, 't, 'loc) computation = "('p, 't, 'loc) configuration stream"
	+
	+context dataflow_topology begin
	+
	+definition the_cm where
	+ "the_cm c loc t n = (THE c'. next_change_multiplicity' c c' loc t n)"
	+
	+text\<open>@{term the_cm} is not commutative in general, only if the necessary conditions hold. It can be converted
	+to @{term apply_cm} for which we prove @{term comp_fun_commute}.\<close>
	+definition apply_cm where
	+ "apply_cm c loc t n =
	+ (let new_pointstamps = (\<lambda>loc'.
	+ (if loc' = loc then update_zmultiset (c_pts c loc') t n
	+ else c_pts c loc')) in
	+ c \<lparr> c_pts := new_pointstamps \<rparr>
	+ \<lparr> c_work :=
	+ (\<lambda>loc'. c_work c loc' + frontier_changes (new_pointstamps loc') (c_pts c loc'))\<rparr>)"
	+
	+definition cm_all' where
	+ "cm_all' c0 \<Delta> =
	+ Finite_Set.fold (\<lambda>(loc, t) c. apply_cm c loc t (zcount \<Delta> (loc,t))) c0 (set_zmset \<Delta>)"
	+
	+definition cm_all where
	+ "cm_all c0 \<Delta> =
	+ Finite_Set.fold (\<lambda>(loc, t) c. the_cm c loc t (zcount \<Delta> (loc,t))) c0 (set_zmset \<Delta>)"
	+
	+definition "propagate_all c0 = while_option (\<lambda>c. \<exists>loc. (c_work c loc) \<noteq> {#}\<^sub>z)
	+ (\<lambda>c. SOME c'. \<exists>loc t. next_propagate' c c' loc t) c0"
	+
	+subsubsection\<open>Initial state and state transitions\<close>
	+
	+definition InitConfig :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> bool" where
	+ "InitConfig c =
	+ ((\<forall>p. init c p = False)
	+ \<and> cri.init_config (exchange_config c)
	+ \<and> (\<forall>p loc t. zcount (c_pts (prop_config c p) loc) t
	+ = zcount (c_glob (exchange_config c) p) (loc, t))
	+ \<and> (\<forall>w. init_config (prop_config c w)))"
	+
	+definition NextPerformOp' :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> ('p, 't, 'loc) configuration
	+ \<Rightarrow> 'p \<Rightarrow> ('loc \<times> 't) multiset \<Rightarrow> ('p \<times> ('loc \<times> 't)) multiset \<Rightarrow> ('loc \<times> 't) multiset \<Rightarrow> bool" where
	+ "NextPerformOp' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self = (
	+ cri.next_performop' (exchange_config c0) (exchange_config c1) p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self
	+ \<and> unchanged prop_config c0 c1
	+ \<and> unchanged init c0 c1)"
	+
	+abbreviation NextPerformOp where
	+ "NextPerformOp c0 c1 \<equiv> \<exists>p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self. NextPerformOp' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+
	+definition NextRecvCap'
	+ :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> ('p, 't, 'loc) configuration \<Rightarrow> 'p \<Rightarrow> 'loc \<times> 't \<Rightarrow> bool" where
	+ "NextRecvCap' c0 c1 p t = (
	+ cri.next_recvcap' (exchange_config c0) (exchange_config c1) p t
	+ \<and> unchanged prop_config c0 c1
	+ \<and> unchanged init c0 c1)"
	+
	+abbreviation NextRecvCap where
	+ "NextRecvCap c0 c1 \<equiv> \<exists>p t. NextRecvCap' c0 c1 p t"
	+
	+definition NextSendUpd' :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> ('p, 't, 'loc) configuration
	+ \<Rightarrow> 'p \<Rightarrow> ('loc \<times> 't) set \<Rightarrow> bool" where
	+ "NextSendUpd' c0 c1 p tt = (
	+ cri.next_sendupd' (exchange_config c0) (exchange_config c1) p tt
	+ \<and> unchanged prop_config c0 c1
	+ \<and> unchanged init c0 c1)"
	+
	+abbreviation NextSendUpd where
	+ "NextSendUpd c0 c1 \<equiv> \<exists>p tt. NextSendUpd' c0 c1 p tt"
	+
	+definition NextRecvUpd' :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> ('p, 't, 'loc) configuration
	+ \<Rightarrow> 'p \<Rightarrow> 'p \<Rightarrow> bool" where
	+ "NextRecvUpd' c0 c1 p q = (
	+ init c0 q \<comment> \<open>Once init is set we are guaranteed that the CM transitions' premises are satisfied\<close>
	+ \<and> cri.next_recvupd' (exchange_config c0) (exchange_config c1) p q
	+ \<and> unchanged init c0 c1
	+ \<and> (\<forall>p'. prop_config c1 p' =
	+ (if p' = q
	+ then cm_all (prop_config c0 q) (hd (c_msg (exchange_config c0) p q))
	+ else prop_config c0 p')))"
	+
	+abbreviation NextRecvUpd where
	+ "NextRecvUpd c0 c1 \<equiv> \<exists>p q. NextRecvUpd' c0 c1 p q"
	+
	+definition NextPropagate' :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> ('p, 't, 'loc) configuration
	+ \<Rightarrow> 'p \<Rightarrow> bool" where
	+ "NextPropagate' c0 c1 p = (
	+ unchanged exchange_config c0 c1
	+ \<and> init c1 = (init c0)(p := True)
	+ \<and> (\<forall>p'. Some (prop_config c1 p') =
	+ (if p' = p
	+ then propagate_all (prop_config c0 p')
	+ else Some (prop_config c0 p'))))"
	+
	+abbreviation NextPropagate where
	+ "NextPropagate c0 c1 \<equiv> \<exists>p. NextPropagate' c0 c1 p"
	+
	+definition "Next'" where
	+ "Next' c0 c1 = (NextPerformOp c0 c1 \<or> NextSendUpd c0 c1 \<or> NextRecvUpd c0 c1 \<or> NextPropagate c0 c1 \<or> NextRecvCap c0 c1 \<or> c1 = c0)"
	+
	+abbreviation "Next" where
	+ "Next s \<equiv> Next' (shd s) (shd (stl s))"
	+
	+definition FullSpec :: "('p :: finite, 't :: order, 'loc) computation \<Rightarrow> bool" where
	+ "FullSpec s = (holds InitConfig s \<and> alw Next s)"
	+
	+lemma NextPerformOpD:
	+ assumes "NextPerformOp' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ shows
	+ "cri.next_performop' (exchange_config c0) (exchange_config c1) p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ "unchanged prop_config c0 c1"
	+ "unchanged init c0 c1"
	+ using assms unfolding NextPerformOp'_def by simp_all
	+
	+lemma NextSendUpdD:
	+ assumes "NextSendUpd' c0 c1 p tt"
	+ shows
	+ "cri.next_sendupd' (exchange_config c0) (exchange_config c1) p tt"
	+ "unchanged prop_config c0 c1"
	+ "unchanged init c0 c1"
	+ using assms unfolding NextSendUpd'_def by simp_all
	+
	+lemma NextRecvUpdD:
	+ assumes "NextRecvUpd' c0 c1 p q"
	+ shows
	+ "init c0 q"
	+ "cri.next_recvupd' (exchange_config c0) (exchange_config c1) p q"
	+ "unchanged init c0 c1"
	+ "(\<forall>p'. prop_config c1 p' =
	+ (if p' = q
	+ then cm_all (prop_config c0 q) (hd (c_msg (exchange_config c0) p q))
	+ else prop_config c0 p'))"
	+ using assms unfolding NextRecvUpd'_def by simp_all
	+
	+lemma NextPropagateD:
	+ assumes "NextPropagate' c0 c1 p"
	+ shows
	+ "unchanged exchange_config c0 c1"
	+ "init c1 = (init c0)(p := True)"
	+ "(\<forall>p'. Some (prop_config c1 p') =
	+ (if p' = p
	+ then propagate_all (prop_config c0 p')
	+ else Some (prop_config c0 p')))"
	+ using assms unfolding NextPropagate'_def by simp_all
	+
	+lemma NextRecvCapD:
	+ assumes "NextRecvCap' c0 c1 p t"
	+ shows
	+ "cri.next_recvcap' (exchange_config c0) (exchange_config c1) p t"
	+ "unchanged prop_config c0 c1"
	+ "unchanged init c0 c1"
	+ using assms unfolding NextRecvCap'_def by simp_all
	+
	+subsection\<open>Auxiliary Lemmas\<close>
	+
	+subsubsection\<open>Auxiliary Lemmas for CM Conversion\<close>
	+
	+lemma apply_cm_is_cm:
	+ "\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc) \<and> t' \<le> t \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> next_change_multiplicity' c (apply_cm c loc t n) loc t n"
	+ by (auto simp: next_change_multiplicity'_def apply_cm_def
	+ intro!: Propagate.configuration.equality)
	+
	+lemma update_zmultiset_commute:
	+ "update_zmultiset (update_zmultiset M t' n') t n = update_zmultiset (update_zmultiset M t n) t' n'"
	+ by transfer (auto simp: equiv_zmset_def split: if_splits)
	+
	+lemma apply_cm_commute: "apply_cm (apply_cm c loc t n) loc' t' n' = apply_cm (apply_cm c loc' t' n') loc t n"
	+ unfolding apply_cm_def Let_def
	+ by (auto intro!: Propagate.configuration.equality simp: update_zmultiset_commute)
	+
	+lemma comp_fun_commute_apply_cm[simp]: "comp_fun_commute (\<lambda>(loc, t) c. apply_cm c loc t (f loc t))"
	+ by (auto intro!: Propagate.configuration.equality simp: update_zmultiset_commute comp_fun_commute_def o_def apply_cm_commute)
	+
	+lemma ex_cm_imp_conds:
	+ assumes "\<exists>c'. next_change_multiplicity' c c' loc t n"
	+ shows "\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc) \<and> t' \<le> t" "n \<noteq> 0"
	+ using assms by (auto simp: next_change_multiplicity'_def)
	+
	+lemma the_cm_eq_apply_cm:
	+ assumes "\<exists>c'. next_change_multiplicity' c c' loc t n"
	+ shows "the_cm c loc t n = apply_cm c loc t n"
	+proof -
	+ from assms have cond: "\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc) \<and> t' \<le> t" "n \<noteq> 0"
	+ using ex_cm_imp_conds by blast+
	+ show ?thesis
	+ unfolding the_cm_def
	+ apply (rule the1_equality)
	+ apply (rule next_change_multiplicity'_unique[OF cond(2,1)])
	+ unfolding apply_cm_def next_change_multiplicity'_def
	+ using cond apply (auto intro!: Propagate.configuration.equality)
	+ done
	+qed
	+
	+lemma apply_cm_preserves_cond:
	+ assumes "\<forall>(loc,t)\<in>set_zmset \<Delta>. \<exists>t'. t' \<in>\<^sub>A frontier (c_imp c0 loc) \<and> t' \<le> t"
	+ shows "\<forall>(loc,t)\<in>set_zmset \<Delta>. \<exists>t'. t' \<in>\<^sub>A frontier (c_imp (apply_cm c0 loc' t'' n) loc) \<and> t' \<le> t"
	+ using assms by (auto simp: apply_cm_def)
	+
	+lemma cm_all_eq_cm_all':
	+ assumes "\<forall>(loc,t)\<in>set_zmset \<Delta>. \<exists>t'. t' \<in>\<^sub>A frontier (c_imp c0 loc) \<and> t' \<le> t"
	+ shows "cm_all c0 \<Delta> = cm_all' c0 \<Delta>"
	+ unfolding cm_all_def cm_all'_def
	+ apply (rule fold_closed_eq[where B = "{c. \<forall>(loc,t)\<in>set_zmset \<Delta>. \<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc) \<and> t' \<le> t}"])
	+ subgoal for a \<Delta>
	+ apply (cases a)
	+ apply simp
	+ apply (rule the_cm_eq_apply_cm)
	+ apply (rule ex1_implies_ex)
	+ apply (rule next_change_multiplicity'_unique)
	+ apply auto
	+ done
	+ subgoal for a \<Delta>
	+ apply (cases a)
	+ apply simp
	+ apply (rule apply_cm_preserves_cond)
	+ apply auto
	+ done
	+ subgoal
	+ using assms by simp
	+ done
	+
	+lemma cm_eq_the_cm:
	+ assumes "next_change_multiplicity' c c' loc t n"
	+ shows "the_cm c loc t n = c'"
	+proof -
	+ from assms have cond: "\<exists>u. u \<in>\<^sub>A frontier (c_imp c loc) \<and> u \<le> t" "n \<noteq> 0"
	+ unfolding next_change_multiplicity'_def by auto
	+ then show ?thesis
	+ using next_change_multiplicity'_unique[OF cond(2,1)] assms the_cm_def
	+ by auto
	+qed
	+
	+lemma zcount_ps_apply_cm:
	+ "zcount (c_pts (apply_cm c loc t n) loc') t' = zcount (c_pts c loc') t' + (if loc = loc' \<and> t = t' then n else 0)"
	+ by (auto simp: apply_cm_def zcount_update_zmultiset)
	+
	+lemma zcount_pointstamps_update: "zcount (c_pts (c\<lparr>c_pts:=M\<rparr>) loc) x = zcount (M loc) x"
	+ by auto
	+
	+lemma nop: "loc1 \<noteq> loc2 \<or> t1 \<noteq> t2 \<longrightarrow>
	+ zcount (c_pts (apply_cm c loc2 t2 (zcount \<Delta> (loc2, t2))) loc1) t1 =
	+ zcount (c_pts c loc1) t1"
	+ apply (simp add: apply_cm_def)
	+ using zcount_update_zmultiset
	+ by (simp add: zcount_update_zmultiset)
	+
	+lemma fold_nop:
	+ "zcount (c_pts (Finite_Set.fold (\<lambda>(loc', t') c. apply_cm c loc' t' (zcount \<Delta>' (loc', t'))) c
	+ (set_zmset \<Delta> - {(loc, t)})) loc) t
	+ = zcount (c_pts c loc) t"
	+proof -
	+ have "finite (set_zmset \<Delta>- {(loc, t)})" using finite_set_zmset by blast
	+ then show ?thesis
	+ proof (induct "set_zmset \<Delta> - {(loc, t)}" arbitrary: \<Delta> rule: finite_induct)
	+ case empty
	+ then show ?case using fold_empty by auto
	+ next
	+ let ?f = "(\<lambda>(loc', t') c. apply_cm c loc' t' (zcount \<Delta>' (loc',t')))"
	+ case (insert x F)
	+ obtain loc' t' where x_pair: "x = (loc', t')" by (meson surj_pair)
	+ from insert have nonmember: "x \<noteq> (loc, t)" by auto
	+ then have finite_s: "finite F" using insert by auto
	+ have commute: "comp_fun_commute ?f"
	+ by (simp add: comp_fun_commute_def comp_def apply_cm_commute)
	+ with finite_s have step1:
	+ "Finite_Set.fold ?f c (insert x F) = ?f x (Finite_Set.fold ?f c F)"
	+ by (metis (mono_tags, lifting) comp_fun_commute.fold_insert insert.hyps(1) insert.hyps(2))
	+ from nonmember have step2:
	+ "zcount (c_pts (?f x (Finite_Set.fold ?f c F)) loc) t
	+ = zcount (c_pts (Finite_Set.fold ?f c F) loc) t"
	+ using x_pair
	+ by (metis (mono_tags, lifting) case_prod_conv nop)
	+ with step1 and x_pair have final:
	+ "zcount (c_pts (Finite_Set.fold ?f c (insert x F)) loc) t
	+ = zcount (c_pts (Finite_Set.fold ?f c F) loc) t"
	+ by simp
	+ from insert(2,4) obtain \<Delta>2 where \<Delta>2: "\<Delta>2 = filter_zmset (\<lambda>y. y\<noteq>x) \<Delta>" by blast
	+ then have "F = set_zmset \<Delta>2 - {(loc, t)}"
	+ proof -
	+ from \<Delta>2 have *: "x \<notin>#\<^sub>z \<Delta>2" by (simp add: not_in_iff_zmset)
	+ from insert(4) and nonmember have **: "x \<in>#\<^sub>z \<Delta>" by blast
	+ from \<Delta>2 have *: "\<forall>y. y \<in>#\<^sub>z \<Delta> \<longleftrightarrow> (y \<in>#\<^sub>z \<Delta>2 \<or> y = x)"
	+ by (metis (mono_tags, lifting) count_filter_zmset zcount_ne_zero_iff)
	+ with *** have "\<forall>y. (y \<in> set_zmset \<Delta> = (y \<in> (set_zmset \<Delta>2 \<union> {x})))" by blast
	+ then have "set_zmset \<Delta> = set_zmset \<Delta>2 \<union> {x}" by (auto simp add: set_eq_iff)
	+ with insert(2,3,4) * show ?thesis
	+ by (metis (mono_tags, lifting) Diff_insert Diff_insert2 Diff_insert_absorb Un_empty_right Un_insert_right)
	+ qed
	+ with final insert show ?case by metis
	+ qed
	+qed
	+
	+lemma zcount_pointstamps_cm_all':
	+ "zcount (c_pts (cm_all' c \<Delta>) loc) x
	+ = zcount (c_pts c loc) x + zcount \<Delta> (loc,x)"
	+proof -
	+ let ?f = "(\<lambda>(loc', t') c. apply_cm c loc' t' (zcount \<Delta> (loc',t')))"
	+ have ?thesis
	+ proof (cases "zcount \<Delta> (loc,x) = 0")
	+ case case_nonmember: True
	+ then have set_zmset\<Delta>: "set_zmset \<Delta> - {(loc, x)} = set_zmset \<Delta>" using zcount_eq_zero_iff by fastforce
	+ have "zcount (c_pts (cm_all' c \<Delta>) loc) x
	+ = zcount (c_pts c loc) x"
	+ unfolding cm_all'_def
	+ apply (subst set_zmset\<Delta>[symmetric])
	+ apply (simp add: fold_nop)
	+ done
	+ with case_nonmember show ?thesis by auto
	+ next
	+ case case_member: False
	+ then have fold_rec: "Finite_Set.fold ?f c (set_zmset \<Delta>)
	+ = ?f (loc, x) (Finite_Set.fold ?f c (set_zmset \<Delta> - {(loc, x)}))"
	+ proof -
	+ have "(loc, x) \<in>#\<^sub>z \<Delta>"
	+ by (meson case_member zcount_inI)
	+ then show ?thesis
	+ using comp_fun_commute_apply_cm
	+ apply (intro comp_fun_commute.fold_rec)
	+ apply simp_all
	+ done
	+ qed
	+ have "zcount (c_pts (Finite_Set.fold ?f c (set_zmset \<Delta> - {(loc, x)})) loc) x
	+ = zcount (c_pts c loc) x" by (simp add: fold_nop)
	+ then have "zcount (c_pts (Finite_Set.fold ?f c (set_zmset \<Delta>)) loc) x
	+ = zcount (c_pts (?f (loc, x) c) loc) x"
	+ using fold_nop fold_rec by (simp add: zcount_ps_apply_cm)
	+ then show ?thesis
	+ by (simp add: zcount_ps_apply_cm cm_all'_def)
	+ qed
	+ then show ?thesis ..
	+qed
	+
	+lemma implications_apply_cm[simp]: "c_imp (apply_cm c loc t n) = c_imp c"
	+ by (auto simp: apply_cm_def)
	+
	+lemma implications_cm_all[simp]:
	+ "c_imp (cm_all' c \<Delta>) = c_imp c"
	+ unfolding cm_all'_def Let_def
	+ apply (rule fold_invar[OF finite_set_zmset])
	+ apply auto
	+ done
	+
	+lemma lift_cm_inv_cm_all':
	+ assumes "(\<And>c0 c1 loc t n. P c0 \<Longrightarrow> next_change_multiplicity' c0 c1 loc t n \<Longrightarrow> P c1)"
	+ and "\<forall>(loc,t)\<in>#\<^sub>z\<Delta>. \<exists>t'. t' \<in>\<^sub>A frontier (c_imp c0 loc) \<and> t' \<le> t"
	+ and "P c0"
	+ shows "P (cm_all' c0 \<Delta>)"
	+proof -
	+ let ?cond_invar = "\<lambda>c. \<forall>(loc, t)\<in>#\<^sub>z\<Delta>. \<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc) \<and> t' \<le> t"
	+ let ?invar = "\<lambda>c. ?cond_invar c \<and> P c"
	+ show ?thesis
	+ unfolding cm_all'_def
	+ apply (rule conjunct2[OF fold_invar[OF finite_set_zmset, of ?invar]])
	+ using assms(2,3) apply simp
	+ subgoal
	+ apply safe
	+ apply auto []
	+ apply (rule assms(1))
	+ apply simp
	+ apply (rule apply_cm_is_cm)
	+ apply auto
	+ done
	+ apply simp
	+ done
	+qed
	+
	+lemma lift_cm_inv_cm_all:
	+ assumes "\<And>c0 c1 loc t n. P c0 \<Longrightarrow> next_change_multiplicity' c0 c1 loc t n \<Longrightarrow> P c1"
	+ and "\<forall>(loc,t)\<in>#\<^sub>z\<Delta>. \<exists>t'. t' \<in>\<^sub>A frontier (c_imp c0 loc) \<and> t' \<le> t"
	+ and "P c0"
	+ shows "P (cm_all c0 \<Delta>)"
	+ apply (subst cm_all_eq_cm_all')
	+ using assms(2) apply simp
	+ using assms apply (rule lift_cm_inv_cm_all')
	+ apply simp_all
	+ done
	+
	+(* Finds a minimal timestamp - location pair in a non-empty zmset (e.g. in c_work) *)
	+lemma obtain_min_worklist:
	+ assumes "(a (loc'::(_ :: finite))::(('t :: order) zmultiset)) \<noteq> {#}\<^sub>z"
	+ obtains loc t
	+ where "t \<in>#\<^sub>z a loc"
	+ and "\<forall>t' loc'. t' \<in>#\<^sub>z a loc' \<longrightarrow> \<not> t' < t"
	+ using assms
	+proof atomize_elim
	+ obtain f where f: "f = minimal_antichain (\<Union>loc'. set_zmset (a loc'))"
	+ by blast
	+ from assms obtain x' where x': "x' \<in> (\<Union>loc'. set_zmset (a loc'))"
	+ using pos_zcount_in_zmset by fastforce
	+ from assms have "finite (\<Union>loc'. set_zmset (a loc'))"
	+ using finite_UNIV by blast
	+ with x' have "f \<noteq> {}" unfolding f
	+ using minimal_antichain_nonempty by blast
	+ then obtain t where t: "t \<in> f" "(\<forall>s\<in>f. \<not> s < t)"
	+ using ex_min_if_finite f minimal_antichain_def by fastforce
	+ with f have thesis1: "\<forall>t' loc'. t' \<in>#\<^sub>z a loc' \<longrightarrow> \<not> t' < t" "\<exists>loc. t \<in>#\<^sub>z a loc"
	+ by (simp add: minimal_antichain_def)+
	+ then show "\<exists>t loc. t \<in>#\<^sub>z a loc \<and> (\<forall>t' loc'. t' \<in>#\<^sub>z a loc' \<longrightarrow> \<not> t' < t)" by blast
	+qed
	+
	+lemma propagate_pointstamps_eq:
	+ assumes "c_work c loc \<noteq> {#}\<^sub>z"
	+ shows "c_pts c = c_pts (SOME c'. \<exists>loc t. next_propagate' c c' loc t)"
	+proof -
	+ from assms obtain loc' t where loc't: "t \<in>#\<^sub>z c_work c loc'"
	+ "\<forall>t' loc'. t' \<in>#\<^sub>z c_work c loc' \<longrightarrow> \<not> t' < t"
	+ apply (rule obtain_min_worklist[of "c_work c" "loc"]) by blast
	+ let ?imps = "\<lambda>locX. if locX = loc' then c_imp c locX + {#t' \<in>#\<^sub>z c_work c locX. t' = t#}
	+ else c_imp c locX"
	+ let ?wl = "\<lambda>locX. if locX = loc' then {#t' \<in>#\<^sub>z c_work c locX. t' \<noteq> t#}
	+ else c_work c locX
	+ + after_summary
	+ (frontier_changes (?imps loc') (c_imp c loc'))
	+ (summary loc' locX)"
	+ let ?c = "c\<lparr>c_imp := ?imps, c_work := ?wl\<rparr>"
	+ from loc't assms have propagate: "\<exists>c'. \<exists>loc t. next_propagate' c c' loc t"
	+ by (intro exI[of _ ?c] exI[of _ loc'] exI[of _ t])
	+ (auto simp add: next_propagate'_def intro!: Propagate.configuration.equality)
	+ { fix c' loc t
	+ assume "next_propagate' c c' loc t"
	+ then have "c_pts c = c_pts c'"
	+ by (simp add: next_propagate'_def)
	+ }
	+ with propagate show ?thesis
	+ by (simp add: verit_sko_ex')
	+qed
	+
	+lemma propagate_all_imp_InvGlobPointstampsEq:
	+ "Some c1 = propagate_all c0 \<Longrightarrow> c_pts c0 = c_pts c1"
	+ unfolding propagate_all_def
	+ using while_option_rule[where P="(\<lambda>c. c_pts c0 = c_pts c)"
	+ and b="(\<lambda>c. \<exists>loc. c_work c loc \<noteq> {#}\<^sub>z)"
	+ and c="(\<lambda>c. SOME c'. \<exists>loc t. next_propagate' c c' loc t)"]
	+ propagate_pointstamps_eq by (metis (no_types, lifting))
	+
	+lemma exists_next_propagate':
	+ assumes "c_work c loc \<noteq> {#}\<^sub>z"
	+ shows "\<exists>c' loc t. next_propagate' c c' loc t"
	+proof -
	+ from assms obtain loc' t where loc't:
	+ "t \<in>#\<^sub>z c_work c loc'"
	+ "\<forall>t' loc'. t' \<in>#\<^sub>z c_work c loc' \<longrightarrow> \<not> t' < t"
	+ by (rule obtain_min_worklist)
	+ let ?imps = "\<lambda>locX. if locX = loc' then c_imp c locX + {#t' \<in>#\<^sub>z c_work c locX. t' = t#}
	+ else c_imp c locX"
	+ let ?wl = "\<lambda>locX. if locX = loc' then {#t' \<in>#\<^sub>z c_work c locX. t' \<noteq> t#}
	+ else c_work c locX
	+ + after_summary
	+ (frontier_changes (?imps loc') (c_imp c loc'))
	+ (summary loc' locX)"
	+ let ?c = "c\<lparr>c_imp := ?imps, c_work := ?wl\<rparr>"
	+ from loc't assms show ?thesis
	+ by (intro exI[of _ ?c] exI[of _ loc'] exI[of _ t])
	+ (auto simp: next_propagate'_def intro!: Propagate.configuration.equality)
	+qed
	+
	+lemma lift_propagate_inv_propagate_all:
	+ assumes "(\<And>c0 c1 loc t. P c0 \<Longrightarrow> next_propagate' c0 c1 loc t \<Longrightarrow> P c1)"
	+ and "P c0"
	+ and "propagate_all c0 = Some c1"
	+ shows "P c1"
	+ apply (rule while_option_rule[of P _, rotated, OF assms(3)[unfolded propagate_all_def], OF assms(2)])
	+ apply clarify
	+ subgoal for c loc
	+ apply (drule exists_next_propagate')
	+ apply (simp add: assms(1) verit_sko_ex')
	+ done
	+ done
	+
	+subsection\<open>Exchange is a Subsystem of Tracker\<close>
	+
	+text\<open>Steps in the Tracker are valid steps in the Exchange protocol.\<close>
	+lemma next_imp_exchange_next:
	+ "Next' c0 c1 \<Longrightarrow> cri.next' (exchange_config c0) (exchange_config c1)"
	+ unfolding Next'_def cri.next'_def NextPerformOp'_def NextRecvUpd'_def NextSendUpd'_def NextPropagate'_def NextRecvCap'_def
	+ by auto
	+
	+lemma alw_next_imp_exchange_next: "alw Next s \<Longrightarrow> alw cri.next (smap exchange_config s)"
	+ by (coinduction arbitrary: s rule: alw.coinduct) (auto dest: alwD next_imp_exchange_next)
	+
	+text\<open>Any Tracker trace is a valid Exchange trace\<close>
	+lemma spec_imp_exchange_spec: "FullSpec s \<Longrightarrow> cri.spec (smap exchange_config s)"
	+ unfolding cri.spec_def FullSpec_def
	+ by (auto simp: InitConfig_def intro: alw_next_imp_exchange_next)
	+
	+lemma lift_exchange_invariant:
	+ assumes "\<And>s. cri.spec s \<Longrightarrow> alw (holds P) s"
	+ shows "FullSpec s \<Longrightarrow> alw (\<lambda>s. P (exchange_config (shd s))) s"
	+proof -
	+ assume "FullSpec s"
	+ note spec_imp_exchange_spec[OF this]
	+ note assms[OF this]
	+ then show ?thesis
	+ by (auto simp: alw_holds_smap_conv_comp)
	+qed
	+
	+text\<open>Lifted Exchange invariants\<close>
	+lemmas
	+ exch_alw_InvCapsNonneg = lift_exchange_invariant[OF cri.alw_InvCapsNonneg, unfolded atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvRecordCount = lift_exchange_invariant[OF cri.alw_InvRecordCount, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvRecordsNonneg = lift_exchange_invariant[OF cri.alw_InvRecordsNonneg, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvGlobVacantImpRecordsVacant = lift_exchange_invariant[OF cri.alw_InvGlobVacantImpRecordsVacant, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvGlobNonposImpRecordsNonpos = lift_exchange_invariant[OF cri.alw_InvGlobNonposImpRecordsNonpos, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvJustifiedGII = lift_exchange_invariant[OF cri.alw_InvJustifiedGII, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvJustifiedII = lift_exchange_invariant[OF cri.alw_InvJustifiedII, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvGlobNonposEqVacant = lift_exchange_invariant[OF cri.alw_InvGlobNonposEqVacant, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvMsgInGlob = lift_exchange_invariant[OF cri.alw_InvMsgInGlob, simplified atomize_imp, simplified, folded atomize_imp] and
	+ exch_alw_InvTempJustified = lift_exchange_invariant[OF cri.alw_InvTempJustified, simplified atomize_imp, simplified, folded atomize_imp]
	+
	+subsection\<open>Definitions\<close>
	+
	+(* First variant of global safe *)
	+definition safe_combined :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> bool" where
	+ "safe_combined c \<equiv> \<forall>loc1 loc2 t s p.
	+ zcount (cri.records (exchange_config c)) (loc1, t) > 0 \<and> s \<in>\<^sub>A path_summary loc1 loc2 \<and> init c p
	+ \<longrightarrow> (\<exists>t'. t' \<in>\<^sub>A frontier (c_imp (prop_config c p) loc2) \<and> t' \<le> results_in t s)"
	+
	+(* Second variant of global safe *)
	+definition safe_combined2 :: "('p::finite, 't::order, 'loc) configuration \<Rightarrow> bool" where
	+ "safe_combined2 c \<equiv> \<forall>loc1 loc2 t s p1 p2.
	+ zcount (c_caps (exchange_config c) p1) (loc1, t) > 0 \<and> s \<in>\<^sub>A path_summary loc1 loc2 \<and> init c p2
	+ \<longrightarrow> (\<exists>t'. t' \<in>\<^sub>A frontier (c_imp (prop_config c p2) loc2) \<and> t' \<le> results_in t s)"
	+
	+definition InvGlobPointstampsEq :: "('p :: finite, 't :: order, 'loc) configuration \<Rightarrow> bool" where
	+ "InvGlobPointstampsEq c = (
	+ (\<forall>p loc t. zcount (c_pts (prop_config c p) loc) t
	+ = zcount (c_glob (exchange_config c) p) (loc, t)))"
	+
	+lemma safe_combined_implies_safe_combined2:
	+ assumes "cri.InvCapsNonneg (exchange_config c)"
	+ and "safe_combined c"
	+ shows "safe_combined2 c"
	+ unfolding safe_combined2_def
	+ apply clarify
	+ subgoal for loc1 loc2 t s p1 p2
	+ apply (rule assms(2)[unfolded safe_combined_def, rule_format, of loc1 t s loc2 p2])
	+ apply (simp add: cri.records_def)
	+ apply (rule add_pos_nonneg)
	+ apply (subst zcount_sum)
	+ apply (rule sum_pos[where y = p1])
	+ using assms(1)
	+ apply (simp_all add: cri.InvCapsNonneg_def)
	+ done
	+ done
	+
	+subsection\<open>Propagate is a Subsystem of Tracker\<close>
	+
	+subsubsection\<open>CM Conditions\<close>
	+
	+definition InvMsgCMConditions where
	+ "InvMsgCMConditions c = (\<forall>p q.
	+ init c q \<longrightarrow> c_msg (exchange_config c) p q \<noteq> [] \<longrightarrow>
	+ (\<forall>(loc,t) \<in>#\<^sub>z (hd (c_msg (exchange_config c) p q)). \<exists>t'. t' \<in>\<^sub>A frontier (c_imp (prop_config c q) loc) \<and> t' \<le> t))"
	+
	+text\<open>Pointstamps in incoming messages all satisfy the CM premise, which is required during NextRecvUpd' steps.\<close>
	+lemma msg_is_cm_safe:
	+ fixes c :: "('p::finite, 't::order, 'loc) configuration"
	+ assumes "safe (prop_config c q)"
	+ and "InvGlobPointstampsEq c"
	+ and "cri.InvMsgInGlob (exchange_config c)"
	+ and "c_msg (exchange_config c) p q \<noteq> []"
	+ shows "\<forall>(loc,t) \<in>#\<^sub>z (hd (c_msg (exchange_config c) p q)). \<exists>t'. t' \<in>\<^sub>A frontier (c_imp (prop_config c q) loc) \<and> t' \<le> t"
	+ using assms(3)[unfolded cri.InvMsgInGlob_def, rule_format, OF assms(4)] assms(1)[unfolded safe_def, rule_format]
	+ apply (clarsimp simp: cri_less_eq_def assms(2)[unfolded InvGlobPointstampsEq_def, rule_format, symmetric])
	+ using order_trans apply blast
	+ done
	+
	+subsubsection\<open>Propagate Safety and InvGlobPointstampsEq\<close>
	+
	+text\<open>To be able to use the @{thm[source] msg_is_cm_safe} lemma at all times and show that Propagate is a
	+subsystem we need to prove that the specification implies Propagate's safe and the
	+InvGlobPointstampsEq. Both of these depend on the CM conditions being satisfied during the
	+NextRecvUpd' step and the safety proof additionally depends on other Propagate invariants, which
	+means that we need to prove all of these jointly.\<close>
	+
	+abbreviation prop_invs where
	+ "prop_invs c \<equiv> inv_implications_nonneg c \<and> inv_imps_work_sum c"
	+
	+abbreviation prop_safe where
	+ "prop_safe c \<equiv> impl_safe c \<and> safe c"
	+
	+definition inv_init_imp_prop_safe where
	+ "inv_init_imp_prop_safe c = (\<forall>p. init c p \<longrightarrow> prop_safe (prop_config c p))"
	+
	+lemma NextRecvUpd'_preserves_prop_safe:
	+ assumes "prop_safe (prop_config c0 q)"
	+ and "InvGlobPointstampsEq c0"
	+ and "cri.InvMsgInGlob (exchange_config c0)"
	+ and "NextRecvUpd' c0 c1 p q"
	+ shows "prop_safe (prop_config c1 q)"
	+proof -
	+ have safe: "safe (prop_config c0 q)"
	+ using assms(1) by blast
	+ note recvupd_change = cri.next_recvupdD(1)[OF NextRecvUpdD(2)[OF assms(4)]]
	+ note cm_conds = msg_is_cm_safe[OF safe assms(2,3) recvupd_change]
	+ have safes:
	+ "prop_safe c0 \<Longrightarrow> next_change_multiplicity' c0 c1 loc t n \<Longrightarrow> prop_safe c1" for c0 c1 loc t n
	+ using
	+ cm_preserves_safe
	+ cm_preserves_impl_safe
	+ by auto
	+ show "prop_safe (prop_config c1 q)"
	+ using
	+ lift_cm_inv_cm_all[rotated, OF cm_conds, of prop_safe, OF assms(1)]
	+ safes
	+ NextRecvUpdD(4)[OF assms(4)]
	+ by metis
	+qed
	+
	+lemma NextRecvUpd'_preserves_InvGlobPointstampsEq:
	+ assumes "impl_safe (prop_config c0 q) \<and> safe (prop_config c0 q)"
	+ and "InvGlobPointstampsEq c0"
	+ and "cri.InvMsgInGlob (exchange_config c0)"
	+ and "NextRecvUpd' c0 c1 p q"
	+ shows "InvGlobPointstampsEq c1"
	+proof -
	+ have safe: "safe (prop_config c0 q)"
	+ using assms(1) by blast
	+ note recvupd_change = cri.next_recvupdD(1)[OF NextRecvUpdD(2)[OF assms(4)]]
	+ note cm_conds = msg_is_cm_safe[OF safe assms(2,3) recvupd_change]
	+ show "InvGlobPointstampsEq c1"
	+ using
	+ assms(2,4)
	+ cm_conds
	+ unfolding NextRecvUpd'_def cri.next_recvupd'_def Let_def InvGlobPointstampsEq_def
	+ by (clarsimp simp: zcount_pointstamps_cm_all' cm_all_eq_cm_all')+
	+qed
	+
	+\<comment> \<open>Whenever some worker p propagates it ends up in a Propagate-safe state\<close>
	+lemma NextPropagate'_causes_safe:
	+ assumes "NextPropagate' c0 c1 p"
	+ and "inv_imps_work_sum (prop_config c1 p)"
	+ and "inv_implications_nonneg (prop_config c1 p)"
	+ shows "safe (prop_config c1 p)" "impl_safe (prop_config c1 p)"
	+proof -
	+ from assms(1) have "Some (prop_config c1 p) = propagate_all (prop_config c0 p)"
	+ by (simp add: NextPropagate'_def)
	+ then have wl: "c_work (prop_config c1 p) loc = {#}\<^sub>z" for loc
	+ unfolding propagate_all_def
	+ by (subst (asm) eq_commute) (auto dest: while_option_stop)
	+ show "safe (prop_config c1 p)" "impl_safe (prop_config c1 p)"
	+ by (rule safe[OF assms(2,3) wl]) (rule impl_safe[OF assms(2,3) wl])
	+qed
	+
	+\<comment> \<open>NextPropagate' preserves Propagate-safe at all workers\<close>
	+lemma NextPropagate'_preserves_safe:
	+ assumes "NextPropagate' c0 c1 q"
	+ and "inv_imps_work_sum (prop_config c1 p)"
	+ and "inv_implications_nonneg (prop_config c1 p)"
	+ and "safe (prop_config c0 p)"
	+ shows "safe (prop_config c1 p)"
	+ apply (cases "p=q")
	+ subgoal
	+ using assms(1-3) by (auto intro: NextPropagate'_causes_safe)
	+ subgoal
	+ using assms(1,4) by (auto dest: spec[of _ p] simp: NextPropagate'_def)
	+ done
	+
	+lemma NextPropagate'_preserves_impl_safe:
	+ assumes "NextPropagate' c0 c1 q"
	+ and "inv_imps_work_sum (prop_config c1 p)"
	+ and "inv_implications_nonneg (prop_config c1 p)"
	+ and "impl_safe (prop_config c0 p)"
	+ shows "impl_safe (prop_config c1 p)"
	+ apply (cases "p=q")
	+ subgoal
	+ using assms(1-3) by (auto intro: NextPropagate'_causes_safe)
	+ subgoal
	+ using assms(1,4) by (auto dest: spec[of _ p] simp: NextPropagate'_def)
	+ done
	+
	+lemma NextRecvUpd'_preserves_inv_init_imp_prop_safe:
	+ assumes "cri.InvMsgInGlob (exchange_config c0)"
	+ and "inv_init_imp_prop_safe c0"
	+ and "InvGlobPointstampsEq c0"
	+ and "NextRecvUpd' c0 c1 p q"
	+ shows "inv_init_imp_prop_safe c1"
	+ using assms(2) unfolding inv_init_imp_prop_safe_def
	+ apply clarify
	+ subgoal for p
	+ apply (cases "p=q")
	+ subgoal
	+ apply (drule spec[of _p])
	+ apply (simp add: NextRecvUpdD(1)[OF assms(4)])
	+ apply (drule NextRecvUpd'_preserves_prop_safe[OF _ assms(3,1,4)])
	+ apply simp
	+ done
	+ subgoal
	+ using NextRecvUpdD(3,4)[OF assms(4)] by fastforce
	+ done
	+ done
	+
	+lemma NextRecvUpd'_preserves_prop_invs:
	+ assumes "cri.InvMsgInGlob (exchange_config c0)"
	+ and "inv_init_imp_prop_safe c0"
	+ and "\<forall>p. prop_invs (prop_config c0 p)"
	+ and "InvGlobPointstampsEq c0"
	+ and "NextRecvUpd' c0 c1 p q"
	+ shows "\<forall>p. prop_invs (prop_config c1 p)"
	+proof -
	+ have safe: "safe (prop_config c0 q)"
	+ using NextRecvUpdD(1) assms(2,5) inv_init_imp_prop_safe_def by blast
	+ note recvupd_change = cri.next_recvupdD(1)[OF NextRecvUpdD(2)[OF assms(5)]]
	+ note cm_conds = msg_is_cm_safe[OF safe assms(4,1) recvupd_change]
	+ have invs:
	+ "prop_invs c0 \<Longrightarrow> next_change_multiplicity' c0 c1 loc t n \<Longrightarrow> prop_invs c1" for c0 c1 loc t n
	+ using
	+ cm_preserves_inv_imps_work_sum
	+ cm_preserves_inv_implications_nonneg
	+ by auto
	+ show "\<forall>q. prop_invs (prop_config c1 q)"
	+ apply rule
	+ subgoal for q'
	+ apply (cases "q'=q")
	+ subgoal
	+ using
	+ lift_cm_inv_cm_all[rotated, OF cm_conds, of prop_invs, OF assms(3)[rule_format]]
	+ invs
	+ NextRecvUpdD(4)[OF assms(5)]
	+ by metis
	+ subgoal
	+ using NextRecvUpdD(4) assms(3) assms(5) by fastforce
	+ done
	+ done
	+qed
	+
	+lemma NextPropagate'_preserves_prop_invs:
	+ assumes "prop_invs (prop_config c0 q)"
	+ and "NextPropagate' c0 c1 p"
	+ shows "prop_invs (prop_config c1 q)"
	+ apply (cases "p=q")
	+ subgoal
	+ using
	+ assms(1)
	+ lift_propagate_inv_propagate_all[
	+ of prop_invs,
	+ rotated 2,
	+ OF NextPropagateD(3)[OF assms(2), rule_format, of p, simplified, symmetric]]
	+ by (simp add: iiws_imp_iipwn p_preserves_inv_implications_nonneg p_preserves_inv_imps_work_sum)
	+ subgoal
	+ by (metis NextPropagateD(3) assms(1) assms(2) option.simps(1))
	+ done
	+
	+lemma NextPropagate'_preserves_inv_init_imp_prop_safe:
	+ assumes "prop_invs (prop_config c0 p)"
	+ and "inv_init_imp_prop_safe c0"
	+ and "NextPropagate' c0 c1 p"
	+ shows "inv_init_imp_prop_safe c1"
	+ using assms(2) unfolding inv_init_imp_prop_safe_def
	+ apply clarsimp
	+ subgoal for p'
	+ apply (cases "p'=p")
	+ subgoal
	+ using NextPropagate'_preserves_prop_invs[OF assms(1,3)]
	+ using NextPropagate'_causes_safe(1,2)[OF assms(3)] by blast
	+ subgoal
	+ using NextPropagateD(2,3)[OF assms(3)]
	+ by (auto dest: spec[of _ p'])
	+ done
	+ done
	+
	+lemma Next'_preserves_invs:
	+ assumes "cri.InvMsgInGlob (exchange_config c0)"
	+ and "inv_init_imp_prop_safe c0"
	+ and "InvGlobPointstampsEq c0"
	+ and "Next' c0 c1"
	+ and "\<forall>p. prop_invs (prop_config c0 p)"
	+ shows
	+ "inv_init_imp_prop_safe c1"
	+ "\<forall>p. prop_invs (prop_config c1 p)"
	+ "InvGlobPointstampsEq c1"
	+ subgoal
	+ using assms(4) unfolding Next'_def
	+ using assms(2)
	+ apply (elim disjE)
	+ subgoal
	+ unfolding inv_init_imp_prop_safe_def
	+ using NextPerformOpD(2,3) by fastforce
	+ subgoal
	+ unfolding inv_init_imp_prop_safe_def
	+ using NextSendUpdD(2,3) by fastforce
	+ subgoal
	+ using NextRecvUpd'_preserves_inv_init_imp_prop_safe[OF assms(1,2,3)]
	+ by blast
	+ subgoal
	+ using NextPropagate'_preserves_inv_init_imp_prop_safe assms(5) by blast
	+ subgoal
	+ unfolding inv_init_imp_prop_safe_def
	+ using NextRecvCapD(2,3) by fastforce
	+ subgoal by simp
	+ done
	+ subgoal
	+ using assms(4) unfolding Next'_def
	+ using assms(5)
	+ apply (elim disjE)
	+ subgoal
	+ using NextPerformOpD(2) by fastforce
	+ subgoal
	+ using NextSendUpdD(2) by fastforce
	+ subgoal
	+ using assms(1,2,3) NextRecvUpd'_preserves_prop_invs by blast
	+ subgoal
	+ using NextPropagate'_preserves_prop_invs by blast
	+ subgoal
	+ unfolding inv_init_imp_prop_safe_def
	+ using NextRecvCapD(2,3) by fastforce
	+ subgoal by simp
	+ done
	+ subgoal
	+ using assms(4) unfolding Next'_def
	+ using assms(3)
	+ apply (elim disjE)
	+ subgoal
	+ by (metis InvGlobPointstampsEq_def NextPerformOpD(1,2) cri.next_performopD(7))
	+ subgoal
	+ by (metis InvGlobPointstampsEq_def NextSendUpdD(1,2) cri.next_sendupdD(5))
	+ subgoal
	+ using NextRecvUpdD(1) NextRecvUpd'_preserves_InvGlobPointstampsEq assms(1,2) inv_init_imp_prop_safe_def by blast
	+ subgoal
	+ unfolding NextPropagate'_def InvGlobPointstampsEq_def
	+ using propagate_all_imp_InvGlobPointstampsEq
	+ by (metis option.inject)
	+ subgoal
	+ by (metis InvGlobPointstampsEq_def NextRecvCapD(1) NextRecvCapD(2) cri.next_recvcapD(4))
	+ subgoal by simp
	+ done
	+ done
	+
	+lemma init_imp_InvGlobPointstampsEq: "InitConfig c \<Longrightarrow> InvGlobPointstampsEq c"
	+ by (simp add: InitConfig_def cri.init_config_def InvGlobPointstampsEq_def)
	+
	+lemma init_imp_inv_init_imp_prop_safe: "InitConfig c \<Longrightarrow> inv_init_imp_prop_safe c"
	+ by (simp add: inv_init_imp_prop_safe_def InitConfig_def)
	+
	+lemma init_imp_prop_invs: "InitConfig c \<Longrightarrow> \<forall>p. prop_invs (prop_config c p)"
	+ by (simp add: InitConfig_def init_imp_inv_implications_nonneg init_imp_inv_imps_work_sum)
	+
	+abbreviation all_invs where
	+ "all_invs c \<equiv> InvGlobPointstampsEq c \<and> inv_init_imp_prop_safe c \<and> (\<forall>p. prop_invs (prop_config c p))"
	+
	+lemma alw_Next'_alw_invs:
	+ assumes "holds all_invs s"
	+ and "alw (holds (\<lambda>c. cri.InvMsgInGlob (exchange_config c))) s"
	+ and "alw Next s"
	+ shows "alw (holds all_invs) s"
	+ using assms
	+ apply (coinduction arbitrary: s)
	+ apply clarsimp
	+ apply safe
	+ apply (metis (mono_tags, lifting) alw_holds2 Next'_preserves_invs(3) alwD)
	+ apply (metis (mono_tags, lifting) alw_holds2 Next'_preserves_invs(1) alwD)
	+ apply (metis (mono_tags, lifting) alw_holds2 Next'_preserves_invs(2) alwD)
	+ apply (metis (mono_tags, lifting) alw_holds2 Next'_preserves_invs(2) alwD)
	+ apply auto
	+ done
	+
	+lemma alw_invs: "FullSpec s \<Longrightarrow> alw (holds all_invs) s"
	+ apply (frule exch_alw_InvMsgInGlob)
	+ unfolding FullSpec_def
	+ apply clarsimp
	+ apply (frule init_imp_InvGlobPointstampsEq)
	+ apply (frule init_imp_inv_init_imp_prop_safe)
	+ apply (drule init_imp_prop_invs)
	+ by (simp add: alw_Next'_alw_invs alw_mono)
	+
	+lemma alw_InvGlobPointstampsEq: "FullSpec s \<Longrightarrow> alw (holds InvGlobPointstampsEq) s"
	+ using alw_invs alw_mono holds_mono by blast
	+
	+lemma alw_inv_init_imp_prop_safe: "FullSpec s \<Longrightarrow> alw (holds inv_init_imp_prop_safe) s"
	+ using alw_invs alw_mono holds_mono by blast
	+
	+lemma alw_holds_conv_shd: "alw (holds \<phi>) s = alw (\<lambda>s. \<phi> (shd s)) s"
	+ by (simp add: alw_iff_sdrop)
	+
	+lemma alw_prop_invs: "FullSpec s \<Longrightarrow> alw (holds (\<lambda>c. \<forall>p. prop_invs (prop_config c p))) s"
	+ by (auto
	+ intro: alw_mono[of "holds all_invs" s "holds (\<lambda>c. \<forall>p. prop_invs (prop_config c p))"]
	+ dest: alw_invs)
	+
	+lemma nrec_pts_delayed:
	+ assumes "cri.InvGlobNonposImpRecordsNonpos (exchange_config c)"
	+ and "zcount (cri.records (exchange_config c)) x > 0"
	+ shows "\<exists>x'. x' \<le>\<^sub>p x \<and> zcount (c_glob (exchange_config c) p) x' > 0"
	+proof -
	+ from assms have r: "\<forall>p. \<not> cri.nonpos_upto (c_glob (exchange_config c) p) x"
	+ unfolding cri.InvGlobNonposImpRecordsNonpos_def cri.nonpos_upto_def
	+ by (metis linorder_not_less cri.order.order_iff_strict)
	+ show ?thesis
	+ using r[rule_format, of p]
	+ by (auto simp: cri.nonpos_upto_def not_le)
	+qed
	+
	+lemma help_lemma:
	+ assumes "0 < zcount (c_pts (prop_config c p) loc0) t0"
	+ and "(loc0, t0) \<le>\<^sub>p (loc1, t1)"
	+ and "s2 \<in>\<^sub>A path_summary loc1 loc2"
	+ and "safe (prop_config c p)"
	+ shows "\<exists> t2. (t2 \<le> results_in t1 s2
	+ \<and> t2 \<in>\<^sub>A frontier (c_imp (prop_config c p) loc2))"
	+proof -
	+ from assms(2) obtain s1 where s1: "s1 \<in>\<^sub>A path_summary loc0 loc1" "results_in t0 s1 \<le> t1"
	+ by (auto simp add: cri_less_eq_def)
	+ from s1(1) assms(3) obtain s_full where s_full: "s_full \<in>\<^sub>A path_summary loc0 loc2" "s_full \<le> followed_by s1 s2"
	+ using flow.path_weight_elem_trans by blast
	+ from s_full(1) assms(1,4) obtain t2 where t2:
	+ "t2 \<in>\<^sub>A frontier (c_imp (prop_config c p) loc2)" "t2 \<le> results_in t0 s_full"
	+ unfolding safe_def by blast
	+ from t2(2) and s_full(2) have "t2 \<le> results_in (results_in t0 s1) s2"
	+ by (metis followed_by_summary order_trans results_in_mono(2))
	+ with s1(2) have "t2 \<le> results_in t1 s2" by (meson order.trans results_in_mono(1))
	+ with t2(1) show ?thesis by auto
	+qed
	+
	+\<comment> \<open>Lift an invariant's preservation proof over @{term next_propagate'} to NextPropagate' transitions\<close>
	+lemma lift_prop_inv_NextPropagate':
	+ assumes "(\<And>c0 c1 loc t. P c0 \<Longrightarrow> next_propagate' c0 c1 loc t \<Longrightarrow> P c1)"
	+ shows "P (prop_config c0 p') \<Longrightarrow> NextPropagate' c0 c1 p \<Longrightarrow> P (prop_config c1 p')"
	+proof -
	+ assume pc0: "P (prop_config c0 p')"
	+ assume np: "NextPropagate' c0 c1 p"
	+ have n_p: "(\<And>c0 c1. P c0 \<Longrightarrow> next_propagate c0 c1 \<Longrightarrow> P c1)"
	+ using assms by auto
	+ let ?f = "\<lambda>c. SOME c'. next_propagate c c'"
	+ let ?b = "\<lambda>c. \<exists>loc. c_work c loc \<noteq> {#}\<^sub>z"
	+ from np have pc1: "Some (prop_config c1 p) = propagate_all (prop_config c0 p)"
	+ by (simp add: NextPropagate'_def)
	+ show ?thesis
	+ apply (cases "p'=p")
	+ subgoal
	+ apply (rule while_option_rule[of P ?b ?f "prop_config c0 p"])
	+ apply (rule n_p)
	+ apply assumption
	+ apply (rule iffD1[OF verit_sko_ex])
	+ apply (elim exE)
	+ apply (rule exists_next_propagate')
	+ apply assumption
	+ using pc1 apply (simp add: propagate_all_def)
	+ using pc0 apply simp
	+ done
	+ subgoal
	+ using np pc0 by (auto simp: NextPropagate'_def dest!: spec[of _ p'])
	+ done
	+qed
	+
	+subsubsection\<open>Propagate is a Subsystem\<close>
	+
	+
	+lemma NextRecvUpd'_next':
	+ assumes "safe (prop_config c0 q)"
	+ and "InvGlobPointstampsEq c0"
	+ and "cri.InvMsgInGlob (exchange_config c0)"
	+ and "NextRecvUpd' c0 c1 p q"
	+ shows "next'\<^sup>+\<^sup>+ (prop_config c0 q') (prop_config c1 q')"
	+ apply (subst NextRecvUpdD(4)[OF assms(4), rule_format])
	+ apply simp
	+ apply safe
	+ subgoal
	+ apply (subst cm_all_eq_cm_all')
	+ apply clarsimp
	+ apply (drule assms(3)[unfolded cri.InvMsgInGlob_def, rule_format, OF cri.next_recvupdD(1)[OF NextRecvUpdD(2)[OF assms(4)]]])
	+ apply clarsimp
	+ subgoal for loc t loc' t'
	+ apply (subst (asm) assms(2)[unfolded InvGlobPointstampsEq_def, rule_format, symmetric])
	+ apply (clarsimp simp: cri_less_eq_def)
	+ subgoal for s
	+ using assms(1)[unfolded safe_def, rule_format, of loc' t' s loc]
	+ apply -
	+ apply (drule meta_mp)
	+ apply simp
	+ apply clarsimp
	+ subgoal for t''
	+ apply (clarsimp intro!: exI[of _ t''])
	+ using order_trans apply blast
	+ done
	+ done
	+ done
	+ apply (rule lift_cm_inv_cm_all')
	+ apply (rule tranclp.intros(2))
	+ apply (auto simp: next'_def) [2]
	+ apply clarsimp
	+ apply (drule assms(3)[unfolded cri.InvMsgInGlob_def, rule_format, OF cri.next_recvupdD(1)[OF NextRecvUpdD(2)[OF assms(4)]]])
	+ apply clarsimp
	+ subgoal for loc t loc' t'
	+ apply (subst (asm) assms(2)[unfolded InvGlobPointstampsEq_def, rule_format, symmetric])
	+ apply (clarsimp simp: cri_less_eq_def)
	+ subgoal for s
	+ using assms(1)[unfolded safe_def, rule_format, of loc' t' s loc]
	+ apply -
	+ apply (drule meta_mp)
	+ apply simp
	+ apply clarsimp
	+ subgoal for t''
	+ apply (clarsimp intro!: exI[of _ t''])
	+ using order_trans apply blast
	+ done
	+ done
	+ done
	+ apply (auto simp: next'_def)
	+ done
	+ apply (auto simp: next'_def)
	+ done
	+
	+lemma NextPropagate'_next':
	+ assumes "NextPropagate' c0 c1 p"
	+ shows "next'\<^sup>+\<^sup>+ (prop_config c0 q) (prop_config c1 q)"
	+ apply (cases "p=q")
	+ subgoal
	+ apply (rule lift_propagate_inv_propagate_all[of _ "prop_config c0 p"])
	+ apply (rule tranclp.intros(2))
	+ apply (auto simp: next'_def NextPropagateD(3)[OF assms, rule_format])
	+ done
	+ subgoal
	+ by (metis NextPropagateD(3) assms next'_def option.simps(1) tranclp.intros(1))
	+ done
	+
	+lemma next_imp_propagate_next:
	+ assumes "inv_init_imp_prop_safe c0"
	+ and "InvGlobPointstampsEq c0"
	+ and "cri.InvMsgInGlob (exchange_config c0)"
	+ shows "Next' c0 c1 \<Longrightarrow> next'\<^sup>+\<^sup>+ (prop_config c0 p) (prop_config c1 p)"
	+ unfolding Next'_def NextPerformOp'_def NextSendUpd'_def NextRecvCap'_def
	+ apply safe
	+ subgoal by (auto simp: next'_def)
	+ subgoal by (auto simp: next'_def)
	+ subgoal for p' q
	+ using assms(1)[unfolded inv_init_imp_prop_safe_def, rule_format, of q]
	+ apply -
	+ apply (drule meta_mp)
	+ apply (rule NextRecvUpdD(1))
	+ apply simp
	+ apply (cases "q=p")
	+ apply (auto dest!: NextRecvUpd'_next'[rotated, OF assms(2-)]) []
	+ apply (auto simp add: NextRecvUpd'_def next'_def)
	+ done
	+ subgoal by (rule NextPropagate'_next')
	+ subgoal by (auto simp: next'_def)
	+ subgoal by (auto simp: next'_def)
	+ done
	+
	+lemma alw_next_imp_propagate_next:
	+ assumes "alw (holds inv_init_imp_prop_safe) s"
	+ and "alw (holds InvGlobPointstampsEq) s"
	+ and "alw (holds cri.InvMsgInGlob) (smap exchange_config s)"
	+ and "alw Next s"
	+ shows "alw (relates (next'\<^sup>+\<^sup>+)) (smap (\<lambda>s. prop_config s p) s)"
	+ using assms by (coinduction arbitrary: s rule: alw.coinduct) (auto intro!: next_imp_propagate_next simp: relates_def alw_holds_smap_conv_comp)
	+
	+text\<open>Any Tracker trace is a valid Propagate trace (using the transitive closure of next, since
	+tracker may take multiple propagate steps at once).\<close>
	+lemma spec_imp_propagate_spec: "FullSpec s \<Longrightarrow> (holds init_config aand alw (relates (next'\<^sup>+\<^sup>+))) (smap (\<lambda>c. prop_config c p) s)"
	+ apply (frule alw_inv_init_imp_prop_safe)
	+ apply (frule alw_InvGlobPointstampsEq)
	+ apply (frule spec_imp_exchange_spec)
	+ apply (drule cri.alw_InvMsgInGlob)
	+ apply (auto intro!: alw_next_imp_propagate_next simp: FullSpec_def InitConfig_def)
	+ done
	+
	+subsection\<open>Safety Proofs\<close>
	+
	+lemma safe_satisfied:
	+ assumes "cri.InvGlobNonposImpRecordsNonpos (exchange_config c)"
	+ and "inv_init_imp_prop_safe c"
	+ and "InvGlobPointstampsEq c"
	+ shows "safe_combined c"
	+proof -
	+ {
	+ fix loc1 loc2 t s p
	+ assume as: "0 < zcount (cri.records (exchange_config c)) (loc1, t)"
	+ "s \<in>\<^sub>A path_summary loc1 loc2" "init c p"
	+ obtain loc0 t0 where delayed:
	+ "(loc0, t0) \<le>\<^sub>p (loc1, t)" "0 < zcount (c_glob (exchange_config c) p) (loc0, t0)"
	+ using nrec_pts_delayed[OF assms(1) as(1)]
	+ by fast
	+ with as(2,3) assms(2) have
	+ "\<exists>t2. t2 \<le> results_in t s \<and> t2 \<in>\<^sub>A frontier (c_imp (prop_config c p) loc2)"
	+ using help_lemma delayed
	+ by (metis InvGlobPointstampsEq_def assms(3) inv_init_imp_prop_safe_def)
	+ }
	+ then show ?thesis
	+ unfolding safe_combined_def by blast
	+qed
	+
	+lemma alw_safe_combined: "FullSpec s \<Longrightarrow> alw (holds safe_combined) s"
	+ apply (frule alw_inv_init_imp_prop_safe)
	+ apply (frule exch_alw_InvGlobNonposImpRecordsNonpos)
	+ apply (drule alw_InvGlobPointstampsEq)
	+ apply (coinduction arbitrary: s rule: alw.coinduct)
	+ apply clarsimp
	+ apply (rule conjI)
	+ apply (metis alwD alw_holds2 safe_satisfied)
	+ apply (rule disjI1)
	+ apply blast
	+ done
	+
	+lemma alw_safe_combined2: "FullSpec s \<Longrightarrow> alw (holds safe_combined2) s"
	+ apply (frule exch_alw_InvCapsNonneg)
	+ apply (drule alw_safe_combined)
	+ apply (simp add: alw_iff_sdrop safe_combined_implies_safe_combined2)
	+ done
	+
	+lemma alw_implication_frontier_eq_implied_frontier:
	+ "FullSpec s \<Longrightarrow>
	+ alw (holds (\<lambda>c. worklists_vacant_to (prop_config c p) b \<longrightarrow>
	+ b \<in>\<^sub>A frontier (c_imp (prop_config c p) loc) \<longleftrightarrow> b \<in>\<^sub>A implied_frontier (c_pts (prop_config c p)) loc)) s"
	+ by (drule alw_prop_invs)
	+ (auto simp: implication_frontier_iff_implied_frontier_vacant all_imp_alw elim: alw_mp)
	+
	+end
	+
	+(<)
	+end
	+(>)
	\ No newline at end of file
	diff --git a/thys/Progress_Tracking/Exchange.thy b/thys/Progress_Tracking/Exchange.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/Exchange.thy
	@@ -0,0 +1,3193 @@
	+section \<open>Exchange Protocol\label{sec:exchange}\<close>
	+
	+(<)
	+theory Exchange
	+ imports
	+ "HOL-Library.While_Combinator"
	+ Auxiliary
	+begin
	+(>)
	+
	+subsection\<open>Specification\<close>
	+
	+record ('p, 't) configuration =
	+ c_temp :: "'p \<Rightarrow> 't zmultiset"
	+ c_msg :: "'p \<Rightarrow> 'p \<Rightarrow> 't zmultiset list"
	+ c_glob :: "'p \<Rightarrow> 't zmultiset"
	+ c_caps :: "'p \<Rightarrow> 't zmultiset"
	+ c_data_msg :: "('p \<times> 't) multiset"
	+
	+text\<open>
	+Description of the configuration:
	+@{term "c_msg c p q"} global, all progress messages currently in-flight from p to q
	+@{term "c_data_msg c"} global, capabilities carried by in-flight data messages
	+@{term "c_temp c p"} local, aggregated progress updates of worker p that haven't been sent yet
	+@{term "c_glob c p"} local, worker p's conservative approximation of all capabilities in the system
	+@{term "c_caps c p"} local, worker p's capabilities
	+
	+global = state of the whole system to which no worker has access
	+local = state that is kept locally by each worker and which it can access
	+\<close>
	+
	+type_synonym ('p, 't) computation = "('p, 't) configuration stream"
	+
	+context order begin
	+
	+abbreviation "timestamps M \<equiv> {# t. (x,t) \<in>#\<^sub>z M #}"
	+
	+definition vacant_upto :: "'a zmultiset \<Rightarrow> 'a \<Rightarrow> bool" where
	+ "vacant_upto a t \<equiv> (\<forall>s. s \<le> t \<longrightarrow> zcount a s = 0)"
	+
	+definition nonpos_upto :: "'a zmultiset \<Rightarrow> 'a \<Rightarrow> bool" where
	+ "nonpos_upto a t = (\<forall>s. s \<le> t \<longrightarrow> zcount a s \<le> 0)"
	+
	+definition supported :: "'a zmultiset \<Rightarrow> 'a \<Rightarrow> bool" where
	+ "supported a t \<equiv> (\<exists>s. s < t \<and> zcount a s < 0)"
	+
	+definition supported_strong :: "'a zmultiset \<Rightarrow> 'a \<Rightarrow> bool" where
	+ "supported_strong a t \<equiv> (\<exists>s. s < t \<and> zcount a s < 0 \<and> nonpos_upto a s)"
	+
	+definition justified where
	+ "justified C M = (\<forall>t. 0 < zcount M t \<longrightarrow> supported M t \<or> (\<exists>t'<t. 0 < zcount C t') \<or> zcount M t < zcount C t)"
	+
	+lemma justified_alt:
	+ "justified C M = (\<forall>t. 0 < zcount M t \<longrightarrow> supported_strong M t \<or> (\<exists>t'<t. 0 < zcount C t') \<or> zcount M t < zcount C t)"
	+ unfolding justified_def supported_def supported_strong_def
	+ apply (rule iffI)
	+ apply clarsimp
	+ apply (drule order_zmset_exists_foundation')
	+ apply clarsimp
	+ subgoal for t s
	+ apply (drule spec[of _ s])
	+ apply safe
	+ apply (meson le_less_trans less_le_trans nonpos_upto_def)
	+ using order.strict_trans2 apply blast
	+ using order.order_iff_strict apply auto
	+ done
	+ apply blast
	+ done
	+
	+definition justified_with where
	+ "justified_with C M N =
	+ (\<forall>t. 0 < zcount M t \<longrightarrow>
	+ (\<exists>s<t. (zcount M s < 0 \<or> zcount N s < 0)) \<or>
	+ (\<exists>s<t. 0 < zcount C s) \<or>
	+ zcount (M+N) t < zcount C t)"
	+
	+lemma justified_with_alt: "justified_with C M N =
	+ (\<forall>t. 0 < zcount M t \<longrightarrow>
	+ (\<exists>s<t. (zcount M s < 0 \<or> zcount N s < 0) \<and> (\<forall>s'<s. zcount M s' \<le> 0)) \<or>
	+ (\<exists>s<t. 0 < zcount C s) \<or>
	+ zcount (M+N) t < zcount C t)"
	+ unfolding justified_with_def
	+ apply (rule iffI)
	+ apply clarsimp
	+ apply (drule order_zmset_exists_foundation')
	+ apply clarsimp
	+ subgoal for t s
	+ apply (drule spec[of _ s])
	+ apply safe
	+ using order.strict_trans order.strict_trans2 apply blast+
	+ apply (metis add_less_zeroD order.order_iff_strict not_less_iff_gr_or_eq order_class.order.strict_trans)
	+ done
	+ apply blast
	+ done
	+
	+definition PositiveImplies where
	+ "PositiveImplies v w \<equiv> \<forall>t. zcount v t > 0 \<longrightarrow> zcount w t > 0"
	+
	+\<comment> \<open>A worker can mint capabilities greater or equal to any owned capability\<close>
	+definition minting_self where
	+ "minting_self C M = (\<forall>t\<in>#M. \<exists>t'\<le>t. 0 < zcount C t')"
	+
	+\<comment> \<open>Sending messages mints a capability at a strictly greater pointstamp\<close>
	+definition minting_msg where
	+ "minting_msg C M = (\<forall>(p,t)\<in>#M. \<exists>t'<t. 0 < zcount C t')"
	+
	+definition records where
	+ "records c = (\<Sum>p\<in>UNIV. c_caps c p) + timestamps (zmset_of (c_data_msg c))"
	+
	+definition InfoAt where
	+ "InfoAt c k p q = (if 0 \<le> k \<and> k < length (c_msg c p q) then (c_msg c p q) ! k else {#}\<^sub>z)"
	+
	+definition IncomingInfo :: "('p, 'a) configuration \<Rightarrow> nat \<Rightarrow> 'p \<Rightarrow> 'p \<Rightarrow> 'a zmultiset" where
	+ "IncomingInfo c k p q \<equiv> sum_list (drop k (c_msg c p q)) + c_temp c p"
	+
	+definition GlobalIncomingInfo :: "('p :: finite, 'a) configuration \<Rightarrow> nat \<Rightarrow> 'p \<Rightarrow> 'p \<Rightarrow> 'a zmultiset" where
	+ "GlobalIncomingInfo c k p q \<equiv> \<Sum>p' \<in> UNIV. IncomingInfo c (if p' = p then k else 0) p' q"
	+
	+(* (GlobalIncomingInfo c 0 q q) sums up all info incoming at q *)
	+abbreviation GlobalIncomingInfoAt where
	+ "GlobalIncomingInfoAt c q \<equiv> GlobalIncomingInfo c 0 q q"
	+
	+definition init_config :: "('p :: finite, 'a) configuration \<Rightarrow> bool" where
	+ "init_config c \<equiv>
	+ (\<forall>p. c_temp c p = {#}\<^sub>z) \<and>
	+ (\<forall>p1 p2. c_msg c p1 p2 = []) \<and>
	+ \<comment> \<open>Capabilities have non-negative multiplicities\<close>
	+ (\<forall>p t. 0 \<le> zcount (c_caps c p) t) \<and>
	+ \<comment> \<open>The pointstamps in glob are exactly those in @{term records}\<close>
	+ (\<forall>p. c_glob c p = records c) \<and>
	+ \<comment> \<open>All capabilities are being tracked\<close>
	+ c_data_msg c = {#}"
	+
	+(* Processor receives a capability, i.e. in timely: receives a data message *)
	+definition next_recvcap' :: "('p :: finite, 'a) configuration \<Rightarrow> ('p, 'a) configuration \<Rightarrow> 'p \<Rightarrow> 'a \<Rightarrow> bool" where
	+ "next_recvcap' c0 c1 p t = (
	+ (p,t) \<in># c_data_msg c0
	+ \<and> c1 = c0\<lparr>c_caps := (c_caps c0)(p := c_caps c0 p + {#t#}\<^sub>z),
	+ c_data_msg := c_data_msg c0 - {#(p,t)#}\<rparr>)"
	+
	+abbreviation next_recvcap where
	+ "next_recvcap c0 c1 \<equiv> \<exists>p t. next_recvcap' c0 c1 p t"
	+
	+text\<open>
	+Can minting of capabilities be described as a refinement of the Abadi model?
	+Short answer: No, not in general.
	+Long answer:
	+Could slightly modify Abadi model, such that a capability always comes with a multiplicity $2^64$ (or
	+similar, could be parametrized over arbitrarily large constant). In that case minting new
	+capabilities can be described as an upright change, dropping one of the capabilities, to make the
	+change upright. This only works as long as no capability is required more than the constant number
	+of times.
	+Issues:
	+- Not fully general, due to the arbitrary constant
	+- Not clear whether refinement proofs would be easier than simply altering the model to support the operations
	+\<close>
	+
	+text\<open>Rationale for the condition on @{term "c_caps c0 p"}:
	+In Abadi, the operation @{term next_performop'} has the premise @{term "\<forall>t. int (count \<Delta>neg t) \<le> zcount (records c0) t"},
	+(records corresponds to the global field @{term nrec} in that model)
	+which means the processor performing the transition must verify that this condition is met.
	+Since @{term "records c"} is "global" state, which no processor can know, an implementation of
	+this protocol has to include some other protocol or reasoning for when it is safe to do this
	+transition.
	+
	+Naively using a processor's @{term "c_glob c p"} to approximate @{term "records c"} and justify
	+transitions can cause a race condition, where a processor drops a pointstamp, e.g.,
	+@{term "\<Delta>neg = {#t#}"}, after which @{term "zcount (records c) t = 0"} but other processors might still
	+use the pointstamp to justify the creation of pointstamps that violate the safety property.
	+
	+Instead we model ownership of pointstamps, calling "owned pointstamps" \<^bold>\<open>capabilities\<close>, which are
	+tracked in @{term "c_caps c"}. In place of @{term nrec} we define @{term "records c"}, which is the sum of
	+all capabilities, as well as @{term "c_data_msg c"}, which contains the capabilities carried by data
	+messages. Since @{term "\<forall>p t. zcount (c_caps c p) t \<le> zcount (records c) t"}, our condition
	+@{term "\<forall>t. int (count \<Delta>neg t) \<le> zcount (c_caps c0 p) t"} implies the one on @{term nrec} in Abadi's model.
	+\<close>
	+
	+text\<open>Conditions in performop:
	+
	+The performop transition takes three msets of pointstamps, @{term \<Delta>neg}, @{term \<Delta>mint_msg}, and @{term \<Delta>mint_self}
	+@{term \<Delta>neg} contains dropped capabilities (a subset of @{term c_caps})
	+@{term \<Delta>mint_msg} contains pairs @{term "(p,t)"}, where a data message is sent (i.e. capability added to the pool), creating a capability at t, owned by p
	+@{term \<Delta>mint_self} contains pointstamps minted and owned by worker @{term p}
	+
	+@{term \<Delta>neg} in combination with @{term \<Delta>mint_msg} also allows any upright updates to be made as in the Abadi model,
	+meaning this definition allows strictly more behaviors.
	+
	+The @{term "\<Delta>mint_msg \<noteq> {#} \<or> zmset_of \<Delta>mint_self - zmset_of \<Delta>neg \<noteq> {#}\<^sub>z"} condition ensures that
	+no-ops aren't possible. However, it's still possible that the combined @{term \<Delta>} is empty. E.g. a processor
	+has capabilities 1 and 2, uses cap 1 to send a message, minting capability 2. Simultaneously it
	+drops a capability 2 (for unrelated reasons), cancelling out the overall change but shifting a
	+capability to the pool, possibly with a different owner than itself.\<close>
	+
	+definition next_performop' :: "('p::finite, 'a) configuration \<Rightarrow> ('p, 'a) configuration \<Rightarrow> 'p \<Rightarrow> 'a multiset \<Rightarrow> ('p \<times> 'a) multiset \<Rightarrow> 'a multiset \<Rightarrow> bool" where
	+ "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self =
	+ \<comment> \<open>@{term \<Delta>pos} contains all positive changes, @{term \<Delta>} the combined positive and negative changes\<close>
	+ (let \<Delta>pos = timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self;
	+ \<Delta> = \<Delta>pos - zmset_of \<Delta>neg
	+ in
	+ (\<Delta>mint_msg \<noteq> {#} \<or> zmset_of \<Delta>mint_self - zmset_of \<Delta>neg \<noteq> {#}\<^sub>z)
	+ \<and> (\<forall>t. int (count \<Delta>neg t) \<le> zcount (c_caps c0 p) t)
	+ \<comment> \<open>Pointstamps added in @{term \<Delta>mint_self} are minted at p\<close>
	+ \<and> minting_self (c_caps c0 p) \<Delta>mint_self
	+ \<comment> \<open>Pointstamps added in @{term \<Delta>mint_msg} correspond to sent data messages\<close>
	+ \<and> minting_msg (c_caps c0 p) \<Delta>mint_msg
	+ \<comment> \<open>Worker immediately knows about dropped and minted capabilities\<close>
	+ \<and> c1 = c0\<lparr>c_caps := (c_caps c0)(p := c_caps c0 p + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg),
	+ \<comment> \<open>Sending a data message creates a capability, once that message arrives. This is modelled as
	+ a pool of capabilities that may (will) appear at processors at some point.\<close>
	+ c_data_msg := c_data_msg c0 + \<Delta>mint_msg,
	+ c_temp := (c_temp c0)(p := c_temp c0 p + \<Delta>)\<rparr>)"
	+
	+abbreviation next_performop where
	+ "next_performop c0 c1 \<equiv> (\<exists>p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self. next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self)"
	+
	+definition next_sendupd' :: "('p::finite, 'a) configuration \<Rightarrow> ('p, 'a) configuration \<Rightarrow> 'p \<Rightarrow> 'a set \<Rightarrow> bool" where
	+ "next_sendupd' c0 c1 p tt =
	+ (let \<gamma> = {#t \<in>#\<^sub>z c_temp c0 p. t \<in> tt#} in
	+ \<gamma> \<noteq> 0
	+ \<and> justified (c_caps c0 p) (c_temp c0 p - \<gamma>)
	+ \<and> c1 = c0\<lparr>c_msg := (c_msg c0)(p := \<lambda>q. c_msg c0 p q @ [\<gamma>]),
	+ c_temp := (c_temp c0)(p := c_temp c0 p - \<gamma>)\<rparr>)"
	+
	+abbreviation next_sendupd where
	+ "next_sendupd c0 c1 \<equiv> (\<exists>p tt. next_sendupd' c0 c1 p tt)"
	+
	+definition next_recvupd' :: "('p::finite, 'a) configuration \<Rightarrow> ('p, 'a) configuration \<Rightarrow> 'p \<Rightarrow> 'p \<Rightarrow> bool" where
	+ "next_recvupd' c0 c1 p q \<equiv>
	+ c_msg c0 p q \<noteq> []
	+ \<and> c1 = c0\<lparr>c_msg := (c_msg c0)(p := (c_msg c0 p)(q := tl (c_msg c0 p q))),
	+ c_glob := (c_glob c0)(q := c_glob c0 q + hd (c_msg c0 p q))\<rparr>"
	+
	+abbreviation next_recvupd where
	+ "next_recvupd c0 c1 \<equiv> (\<exists>p q. next_recvupd' c0 c1 p q)"
	+
	+definition "next'" where
	+ "next' c0 c1 = (next_performop c0 c1 \<or> next_sendupd c0 c1 \<or> next_recvupd c0 c1 \<or> next_recvcap c0 c1 \<or> c1 = c0)"
	+
	+abbreviation "next" where
	+ "next s \<equiv> next' (shd s) (shd (stl s))"
	+
	+definition spec :: "('p :: finite, 'a) computation \<Rightarrow> bool" where
	+ "spec s \<equiv> holds init_config s \<and> alw next s"
	+
	+abbreviation GlobVacantUpto where
	+ "GlobVacantUpto c q t \<equiv> vacant_upto (c_glob c q) t"
	+
	+abbreviation GlobNonposUpto where
	+ "GlobNonposUpto c q t \<equiv> nonpos_upto (c_glob c q) t"
	+
	+abbreviation RecordsVacantUpto where
	+ "RecordsVacantUpto c t \<equiv> vacant_upto (records c) t"
	+
	+definition SafeGlobVacantUptoImpliesStickyNrec :: "('p :: finite, 'a) computation \<Rightarrow> bool" where
	+ "SafeGlobVacantUptoImpliesStickyNrec s =
	+ (let c = shd s in \<forall>t q. GlobVacantUpto c q t \<longrightarrow> alw (holds (\<lambda>c. RecordsVacantUpto c t)) s)"
	+
	+subsection\<open>Auxiliary Lemmas\<close>
	+
	+lemma finite_induct_select [consumes 1, case_names empty select]:
	+ assumes "finite S"
	+ and empty: "P {}"
	+ and select: "\<And>T. finite T \<Longrightarrow> T \<subset> S \<Longrightarrow> P T \<Longrightarrow> \<exists>s\<in>S - T. P (insert s T)"
	+ shows "P S"
	+proof -
	+ from assms(1) have "P S \<and> finite S"
	+ by (induct S rule: finite_induct_select) (auto intro: empty select)
	+ then show ?thesis by blast
	+qed
	+
	+lemma finite_induct_decompose_sum:
	+ fixes f :: "'c \<Rightarrow> ('b :: comm_monoid_add)"
	+ assumes "finite X"
	+ and "x\<in>X"
	+ and "A (f x)"
	+ and "\<forall>Z. B (sum f Z)"
	+ and "\<And>x Z. A (f x) \<Longrightarrow> B (sum f Z) \<Longrightarrow> A (f x + sum f Z)"
	+ and "\<And>x Z. B (f x) \<Longrightarrow> A (sum f Z) \<Longrightarrow> A (f x + sum f Z)"
	+ shows "A (\<Sum>x\<in>X. f x)"
	+ using assms(1,2,3)
	+ apply (induct X rule: finite_induct_select)
	+ apply simp
	+ apply (simp add: sum.insert_remove)
	+ subgoal for T
	+ apply (cases "x \<in> T"; simp add: assms(3))
	+ apply (drule psubset_imp_ex_mem)
	+ apply clarsimp
	+ subgoal for z
	+ apply (rule bexI[of _ z])
	+ apply (rule conjI)
	+ apply clarsimp
	+ apply (rule assms(6)[of z T])
	+ apply (rule assms(4)[THEN spec, of "{z}", simplified])
	+ apply simp
	+ apply simp
	+ done
	+ apply clarsimp
	+ apply (drule bspec[of _ _ x])
	+ apply safe
	+ apply (rule assms(2))
	+ using assms(4) assms(5) apply blast
	+ done
	+ done
	+
	+lemma minting_msg_add_records: "minting_msg C1 M \<Longrightarrow> \<forall>t. 0 \<le> zcount C2 t \<Longrightarrow> minting_msg (C1+C2) M"
	+ by (auto simp: minting_msg_def intro: add_strict_increasing dest!: bspec)
	+
	+lemma add_less: "(a::int) < c \<Longrightarrow> b \<le> 0 \<Longrightarrow> a + b < c"
	+ by linarith
	+
	+lemma disj3_split: "P \<or> Q \<or> R \<Longrightarrow> (P \<Longrightarrow> thesis) \<Longrightarrow> (\<not> P \<and> Q \<Longrightarrow> thesis) \<Longrightarrow> (\<not> P \<Longrightarrow> \<not> Q \<Longrightarrow> R \<Longrightarrow> thesis) \<Longrightarrow> thesis"
	+ by blast
	+
	+lemma filter_zmset_conclude_predicate: "0 < zcount {# x \<in>#\<^sub>z M. P x #} x \<Longrightarrow> 0 < zcount M x \<Longrightarrow> P x"
	+ by (auto split: if_splits)
	+
	+lemma alw_holds2: "alw (holds P) ss = (P (shd ss) \<and> alw (holds P) (stl ss))"
	+ by (meson alw.simps holds.elims(2) holds.elims(3))
	+
	+lemma zmset_of_remove1_mset: "x \<in># M \<Longrightarrow> zmset_of (remove1_mset x M) = zmset_of M - {#x#}\<^sub>z"
	+ by (induct M) auto
	+
	+lemma timestamps_zmset_of_pair_image[simp]: "timestamps (zmset_of {# (c,t). t \<in># M #}) = zmset_of M"
	+ by (induct M) auto
	+
	+lemma timestamps_image_zmset_fst[simp]: "timestamps {# (f x, t). (x, t) \<in>#\<^sub>z M #} = timestamps M"
	+ apply transfer
	+ apply (clarsimp simp: equiv_zmset_def)
	+ apply (metis (no_types, lifting) case_prod_unfold image_mset_cong prod.collapse prod.inject)
	+ done
	+
	+lemma lift_invariant_to_spec:
	+ assumes "(\<And>c. init_config c \<Longrightarrow> P c)"
	+ and "(\<And>s. holds P s \<Longrightarrow> next s \<Longrightarrow> nxt (holds P) s)"
	+ shows "spec s \<Longrightarrow> alw (holds P) s"
	+ unfolding spec_def
	+ apply (elim conjE)
	+ apply (coinduction arbitrary: s)
	+ apply clarsimp
	+ apply (intro conjI assms(1))
	+ apply safe
	+ subgoal
	+ proof -
	+ fix sa :: "('b, 'a) configuration stream"
	+ assume a1: "init_config (shd sa)"
	+ assume a2: "alw next sa"
	+ assume "\<not> alw (holds P) (stl sa)"
	+ then have "\<not> alw (\<lambda>s. holds P s \<longrightarrow> nxt (holds P) s) sa"
	+ using a1 by (metis (no_types) alw.cases alw_invar assms(1) holds.elims(3))
	+ then show "init_config (shd (stl sa))"
	+ using a2 by (metis (lifting) alw_iff_sdrop assms(2))
	+ qed
	+ apply auto
	+ done
	+
	+lemma timestamps_sum_distrib[simp]: "(\<Sum>p \<in> A. timestamps (f p)) = timestamps (\<Sum>p \<in> A. f p)"
	+ by (induction A rule: infinite_finite_induct) auto
	+
	+lemma timestamps_zmset_of[simp]: "timestamps (zmset_of M) = zmset_of {# t. (p,t) \<in># M #}"
	+ by (induct M) auto
	+
	+lemma vacant_upto_add: "vacant_upto a t \<Longrightarrow> vacant_upto b t \<Longrightarrow> vacant_upto (a+b) t"
	+ by (simp add: vacant_upto_def)
	+
	+lemma nonpos_upto_add: "nonpos_upto a t \<Longrightarrow> nonpos_upto b t \<Longrightarrow> nonpos_upto (a+b) t"
	+ by (auto intro: add_nonpos_nonpos simp: nonpos_upto_def)
	+
	+lemma nonzero_lt_gtD: "(n::_::linorder) \<noteq> 0 \<Longrightarrow> 0 < n \<or> n < 0"
	+ by auto
	+
	+lemma zero_lt_diff: "(0::int) < a - b \<Longrightarrow> b \<ge> 0 \<Longrightarrow> 0 < a"
	+ by auto
	+
	+lemma zero_lt_add_disj: "0 < (a::int) + b \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 < a \<or> 0 < b"
	+ by auto
	+
	+subsubsection\<open>Transition lemmas\<close>
	+
	+lemma next_performopD:
	+ assumes "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ shows
	+ "\<Delta>mint_msg \<noteq> {#} \<or> zmset_of \<Delta>mint_self - zmset_of \<Delta>neg \<noteq> {#}\<^sub>z"
	+ "\<forall>t. int (count \<Delta>neg t) \<le> zcount (c_caps c0 p) t"
	+ "minting_self (c_caps c0 p) \<Delta>mint_self"
	+ "minting_msg (c_caps c0 p) \<Delta>mint_msg"
	+ "c_temp c1 = (c_temp c0)(p := c_temp c0 p + (timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg))"
	+ "c_msg c1 = c_msg c0"
	+ "c_glob c1 = c_glob c0"
	+ "c_data_msg c1 = c_data_msg c0 + \<Delta>mint_msg"
	+ "c_caps c1 = (c_caps c0)(p := c_caps c0 p + (zmset_of \<Delta>mint_self - zmset_of \<Delta>neg))"
	+ using assms by (simp_all add: next_performop'_def Let_def algebra_simps)
	+
	+lemma next_performop_complexD:
	+ assumes "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ shows
	+ "records c1 = records c0 + (timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg)"
	+ "GlobalIncomingInfoAt c1 q = GlobalIncomingInfoAt c0 q + (timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg)"
	+ "IncomingInfo c1 k p' q = (if p' = p
	+ then IncomingInfo c0 k p' q + (timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg)
	+ else IncomingInfo c0 k p' q)"
	+ "\<forall>t'<t. zcount (c_caps c0 p) t' = 0 \<Longrightarrow> zcount (timestamps (zmset_of \<Delta>mint_msg)) t = 0"
	+ "InfoAt c1 k p' q = InfoAt c0 k p' q"
	+proof -
	+ let ?\<Delta> = "timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg"
	+ note change = next_performopD[OF assms(1)]
	+ show "records c1 = records c0 + ?\<Delta>"
	+ unfolding records_def change
	+ apply simp
	+ apply (subst add_diff_eq[symmetric])
	+ apply (subst sum_if_distrib_add)
	+ apply (simp_all add: algebra_simps zmset_of_plus)
	+ done
	+ show "IncomingInfo c1 k p' q = (if p' = p
	+ then IncomingInfo c0 k p' q + (timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg)
	+ else IncomingInfo c0 k p' q)"
	+ unfolding IncomingInfo_def change
	+ by (auto simp: algebra_simps)
	+ show "GlobalIncomingInfoAt c1 q = GlobalIncomingInfoAt c0 q + ?\<Delta>" for q
	+ unfolding GlobalIncomingInfo_def IncomingInfo_def
	+ by (rule Sum_eq_pick_changed_elem[where m = p]) (simp_all add: change algebra_simps)
	+ show "\<forall>t'<t. zcount (c_caps c0 p) t' = 0 \<Longrightarrow> zcount (timestamps (zmset_of \<Delta>mint_msg)) t = 0" for t
	+ by (rule ccontr) (clarsimp dest!: image_zmset_pre change(4)[unfolded minting_msg_def, rule_format])
	+ show "InfoAt c1 k p' q = InfoAt c0 k p' q"
	+ unfolding InfoAt_def change by simp
	+qed
	+
	+lemma next_sendupdD:
	+ assumes "next_sendupd' c0 c1 p tt"
	+ shows
	+ "{#t \<in>#\<^sub>z c_temp c0 p. t \<in> tt#} \<noteq> {#}\<^sub>z"
	+ "justified (c_caps c0 p) (c_temp c0 p - {#t \<in>#\<^sub>z c_temp c0 p. t \<in> tt#})"
	+ "c_temp c1 p' = (if p' = p then c_temp c0 p - {#t \<in>#\<^sub>z c_temp c0 p. t \<in> tt#} else c_temp c0 p')"
	+ "c_msg c1 = (\<lambda>p' q. if p' = p then c_msg c0 p q @ [{#t \<in>#\<^sub>z c_temp c0 p. t \<in> tt#}] else c_msg c0 p' q)"
	+ "c_glob c1 = c_glob c0"
	+ "c_caps c1 = c_caps c0"
	+ "c_data_msg c1 = c_data_msg c0"
	+ using assms by (simp_all add: next_sendupd'_def Let_def fun_eq_iff)
	+
	+lemma next_sendupd_complexD:
	+ assumes "next_sendupd' c0 c1 p tt"
	+ shows
	+ "records c1 = records c0"
	+ "IncomingInfo c1 0 = IncomingInfo c0 0"
	+ "IncomingInfo c1 k p' q = (if p' = p \<and> length (c_msg c0 p q) < k
	+ then IncomingInfo c0 k p' q - {#t \<in>#\<^sub>z c_temp c0 p'. t \<in> tt#}
	+ else IncomingInfo c0 k p' q)"
	+ "k \<le> length (c_msg c0 p q) \<Longrightarrow> IncomingInfo c1 k p' q = IncomingInfo c0 k p' q"
	+ "length (c_msg c0 p q) < k \<Longrightarrow>
	+ IncomingInfo c1 k p' q = (if p' = p
	+ then IncomingInfo c0 k p' q - {#t \<in>#\<^sub>z c_temp c0 p'. t \<in> tt#}
	+ else IncomingInfo c0 k p' q)"
	+ "GlobalIncomingInfoAt c1 q = GlobalIncomingInfoAt c0 q"
	+ "InfoAt c1 k p' q = (if p' = p \<and> k = length (c_msg c0 p q) then {#t \<in>#\<^sub>z c_temp c0 p'. t \<in> tt#} else InfoAt c0 k p' q)"
	+proof -
	+ note change = next_sendupdD[OF assms]
	+ show "records c1 = records c0"
	+ by (simp add: records_def change)
	+ show ii: "IncomingInfo c1 k p' q = (if p' = p \<and> length (c_msg c0 p q) < k
	+ then IncomingInfo c0 k p' q - {#t \<in>#\<^sub>z c_temp c0 p'. t \<in> tt#}
	+ else IncomingInfo c0 k p' q)"
	+ by (simp add: algebra_simps IncomingInfo_def change)
	+ then show "k \<le> length (c_msg c0 p q) \<Longrightarrow> IncomingInfo c1 k p' q = IncomingInfo c0 k p' q"
	+ by auto
	+ from ii show "length (c_msg c0 p q) < k \<Longrightarrow>
	+ IncomingInfo c1 k p' q = (if p' = p
	+ then IncomingInfo c0 k p' q - {#t \<in>#\<^sub>z c_temp c0 p'. t \<in> tt#}
	+ else IncomingInfo c0 k p' q)"
	+ by auto
	+ have "IncomingInfo c1 0 p q = IncomingInfo c0 0 p q" for p q
	+ by (simp add: algebra_simps IncomingInfo_def change)
	+ then show "IncomingInfo c1 0 = IncomingInfo c0 0"
	+ by auto
	+ then show "GlobalIncomingInfoAt c1 q = GlobalIncomingInfoAt c0 q"
	+ unfolding GlobalIncomingInfo_def by auto
	+ show "InfoAt c1 k p' q = (if p' = p \<and> k = length (c_msg c0 p q) then {#t \<in>#\<^sub>z c_temp c0 p'. t \<in> tt#} else InfoAt c0 k p' q)"
	+ unfolding InfoAt_def change
	+ by (auto simp: nth_append)
	+qed
	+
	+lemma next_recvupdD:
	+ assumes "next_recvupd' c0 c1 p q"
	+ shows
	+ "c_msg c0 p q \<noteq> []"
	+ "c_temp c1 = c_temp c0"
	+ "c_msg c1 = (\<lambda>p' q'. if p' = p \<and> q' = q then tl (c_msg c0 p q) else c_msg c0 p' q')"
	+ "c_glob c1 = (c_glob c0)(q := c_glob c0 q + hd (c_msg c0 p q))"
	+ "c_caps c1 = c_caps c0"
	+ "c_data_msg c1 = c_data_msg c0"
	+ using assms by (simp_all add: next_recvupd'_def fun_eq_iff)
	+
	+lemma next_recvupd_complexD:
	+ assumes "next_recvupd' c0 c1 p q"
	+ shows
	+ "records c1 = records c0"
	+ "IncomingInfo c1 0 p' q' = (if p' = p \<and> q' = q then IncomingInfo c0 0 p' q' - hd (c_msg c0 p q) else IncomingInfo c0 0 p' q')"
	+ "IncomingInfo c1 k p' q' = (if p' = p \<and> q' = q
	+ then IncomingInfo c0 (k+1) p' q'
	+ else IncomingInfo c0 k p' q')"
	+ "GlobalIncomingInfoAt c1 q' = (if q' = q then GlobalIncomingInfoAt c0 q' - hd (c_msg c0 p q) else GlobalIncomingInfoAt c0 q')"
	+ "InfoAt c1 k p q = InfoAt c0 (k+1) p q"
	+ "InfoAt c1 k p' q' = (if p' = p \<and> q' = q then InfoAt c0 (k+1) p q else InfoAt c0 k p' q')"
	+proof -
	+ note change = next_recvupdD[OF assms]
	+ show "records c1 = records c0"
	+ by (simp add: records_def change)
	+ show ii: "IncomingInfo c1 0 p' q' = (if p' = p \<and> q' = q then IncomingInfo c0 0 p' q' - hd (c_msg c0 p q) else IncomingInfo c0 0 p' q')" for p' q'
	+ by (auto simp: IncomingInfo_def change algebra_simps sum_list_hd_tl)
	+ show "IncomingInfo c1 k p' q' = (if p' = p \<and> q' = q
	+ then IncomingInfo c0 (k+1) p' q'
	+ else IncomingInfo c0 k p' q')"
	+ by (auto simp: IncomingInfo_def change algebra_simps sum_list_hd_tl drop_Suc)
	+ show "GlobalIncomingInfoAt c1 q' = (if q' = q then GlobalIncomingInfoAt c0 q' - hd (c_msg c0 p q) else GlobalIncomingInfoAt c0 q')"
	+ unfolding GlobalIncomingInfo_def
	+ apply (cases "q'=q")
	+ apply simp
	+ apply (subst diff_conv_add_uminus)
	+ apply (intro Sum_eq_pick_changed_elem[where m = p])
	+ apply (simp_all add: ii)
	+ done
	+ show "InfoAt c1 k p q = InfoAt c0 (k+1) p q"
	+ unfolding InfoAt_def change
	+ by (auto simp: nth_tl)
	+ show "InfoAt c1 k p' q' = (if p' = p \<and> q' = q then InfoAt c0 (k+1) p q else InfoAt c0 k p' q')"
	+ unfolding InfoAt_def change
	+ by (auto simp: nth_tl)
	+qed
	+
	+lemma next_recvcapD:
	+ assumes "next_recvcap' c0 c1 p t"
	+ shows
	+ "(p,t) \<in># c_data_msg c0"
	+ "c_temp c1 = c_temp c0"
	+ "c_msg c1 = c_msg c0"
	+ "c_glob c1 = c_glob c0"
	+ "c_caps c1 = (c_caps c0)(p := c_caps c0 p + {#t#}\<^sub>z)"
	+ "c_data_msg c1 = c_data_msg c0 - {#(p,t)#}"
	+ using assms by (simp_all add: next_recvcap'_def)
	+
	+lemma next_recvcap_complexD:
	+ assumes "next_recvcap' c0 c1 p t"
	+ shows
	+ "records c1 = records c0"
	+ "IncomingInfo c1 = IncomingInfo c0"
	+ "GlobalIncomingInfo c1 = GlobalIncomingInfo c0"
	+ "InfoAt c1 k p' q = InfoAt c0 k p' q"
	+proof -
	+ note change = next_recvcapD[OF assms]
	+ show "records c1 = records c0"
	+ unfolding records_def change fun_upd_apply
	+ apply (subst sum_if_distrib_add)
	+ using change(1) apply (simp_all add: zmset_of_remove1_mset algebra_simps records_def change)
	+ done
	+ show "IncomingInfo c1 = IncomingInfo c0"
	+ unfolding IncomingInfo_def change by simp
	+ then show "GlobalIncomingInfo c1 = GlobalIncomingInfo c0"
	+ unfolding GlobalIncomingInfo_def by simp
	+ show "InfoAt c1 k p' q = InfoAt c0 k p' q"
	+ unfolding InfoAt_def change by simp
	+qed
	+
	+lemma ex_next_recvupd:
	+ assumes "c_msg c0 p q \<noteq> []"
	+ shows "\<exists>c1. next_recvupd' c0 c1 p q"
	+ using assms unfolding next_recvupd'_def
	+ by (intro
	+ exI[of _ "c0\<lparr>c_msg := (\<lambda>p' q'. if p' = p \<and> q' = q then tl (c_msg c0 p q) else c_msg c0 p' q'),
	+ c_glob := (\<lambda>q'. if q' = q then c_glob c0 q + hd (c_msg c0 p q) else c_glob c0 q')\<rparr>"])
	+ (auto simp: fun_eq_iff)
	+
	+subsubsection\<open>Facts about @{term justified}'ness\<close>
	+
	+lemma justified_empty[simp]: "justified {#}\<^sub>z {#}\<^sub>z"
	+ by (simp add: justified_def)
	+
	+text\<open>It's sufficient to show justified for least pointstamps in M.\<close>
	+lemma justified_leastI:
	+ assumes "\<forall>t. 0 < zcount M t \<longrightarrow> (\<forall>t'<t. zcount M t' \<le> 0) \<longrightarrow> supported_strong M t \<or> (\<exists>t'<t. 0 < zcount C t') \<or> (zcount M t < zcount C t)"
	+ shows "justified C M"
	+ unfolding justified_alt supported_strong_def
	+ apply (intro allI impI)
	+ apply (drule order_zmset_exists_foundation)
	+ apply (elim exE conjE)
	+ subgoal for t' s
	+ apply (drule assms(1)[unfolded supported_strong_def, rule_format])
	+ apply (auto intro: ccontr) []
	+ apply (elim disj3_split)
	+ apply (rule disjI1)
	+ using order.strict_trans2 apply blast
	+ apply (rule disjI2, rule disjI1)
	+ using order.strict_trans2 apply blast
	+ apply (clarsimp simp: nonpos_upto_def)
	+ apply (metis le_less_linear linear le_imp_less_or_eq preorder_class.le_less_trans)
	+ done
	+ done
	+
	+lemma justified_add:
	+ assumes "justified C1 M1"
	+ and "justified C2 M2"
	+ and "\<forall>t. 0 \<le> zcount C1 t"
	+ and "\<forall>t. 0 \<le> zcount C2 t"
	+ shows "justified (C1+C2) (M1+M2)"
	+ apply (rule justified_leastI)
	+ apply (intro allI impI)
	+ subgoal for t
	+ apply (cases "0 < zcount M1 t") (* symmetric cases *)
	+ subgoal
	+ apply (drule assms(1)[unfolded justified_alt supported_strong_def, rule_format])
	+ apply (elim disj3_split)
	+ subgoal
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation_neg)
	+ apply (elim exE conjE)
	+ subgoal for s s' (* anything less than s' is 0 in M1 *)
	+ apply (cases "zcount (M1 + M2) s' < 0")
	+ subgoal
	+ apply (rule disjI1)
	+ apply (auto intro!: exI[of _ s'] simp: nonpos_upto_def supported_strong_def) []
	+ done
	+ subgoal
	+ apply (subst (asm) not_less)
	+ apply (cases "0 < zcount M2 s'")
	+ prefer 2
	+ subgoal by auto (* trivial contradiction *)
	+ subgoal
	+ apply (drule assms(2)[unfolded justified_alt supported_strong_def, rule_format])
	+ apply (elim disj3_split)
	+ subgoal
	+ apply (rule disjI1)
	+ apply (elim exE)
	+ subgoal for s''
	+ by (auto intro!: exI[of _ s''] simp: nonpos_upto_def supported_strong_def add_nonpos_neg)
	+ done
	+ subgoal
	+ apply (rule disjI2, rule disjI1)
	+ apply (elim exE conjE)
	+ subgoal for s''
	+ using assms(3) by (auto simp: add_nonneg_pos intro!: exI[of _ s''])
	+ done
	+ subgoal
	+ by (metis add.right_neutral add_strict_increasing2 assms(3) less_add_same_cancel1 order.strict_trans1 pos_add_strict zcount_union)
	+ done
	+ done
	+ done
	+ done
	+ subgoal
	+ by (metis add.commute add_mono_thms_linordered_field(4) assms(4) add_0 zcount_union)
	+ subgoal
	+ apply (cases "supported_strong M2 t")
	+ subgoal
	+ apply (rule disjI1)
	+ using assms(1)[unfolded justified_alt]
	+ apply (subst supported_strong_def)
	+ apply (subst (asm) supported_strong_def)
	+ apply (elim exE conjE)
	+ unfolding not_ex
	+ subgoal for s
	+ apply clarsimp
	+ apply (rule exI[of _ s])
	+ apply (intro conjI)
	+ apply blast
	+ apply (rule add_nonpos_neg)
	+ apply (metis order.strict_trans1 less_imp_le not_le not_less_iff_gr_or_eq order_class.order.strict_trans2 supported_strong_def)
	+ apply simp
	+ apply (clarsimp simp: nonpos_upto_def)
	+ done
	+ done
	+ subgoal
	+ apply (cases "\<exists>t'<t. 0 < zcount C2 t'")
	+ subgoal
	+ by (metis add_cancel_left_left assms(3) order_class.order.not_eq_order_implies_strict zcount_union)
	+ subgoal
	+ apply (intro disjI2)
	+ apply clarsimp
	+ using assms(2)[unfolded justified_alt, rule_format, of t]
	+ apply (metis add.commute add_cancel_left_right add_mono_thms_linordered_field(5) add_strict_increasing2 assms(4) nonzero_lt_gtD)
	+ done
	+ done
	+ done
	+ done
	+ subgoal
	+ apply (cases "0 < zcount M2 t") (* symmetric case *)
	+ prefer 2
	+ subgoal by auto
	+ subgoal
	+ apply (drule assms(2)[unfolded justified_alt supported_strong_def, rule_format])
	+ apply (elim disj3_split)
	+ subgoal
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation_neg)
	+ apply (elim exE conjE)
	+ subgoal for s s' (* anything less than s' is 0 in M1 *)
	+ apply (cases "zcount (M1 + M2) s' < 0")
	+ subgoal
	+ apply (rule disjI1)
	+ apply (auto intro!: exI[of _ s'] simp: nonpos_upto_def supported_strong_def) []
	+ done
	+ subgoal
	+ apply (subst (asm) not_less)
	+ apply (cases "0 < zcount M1 s'")
	+ prefer 2
	+ subgoal by auto (* trivial contradiction *)
	+ subgoal
	+ apply (drule assms(1)[unfolded justified_alt supported_strong_def, rule_format])
	+ apply (elim disj3_split)
	+ subgoal
	+ apply (rule disjI1)
	+ apply (elim exE)
	+ subgoal for s''
	+ by (auto intro!: exI[of _ s''] simp: nonpos_upto_def supported_strong_def add_neg_nonpos)
	+ done
	+ subgoal
	+ apply (rule disjI2, rule disjI1)
	+ apply (elim exE conjE)
	+ subgoal for s''
	+ using assms(4) by (auto simp: add_pos_nonneg intro!: exI[of _ s''])
	+ done
	+ subgoal
	+ apply (rule disjI2, rule disjI1, rule exI[of _ s'], rule conjI)
	+ using assms(4) by (auto intro!: add_pos_nonneg)
	+ done
	+ done
	+ done
	+ done
	+ subgoal
	+ by (metis add_mono_thms_linordered_field(4) assms(3) add_0 zcount_union)
	+ subgoal
	+ apply (cases "supported_strong M1 t")
	+ subgoal
	+ apply (rule disjI1)
	+ apply (simp only: supported_strong_def)
	+ apply (elim exE)
	+ subgoal for s
	+ apply (clarsimp simp: nonpos_upto_def intro!: exI[of _ s])
	+ using assms(2)[unfolded justified_alt nonpos_upto_def supported_strong_def, rule_format, of s]
	+ assms(4)[rule_format, of s]
	+ apply (metis (mono_tags, hide_lams) less_add_same_cancel1 order.strict_trans2 less_imp_le not_less order_class.order.not_eq_order_implies_strict order_class.order.strict_implies_order)
	+ done
	+ done
	+ subgoal
	+ apply (cases "\<exists>t'<t. 0 < zcount C1 t'")
	+ subgoal
	+ by (metis add.commute add_cancel_left_left assms(4) order_class.order.not_eq_order_implies_strict zcount_union)
	+ subgoal
	+ apply (intro disjI2)
	+ apply (metis add.commute add_strict_increasing2 assms(3) not_le sublist_order.add_less zcount_union)
	+ done
	+ done
	+ done
	+ done
	+ done
	+ done
	+ done
	+
	+lemma justified_sum:
	+ assumes "\<forall>p\<in>P. justified (f p) (g p)"
	+ and "\<forall>p\<in>P. \<forall>t. 0 \<le> zcount (f p) t"
	+ shows "justified (\<Sum>p\<in>P. f p) (\<Sum>p\<in>P. g p)"
	+ using assms
	+ by (induct P rule: infinite_finite_induct)
	+ (auto intro!: justified_add sum_nonneg simp: zcount_sum)
	+
	+lemma justified_add_records:
	+ assumes "justified C M"
	+ and "\<forall>t. 0 \<le> zcount C' t"
	+ shows "justified (C+C') M"
	+ using assms unfolding justified_def
	+ apply (clarsimp intro: add_pos_nonneg)
	+ apply (metis add.commute add_strict_increasing2 assms(2))
	+ done
	+
	+lemma justified_add_zmset_records:
	+ assumes "justified C M"
	+ shows "justified (add_zmset t C) M"
	+ using assms
	+ apply (subst add_zmset_add_single)
	+ apply (rule justified_add_records)
	+ apply simp_all
	+ done
	+
	+lemma justified_diff:
	+ assumes "justified C M"
	+ and "\<forall>t. 0 \<le> zcount C t"
	+ and "\<forall>t. count \<Delta> t \<le> zcount C t"
	+ shows "justified (C - zmset_of \<Delta>) (M - zmset_of \<Delta>)"
	+proof (intro justified_leastI allI impI)
	+ fix t
	+ assume least: "\<forall>t'<t. zcount (M - zmset_of \<Delta>) t' \<le> 0"
	+ assume "0 < zcount (M - zmset_of \<Delta>) t"
	+ then have Mt: "0 < zcount M t"
	+ by auto
	+ note assms(1)[unfolded justified_alt, rule_format, OF Mt]
	+ then consider "supported_strong M t" \| "\<exists>t'<t. 0 < zcount C t'" \| "zcount M t < zcount C t"
	+ by blast
	+ then show "supported_strong (M - zmset_of \<Delta>) t \<or> (\<exists>t'<t. 0 < zcount (C - zmset_of \<Delta>) t') \<or> zcount (M - zmset_of \<Delta>) t < zcount (C - zmset_of \<Delta>) t"
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ unfolding supported_strong_def
	+ apply (elim exE)
	+ subgoal for s
	+ by (auto intro!: disjI1 exI[of _ s] simp: nonpos_upto_def)
	+ done
	+ next
	+ case 2
	+ then obtain s where s: "s < t" "0 < zcount C s" "\<forall>s'<s. zcount C s' = 0"
	+ apply atomize_elim
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation')
	+ apply (elim exE conjE)
	+ subgoal for t' s
	+ apply (rule exI[of _ s])
	+ apply (intro conjI)
	+ apply auto [2]
	+ apply (intro allI impI)
	+ subgoal for s'
	+ using assms(2)[rule_format, of s']
	+ apply auto
	+ done
	+ done
	+ done
	+ then consider
	+ "0 < zcount (C - zmset_of \<Delta>) s" \|
	+ "zcount (C - zmset_of \<Delta>) s = 0" "zcount (M - zmset_of \<Delta>) s < 0" \|
	+ "zcount (C - zmset_of \<Delta>) s = 0" "zcount (M - zmset_of \<Delta>) s = 0" \|
	+ "zcount (C - zmset_of \<Delta>) s = 0" "zcount (M - zmset_of \<Delta>) s > 0"
	+ using assms(3)[rule_format, of s] by atomize_elim auto
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ using s by auto
	+ next
	+ case 2
	+ then show ?thesis
	+ using s least by (auto simp: nonpos_upto_def supported_strong_def)
	+ next
	+ case 3
	+ note case3 = 3
	+ with s(2) have Ms: "0 < zcount M s"
	+ by - (rule ccontr, auto simp: not_less)
	+ note assms(1)[unfolded justified_alt, rule_format, OF Ms]
	+ then consider "supported_strong M s" \| "\<exists>t'<s. 0 < zcount C t'" \| "zcount M s < zcount C s"
	+ using not_less by blast
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ unfolding supported_strong_def
	+ apply (elim exE conjE)
	+ subgoal for s'
	+ apply (intro disjI1 exI[of _ s'])
	+ using s(1,2) apply (auto intro: exI[of _ s'] simp: nonpos_upto_def)
	+ done
	+ done
	+ next
	+ case 2
	+ then show ?thesis
	+ using s(3) by auto
	+ next
	+ case 3
	+ from case3 have "zcount C s = zcount M s"
	+ by auto
	+ with 3 show ?thesis
	+ by linarith
	+ qed
	+ next
	+ case 4
	+ then show ?thesis
	+ using least s(1) by auto
	+ qed
	+ next
	+ case 3
	+ then show ?thesis
	+ by auto
	+ qed
	+qed
	+
	+lemma justified_add_msg_delta:
	+ assumes "justified C M"
	+ and "minting_msg C \<Delta>"
	+ and "\<forall>t. 0 \<le> zcount C t"
	+ shows "justified C (M + timestamps (zmset_of \<Delta>))"
	+proof (intro allI impI justified_leastI)
	+ fix t
	+ assume t: "0 < zcount (M + timestamps (zmset_of \<Delta>)) t"
	+ assume least: "\<forall>t'<t. zcount (M + timestamps (zmset_of \<Delta>)) t' \<le> 0"
	+ have \<Delta>t: "0 < zcount (timestamps (zmset_of \<Delta>)) t \<Longrightarrow> supported_strong (M + timestamps (zmset_of \<Delta>)) t \<or> (\<exists>t'<t. 0 < zcount C t') \<or> zcount (M + timestamps (zmset_of \<Delta>)) t < zcount C t"
	+ by (auto dest: pos_image_zmset_obtain_pre[rotated] assms(2)[unfolded minting_msg_def, rule_format])
	+ { assume \<Delta>t: "zcount (timestamps (zmset_of \<Delta>)) t \<le> 0"
	+ with t have Mt: "0 < zcount M t"
	+ by auto
	+ note assms(1)[unfolded justified_alt, rule_format, OF Mt]
	+ then consider
	+ "supported_strong M t" "\<forall>t'<t. zcount C t' = 0" "zcount M t \<ge> zcount C t" \|
	+ "\<exists>t'<t. 0 < zcount C t'" \|
	+ "zcount M t < zcount C t"
	+ using not_less assms(3)
	+ by (metis order_class.order.not_eq_order_implies_strict)
	+ then have "supported_strong (M + timestamps (zmset_of \<Delta>)) t \<or> (\<exists>t'<t. 0 < zcount C t') \<or> zcount (M + timestamps (zmset_of \<Delta>)) t < zcount C t"
	+ proof cases
	+ case 1
	+ then obtain s where s: "s < t" "zcount M s < 0" "\<forall>s'<s. zcount M s' = 0"
	+ unfolding supported_strong_def
	+ apply atomize_elim
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation_neg')
	+ apply (elim exE conjE)
	+ subgoal for s s'
	+ by (auto intro!: exI[of _ s'] simp: nonpos_upto_def order_class.antisym)
	+ done
	+ then show ?thesis
	+ apply (cases "\<exists>s'\<le>s. zcount (timestamps (zmset_of \<Delta>)) s' > 0")
	+ apply (elim exE conjE)
	+ subgoal for s'
	+ apply (drule pos_image_zmset_obtain_pre[rotated])
	+ apply simp
	+ apply (elim exE conjE)
	+ apply simp
	+ apply (drule assms(2)[unfolded minting_msg_def, rule_format])
	+ apply (auto simp: supported_strong_def)
	+ done
	+ subgoal
	+ apply (intro disjI1 exI[of _ s])
	+ unfolding not_less
	+ apply (metis (full_types) le_less_linear least eq_refl order.strict_trans1 nonpos_upto_def supported_strong_def sublist_order.add_less zcount_union)
	+ done
	+ done
	+ next
	+ case 2
	+ then show ?thesis by auto
	+ next
	+ case 3
	+ then show ?thesis
	+ using \<Delta>t by auto
	+ qed
	+ }
	+ then show "supported_strong (M + timestamps (zmset_of \<Delta>)) t \<or> (\<exists>t'<t. 0 < zcount C t') \<or> zcount (M + timestamps (zmset_of \<Delta>)) t < zcount C t"
	+ apply (cases "zcount (timestamps (zmset_of \<Delta>)) t \<le> 0")
	+ apply blast
	+ apply (rule \<Delta>t)
	+ apply auto
	+ done
	+qed
	+
	+lemma justified_add_same:
	+ assumes "justified C M"
	+ and "minting_self C \<Delta>"
	+ and "\<forall>t. 0 \<le> zcount C t"
	+ shows "justified (C + zmset_of \<Delta>) (M + zmset_of \<Delta>)"
	+proof (intro allI impI justified_leastI)
	+ fix t
	+ assume t: "0 < zcount (M + zmset_of \<Delta>) t"
	+ assume least: "\<forall>t'<t. zcount (M + zmset_of \<Delta>) t' \<le> 0"
	+ from t consider
	+ "0 < zcount M t" \|
	+ "0 < zcount (zmset_of \<Delta>) t" "zcount M t \<le> 0"
	+ by atomize_elim (auto simp: not_less count_inI)
	+ then show "supported_strong (M + zmset_of \<Delta>) t \<or> (\<exists>t'<t. 0 < zcount (C + zmset_of \<Delta>) t') \<or> zcount (M + zmset_of \<Delta>) t < zcount (C + zmset_of \<Delta>) t"
	+ proof cases
	+ case 1
	+ note assms(1)[unfolded justified_alt, rule_format, OF 1]
	+ then consider
	+ "supported_strong M t" \|
	+ "\<exists>t'<t. 0 < zcount C t'" \|
	+ "zcount M t < zcount C t"
	+ by blast
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ unfolding supported_strong_def
	+ apply (elim exE conjE)
	+ subgoal for t'
	+ apply (cases "\<exists>s\<le>t'. zcount (zmset_of \<Delta>) s > 0")
	+ apply (elim exE conjE)
	+ subgoal for s
	+ apply simp
	+ apply (drule assms(2)[unfolded minting_self_def, rule_format])
	+ apply (meson add_pos_nonneg order.ordering_axioms of_nat_0_le_iff ordering.strict_trans1)
	+ done
	+ subgoal
	+ apply (intro disjI1 exI[of _ t'] conjI)
	+ apply simp
	+ apply simp
	+ apply (metis add_cancel_right_left add_mono_thms_linordered_field(1) count_eq_zero_iff order.order_iff_strict of_nat_eq_0_iff)
	+ using least nonpos_upto_def apply auto
	+ done
	+ done
	+ done
	+ next
	+ case 2
	+ then show ?thesis
	+ by auto
	+ next
	+ case 3
	+ then show ?thesis
	+ by auto
	+ qed
	+ next
	+ case 2
	+ then obtain t' where t': "t' \<le> t" "0 < zcount C t'"
	+ using assms(2)[unfolded minting_self_def]
	+ by auto
	+ then show ?thesis
	+ apply (cases "t'=t")
	+ subgoal
	+ using 2(2) by auto
	+ subgoal
	+ apply (rule disjI2, rule disjI1)
	+ using assms(3) order.not_eq_order_implies_strict apply fastforce
	+ done
	+ done
	+ qed
	+qed
	+
	+subsubsection\<open>Facts about @{term justified_with}'ness\<close>
	+
	+lemma justified_with_add_records:
	+ assumes "justified_with C1 M N"
	+ and "\<forall>t. 0 \<le> zcount C2 t"
	+ shows "justified_with (C1+C2) M N"
	+ unfolding justified_with_def
	+ apply (intro allI impI)
	+ subgoal for t
	+ apply (drule assms(1)[unfolded justified_with_def, rule_format])
	+ apply (elim disjE)
	+ subgoal
	+ by blast
	+ subgoal
	+ apply (elim exE)
	+ subgoal for s
	+ apply (rule disjI2, rule disjI1)
	+ using assms(2)[rule_format, of s] by auto
	+ done
	+ subgoal
	+ apply (intro disjI2)
	+ using assms(2)[rule_format, of t]
	+ by auto
	+ done
	+ done
	+
	+lemma justified_with_leastI:
	+ assumes
	+ "(\<forall>t. 0 < zcount M t \<longrightarrow> (\<forall>t'<t. zcount M t' \<le> 0) \<longrightarrow>
	+ (\<exists>s<t. (zcount M s < 0 \<or> zcount N s < 0) \<and> (\<forall>s'<s. zcount M s' \<le> 0)) \<or>
	+ (\<exists>s<t. 0 < zcount C s) \<or>
	+ zcount (M+N) t < zcount C t)"
	+ shows "justified_with C M N"
	+ unfolding justified_with_alt
	+proof (intro allI impI)
	+ fix t
	+ assume t: "0 < zcount M t"
	+ from t obtain t' where t': "t' \<le> t" "0 < zcount M t'" "\<forall>s<t'. zcount M s \<le> 0"
	+ by atomize_elim (drule order_zmset_exists_foundation')
	+ note assms[rule_format, OF t'(2)]
	+ with t'(3) consider
	+ "\<exists>s<t'. (zcount M s < 0 \<or> zcount N s < 0) \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t'. 0 < zcount C s" \|
	+ "zcount (M+N) t' < zcount C t'"
	+ using not_less by blast
	+ then show "(\<exists>s<t. (zcount M s < 0 \<or> zcount N s < 0) \<and> (\<forall>s'<s. zcount M s' \<le> 0)) \<or> (\<exists>s<t. 0 < zcount C s) \<or> zcount (M+N) t < zcount C t"
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ using order.strict_trans2 t'(1) by blast
	+ next
	+ case 2
	+ then show ?thesis
	+ using order.strict_trans2 t'(1) by blast
	+ next
	+ case 3
	+ then consider
	+ "zcount (M+N) t' < 0" \|
	+ "zcount C t' > 0"
	+ by atomize_elim auto
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then have "zcount N t' < 0"
	+ using t'(2) by auto
	+ with t'(3) show ?thesis
	+ apply (cases "t'=t")
	+ subgoal
	+ using 3(1) by blast
	+ subgoal
	+ using t'(1) by (auto intro: exI[of _ t'])
	+ done
	+ next
	+ case 2
	+ then show ?thesis
	+ apply (cases "t'=t")
	+ subgoal
	+ apply (intro disjI2)
	+ using 3(1) apply blast
	+ done
	+ subgoal
	+ apply (rule disjI2)
	+ apply (rule disjI1)
	+ using order.not_eq_order_implies_strict t'(1) apply blast
	+ done
	+ done
	+ qed
	+ qed
	+qed
	+
	+lemma justified_with_add:
	+ assumes "justified_with C1 M N1"
	+ and "justified C1 N1"
	+ and "justified C2 N2"
	+ and "\<forall>t. 0 \<le> zcount C1 t"
	+ and "\<forall>t. 0 \<le> zcount C2 t"
	+ shows "justified_with (C1+C2) M (N1+N2)"
	+proof (intro justified_with_leastI allI impI)
	+ fix t
	+ assume count_t: "0 < zcount M t"
	+ assume least: "\<forall>t'<t. zcount M t' \<le> 0"
	+ note assms(1)[unfolded justified_with_alt, rule_format, OF count_t]
	+ then consider
	+ "\<exists>s<t. zcount M s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. zcount N1 s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. 0 < zcount C1 s" \|
	+ "zcount (M + N1) t < zcount C1 t"
	+ by blast
	+ then show "(\<exists>s<t. (zcount M s < 0 \<or> zcount (N1 + N2) s < 0) \<and> (\<forall>s'<s. zcount M s' \<le> 0)) \<or>
	+ (\<exists>s<t. 0 < zcount (C1 + C2) s) \<or> zcount (M + (N1 + N2)) t < zcount (C1 + C2) t"
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ by blast
	+ next
	+ case 2
	+ then obtain s where s: "s < t" "zcount N1 s < 0" "\<forall>s'<s. 0 \<le> zcount N1 s'"
	+ apply atomize_elim
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation_neg')
	+ using order.strict_trans order.strict_trans1 apply blast
	+ done
	+ then consider
	+ "zcount (N1 + N2) s < 0" \|
	+ "0 < zcount N2 s" "zcount (N1 + N2) s \<ge> 0"
	+ by atomize_elim auto
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ using least order.strict_trans s(1) by blast
	+ next
	+ case 2
	+ note assms(3)[unfolded justified_alt, rule_format, OF 2(1)]
	+ then consider
	+ "supported_strong N2 s" "\<forall>t'<s. zcount C2 t' \<le> 0" "zcount N2 s \<ge> zcount C2 s" \|
	+ "\<exists>t'<s. 0 < zcount C2 t'" \|
	+ "zcount N2 s < zcount C2 s"
	+ using not_less by blast
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then obtain s' where s': "s' < s" "zcount N2 s' < 0" "nonpos_upto N2 s'"
	+ unfolding supported_strong_def
	+ by blast
	+ from s'(2) have nonneg: "0 \<le> zcount (N1+N2) s' \<Longrightarrow> 0 < zcount N1 s'"
	+ by auto
	+ show ?thesis
	+ apply (cases "zcount (N1 + N2) s' < 0")
	+ subgoal
	+ using least order.strict_trans s'(1) s(1) by (intro disjI1) blast
	+ subgoal
	+ unfolding not_less
	+ apply (drule nonneg)
	+ apply (drule assms(2)[unfolded justified_alt supported_strong_def, rule_format])
	+ apply (elim disjE exE conjE)
	+ subgoal for u
	+ by (metis (full_types) order.ordering_axioms order_class.order.irrefl order_class.order.strict_trans2 ordering.strict_trans s'(1) s(3))
	+ subgoal for u
	+ by (metis (no_types, hide_lams) 1(2) add_cancel_left_right assms(5) less_trans order_class.antisym s'(1) s(1) zcount_union)
	+ subgoal
	+ by (metis (no_types, hide_lams) 1(2) add_cancel_left_right assms(5) less_trans not_le order_class.antisym order_class.order.strict_trans2 s'(1) s(1) s(3) zcount_union)
	+ done
	+ done
	+ next
	+ case 2
	+ then show ?thesis
	+ apply (elim exE conjE)
	+ subgoal for s'
	+ apply (rule disjI2)
	+ apply (rule disjI1)
	+ using assms(4)[rule_format, of s'] s(1)
	+ apply (auto intro!: exI[of _ s'])
	+ done
	+ done
	+ next
	+ case 3
	+ then show ?thesis
	+ by (metis 2(1) add_cancel_left_right add_strict_increasing2 assms(4) not_le order_class.order.irrefl order_class.order.strict_trans2 pos_add_strict s(1) zcount_union)
	+ qed
	+ qed
	+ next
	+ case 3
	+ then show ?thesis
	+ using assms(5)
	+ apply -
	+ apply (rule disjI2)
	+ apply (rule disjI1)
	+ apply (metis order_class.order.strict_trans2 subset_zmset.le_add_same_cancel1 subseteq_zmset_def zcount_empty)
	+ done
	+ next
	+ case 4
	+ then show ?thesis
	+ proof (cases "zcount (M + (N1 + N2)) t < zcount (C1 + C2) t")
	+ case True
	+ then show ?thesis
	+ by blast
	+ next
	+ case False
	+ then have N2t: "0 < zcount N2 t"
	+ using 4 assms(5)[rule_format, of t]
	+ unfolding not_less zcount_union
	+ by linarith
	+ then show ?thesis
	+ using assms(3)[unfolded justified_alt supported_strong_def, rule_format, OF N2t]
	+ apply (elim exE conjE disjE)
	+ subgoal for s
	+ apply (cases "0 < zcount N1 s")
	+ subgoal
	+ apply (drule assms(2)[unfolded justified_alt supported_strong_def, rule_format])
	+ apply (elim exE conjE disjE)
	+ subgoal for s'
	+ apply (rule disjI1)
	+ apply (rule exI[of _ s'])
	+ apply (intro conjI)
	+ apply simp
	+ apply (metis add_cancel_right_right add_neg_neg order.strict_implies_order nonpos_upto_def order_class.order.not_eq_order_implies_strict zcount_union)
	+ apply (meson least less_trans)
	+ done
	+ subgoal for s'
	+ by (metis add_pos_nonneg assms(5) less_trans zcount_union)
	+ subgoal
	+ apply (rule ccontr)
	+ apply (clarsimp simp: not_le not_less)
	+ apply (metis (no_types, hide_lams) add_cancel_right_right add_neg_neg assms(4) assms(5) least less_trans not_less order_class.order.not_eq_order_implies_strict pos_add_strict)
	+ done
	+ done
	+ subgoal
	+ apply (intro disjI1 exI[of _ s])
	+ apply (intro disjI2 conjI)
	+ apply simp
	+ apply simp
	+ using least apply simp
	+ done
	+ done
	+ subgoal for s
	+ by (metis add.comm_neutral add_mono_thms_linordered_field(4) assms(4) zcount_union)
	+ subgoal
	+ using 4 by auto
	+ done
	+ qed
	+ qed
	+qed
	+
	+lemma justified_with_sum':
	+ assumes "finite X" "X\<noteq>{}"
	+ and "\<forall>x\<in>X. justified_with (C x) M (N x)"
	+ and "\<forall>x\<in>X. justified (C x) (N x)"
	+ and "\<forall>x\<in>X. \<forall>t. 0 \<le> zcount (C x) t"
	+ shows "justified_with (\<Sum>x\<in>X. C x) M (\<Sum>x\<in>X. N x)"
	+ using assms
	+proof (induct X rule: finite_induct)
	+ case empty
	+ then show ?case by simp
	+next
	+ case (insert x F)
	+ show ?case
	+ apply (cases "F={}")
	+ subgoal
	+ using insert(5) by simp
	+ subgoal
	+ apply (subst (1 2) sum.insert_remove)
	+ using insert(1) apply simp
	+ using insert(2) apply simp
	+ apply (rule justified_with_add)
	+ using insert(5) apply simp
	+ using insert(6) apply simp
	+ apply (rule justified_sum)
	+ using insert(6) apply simp
	+ using insert(7) apply simp
	+ using insert(7) apply simp
	+ apply (intro allI)
	+ unfolding zcount_sum
	+ apply (rule sum_nonneg)
	+ using insert(7) apply simp
	+ done
	+ done
	+qed
	+
	+lemma justified_with_sum:
	+ assumes "finite X" "X\<noteq>{}"
	+ and "x \<in> X"
	+ and "justified_with (C x) M (N x)"
	+ and "\<forall>x\<in>X. justified (C x) (N x)"
	+ and "\<forall>x\<in>X. \<forall>t. 0 \<le> zcount (C x) t"
	+ shows "justified_with (\<Sum>x\<in>X. C x) M (\<Sum>x\<in>X. N x)"
	+ using assms
	+proof (induct X rule: finite_induct)
	+ case empty
	+ then show ?case
	+ by simp
	+next
	+ case (insert y F)
	+ thm insert
	+ show ?case
	+ apply (cases "F={}")
	+ subgoal
	+ using insert by simp
	+ subgoal
	+ apply (subst (1 2) sum.insert_remove)
	+ using insert(1) apply simp
	+ using insert(2) apply simp
	+ apply (cases "y=x")
	+ subgoal
	+ apply (rule justified_with_add)
	+ using insert(6) apply simp
	+ using insert(7) apply simp
	+ apply (rule justified_sum)
	+ using insert(7) apply simp
	+ using insert(8) apply simp
	+ using insert(8) apply simp
	+ apply (intro allI)
	+ unfolding zcount_sum
	+ apply (rule sum_nonneg)
	+ using insert(8) apply simp
	+ done
	+ subgoal
	+ apply (subst (1 2) add.commute)
	+ apply (rule justified_with_add)
	+ apply (rule insert(3))
	+ apply simp
	+ using insert(5) apply simp
	+ using insert(6) apply simp
	+ using insert(7) apply simp
	+ using insert(8) apply simp
	+ apply (rule justified_sum)
	+ using insert(7) apply simp
	+ using insert(8) apply simp
	+ using insert(7) apply simp
	+ apply (intro allI)
	+ unfolding zcount_sum
	+ apply (rule sum_nonneg)
	+ using insert(8) apply simp
	+ using insert(8) apply simp
	+ done
	+ done
	+ done
	+qed
	+
	+lemma justified_with_add_same:
	+ assumes "justified_with C M N"
	+ and "\<forall>t. 0 \<le> zcount C t"
	+ shows "justified_with (C + zmset_of \<Delta>) M (N + zmset_of \<Delta>)"
	+ unfolding justified_with_def
	+proof (intro allI impI)
	+ fix t
	+ assume Mt: "0 < zcount M t"
	+ note assms(1)[unfolded justified_with_alt, rule_format, OF Mt]
	+ with Mt consider
	+ "\<exists>s<t. zcount M s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. zcount N s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. 0 < zcount C s" \|
	+ "zcount (M + N) t < zcount C t"
	+ using not_less by blast
	+ then show "(\<exists>s<t. (zcount M s < 0 \<or> zcount (N + zmset_of \<Delta>) s < 0)) \<or>
	+ (\<exists>s<t. 0 < zcount (C + zmset_of \<Delta>) s) \<or> zcount (M + (N + zmset_of \<Delta>)) t < zcount (C + zmset_of \<Delta>) t"
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ by blast
	+ next
	+ case 2
	+ then show ?thesis
	+ by (metis add_less_same_cancel2 assms(2) not_less preorder_class.le_less_trans zcount_union)
	+ next
	+ case 3
	+ then show ?thesis
	+ by fastforce
	+ next
	+ case 4
	+ then show ?thesis
	+ by auto
	+ qed
	+qed
	+
	+lemma justified_with_add_msg_delta:
	+ assumes "justified_with C M N"
	+ and "minting_msg C \<Delta>"
	+ and "\<forall>t. 0 \<le> zcount C t"
	+ shows "justified_with C M (N + timestamps (zmset_of \<Delta>))"
	+ unfolding justified_with_def
	+proof (intro allI impI)
	+ fix t
	+ assume Mt: "0 < zcount M t"
	+ note assms(1)[unfolded justified_with_alt, rule_format, OF Mt]
	+ with Mt consider
	+ "\<exists>s<t. zcount M s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. zcount N s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. 0 < zcount C s" \|
	+ "zcount (M + N) t < zcount C t"
	+ using not_less by blast
	+ then show "(\<exists>s<t. (zcount M s < 0 \<or> zcount (N + timestamps (zmset_of \<Delta>)) s < 0)) \<or>
	+ (\<exists>s<t. 0 < zcount C s) \<or> zcount (M + (N + timestamps (zmset_of \<Delta>))) t < zcount C t"
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ by blast
	+ next
	+ case 2
	+ then obtain s where s: "s < t" "zcount N s < 0"
	+ by blast
	+ then show ?thesis
	+ proof (cases "\<exists>(p,s')\<in>#\<Delta>. s' \<le> s")
	+ case True
	+ then show ?thesis
	+ apply -
	+ apply clarsimp
	+ apply (drule assms(2)[unfolded minting_msg_def, rule_format])
	+ using order.strict_trans order.strict_trans1 s(1) not_less apply blast
	+ done
	+ next
	+ case False
	+ then have "zcount (timestamps (zmset_of \<Delta>)) s = 0"
	+ by (force intro: ccontr dest: pos_image_zmset_obtain_pre[rotated])
	+ then show ?thesis
	+ by (metis plus_int_code(1) s(1,2) zcount_union)
	+ qed
	+ next
	+ case 3
	+ then show ?thesis
	+ by blast
	+ next
	+ case 4
	+ then show ?thesis
	+ apply (cases "zcount (timestamps (zmset_of \<Delta>)) t > 0")
	+ apply (auto dest: pos_image_zmset_obtain_pre[rotated] assms(2)[unfolded minting_msg_def, rule_format]) []
	+ unfolding not_less apply auto
	+ done
	+ qed
	+qed
	+
	+lemma justified_with_diff:
	+ assumes "justified_with C M N"
	+ and "\<forall>t. 0 \<le> zcount C t"
	+ and "\<forall>t. count \<Delta> t \<le> zcount C t"
	+ and "justified C N"
	+ shows "justified_with (C - zmset_of \<Delta>) M (N - zmset_of \<Delta>)"
	+proof (intro allI impI justified_with_leastI)
	+ fix t
	+ assume Mt: "0 < zcount M t"
	+ assume least: "\<forall>t'<t. zcount M t' \<le> 0"
	+ note assms(1)[unfolded justified_with_alt, rule_format, OF Mt]
	+ with Mt consider
	+ "\<exists>s<t. zcount M s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. zcount N s < 0 \<and> (\<forall>s'<s. zcount M s' \<le> 0)" \|
	+ "\<exists>s<t. 0 < zcount C s" "\<forall>s<t. zcount M s \<ge> 0 \<or> \<not> (\<forall>s'<s. zcount M s' \<le> 0)" "\<forall>s<t. zcount N s \<ge> 0 \<or> \<not> (\<forall>s'<s. zcount M s' \<le> 0)" "zcount (M + N) t \<ge> zcount C t" \|
	+ "zcount (M + N) t < zcount C t"
	+ using not_less by blast
	+ then show "(\<exists>s<t. (zcount M s < 0 \<or> zcount (N - zmset_of \<Delta>) s < 0) \<and> (\<forall>s'<s. zcount M s' \<le> 0)) \<or>
	+ (\<exists>s<t. 0 < zcount (C - zmset_of \<Delta>) s) \<or> zcount (M + (N - zmset_of \<Delta>)) t < zcount (C - zmset_of \<Delta>) t"
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ by blast
	+ next
	+ case 2
	+ then show ?thesis
	+ using diff_add_cancel zcount_union zcount_zmset_of_nonneg by auto
	+ next
	+ case 3
	+ then obtain s where s: "s < t" "0 < zcount C s" "\<forall>s'<s. zcount C s' = 0"
	+ apply atomize_elim
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation')
	+ apply (elim exE conjE)
	+ subgoal for t' s
	+ apply (rule exI[of _ s])
	+ apply (intro conjI)
	+ apply auto [2]
	+ apply (intro allI impI)
	+ subgoal for s'
	+ using assms(2)[rule_format, of s'] by auto
	+ done
	+ done
	+ then consider
	+ "0 < zcount (C - zmset_of \<Delta>) s" \|
	+ "zcount (C - zmset_of \<Delta>) s = 0" "zcount (N - zmset_of \<Delta>) s < 0" \|
	+ "zcount (C - zmset_of \<Delta>) s = 0" "zcount (N - zmset_of \<Delta>) s = 0" \|
	+ "zcount (C - zmset_of \<Delta>) s = 0" "zcount (N - zmset_of \<Delta>) s > 0"
	+ using assms(3)[rule_format, of s] by atomize_elim auto
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ using s by auto
	+ next
	+ case 2
	+ then show ?thesis
	+ using s least by (auto simp: nonpos_upto_def)
	+ next
	+ case 3
	+ note case3 = 3
	+ with s(2) have Ns: "0 < zcount N s"
	+ by (auto intro: ccontr simp: not_less)
	+ note assms(4)[unfolded justified_alt, rule_format, OF Ns]
	+ then consider "supported_strong N s" \| "\<exists>t'<s. 0 < zcount C t'" \| "zcount N s < zcount C s"
	+ using not_less by blast
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ unfolding supported_strong_def
	+ apply (elim exE conjE)
	+ subgoal for s'
	+ using s(1,2) least by (auto intro: exI[of _ s'] simp: nonpos_upto_def)
	+ done
	+ next
	+ case 2
	+ then show ?thesis
	+ using s(3) by auto
	+ next
	+ case 3
	+ from case3 have "zcount C s = zcount N s"
	+ by auto
	+ with 3 show ?thesis
	+ by linarith
	+ qed
	+ next
	+ case 4
	+ then have Ns: "0 < zcount N s"
	+ by auto
	+ note assms(4)[unfolded justified_alt, rule_format, OF Ns]
	+ then consider "supported_strong N s" \| "\<exists>t'<s. 0 < zcount C t'" \| "zcount N s < zcount C s"
	+ using not_less by blast
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ unfolding supported_strong_def
	+ apply (elim exE conjE)
	+ subgoal for s'
	+ using s(1,2) least by (auto intro: exI[of _ s'] simp: nonpos_upto_def)
	+ done
	+ next
	+ case 2
	+ then show ?thesis
	+ using s(3) by auto
	+ next
	+ case 3
	+ have "zcount C s = zcount N s"
	+ using 3 4(1,2) by auto
	+ with 3 show ?thesis
	+ by linarith
	+ qed
	+ qed
	+ next
	+ case 4
	+ then show ?thesis
	+ by auto
	+ qed
	+qed
	+
	+lemma PositiveImplies_justified_with:
	+ assumes "justified C (M+N)"
	+ and "PositiveImplies M (M+N)"
	+ shows "justified_with C M N"
	+ unfolding justified_with_def
	+ apply (intro allI impI)
	+ apply (drule assms(2)[unfolded PositiveImplies_def, rule_format])
	+ apply (frule assms(1)[unfolded justified_alt supported_strong_def, rule_format])
	+ apply (elim disjE)
	+ subgoal for t
	+ apply (intro disjI1)
	+ apply (elim exE)
	+ subgoal for s
	+ apply (clarsimp intro!: exI[of _ s])
	+ done
	+ done
	+ subgoal for t
	+ using less_imp_le by blast
	+ subgoal for t
	+ by (intro disjI2 exI[of _ t]) auto
	+ done
	+
	+lemma justified_with_add_zmset[simp]:
	+ assumes "justified_with C M N"
	+ shows "justified_with (add_zmset c C) M N"
	+ using assms
	+ apply (subst add_zmset_add_single)
	+ apply (rule justified_with_add_records)
	+ apply simp_all
	+ done
	+
	+lemma next_performop'_preserves_justified_with:
	+ assumes "justified_with (c_caps c0 p) M N"
	+ and "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ and "\<forall>t. 0 \<le> zcount (c_caps c0 p) t"
	+ and "justified (c_caps c0 p) N"
	+ shows "justified_with (c_caps c0 p + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg) M (N + zmset_of \<Delta>mint_self + timestamps (zmset_of \<Delta>mint_msg) - zmset_of \<Delta>neg)"
	+ apply (rule justified_with_diff)
	+ apply (rule justified_with_add_msg_delta)
	+ apply (rule justified_with_add_same)
	+ using assms(1) apply simp
	+ using assms(3) apply simp
	+ apply (rule minting_msg_add_records)
	+ using next_performopD(4)[OF assms(2)] apply simp
	+ apply simp
	+ using assms(3) apply simp
	+ using assms(3) apply simp
	+ using next_performopD(2)[OF assms(2)] apply (simp add: add.commute add_increasing)
	+ apply (rule justified_add_msg_delta)
	+ apply (rule justified_add_same)
	+ using assms(4) apply simp
	+ using next_performopD(3)[OF assms(2)] apply simp
	+ using assms(3) apply simp
	+ apply (rule minting_msg_add_records)
	+ using next_performopD(4)[OF assms(2)] apply simp
	+ apply simp
	+ using assms(3) apply (simp add: add.commute add_increasing)
	+ done
	+
	+subsection\<open>Invariants\<close>
	+
	+subsubsection\<open>InvRecordCount\<close>
	+
	+text\<open>InvRecordCount states that for every processor, its local approximation @{text "c_glob c q"}
	+and the sum of all incoming progress updates @{text "GlobalIncomingInfoAt c q"} together are equal
	+to the sum of all capabilities in the system.\<close>
	+
	+definition InvRecordCount where
	+ "InvRecordCount c \<equiv> \<forall>q. records c = GlobalIncomingInfoAt c q + c_glob c q"
	+
	+lemma init_config_implies_InvRecordCount: "init_config c \<Longrightarrow> InvRecordCount c"
	+ by (simp add: InvRecordCount_def init_config_def GlobalIncomingInfo_def IncomingInfo_def)
	+
	+lemma performop_preserves_InvRecordCount:
	+ assumes "InvRecordCount c0"
	+ and "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ shows "InvRecordCount c1"
	+proof -
	+ note change = next_performopD[OF assms(2)]
	+ note complex_change = next_performop_complexD[OF assms(2)]
	+ show "InvRecordCount c1"
	+ unfolding InvRecordCount_def complex_change
	+ by (auto intro: assms(1)[unfolded InvRecordCount_def, rule_format] simp: change)
	+qed
	+
	+lemma sendupd_preserves_InvRecordCount:
	+ assumes "InvRecordCount c0"
	+ and "next_sendupd' c0 c1 p tt"
	+ shows "InvRecordCount c1"
	+proof -
	+ note change = next_sendupdD[OF assms(2)]
	+ note complex_change = next_sendupd_complexD[OF assms(2)]
	+ from assms(1) show "InvRecordCount c1"
	+ unfolding InvRecordCount_def complex_change change(5) by assumption
	+qed
	+
	+lemma recvupd_preserves_InvRecordCount:
	+ assumes "InvRecordCount c0"
	+ and "next_recvupd' c0 c1 p q"
	+ shows "InvRecordCount c1"
	+proof -
	+ note change = next_recvupdD[OF assms(2)]
	+ note complex_change = next_recvupd_complexD[OF assms(2)]
	+ show "InvRecordCount c1"
	+ unfolding InvRecordCount_def complex_change change(4)
	+ by (auto simp: assms(1)[unfolded InvRecordCount_def, rule_format])
	+qed
	+
	+lemma recvcap_preserves_InvRecordCount:
	+ assumes "InvRecordCount c0"
	+ and "next_recvcap' c0 c1 p t"
	+ shows "InvRecordCount c1"
	+proof -
	+ note change = next_recvcapD[OF assms(2)]
	+ note complex_change = next_recvcap_complexD[OF assms(2)]
	+ show "InvRecordCount c1"
	+ unfolding InvRecordCount_def complex_change change(4)
	+ by (auto simp: assms(1)[unfolded InvRecordCount_def, rule_format])
	+qed
	+
	+lemma next_preserves_InvRecordCount: "InvRecordCount c0 \<Longrightarrow> next' c0 c1 \<Longrightarrow> InvRecordCount c1"
	+ unfolding next'_def
	+ apply (elim disjE)
	+ subgoal
	+ using performop_preserves_InvRecordCount by auto
	+ subgoal
	+ using sendupd_preserves_InvRecordCount by auto
	+ subgoal
	+ using recvupd_preserves_InvRecordCount by auto
	+ subgoal
	+ using recvcap_preserves_InvRecordCount by auto
	+ subgoal
	+ by simp
	+ done
	+
	+lemma alw_InvRecordCount: "spec s \<Longrightarrow> alw (holds InvRecordCount) s"
	+ using lift_invariant_to_spec init_config_implies_InvRecordCount next_preserves_InvRecordCount
	+ by (metis (mono_tags, lifting) holds.elims(2) holds.elims(3) nxt.simps)
	+
	+subsubsection\<open>InvCapsNonneg and InvRecordsNonneg\<close>
	+
	+text\<open>InvCapsNonneg states that elements in a processor's @{text "c_caps c p"} always have
	+non-negative cardinality. InvRecordsNonneg lifts this result to @{text "records c"}\<close>
	+
	+definition InvCapsNonneg :: "('p :: finite, 'a) configuration \<Rightarrow> bool" where
	+ "InvCapsNonneg c = (\<forall>p t. 0 \<le> zcount (c_caps c p) t)"
	+
	+definition InvRecordsNonneg where
	+ "InvRecordsNonneg c = (\<forall>t. 0 \<le> zcount (records c) t)"
	+
	+lemma init_config_implies_InvCapsNonneg: "init_config c \<Longrightarrow> InvCapsNonneg c"
	+ unfolding init_config_def InvCapsNonneg_def by simp
	+
	+lemma performop_preserves_InvCapsNonneg:
	+ assumes "InvCapsNonneg c0"
	+ and "next_performop' c0 c1 p \<Delta>\<^sub>m \<Delta>\<^sub>p\<^sub>1 \<Delta>\<^sub>p\<^sub>2"
	+ shows "InvCapsNonneg c1"
	+ using assms unfolding InvCapsNonneg_def next_performop'_def Let_def
	+ by clarsimp (metis add.right_neutral add_mono_thms_linordered_semiring(1) of_nat_0_le_iff)
	+
	+lemma sendupd_performs_InvCapsNonneg:
	+ assumes "InvCapsNonneg c0"
	+ and "next_sendupd' c0 c1 p tt"
	+ shows "InvCapsNonneg c1"
	+ using assms by (simp add: InvCapsNonneg_def next_sendupd'_def Let_def)
	+
	+lemma recvupd_preserves_InvCapsNonneg:
	+ assumes "InvCapsNonneg c0"
	+ and "next_recvupd' c0 c1 p q"
	+ shows "InvCapsNonneg c1"
	+ using assms unfolding InvCapsNonneg_def next_recvupd'_def
	+ by simp
	+
	+lemma recvcap_preserves_InvCapsNonneg:
	+ assumes "InvCapsNonneg c0"
	+ and "next_recvcap' c0 c1 p t"
	+ shows "InvCapsNonneg c1"
	+ using assms unfolding InvCapsNonneg_def next_recvcap'_def
	+ by simp
	+
	+lemma next_preserves_InvCapsNonneg: "holds InvCapsNonneg s \<Longrightarrow> next s \<Longrightarrow> nxt (holds InvCapsNonneg) s"
	+ unfolding next'_def
	+ apply (elim disjE)
	+ subgoal
	+ using performop_preserves_InvCapsNonneg by auto
	+ subgoal
	+ using sendupd_performs_InvCapsNonneg by auto
	+ subgoal
	+ using recvupd_preserves_InvCapsNonneg by auto
	+ subgoal
	+ using recvcap_preserves_InvCapsNonneg by auto
	+ subgoal
	+ by simp
	+ done
	+
	+lemma alw_InvCapsNonneg: "spec s \<Longrightarrow> alw (holds InvCapsNonneg) s"
	+ using lift_invariant_to_spec next_preserves_InvCapsNonneg init_config_implies_InvCapsNonneg
	+ by blast
	+
	+lemma alw_InvRecordsNonneg: "spec s \<Longrightarrow> alw (holds InvRecordsNonneg) s"
	+ apply (rule alw_mp[where \<phi> = "holds InvCapsNonneg"])
	+ using alw_InvCapsNonneg apply assumption
	+ apply (rule all_imp_alw)
	+ unfolding InvCapsNonneg_def InvRecordsNonneg_def records_def
	+ apply (auto intro!: add_nonneg_nonneg sum_nonneg simp: zcount_sum)
	+ done
	+
	+subsubsection\<open>Resulting lemmas\<close>
	+
	+lemma pos_caps_pos_records:
	+ assumes "InvCapsNonneg c"
	+ shows "0 < zcount (c_caps c p) x \<Longrightarrow> 0 < zcount (records c) x"
	+proof -
	+ fix x
	+ assume "0 < zcount (c_caps c p) x"
	+ then have "0 < zcount (\<Sum>p\<in>UNIV. c_caps c p) x"
	+ using assms(1)[unfolded InvCapsNonneg_def]
	+ by (auto intro!: sum_pos2 simp: zcount_sum)
	+ then show "0 < zcount (records c) x"
	+ unfolding records_def by simp
	+qed
	+
	+subsubsection\<open>SafeRecordsMono\<close>
	+
	+text\<open>The records in the system are monotonic, i.e. once @{text "records c"} contains no records up
	+to some timestamp t, then it will stay that way forever.\<close>
	+
	+definition SafeRecordsMono :: "('p :: finite, 'a) computation \<Rightarrow> bool" where
	+ "SafeRecordsMono s = (\<forall>t. RecordsVacantUpto (shd s) t \<longrightarrow> alw (holds (\<lambda>c. RecordsVacantUpto c t)) s)"
	+
	+lemma performop_preserves_RecordsVacantUpto:
	+ assumes "RecordsVacantUpto c0 t"
	+ and "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ and "InvRecordsNonneg c1"
	+ and "InvCapsNonneg c0"
	+ shows "RecordsVacantUpto c1 t"
	+proof -
	+ note InvRecordsNonneg = assms(3)[rule_format]
	+ { fix s
	+ let ?\<Delta>pos = "timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self"
	+ let ?\<Delta> = "?\<Delta>pos - zmset_of \<Delta>neg"
	+ note change = next_performopD[OF assms(2)]
	+ note complex_change = next_performop_complexD[OF assms(2)]
	+ assume s: "s \<le> t" "zcount (records c1) s \<noteq> 0"
	+ then have s_pos: "0 < zcount (records c1) s"
	+ using InvRecordsNonneg
	+ by (simp add: order_class.order.not_eq_order_implies_strict InvRecordsNonneg_def)
	+ have \<Delta>_in_nrec: "0 < zcount ?\<Delta> t \<Longrightarrow> \<exists>t'\<le>t. 0 < zcount (records c0) t'" for t
	+ apply (subst (asm) zcount_diff)
	+ apply (subst (asm) zcount_union)
	+ apply (drule zero_lt_diff)
	+ apply simp
	+ apply (drule zero_lt_add_disj)
	+ apply simp
	+ apply simp
	+ apply (erule disjE)
	+ subgoal
	+ apply (drule pos_image_zmset_obtain_pre[rotated])
	+ apply (auto dest!: change(4)[unfolded minting_msg_def, rule_format] pos_caps_pos_records[OF assms(4)] less_imp_le)
	+ done
	+ subgoal
	+ by (auto dest!: change(3)[unfolded minting_self_def, rule_format] pos_caps_pos_records[OF assms(4)])
	+ done
	+ have nrec0s: "zcount (records c0) s = 0"
	+ by (rule assms(1)[unfolded vacant_upto_def, rule_format, OF s(1)])
	+ have "zcount (records c1) s \<le> 0"
	+ unfolding complex_change
	+ apply (subst zcount_union)
	+ apply (subst nrec0s)
	+ apply (subst add_0)
	+ apply (rule ccontr)
	+ unfolding not_le
	+ apply (drule \<Delta>_in_nrec[of s])
	+ apply (meson assms(1) order_trans pos_zcount_in_zmset s(1) vacant_upto_def zcount_ne_zero_iff)
	+ done
	+ with s_pos have False
	+ by linarith
	+ }
	+ note r = this
	+ from assms show ?thesis
	+ unfolding next_performop'_def Let_def vacant_upto_def
	+ apply clarify
	+ apply (rule ccontr)
	+ apply (rule r)
	+ apply auto
	+ done
	+qed
	+
	+lemma next'_preserves_RecordsVacantUpto:
	+ fixes c0 :: "('p::finite, 'a) configuration"
	+ shows "InvCapsNonneg c0 \<Longrightarrow> InvRecordsNonneg c1 \<Longrightarrow> RecordsVacantUpto c0 t \<Longrightarrow> next' c0 c1 \<Longrightarrow> RecordsVacantUpto c1 t"
	+ unfolding next'_def
	+ apply (elim disjE)
	+ subgoal
	+ by (auto intro: performop_preserves_RecordsVacantUpto)
	+ subgoal
	+ by (auto simp: next_sendupd'_def Let_def records_def)
	+ subgoal
	+ by (auto simp: next_recvupd'_def records_def)
	+ subgoal
	+ by (auto dest: next_recvcap_complexD)
	+ subgoal
	+ by simp
	+ done
	+
	+lemma alw_next_implies_alw_SafeRecordsMono:
	+ "alw next s \<Longrightarrow> alw (holds InvCapsNonneg) s \<Longrightarrow> alw (holds InvRecordsNonneg) s \<Longrightarrow> alw SafeRecordsMono s"
	+ apply (coinduction arbitrary: s)
	+ subgoal for s
	+ unfolding spec_def next'_def SafeRecordsMono_def Let_def
	+ apply (rule exI[of _ s])
	+ apply safe
	+ subgoal for t
	+ apply (coinduction arbitrary: s rule: alw.coinduct)
	+ apply clarsimp
	+ apply (rule conjI)
	+ apply blast
	+ apply (erule alw.cases)
	+ apply clarsimp
	+ apply (metis (no_types, lifting) next'_def next'_preserves_RecordsVacantUpto alw_holds2)
	+ done
	+ apply blast
	+ done
	+ done
	+
	+lemma alw_SafeRecordsMono: "spec s \<Longrightarrow> alw SafeRecordsMono s"
	+ by (auto intro!: alw_next_implies_alw_SafeRecordsMono alw_InvRecordsNonneg alw_InvCapsNonneg simp: spec_def)
	+
	+
	+subsubsection\<open>InvJustifiedII and InvJustifiedGII\<close>
	+
	+text\<open>These two invariants state that any net-positive change in the sum of incoming progress updates
	+is "justified" by one of several statements being true.\<close>
	+
	+definition InvJustifiedII where
	+ "InvJustifiedII c = (\<forall>k p q. justified (c_caps c p) (IncomingInfo c k p q))"
	+
	+definition InvJustifiedGII where
	+ "InvJustifiedGII c = (\<forall>k p q. justified (records c) (GlobalIncomingInfo c k p q))"
	+
	+text\<open>Given some zmset @{term M} justified wrt to @{term "caps c0 p"}, after a performop @{term "M + \<Delta>"} is justified wrt to
	+@{term "c_caps c1 p"}. This lemma captures the identical argument used for preservation of InvTempJustified
	+and InvJustifiedII.\<close>
	+lemma next_performop'_preserves_justified:
	+ assumes "justified (c_caps c0 p) M"
	+ and "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ and "InvCapsNonneg c0"
	+ shows "justified (c_caps c1 p) (M + (timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self - zmset_of \<Delta>neg))"
	+proof -
	+ let ?\<Delta>pos = "timestamps (zmset_of \<Delta>mint_msg) + zmset_of \<Delta>mint_self"
	+ let ?\<Delta> = "?\<Delta>pos - zmset_of \<Delta>neg"
	+ let ?M1 = "M + ?\<Delta>"
	+ note change = next_performopD[OF assms(2)]
	+ note complex_change = next_performop_complexD[OF assms(2)]
	+ note inv0 = assms(1)[unfolded InvJustifiedII_def justified_alt, rule_format]
	+ { fix k q t
	+ assume t: "0 < zcount ?M1 t"
	+ assume least: "\<forall>t'<t. zcount ?M1 t' \<le> 0"
	+ from t consider "0 < zcount M t" \| "zcount M t \<le> 0" "0 < zcount ?\<Delta> t"
	+ by atomize_elim (auto simp: complex_change)
	+ then have "supported_strong ?M1 t \<or> (\<exists>t'<t. 0 < zcount (c_caps c1 p) t') \<or> zcount ?M1 t < zcount (c_caps c1 p) t"
	+ proof cases
	+ case 1 \<comment> \<open>@{term M} was already positive at @{term t} in @{term c0}\<close>
	+ note Mcount = 1
	+ note assms(1)[unfolded InvJustifiedII_def justified_alt, rule_format, OF Mcount]
	+ then consider
	+ "supported_strong M t" \|
	+ "\<not> supported_strong M t" "\<exists>t'<t. 0 < zcount (c_caps c0 p) t'" \|
	+ "\<forall>t'<t. zcount (c_caps c0 p) t' \<le> 0" "zcount M t < zcount (c_caps c0 p) t"
	+ by atomize_elim auto
	+ then show ?thesis
	+ proof cases
	+ case 1
	+ { assume nosupp: "\<not> supported_strong ?M1 t"
	+ assume "\<forall>t'<t. \<not> 0 < zcount (c_caps c1 p) t'"
	+ then have nocaps: "\<forall>t'<t. zcount (c_caps c1 p) t' = 0"
	+ using InvCapsNonneg_def assms(2) assms(3) order_class.le_less performop_preserves_InvCapsNonneg by fastforce
	+ from 1 obtain s where s: "s < t" "zcount M s < 0" "\<And>s'. s' < s \<Longrightarrow> zcount M s' = 0"
	+ unfolding nonpos_upto_def supported_strong_def
	+ apply atomize_elim
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation_neg)
	+ apply (elim exE)
	+ subgoal for _ s
	+ apply (rule exI[of _ s])
	+ apply (rule conjI)
	+ using le_less_trans apply blast
	+ using less_imp_le order_trans order_class.order.not_eq_order_implies_strict apply blast
	+ done
	+ done
	+ have count1s: "0 \<le> zcount ?M1 s"
	+ apply (rule ccontr)
	+ apply (subst (asm) not_le)
	+ using nosupp[unfolded nonpos_upto_def supported_strong_def, simplified, rule_format]
	+ using least order.strict_trans2 s(1) apply fastforce
	+ done
	+ have \<Delta>inc: "0 < zcount ?\<Delta> s"
	+ using complex_change(3) count1s s(2) by auto
	+ have "0 < zcount (timestamps (zmset_of \<Delta>mint_msg)) s"
	+ using \<Delta>inc change(2)[rule_format, of s] nocaps[rule_format, OF s(1)]
	+ unfolding change(9) fun_upd_same zcount_union zcount_diff
	+ by linarith
	+ then obtain u where u: "u < s" "0 < zcount (c_caps c0 p) u" "\<forall>u'<u. zcount (c_caps c0 p) u' = 0"
	+ apply atomize_elim
	+ apply (drule pos_image_zmset_obtain_pre[rotated])
	+ apply simp
	+ apply clarify
	+ subgoal for p'
	+ apply simp
	+ apply (drule change(4)[unfolded minting_msg_def, rule_format])
	+ apply simp
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation)
	+ apply clarsimp
	+ subgoal for s' u
	+ apply (rule exI[of _ u])
	+ apply clarsimp
	+ using assms(3)[unfolded InvCapsNonneg_def, rule_format]
	+ apply (metis le_less_trans order_class.order.not_eq_order_implies_strict)
	+ done
	+ done
	+ done
	+ have count1u: "zcount ?M1 u < 0"
	+ using complex_change(4)[of u] nocaps[unfolded change(9) fun_upd_same] order.strict_trans[OF u(1) s(1)] s(3)[OF u(1)] u(2) u(3)
	+ by auto
	+ then have "nonpos_upto ?M1 u"
	+ unfolding nonpos_upto_def
	+ using least order.strict_implies_order order.strict_trans1 s(1) u(1) by blast
	+ then have "supported_strong ?M1 t"
	+ using count1u order.strict_trans s(1) u(1) supported_strong_def by blast
	+ with nosupp have False
	+ by blast
	+ }
	+ then show ?thesis
	+ by blast
	+ next
	+ case 2
	+ { assume nosupp: "\<not> supported_strong ?M1 t"
	+ assume "\<forall>t'<t. \<not> 0 < zcount (c_caps c1 p) t'"
	+ then have nocaps: "\<forall>t'<t. zcount (c_caps c1 p) t' = 0"
	+ using InvCapsNonneg_def assms(2) assms(3) order_class.le_less performop_preserves_InvCapsNonneg by fastforce
	+ from 2(2) obtain s where s: "s < t" "0 < zcount (c_caps c0 p) s" "\<forall>s'<s. zcount (c_caps c0 p) s' = 0"
	+ apply atomize_elim
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation)
	+ apply (elim exE conjE)
	+ subgoal for _ s
	+ apply (rule exI[of _ s])
	+ apply (rule conjI, simp)
	+ apply (rule conjI, simp)
	+ apply (intro allI impI)
	+ apply (rule ccontr)
	+ subgoal
	+ using assms(3)[unfolded InvCapsNonneg_def, rule_format]
	+ by (simp add: order_class.order.not_eq_order_implies_strict)
	+ done
	+ done
	+ have \<Delta>counts:
	+ "\<And>s. s < t \<Longrightarrow> count \<Delta>neg s = zcount (c_caps c0 p) s"
	+ "\<And>s. s < t \<Longrightarrow> count \<Delta>mint_self s = 0"
	+ "\<And>p s'. s' \<le> s \<Longrightarrow> count \<Delta>mint_msg (p,s') = 0"
	+ subgoal for s'
	+ using change(2) nocaps s(1) order_class.order.not_eq_order_implies_strict
	+ by (fastforce simp: change(9))
	+ subgoal for s'
	+ using nocaps[rule_format, of s']
	+ by (simp add: change(9) \<open>\<And>s'. s' < t \<Longrightarrow> int (count \<Delta>neg s') = zcount (c_caps c0 p) s'\<close>)
	+ subgoal for p s'
	+ using change(4)[unfolded minting_msg_def, rule_format, of "(p,s')"] s(3)
	+ by (force intro: ccontr)
	+ done
	+ have caps_le_ii0: "zcount (c_caps c0 p) s \<le> zcount M s"
	+ proof (rule ccontr)
	+ assume nle: "\<not> zcount (c_caps c0 p) s \<le> zcount M s"
	+ have "zcount ?M1 s < 0"
	+ unfolding complex_change(3)
	+ using complex_change(4) nle s(3) by (auto simp: \<Delta>counts(1,2)[OF s(1)])
	+ then show False
	+ using s(1) least
	+ by (force dest!: nosupp[unfolded supported_strong_def, simplified, rule_format] simp: nonpos_upto_def)
	+ qed
	+ with s(2) have count0s: "0 < zcount M s"
	+ by auto
	+ have False
	+ using inv0[OF count0s]
	+ apply (elim disj3_split)
	+ using 2(1) order.strict_trans s(1) supported_strong_def apply blast
	+ using s(3) apply auto []
	+ using caps_le_ii0 apply linarith
	+ done
	+ }
	+ then show ?thesis
	+ by blast
	+ next
	+ case 3
	+ then show ?thesis (* positive and negative changes to a least pointstamp are directly reflected in c_caps *)
	+ apply (intro disjI2)
	+ unfolding complex_change(3) change(9)
	+ apply (simp only: if_P zcount_union zcount_diff)
	+ apply (subst complex_change(4)[of t])
	+ using assms(3)[unfolded InvCapsNonneg_def, rule_format]
	+ apply (simp add: order_class.antisym)
	+ apply simp
	+ done
	+ qed
	+ next \<comment> \<open>Adding @{term \<Delta>} made @{term M} positive at @{term t} in @{term c}1\<close>
	+ case 2
	+ { assume nosupp: "\<not> supported_strong ?M1 t"
	+ assume "\<forall>t'<t. \<not> 0 < zcount (c_caps c1 p) t'"
	+ then have nocaps: "\<forall>t'<t. zcount (c_caps c1 p) t' = 0"
	+ using InvCapsNonneg_def assms(2) assms(3) order_class.le_less performop_preserves_InvCapsNonneg by metis
	+ assume "\<not> zcount ?M1 t < zcount (c_caps c1 p) t"
	+ then have caps_le: "zcount (c_caps c1 p) t \<le> zcount ?M1 t"
	+ by linarith
	+ from 2 have "count \<Delta>neg t < zcount ?\<Delta>pos t"
	+ by auto
	+ then have "0 < count \<Delta>mint_self t \<or> 0 < zcount (timestamps (zmset_of \<Delta>mint_msg)) t"
	+ by (metis 2(2) add.commute add.left_neutral not_gr_zero of_nat_0 zero_lt_diff zcount_diff zcount_of_mset zcount_union zcount_zmset_of_nonneg)
	+ then obtain s where s: "s \<le> t" "0 < zcount (c_caps c0 p) s" "\<forall>s'<s. zcount (c_caps c0 p) s' = 0"
	+ apply atomize_elim
	+ apply (elim disjE)
	+ subgoal
	+ apply simp
	+ apply (drule change(3)[unfolded minting_self_def, rule_format])
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation)
	+ apply clarsimp
	+ subgoal for s' u
	+ apply (rule exI[of _ u])
	+ apply clarsimp
	+ using assms(3)[unfolded InvCapsNonneg_def, rule_format]
	+ apply (metis order.trans order_class.order.not_eq_order_implies_strict)
	+ done
	+ done
	+ subgoal
	+ apply (drule pos_image_zmset_obtain_pre[rotated])
	+ apply simp
	+ apply clarify
	+ subgoal for p'
	+ apply simp
	+ apply (drule change(4)[unfolded minting_msg_def, rule_format])
	+ apply simp
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation)
	+ apply clarsimp
	+ subgoal for s' u
	+ apply (rule exI[of _ u])
	+ apply clarsimp
	+ using assms(3)[unfolded InvCapsNonneg_def, rule_format]
	+ apply (metis order.strict_trans1 less_imp_le order_class.order.not_eq_order_implies_strict)
	+ done
	+ done
	+ done
	+ done
	+ have \<Delta>counts:
	+ "\<And>s. s < t \<Longrightarrow> count \<Delta>neg s = zcount (c_caps c0 p) s"
	+ "\<And>s. s < t \<Longrightarrow> count \<Delta>mint_self s = 0"
	+ "\<And>p s'. s' \<le> s \<Longrightarrow> count \<Delta>mint_msg (p,s') = 0"
	+ subgoal for s'
	+ using change(2) nocaps s(1) order_class.order.not_eq_order_implies_strict
	+ by (fastforce simp: change(9))
	+ subgoal for s'
	+ using nocaps[rule_format, of s']
	+ by (simp add: change(9) \<open>\<And>s'. s' < t \<Longrightarrow> int (count \<Delta>neg s') = zcount (c_caps c0 p) s'\<close>)
	+ subgoal for p s'
	+ using change(4)[unfolded minting_msg_def, rule_format, of "(p,s')"] s(3)
	+ by (force intro: ccontr)
	+ done
	+ { assume less: "s < t"
	+ have caps_le_ii0: "zcount (c_caps c0 p) s \<le> zcount M s"
	+ proof (rule ccontr)
	+ assume nle: "\<not> zcount (c_caps c0 p) s \<le> zcount M s"
	+ have "zcount ?M1 s < 0"
	+ unfolding complex_change(3)
	+ using complex_change(4) nle s(3) by (auto simp: \<Delta>counts(1,2)[OF less])
	+ then show False
	+ using less least order.strict_trans2
	+ by (force dest!: nosupp[unfolded supported_strong_def, simplified, rule_format] simp: nonpos_upto_def)
	+ qed
	+ with s(2) have count0s: "0 < zcount M s"
	+ by auto
	+ have False
	+ using inv0[OF count0s]
	+ apply (elim disj3_split)
	+ subgoal
	+ proof -
	+ assume "supported_strong M s"
	+ then obtain u where u: "u < s" "zcount M u < 0"
	+ unfolding supported_strong_def
	+ by blast
	+ have "0 \<le> zcount ?M1 u"
	+ using least nosupp[unfolded supported_strong_def nonpos_upto_def, simplified, rule_format, of u] order.strict_trans[OF u(1) less]
	+ by fastforce
	+ then have "0 < zcount ?\<Delta>pos u"
	+ using \<Delta>counts(1)[of u] s(3) u(1) u(2) less by force
	+ then have "0 < count \<Delta>mint_self u \<or> 0 < zcount (timestamps (zmset_of \<Delta>mint_msg)) u"
	+ using gr0I by fastforce
	+ then obtain u' where "u' \<le> u" "0 < zcount (c_caps c0 p) u'"
	+ apply atomize_elim
	+ apply (elim disjE)
	+ subgoal
	+ apply simp
	+ apply (drule change(3)[unfolded minting_self_def, rule_format])
	+ using s(1) s(2) apply blast
	+ done
	+ subgoal
	+ apply (drule pos_image_zmset_obtain_pre[rotated])
	+ apply simp
	+ apply clarify
	+ subgoal for p'
	+ apply simp
	+ apply (drule change(4)[unfolded minting_msg_def, rule_format])
	+ using order.strict_iff_order apply auto
	+ done
	+ done
	+ done
	+ then show False
	+ using s(3) u(1) by auto
	+ qed
	+ using s(3) apply auto []
	+ using caps_le_ii0 apply linarith
	+ done
	+ }
	+ moreover
	+ { assume eq: "s = t"
	+ have count0t: "0 < zcount M t"
	+ using eq caps_le change(9) complex_change(3,4) s(2,3) by auto
	+ have False
	+ using 2(1) count0t by auto
	+ }
	+ ultimately have False
	+ using order.not_eq_order_implies_strict s(1) by blast
	+ }
	+ then show ?thesis
	+ by blast
	+ qed
	+ }
	+ then show "justified (c_caps c1 p) ?M1"
	+ by (intro justified_leastI) blast
	+qed
	+
	+lemma InvJustifiedII_implies_InvJustifiedGII:
	+ assumes "InvJustifiedII c"
	+ and "InvCapsNonneg c"
	+ shows "InvJustifiedGII c"
	+ using assms
	+ unfolding
	+ InvJustifiedGII_def
	+ InvJustifiedII_def
	+ GlobalIncomingInfo_def
	+ records_def
	+ InvCapsNonneg_def
	+ by (auto intro!: justified_add_records justified_sum)
	+
	+lemma init_config_implies_InvJustifiedII: "init_config c \<Longrightarrow> InvJustifiedII c"
	+ by (simp add: init_config_def InvJustifiedII_def justified_alt IncomingInfo_def)
	+
	+lemma performop_preserves_InvJustifiedII:
	+ assumes "InvJustifiedII c0"
	+ and "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ and "InvCapsNonneg c0"
	+ shows "InvJustifiedII c1"
	+ unfolding InvJustifiedII_def
	+ apply clarify
	+ subgoal for k p' q
	+ apply (cases "p'=p")
	+ subgoal
	+ unfolding next_performop_complexD[OF assms(2)]
	+ apply (simp only: if_P)
	+ apply (rule next_performop'_preserves_justified[
	+ OF assms(1)[unfolded InvJustifiedII_def, rule_format, of p k q],
	+ OF assms(2,3)])
	+ done
	+ subgoal
	+ unfolding
	+ next_performopD[OF assms(2)]
	+ next_performop_complexD[OF assms(2)]
	+ using assms(1)[unfolded InvJustifiedII_def]
	+ by simp
	+ done
	+ done
	+
	+lemma sendupd_preserves_InvJustifiedII:
	+ assumes "InvJustifiedII c0"
	+ and "next_sendupd' c0 c1 p tt"
	+ shows "InvJustifiedII c1"
	+ unfolding InvJustifiedII_def justified_alt supported_strong_def next_sendupdD(6)[OF assms(2)]
	+ apply (intro allI)
	+ subgoal for k p' q t
	+ apply (cases "k \<le> length (c_msg c0 p q)")
	+ subgoal
	+ apply (drule next_sendupd_complexD(4)[OF assms(2), of _ _ p'])
	+ apply (auto dest: assms(1)[unfolded InvJustifiedII_def justified_alt supported_strong_def, rule_format])
	+ done
	+ subgoal
	+ apply (subst (asm) not_le)
	+ apply (subst (1 2 3 4) next_sendupd_complexD(5)[OF assms(2), of _ _ p'])
	+ apply simp
	+ apply simp
	+ apply (cases "p'=p")
	+ subgoal
	+ apply rule
	+ apply (subst (asm) if_P)
	+ apply simp
	+ apply (subst (1 2 3) if_P)
	+ apply simp
	+ apply simp
	+ unfolding IncomingInfo_def
	+ apply (subst (asm) drop_all)
	+ apply simp
	+ apply (subst drop_all)
	+ apply simp
	+ apply (simp del: zcount_diff)
	+ \<comment> \<open>The justified condition ensures that anything remaining in temp satisfies this invariant\<close>
	+ apply (drule next_sendupdD(2)[OF assms(2), unfolded justified_alt supported_strong_def, rule_format])
	+ apply simp
	+ done
	+ subgoal
	+ by (auto intro!: assms(1)[unfolded InvJustifiedII_def justified_alt supported_strong_def, rule_format])
	+ done
	+ done
	+ done
	+
	+lemma recvupd_preserves_InvJustifiedII:
	+ assumes "InvJustifiedII c0"
	+ and "next_recvupd' c0 c1 p q"
	+ shows "InvJustifiedII c1"
	+ using assms(1)
	+ unfolding
	+ InvJustifiedII_def
	+ next_recvupd_complexD[OF assms(2)]
	+ next_recvupdD[OF assms(2)]
	+ by auto
	+
	+lemma recvcap_preserves_InvJustifiedII:
	+ assumes "InvJustifiedII c0"
	+ and "next_recvcap' c0 c1 p t"
	+ shows "InvJustifiedII c1"
	+ unfolding InvJustifiedII_def justified_alt supported_strong_def next_recvcap_complexD[OF assms(2)] next_recvcapD(5)[OF assms(2)]
	+ by (auto dest!: assms(1)[unfolded InvJustifiedII_def justified_alt supported_strong_def, rule_format])
	+
	+lemma next'_preserves_InvJustifiedII:
	+ "InvCapsNonneg c0 \<Longrightarrow> InvJustifiedII c0 \<Longrightarrow> next' c0 c1 \<Longrightarrow> InvJustifiedII c1"
	+ using
	+ next'_def
	+ performop_preserves_InvJustifiedII
	+ recvcap_preserves_InvJustifiedII
	+ recvupd_preserves_InvJustifiedII
	+ sendupd_preserves_InvJustifiedII
	+ by blast
	+
	+lemma alw_InvJustifiedII: "spec s \<Longrightarrow> alw (holds InvJustifiedII) s"
	+ apply (frule alw_InvCapsNonneg)
	+ unfolding spec_def
	+ apply (elim conjE)
	+ apply (subst (asm) holds.simps)
	+ apply (drule init_config_implies_InvJustifiedII)
	+ apply (coinduction arbitrary: s rule: alw.coinduct)
	+ apply (subst (asm) (1 2) alw_nxt)
	+ apply clarsimp
	+ using next'_preserves_InvJustifiedII apply blast
	+ done
	+
	+lemma alw_InvJustifiedGII: "spec s \<Longrightarrow> alw (holds InvJustifiedGII) s"
	+ apply (frule alw_InvJustifiedII)
	+ apply (drule alw_InvCapsNonneg)
	+ apply (simp add: alw_iff_sdrop InvJustifiedII_implies_InvJustifiedGII)
	+ done
	+
	+subsubsection\<open>InvTempJustified\<close>
	+
	+definition InvTempJustified where
	+ "InvTempJustified c = (\<forall>p. justified (c_caps c p) (c_temp c p))"
	+
	+lemma init_config_implies_InvTempJustified: "init_config c \<Longrightarrow> InvTempJustified c"
	+ unfolding init_config_def InvTempJustified_def
	+ using justified_add_records[OF justified_empty]
	+ by auto
	+
	+lemma recvcap_preserves_InvTempJustified:
	+ assumes "InvTempJustified c0"
	+ and "next_recvcap' c0 c1 p t"
	+ shows "InvTempJustified c1"
	+ using assms(1)[unfolded InvTempJustified_def, rule_format, of p] assms(1)
	+ unfolding next_recvcapD[OF assms(2)] InvTempJustified_def
	+ by - (frule justified_add_records[of _ _ "{#t#}\<^sub>z"], auto)
	+
	+lemma recvupd_preserves_InvTempJustified:
	+ assumes "InvTempJustified c0"
	+ and "next_recvupd' c0 c1 p t"
	+ shows "InvTempJustified c1"
	+ using assms(1)
	+ unfolding next_recvupdD[OF assms(2)] InvTempJustified_def
	+ by assumption
	+
	+lemma sendupd_preserves_InvTempJustified:
	+ assumes "InvTempJustified c0"
	+ and "next_sendupd' c0 c1 p tt"
	+ shows "InvTempJustified c1"
	+ using assms(1)
	+ unfolding next_sendupdD[OF assms(2)] InvTempJustified_def
	+ using next_sendupdD(2)[OF assms(2)]
	+ by auto
	+
	+lemma performop_preserves_InvTempJustified:
	+ assumes "InvTempJustified c0"
	+ and "next_performop' c0 c1 p \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ and "InvCapsNonneg c0"
	+ shows "InvTempJustified c1"
	+ unfolding InvTempJustified_def
	+ apply clarify
	+ subgoal for p'
	+ apply (cases "p'=p")
	+ subgoal
	+ unfolding next_performopD(5)[OF assms(2)] fun_upd_apply
	+ apply (simp only: if_P)
	+ apply (rule next_performop'_preserves_justified[
	+ OF assms(1)[unfolded InvTempJustified_def, rule_format, of p],
	+ OF assms(2,3)])
	+ done
	+ subgoal
	+ unfolding
	+ next_performopD[OF assms(2)]
	+ next_performop_complexD[OF assms(2)]
	+ using assms(1)[unfolded InvTempJustified_def]
	+ by simp
	+ done
	+ done
	+
	+lemma next'_preserves_InvTempJustified:
	+ "InvCapsNonneg c0 \<Longrightarrow> InvTempJustified c0 \<Longrightarrow> next' c0 c1 \<Longrightarrow> InvTempJustified c1"
	+ using
	+ next'_def
	+ performop_preserves_InvTempJustified
	+ recvcap_preserves_InvTempJustified
	+ recvupd_preserves_InvTempJustified
	+ sendupd_preserves_InvTempJustified
	+ by blast
	+
	+lemma alw_InvTempJustified: "spec s \<Longrightarrow> alw (holds InvTempJustified) s"
	+ apply (frule alw_InvCapsNonneg)
	+ unfolding spec_def
	+ apply (elim conjE)
	+ apply (subst (asm) holds.simps)
	+ apply (drule init_config_implies_InvTempJustified)
	+ apply (coinduction arbitrary: s rule: alw.coinduct)
	+ apply (subst (asm) (1 2) alw_nxt)
	+ apply clarsimp
	+ using next'_preserves_InvTempJustified apply blast
	+ done
	+
	+subsubsection\<open>InvGlobNonposImpRecordsNonpos\<close>
	+
	+text\<open>InvGlobNonposImpRecordsNonpos states that each processor's @{term "c_glob c q"} is a conservative
	+approximation of @{term "records c"}.\<close>
	+
	+definition InvGlobNonposImpRecordsNonpos :: "('p :: finite, 'a) configuration \<Rightarrow> bool" where
	+ "InvGlobNonposImpRecordsNonpos c = (\<forall>t q. nonpos_upto (c_glob c q) t \<longrightarrow> nonpos_upto (records c) t)"
	+
	+definition InvGlobVacantImpRecordsVacant :: "('p :: finite, 'a) configuration \<Rightarrow> bool" where
	+ "InvGlobVacantImpRecordsVacant c = (\<forall>t q. GlobVacantUpto c q t \<longrightarrow> RecordsVacantUpto c t)"
	+
	+lemma invs_imp_InvGlobNonposImpRecordsNonpos:
	+ assumes "InvJustifiedGII c"
	+ and "InvRecordCount c"
	+ and "InvRecordsNonneg c"
	+ shows "InvGlobNonposImpRecordsNonpos c"
	+ unfolding InvGlobNonposImpRecordsNonpos_def
	+ apply (rule ccontr)
	+ apply (clarsimp simp: nonpos_upto_def)
	+ subgoal for t q u
	+ proof -
	+ let ?GII = "GlobalIncomingInfoAt c q"
	+ assume gvu: "\<forall>sa\<le>t. zcount (c_glob c q) sa \<le> 0"
	+ assume uleqt: "u \<le> t"
	+ assume "\<not> zcount (records c) u \<le> 0"
	+ \<comment> \<open>u is pointstamp that violates @{term InvGlobNonposImpRecordsNonpos}\<close>
	+ with assms(2) have u: "0 < zcount (records c) u"
	+ by linarith
	+ \<comment> \<open>u' is the least pointstamp with positive @{term records}\<close>
	+ with uleqt obtain u' where u': "0 < zcount (records c) u'" "\<forall>u. 0 < zcount (records c) u \<longrightarrow> \<not> u < u'" "u' \<le> t"
	+ using order_zmset_exists_foundation[OF u] by auto
	+ \<comment> \<open>from the @{term records} count we know that GII also has positive count\<close>
	+ from u'(1,3) assms(2) gvu have pos_gii: "0 < zcount ?GII u'"
	+ unfolding InvRecordCount_def
	+ by (metis add_diff_cancel_left' diff_eq_eq less_add_same_cancel1 order_class.order.strict_trans1 zcount_diff)
	+ \<comment> \<open>Case distinction on which part of the partition GII's u is in\<close>
	+ { \<comment> \<open>Original proof from Abadi paper, change is justified by uprightness\<close>
	+ assume "supported_strong ?GII u'"
	+ \<comment> \<open>uprightness gives us a lesser pointstamp with negative count in GII..\<close>
	+ then obtain v where v: "v \<le> u'" "zcount ?GII v < 0"
	+ using order.strict_implies_order supported_strong_def by blast
	+ \<comment> \<open>..which is also negative in @{term records}..\<close>
	+ with u'(3) v(1) assms(2) have "zcount (records c) v < 0"
	+ by (metis (no_types, hide_lams) InvRecordCount_def add.commute gvu less_add_same_cancel2 order.trans not_le order_class.order.strict_trans2 zcount_union)
	+ \<comment> \<open>..contradicting InvNrecNonneg\<close>
	+ with assms(3) have "False"
	+ unfolding InvRecordsNonneg_def
	+ using order_class.leD by blast
	+ }
	+ moreover
	+ { \<comment> \<open>Change is justified by strictly lesser pointstamp in @{term records}\<close>
	+ assume "\<exists>t'<u'. 0 < zcount (records c) t'"
	+ \<comment> \<open>v is a strictly lesser positive count in @{term records}..\<close>
	+ then obtain v where v: "v < u'" "0 < zcount (records c) v"
	+ by auto
	+ \<comment> \<open>..which contradicts the fact that we obtained @{term u'} as the least, positive pointstamp in @{term records}\<close>
	+ with u'(2) have "False"
	+ by auto
	+ }
	+ moreover
	+ { \<comment> \<open>Change is justified by records\<close>
	+ assume "zcount ?GII u' < zcount (records c) u'"
	+ then have "0 < zcount (c_glob c q) u'"
	+ by (simp add: assms(2)[unfolded InvRecordCount_def, rule_format, of q])
	+ then have False
	+ using gvu u'(3) by auto
	+ }
	+ ultimately show False
	+ using pos_gii assms(1)[unfolded InvJustifiedGII_def justified_alt, rule_format, OF pos_gii]
	+ by auto
	+ qed
	+ done
	+
	+text\<open>InvGlobVacantImpRecordsVacant is the one proved in the Abadi paper. We prove
	+InvGlobNonposImpRecordsNonpos, which implies this.\<close>
	+lemma invs_imp_InvGlobVacantImpRecordsVacant:
	+ assumes "InvJustifiedGII c"
	+ and "InvRecordCount c"
	+ and "InvRecordsNonneg c"
	+ shows "InvGlobVacantImpRecordsVacant c"
	+proof -
	+ { fix p x
	+ assume "GlobVacantUpto c p x"
	+ then have "GlobNonposUpto c p x"
	+ unfolding nonpos_upto_def vacant_upto_def by simp
	+ note invs_imp_InvGlobNonposImpRecordsNonpos[OF assms, unfolded InvGlobNonposImpRecordsNonpos_def, rule_format, OF this]
	+ then have "RecordsVacantUpto c x"
	+ using assms(3)
	+ unfolding nonpos_upto_def vacant_upto_def InvRecordsNonneg_def
	+ by (simp add: order_class.order.antisym)
	+ }
	+ then show ?thesis
	+ unfolding InvGlobVacantImpRecordsVacant_def by simp
	+qed
	+
	+lemma alw_InvGlobNonposImpRecordsNonpos: "spec s \<Longrightarrow> alw (holds InvGlobNonposImpRecordsNonpos) s"
	+ apply (frule alw_InvJustifiedGII)
	+ apply (frule alw_InvRecordCount)
	+ apply (drule alw_InvRecordsNonneg)
	+ apply (simp add: alw_iff_sdrop invs_imp_InvGlobNonposImpRecordsNonpos)
	+ done
	+
	+lemma alw_InvGlobVacantImpRecordsVacant: "spec s \<Longrightarrow> alw (holds InvGlobVacantImpRecordsVacant) s"
	+ apply (frule alw_InvGlobNonposImpRecordsNonpos)
	+ apply (frule alw_InvJustifiedGII)
	+ apply (frule alw_InvRecordCount)
	+ apply (drule alw_InvRecordsNonneg)
	+ apply (simp add: alw_iff_sdrop invs_imp_InvGlobVacantImpRecordsVacant)
	+ done
	+
	+subsubsection\<open>SafeGlobVacantUptoImpliesStickyNrec\<close>
	+
	+text\<open>This is the main safety property proved in the Abadi paper.\<close>
	+
	+lemma invs_imp_SafeGlobVacantUptoImpliesStickyNrec:
	+ "SafeRecordsMono s \<Longrightarrow> holds InvGlobVacantImpRecordsVacant s \<Longrightarrow> SafeGlobVacantUptoImpliesStickyNrec s"
	+ by (simp add: InvGlobVacantImpRecordsVacant_def SafeRecordsMono_def SafeGlobVacantUptoImpliesStickyNrec_def)
	+
	+lemma alw_SafeGlobVacantUptoImpliesStickyNrec:
	+ "spec s \<Longrightarrow> alw SafeGlobVacantUptoImpliesStickyNrec s"
	+ by (meson alw_iff_sdrop invs_imp_SafeGlobVacantUptoImpliesStickyNrec alw_SafeRecordsMono alw_InvGlobVacantImpRecordsVacant)
	+
	+subsubsection\<open>InvGlobNonposEqVacant\<close>
	+
	+text\<open>The least pointstamps in glob are always positive, i.e. @{term nonpos_upto} and @{term vacant_upto} on glob
	+are equivalent.\<close>
	+
	+definition InvGlobNonposEqVacant where
	+ "InvGlobNonposEqVacant c = (\<forall>q t. GlobVacantUpto c q t = GlobNonposUpto c q t)"
	+
	+lemma invs_imp_InvGlobNonposEqVacant:
	+ assumes "InvRecordCount c"
	+ and "InvJustifiedGII c"
	+ and "InvRecordsNonneg c"
	+ shows "InvGlobNonposEqVacant c"
	+proof -
	+ note safe = invs_imp_InvGlobNonposImpRecordsNonpos[OF assms(2,1,3), unfolded InvGlobNonposImpRecordsNonpos_def nonpos_upto_def, THEN spec2, THEN mp]
	+ note nonneg = assms(3)[unfolded InvRecordsNonneg_def, rule_format]
	+ note count = assms(1)[unfolded InvRecordCount_def, rule_format]
	+ { fix q t
	+ assume np: "GlobNonposUpto c q t"
	+ assume nv: "\<not> GlobVacantUpto c q t"
	+ \<comment> \<open>Obtain the least, negative pointstamp in glob\<close>
	+ obtain s where s: "s \<le> t" "zcount (c_glob c q) s < 0" "\<forall>s'<s. zcount (c_glob c q) s' = 0"
	+ apply atomize_elim
	+ using nv[unfolded vacant_upto_def]
	+ apply clarsimp
	+ apply (drule elem_order_zmset_exists_foundation)
	+ apply clarsimp
	+ subgoal for _ s
	+ apply (rule exI[of _ s])
	+ apply (meson order.ordering_axioms nonpos_upto_def np order_class.le_less ordering.trans zcount_ne_zero_iff)
	+ done
	+ done
	+ \<comment> \<open>No records @{term "s' \<le> s"} can exist, since that would violate InvGlobNonposImpRecordsNonpos\<close>
	+ have norec: "s' \<le> s \<Longrightarrow> zcount (records c) s' = 0" for s'
	+ by (metis (full_types) order.ordering_axioms nonneg nonpos_upto_def np order_class.antisym_conv ordering.trans s(1) safe)
	+ \<comment> \<open>Hence GII must be positive at @{term s}\<close>
	+ have gii: "zcount (GlobalIncomingInfoAt c q) s > 0"
	+ using count[of q] s(2) norec[of s, simplified]
	+ by (metis add.commute less_add_same_cancel1 zcount_union)
	+ \<comment> \<open>which means it must be justified by one of these three disjuncts\<close>
	+ then consider
	+ "supported_strong (GlobalIncomingInfoAt c q) s" \|
	+ "\<exists>t'<s. 0 < zcount (records c) t'" \|
	+ "zcount (GlobalIncomingInfoAt c q) s < zcount (records c) s"
	+ using assms(2)[unfolded InvJustifiedGII_def justified_alt, rule_format, OF gii]
	+ by atomize_elim auto
	+ then have False
	+ proof cases
	+ case 1 \<comment> \<open>@{term s} can't be @{term supported_strong}, since either glob or records would have to be positive at the support\<close>
	+ then show False
	+ using norec count s(3)
	+ unfolding supported_strong_def
	+ by (metis (full_types) add.commute add.left_neutral less_le preorder_class.less_irrefl zcount_union)
	+ next
	+ case 2 \<comment> \<open>no lesser capabilities exist\<close>
	+ then show ?thesis
	+ using norec s(2,3) order.order_iff_strict by auto
	+ next
	+ case 3 \<comment> \<open>no capabilities at @{term s} exist\<close>
	+ then show ?thesis
	+ unfolding norec[of s, simplified]
	+ using gii by auto
	+ qed
	+ }
	+ then show ?thesis
	+ unfolding InvGlobNonposEqVacant_def
	+ apply (intro allI)
	+ apply (rule iffI)
	+ apply (simp add: nonpos_upto_def vacant_upto_def)
	+ apply auto
	+ done
	+qed
	+
	+lemma alw_InvGlobNonposEqVacant: "spec s \<Longrightarrow> alw (holds InvGlobNonposEqVacant) s"
	+ using
	+ alw_InvJustifiedGII
	+ alw_InvRecordCount
	+ alw_InvRecordsNonneg
	+ invs_imp_InvGlobNonposEqVacant
	+ by (metis alw_iff_sdrop holds.elims(2) holds.elims(3))
	+
	+subsubsection\<open>InvInfoJustifiedWithII and InvInfoJustifiedWithGII\<close>
	+
	+definition InvInfoJustifiedWithII where
	+ "InvInfoJustifiedWithII c = (\<forall>k p q. justified_with (c_caps c p) (InfoAt c k p q) (IncomingInfo c (k+1) p q))"
	+
	+definition InvInfoJustifiedWithGII where
	+ "InvInfoJustifiedWithGII c = (\<forall>k p q. justified_with (records c) (InfoAt c k p q) (GlobalIncomingInfo c (k+1) p q))"
	+
	+lemma init_config_implies_InvInfoJustifiedWithII: "init_config c \<Longrightarrow> InvInfoJustifiedWithII c"
	+ unfolding init_config_def InvInfoJustifiedWithII_def justified_with_def InfoAt_def
	+ by auto
	+
	+text\<open>This proof relies heavily on the addition properties summarized in the lemma
	+@{thm "next_performop'_preserves_justified_with"}\<close>
	+lemma performop_preserves_InvInfoJustifiedWithII:
	+ assumes "InvInfoJustifiedWithII c0"
	+ and "next_performop' c0 c1 p' \<Delta>neg \<Delta>mint_msg \<Delta>mint_self"
	+ and "InvJustifiedII c0"
	+ and "InvCapsNonneg c0"
	+ shows "InvInfoJustifiedWithII c1"
	+ unfolding InvInfoJustifiedWithII_def
	+ apply (intro allI)
	+ subgoal for k p q
	+ apply (cases "p'=p")
	+ subgoal
	+ unfolding next_performop_complexD[OF assms(2)] next_performopD[OF assms(2)]
	+ apply (simp only: add_diff_eq if_P fun_upd_same)
	+ apply (subst (4) add.commute)
	+ apply (subst add.assoc[symmetric])
	+ apply (rule next_performop'_preserves_justified_with)
	+ using assms(1)[unfolded InvInfoJustifiedWithII_def] apply simp
	+ using assms(2) apply simp
	+ using assms(4)[unfolded InvCapsNonneg_def] apply simp
	+ using assms(3)[unfolded InvJustifiedII_def] apply simp
	+ done
	+ subgoal
	+ using assms(1)[unfolded InvInfoJustifiedWithII_def justified_with_def]
	+ by (auto simp: not_less justified_with_def next_performop_complexD[OF assms(2)] next_performopD[OF assms(2)])
	+ done
	+ done
	+
	+lemma sendupd_preserves_InvInfoJustifiedWithII:
	+ assumes "InvInfoJustifiedWithII c0"
	+ and "next_sendupd' c0 c1 p' tt"
	+ and "InvTempJustified c0"
	+ shows "InvInfoJustifiedWithII c1"
	+ unfolding InvInfoJustifiedWithII_def
	+proof (intro allI impI)
	+ fix k :: nat and p q
	+ note complex = next_sendupd_complexD[OF assms(2)]
	+ note change = next_sendupdD[OF assms(2)]
	+ consider
	+ "p' = p" "k < length (c_msg c0 p q)" \|
	+ "p' = p" "k = length (c_msg c0 p q)" \|
	+ "p' = p" "k > length (c_msg c0 p q)" \|
	+ "p' \<noteq> p"
	+ by atomize_elim auto
	+ then show "justified_with (c_caps c1 p) (InfoAt c1 k p q) (IncomingInfo c1 (k+1) p q)"
	+ proof cases
	+ case 1
	+ then show ?thesis
	+ by (metis InvInfoJustifiedWithII_def Suc_eq_plus1 Suc_le_eq assms(1) change(6) complex(4,7) order_class.less_le)
	+ next
	+ case 2
	+ have temp0: "c_temp c0 p = InfoAt c1 k p q + c_temp c1 p"
	+ unfolding complex change
	+ using 2 by (auto simp: algebra_simps)
	+ have pi: "PositiveImplies (InfoAt c1 k p q) (c_temp c0 p)"
	+ unfolding PositiveImplies_def complex
	+ using 2(2) by (auto simp: InfoAt_def)
	+ have iitemp: "IncomingInfo c1 (k+1) p q = c_temp c1 p"
	+ unfolding IncomingInfo_def
	+ using 2 by (simp add: change)
	+ show ?thesis
	+ apply (rule PositiveImplies_justified_with)
	+ unfolding iitemp temp0[symmetric]
	+ unfolding change
	+ using assms(3) apply (simp add: InvTempJustified_def)
	+ using pi apply simp
	+ done
	+ next
	+ case 3
	+ then show ?thesis
	+ by (metis add_cancel_right_left complex(7) justified_with_leastI preorder_class.less_asym InfoAt_def zcount_union)
	+ next
	+ case 4
	+ then show ?thesis
	+ unfolding complex change
	+ using assms(1)[unfolded InvInfoJustifiedWithII_def, rule_format]
	+ apply simp
	+ done
	+ qed
	+qed
	+
	+lemma recvupd_preserves_InvInfoJustifiedWithII:
	+ assumes "InvInfoJustifiedWithII c0"
	+ and "next_recvupd' c0 c1 p q"
	+ shows "InvInfoJustifiedWithII c1"
	+ using assms(1)
	+ unfolding
	+ InvInfoJustifiedWithII_def
	+ next_recvupd_complexD[OF assms(2)]
	+ next_recvupdD[OF assms(2)]
	+ by auto
	+
	+lemma recvcap_preserves_InvInfoJustifiedWithII:
	+ assumes "InvInfoJustifiedWithII c0"
	+ and "next_recvcap' c0 c1 p t"
	+ shows "InvInfoJustifiedWithII c1"
	+ using assms(1)
	+ unfolding
	+ InvInfoJustifiedWithII_def
	+ next_recvcap_complexD[OF assms(2)]
	+ next_recvcapD[OF assms(2)]
	+ by simp
	+
	+lemma invs_imp_InvInfoJustifiedWithGII:
	+ assumes "InvInfoJustifiedWithII c"
	+ and "InvJustifiedII c"
	+ and "InvCapsNonneg c"
	+ shows "InvInfoJustifiedWithGII c"
	+ unfolding InvInfoJustifiedWithGII_def
	+ apply clarify
	+ subgoal for k p q
	+ unfolding GlobalIncomingInfo_def records_def
	+ apply (rule justified_with_add_records)
	+ subgoal
	+ apply (rule justified_with_sum[where x = p])
	+ apply simp
	+ apply simp
	+ apply simp
	+ using assms(1)[unfolded InvInfoJustifiedWithII_def, rule_format, of p k q]
	+ apply simp
	+ using assms(2)[unfolded InvJustifiedII_def] apply simp
	+ using assms(3)[unfolded InvCapsNonneg_def] apply simp
	+ done
	+ apply simp
	+ done
	+ done
	+
	+lemma next'_preserves_InvInfoJustifiedWithII:
	+ assumes "InvInfoJustifiedWithII c0"
	+ and "next' c0 c1"
	+ and "InvCapsNonneg c0"
	+ and "InvJustifiedII c0"
	+ and "InvTempJustified c0"
	+ shows "InvInfoJustifiedWithII c1"
	+ using assms unfolding next'_def
	+ apply (elim disjE exE)
	+ apply (drule (4) performop_preserves_InvInfoJustifiedWithII)
	+ apply (drule (3) sendupd_preserves_InvInfoJustifiedWithII)
	+ apply (drule (2) recvupd_preserves_InvInfoJustifiedWithII)
	+ apply (drule (2) recvcap_preserves_InvInfoJustifiedWithII)
	+ apply simp
	+ done
	+
	+lemma alw_InvInfoJustifiedWithII: "spec s \<Longrightarrow> alw (holds InvInfoJustifiedWithII) s"
	+ apply (frule alw_InvCapsNonneg)
	+ apply (frule alw_InvJustifiedII)
	+ apply (frule alw_InvTempJustified)
	+ unfolding spec_def
	+ apply (elim conjE)
	+ apply (subst (asm) holds.simps)
	+ apply (drule init_config_implies_InvInfoJustifiedWithII)
	+ apply (coinduction arbitrary: s rule: alw.coinduct)
	+ apply (subst (asm) (1 2 3) alw_nxt)
	+ apply clarsimp
	+ using next'_preserves_InvInfoJustifiedWithII
	+ apply blast
	+ done
	+
	+lemma alw_InvInfoJustifiedWithGII: "spec s \<Longrightarrow> alw (holds InvInfoJustifiedWithGII) s"
	+ by (metis alw_InvCapsNonneg alw_InvInfoJustifiedWithII alw_InvJustifiedII alw_iff_sdrop holds.elims(2,3) invs_imp_InvInfoJustifiedWithGII)
	+
	+
	+subsubsection\<open>SafeGlobMono and InvMsgInGlob\<close>
	+
	+text\<open>The records in glob are monotonic. This implies the corollary InvMsgInGlob; No incoming message
	+carries a timestamp change that would cause glob to regress.\<close>
	+
	+definition SafeGlobMono where
	+ "SafeGlobMono c0 c1 = (\<forall>p t. GlobVacantUpto c0 p t \<longrightarrow> GlobVacantUpto c1 p t)"
	+
	+definition InvMsgInGlob where
	+ "InvMsgInGlob c = (\<forall>p q t. c_msg c p q \<noteq> [] \<longrightarrow> t \<in>#\<^sub>z hd (c_msg c p q) \<longrightarrow> (\<exists>t'\<le>t. 0 < zcount (c_glob c q) t'))"
	+
	+lemma not_InvMsgInGlob_imp_not_SafeGlobMono:
	+ assumes "\<not> InvMsgInGlob c0"
	+ and "InvGlobNonposEqVacant c0"
	+ shows "\<exists>c1. next_recvupd c0 c1 \<and> \<not> SafeGlobMono c0 c1"
	+proof -
	+ note npeq0 = assms(2)[unfolded InvGlobNonposEqVacant_def, rule_format]
	+ from assms(1) obtain p q t c1 where t:
	+ "next_recvupd' c0 c1 p q"
	+ "t \<in>#\<^sub>z hd (c_msg c0 p q)"
	+ "GlobVacantUpto c0 q t"
	+ by (auto simp: InvMsgInGlob_def npeq0 nonpos_upto_def not_less dest!: ex_next_recvupd)
	+ have nvu: "\<not> GlobVacantUpto c1 q t"
	+ unfolding vacant_upto_def next_recvupdD(4)[OF t(1)]
	+ using t(2) t(3) vacant_upto_def by auto
	+ from t(3) nvu have "\<not> SafeGlobMono c0 c1"
	+ by (auto simp: SafeGlobMono_def)
	+ with t(1) show ?thesis
	+ by blast
	+qed
	+
	+lemma GII_eq_GIA: "GlobalIncomingInfo c 1 p q = (if c_msg c p q = [] then GlobalIncomingInfoAt c q else GlobalIncomingInfoAt c q - hd (c_msg c p q))"
	+ unfolding GlobalIncomingInfo_def
	+ apply (cases "c_msg c p q = []")
	+ apply (simp add: IncomingInfo_def)
	+ apply (rule sum.cong[OF refl], simp)
	+ apply simp
	+ apply (subst diff_conv_add_uminus)
	+ apply (rule Sum_eq_pick_changed_elem)
	+ apply (auto simp: IncomingInfo_def drop_Suc sum_list_hd_tl algebra_simps)
	+ done
	+
	+lemma recvupd_preserves_GlobVacantUpto:
	+ assumes "GlobVacantUpto c0 q t"
	+ and "next_recvupd' c0 c1 p q"
	+ and "InvInfoJustifiedWithGII c0"
	+ and "InvGlobNonposEqVacant c1"
	+ and "InvGlobVacantImpRecordsVacant c0"
	+ and "InvRecordCount c0"
	+ shows "GlobVacantUpto c1 q t"
	+proof (rule ccontr)
	+ note npeq1 = assms(4)[unfolded InvGlobNonposEqVacant_def, rule_format]
	+ note gvu0 = assms(1)[unfolded vacant_upto_def, rule_format]
	+ note nvu0 = assms(5)[unfolded InvGlobVacantImpRecordsVacant_def, rule_format, OF assms(1)]
	+ note recordcount = assms(6)[unfolded InvRecordCount_def zmultiset_eq_iff zcount_union, rule_format]
	+ note change = next_recvupdD[OF assms(2)]
	+ let ?\<kappa> = "hd (c_msg c0 p q)"
	+ from change(1) have ia\<kappa>: "?\<kappa> = InfoAt c0 0 p q"
	+ unfolding InfoAt_def by (simp add: hd_conv_nth)
	+ assume gvu1: "\<not> GlobVacantUpto c1 q t"
	+ obtain t' where t':
	+ "t' \<le> t"
	+ "0 < zcount (c_glob c1 q) t'"
	+ "zcount (c_glob c0 q) t' = 0"
	+ "\<forall>s<t'. zcount (c_glob c1 q) s \<le> 0"
	+ apply atomize_elim
	+ using gvu1
	+ unfolding npeq1 nonpos_upto_def
	+ apply (simp add: not_le)
	+ apply (elim exE conjE)
	+ apply (drule order_zmset_exists_foundation')
	+ apply (elim exE conjE)
	+ subgoal for s s'
	+ apply (rule exI[of _ s'])
	+ using gvu0 apply auto
	+ done
	+ done
	+ from t'(2,3) have count\<kappa>: "0 < zcount ?\<kappa> t'"
	+ by (auto simp: change(4))
	+ note assms(3)[unfolded InvInfoJustifiedWithGII_def justified_with_alt, rule_format, OF count\<kappa>[unfolded ia\<kappa>]]
	+ then consider
	+ "\<exists>s<t'. zcount (InfoAt c0 0 p q) s < 0 \<and> (\<forall>s'<s. zcount (InfoAt c0 0 p q) s' \<le> 0)" \|
	+ "\<exists>s<t'. zcount (GlobalIncomingInfo c0 1 p q) s < 0 \<and> (\<forall>s'<s. zcount (InfoAt c0 0 p q) s' \<le> 0)"
	+ "\<nexists>s. s < t' \<and> zcount (InfoAt c0 0 p q) s < 0 \<and> (\<forall>s'<s. zcount (InfoAt c0 0 p q) s' \<le> 0)" \|
	+ "\<exists>s<t'. 0 < zcount (records c0) s" \|
	+ "zcount (InfoAt c0 0 p q + GlobalIncomingInfo c0 1 p q) t' < zcount (records c0) t'"
	+ by atomize_elim auto
	+ then show False
	+ proof cases
	+ case 1
	+ then obtain s where s: "s < t'" "zcount (InfoAt c0 0 p q) s < 0" "\<forall>s'<s. zcount (InfoAt c0 0 p q) s' \<le> 0"
	+ by blast
	+ then have globs: "zcount (c_glob c1 q) s < 0"
	+ using gvu0 ia\<kappa> t'(1) by (auto simp: change(4))
	+ have "zcount (c_glob c1 q) s \<le> 0"
	+ using globs by linarith
	+ then have "\<forall>s'\<le>s. zcount (c_glob c1 q) s' \<le> 0"
	+ using s(1) t'(4) by auto
	+ with globs show False
	+ by (auto simp: npeq1[unfolded nonpos_upto_def, symmetric] vacant_upto_def)
	+ next
	+ case 2
	+ then obtain s where s: "s < t'" "zcount (GlobalIncomingInfo c0 1 p q) s < 0" "\<forall>s'<s. zcount (InfoAt c0 0 p q) s' \<le> 0"
	+ by blast
	+ from 2(2) s(1,3) have "zcount (InfoAt c0 0 p q) s \<ge> 0"
	+ by force
	+ have rc: "zcount (records c0) s = 0"
	+ using order.strict_implies_order order.strict_trans2 nvu0 s(1) t'(1) vacant_upto_def by blast
	+ show False
	+ using assms(6) change(1,4) s(1,2) rc t'(4)
	+ unfolding GII_eq_GIA InvRecordCount_def fun_upd_same
	+ by clarsimp (metis add.commute add_mono_thms_linordered_field(1) not_le recordcount)
	+ next
	+ case 3
	+ with nvu0 t'(1) show False
	+ unfolding vacant_upto_def by auto
	+ next
	+ case 4
	+ then have "0 < zcount (c_glob c0 q) t'"
	+ using change(1) ia\<kappa> t'(3)
	+ unfolding GII_eq_GIA
	+ apply clarsimp
	+ apply (metis add.right_neutral preorder_class.less_irrefl recordcount)
	+ done
	+ then show False
	+ by (simp add: t'(3))
	+ qed
	+qed
	+
	+lemma recvupd_imp_SafeGlobMono:
	+ assumes "next_recvupd' c0 c1 p q"
	+ and "InvInfoJustifiedWithGII c0"
	+ and "InvGlobNonposEqVacant c1"
	+ and "InvGlobVacantImpRecordsVacant c0"
	+ and "InvRecordCount c0"
	+ shows "SafeGlobMono c0 c1"
	+ unfolding SafeGlobMono_def
	+ apply clarify
	+ subgoal for q' t
	+ apply (cases "q'=q")
	+ subgoal
	+ apply (rule recvupd_preserves_GlobVacantUpto)
	+ using assms apply simp_all
	+ done
	+ subgoal
	+ unfolding next_recvupdD[OF assms(1)]
	+ by simp
	+ done
	+ done
	+
	+lemma next'_imp_SafeGlobMono:
	+ assumes "next' c0 c1"
	+ and "InvInfoJustifiedWithGII c0"
	+ and "InvGlobNonposEqVacant c1"
	+ and "InvGlobVacantImpRecordsVacant c0"
	+ and "InvRecordCount c0"
	+ shows "SafeGlobMono c0 c1"
	+ using assms unfolding next'_def
	+ apply (elim disjE exE)
	+ subgoal
	+ by (auto simp: SafeGlobMono_def dest: next_performopD(7))
	+ subgoal
	+ by (auto simp: SafeGlobMono_def dest: next_sendupdD(5))
	+ subgoal
	+ by (auto intro: recvupd_imp_SafeGlobMono)
	+ subgoal
	+ by (auto simp: SafeGlobMono_def dest: next_recvcapD(4))
	+ subgoal
	+ by (simp add: SafeGlobMono_def)
	+ done
	+
	+lemma invs_imp_InvMsgInGlob:
	+ fixes c0 :: "('p::finite, 'a) configuration"
	+ assumes "InvInfoJustifiedWithGII c0"
	+ and "InvGlobNonposEqVacant c0"
	+ and "InvGlobVacantImpRecordsVacant c0"
	+ and "InvRecordCount c0"
	+ and "InvJustifiedII c0"
	+ and "InvCapsNonneg c0"
	+ and "InvRecordsNonneg c0"
	+ shows "InvMsgInGlob c0"
	+ using assms
	+ apply -
	+ apply (rule ccontr)
	+ apply (drule not_InvMsgInGlob_imp_not_SafeGlobMono[rotated, OF assms(2)])
	+ apply (elim exE conjE)
	+ apply (frule recvupd_imp_SafeGlobMono)
	+ apply simp
	+ subgoal
	+ apply (rule invs_imp_InvGlobNonposEqVacant)
	+ apply (drule (2) recvupd_preserves_InvRecordCount)
	+ apply (drule (1) recvupd_preserves_InvJustifiedII)
	+ apply (rule InvJustifiedII_implies_InvJustifiedGII)
	+ apply simp
	+ apply (drule (2) recvupd_preserves_InvCapsNonneg)
	+ apply (simp add: InvRecordsNonneg_def next_recvupd_complexD)
	+ done
	+ apply simp
	+ apply simp
	+ apply simp
	+ done
	+
	+lemma alw_SafeGlobMono: "spec s \<Longrightarrow> alw (relates SafeGlobMono) s"
	+proof -
	+ assume spec: "spec s"
	+ { assume "alw next s"
	+ moreover assume "alw (holds InvGlobNonposEqVacant) s"
	+ moreover assume "alw (holds InvGlobVacantImpRecordsVacant) s"
	+ moreover assume "alw (holds InvInfoJustifiedWithGII) s"
	+ moreover assume "alw (holds InvRecordCount) s"
	+ ultimately have "alw (relates SafeGlobMono) s"
	+ apply (coinduction arbitrary: s)
	+ apply (clarsimp simp: relates_def intro!: next'_imp_SafeGlobMono)
	+ apply (rule conjI)
	+ apply (rule next'_imp_SafeGlobMono)
	+ apply auto [2]
	+ apply (subst (asm) alw_holds2)
	+ apply clarify
	+ apply (drule alwD)+
	+ apply simp
	+ apply auto
	+ done
	+ }
	+ with spec show ?thesis
	+ apply -
	+ apply (frule alw_InvGlobNonposEqVacant)
	+ apply (frule alw_InvGlobVacantImpRecordsVacant)
	+ apply (frule alw_InvInfoJustifiedWithGII)
	+ apply (frule alw_InvRecordCount)
	+ unfolding spec_def
	+ apply auto
	+ done
	+qed
	+
	+lemma alw_InvMsgInGlob: "spec s \<Longrightarrow> alw (holds InvMsgInGlob) s"
	+ apply (frule alw_InvInfoJustifiedWithGII)
	+ apply (frule alw_InvGlobNonposEqVacant)
	+ apply (frule alw_InvGlobVacantImpRecordsVacant)
	+ apply (frule alw_InvRecordCount)
	+ apply (frule alw_InvJustifiedII)
	+ apply (frule alw_InvCapsNonneg)
	+ apply (drule alw_InvRecordsNonneg)
	+ apply (simp add: alw_iff_sdrop invs_imp_InvMsgInGlob)
	+ done
	+
	+lemma SafeGlobMono_preserves_vacant:
	+ assumes "\<forall>t'\<le>t. zcount (c_glob c0 q) t' = 0"
	+ and "(\<lambda>c0 c1. SafeGlobMono c0 c1)\<^sup>\<^sup> c0 c1"
	+ shows "\<forall>t'\<le>t. zcount (c_glob c1 q) t' = 0"
	+ using assms(2,1)
	+ by (induct rule: rtranclp_induct)(auto simp: SafeGlobMono_def vacant_upto_def)
	+
	+lemma rtranclp_all_imp_rel: "r\<^sup>\<^sup> x y \<Longrightarrow> \<forall>a b. r a b \<longrightarrow> r' a b \<Longrightarrow> r'\<^sup>\<^sup> x y"
	+ by (metis mono_rtranclp)
	+
	+lemma rtranclp_rel_and_invar: "r\<^sup>\<^sup> x y \<Longrightarrow> Q x \<Longrightarrow> \<forall>a b. Q a \<and> r a b \<longrightarrow> P a b \<and> Q b \<Longrightarrow> (\<lambda>x y. P x y \<and> Q y)\<^sup>\<^sup> x y"
	+ apply (induct rule: rtranclp_induct)
	+ apply auto []
	+ apply (metis (no_types, lifting) rtranclp.simps)
	+ done
	+
	+lemma rtranclp_invar_conclude_last: "(\<lambda>x y. P x y \<and> Q y)\<^sup>\<^sup> x y \<Longrightarrow> Q x \<Longrightarrow> Q y"
	+ using rtranclp.cases by fastforce
	+
	+lemma InvCapsNonneg_imp_InvRecordsNonneg: "InvCapsNonneg c \<Longrightarrow> InvRecordsNonneg c"
	+ unfolding InvCapsNonneg_def InvRecordsNonneg_def records_def
	+ by (auto simp: zcount_sum intro!: sum_nonneg add_nonneg_nonneg)
	+
	+lemma invs_imp_msg_in_glob:
	+ fixes c :: "('p::finite, 'a) configuration"
	+ assumes "M \<in> set (c_msg c p q)"
	+ and "t \<in>#\<^sub>z M"
	+ and "InvGlobNonposEqVacant c"
	+ and "InvJustifiedII c"
	+ and "InvInfoJustifiedWithII c"
	+ and "InvGlobVacantImpRecordsVacant c"
	+ and "InvRecordCount c"
	+ and "InvCapsNonneg c"
	+ and "InvMsgInGlob c"
	+ shows "\<exists>t'\<le>t. 0 < zcount (c_glob c q) t'"
	+proof (rule ccontr)
	+ assume "\<not> (\<exists>t'\<le>t. 0 < zcount (c_glob c q) t')"
	+ then have vacant: "\<forall>t'\<le>t. zcount (c_glob c q) t' = 0"
	+ using assms(3)
	+ by (auto simp: InvGlobNonposEqVacant_def vacant_upto_def nonpos_upto_def)
	+ let ?c1 = "the (while_option (\<lambda>c. hd (c_msg c p q) \<noteq> M) (\<lambda>c. SOME c'. next_recvupd' c c' p q) c)"
	+ have r[simp]: "M \<in> set (c_msg c p q) \<Longrightarrow> c_msg (SOME c'. next_recvupd' c c' p q) p q = tl (c_msg c p q)" for c
	+ by (rule someI2_ex[OF ex_next_recvupd]) (auto simp: next_recvupd'_def)
	+ obtain c1 where while_some:
	+ "while_option (\<lambda>c. hd (c_msg c p q) \<noteq> M) (\<lambda>c. SOME c'. next_recvupd' c c' p q) c = Some c1"
	+ apply atomize_elim
	+ apply (rule measure_while_option_Some[where P="\<lambda>c. M \<in> set (c_msg c p q)"
	+ and f="\<lambda>c. Min {i. i < length (c_msg c p q) \<and> M = c_msg c p q ! i}"])
	+ apply clarsimp
	+ apply safe
	+ apply (metis list.exhaust_sel list.sel(2) set_ConsD)
	+ apply (subst Min_gr_iff)
	+ apply (auto simp: in_set_conv_nth nth_tl) [2]
	+ apply clarsimp
	+ apply (subst Min_less_iff)
	+ apply (auto simp: in_set_conv_nth nth_tl) []
	+ apply (clarsimp simp: in_set_conv_nth nth_tl)
	+ apply (metis (no_types, hide_lams) Suc_less_eq Suc_pred hd_conv_nth list.size(3) not_gr_zero not_less_zero)
	+ apply (clarsimp simp: in_set_conv_nth nth_tl)
	+ subgoal for s x
	+ by (rule exI[of _ "x-1"])
	+ (metis One_nat_def Suc_le_eq Suc_pred' diff_less diff_less_mono hd_conv_nth length_tl list.size(3) not_gr_zero nth_tl zero_less_Suc)
	+ apply (meson assms(1) in_set_conv_nth)
	+ done
	+ have c1: "(\<lambda>c0 c1. next_recvupd' c0 c1 p q)\<^sup>\<^sup> c c1" "c_msg c1 p q \<noteq> []" "hd (c_msg c1 p q) = M"
	+ subgoal
	+ apply (rule conjunct2)
	+ apply (rule while_option_rule[OF _ while_some, where P="\<lambda>d. M \<in> set (c_msg d p q) \<and> (\<lambda>c0 c1. next_recvupd' c0 c1 p q)\<^sup>\<^sup> c d"])
	+ apply (rule conjI)
	+ apply (metis list.sel(1) list.sel(3) list.set_cases r)
	+ apply (auto simp: assms(1) elim!: rtrancl_into_rtrancl[to_pred] intro: someI2_ex[OF ex_next_recvupd])
	+ done
	+ subgoal
	+ using while_option_rule[OF _ while_some, where P="\<lambda>c. M \<in> set (c_msg c p q)"]
	+ by (metis assms(1) empty_iff hd_Cons_tl list.set(1) r set_ConsD)
	+ subgoal
	+ using while_option_stop[OF while_some] by simp
	+ done
	+ have invs_trancl:
	+ "(\<lambda>c0 c1. SafeGlobMono c0 c1 \<and> InvJustifiedII c1 \<and> InvGlobNonposEqVacant c1 \<and> InvInfoJustifiedWithII c1 \<and> InvGlobVacantImpRecordsVacant c1 \<and> InvRecordCount c1 \<and> InvCapsNonneg c1)\<^sup>\<^sup> c c1"
	+ apply (rule rtranclp_rel_and_invar)
	+ using c1(1) apply simp
	+ using assms(3-8) apply simp
	+ apply clarsimp
	+ subgoal for a b
	+ apply (frule InvJustifiedII_implies_InvJustifiedGII)
	+ apply simp
	+ apply (frule recvupd_preserves_InvJustifiedII)
	+ apply simp
	+ apply (frule InvCapsNonneg_imp_InvRecordsNonneg)
	+ apply (frule next_preserves_InvRecordCount[of _ b])
	+ apply (auto simp: next'_def) []
	+ apply (frule recvupd_preserves_InvCapsNonneg[of _ b])
	+ apply simp
	+ apply (frule InvJustifiedII_implies_InvJustifiedGII[of b])
	+ apply simp
	+ apply (frule InvCapsNonneg_imp_InvRecordsNonneg[of b])
	+ apply (frule invs_imp_InvGlobNonposEqVacant[of b])
	+ apply simp_all [2]
	+ apply (frule recvupd_preserves_InvInfoJustifiedWithII[of _ b])
	+ apply simp
	+ apply (frule invs_imp_InvInfoJustifiedWithGII)
	+ apply simp_all [2]
	+ apply (frule invs_imp_InvInfoJustifiedWithGII[of b])
	+ apply simp_all [2]
	+ apply (intro conjI)
	+ apply (rule next'_imp_SafeGlobMono)
	+ apply (clarsimp simp: next'_def)
	+ apply simp_all [7]
	+ apply (rule invs_imp_InvGlobVacantImpRecordsVacant)
	+ apply simp_all
	+ done
	+ done
	+ then have trancl_mono: "(\<lambda>c0 c1. SafeGlobMono c0 c1)\<^sup>\<^sup> c c1"
	+ by (metis (no_types, lifting) rtranclp_all_imp_rel)
	+ then have vacant_c1: "\<forall>t'\<le>t. zcount (c_glob c1 q) t' = 0"
	+ by (rule SafeGlobMono_preserves_vacant[OF vacant])
	+ have InvMsgInGlob: "InvMsgInGlob c1"
	+ using rtranclp_invar_conclude_last[OF invs_trancl] assms
	+ apply (intro invs_imp_InvMsgInGlob)
	+ using invs_imp_InvInfoJustifiedWithGII InvCapsNonneg_imp_InvRecordsNonneg apply blast+
	+ done
	+ have "\<exists>t'\<le>t. 0 < zcount (c_glob c1 q) t'"
	+ using InvMsgInGlob[unfolded InvMsgInGlob_def] c1(2,3) assms(1,2)
	+ by auto
	+ then show False
	+ using vacant_c1 by auto
	+qed
	+
	+lemma alw_msg_glob: "spec s \<Longrightarrow>
	+ alw (holds (\<lambda>c. \<forall>p q t. (\<exists>M \<in> set (c_msg c p q). t \<in>#\<^sub>z M) \<longrightarrow> (\<exists>t'\<le>t. 0 < zcount (c_glob c q) t'))) s"
	+ apply (frule alw_InvGlobNonposEqVacant)
	+ apply (frule alw_InvJustifiedII)
	+ apply (frule alw_InvInfoJustifiedWithII)
	+ apply (frule alw_InvGlobVacantImpRecordsVacant)
	+ apply (frule alw_InvRecordCount)
	+ apply (frule alw_InvCapsNonneg)
	+ apply (drule alw_InvMsgInGlob)
	+ apply (coinduction arbitrary: s)
	+ apply clarsimp
	+ apply (rule conjI)
	+ apply clarify
	+ apply (rule invs_imp_msg_in_glob)
	+ apply auto [2]
	+ using holds.elims(2) apply blast+
	+ done
	+
	+end
	+
	+(<)
	+end
	+(>)
	\ No newline at end of file
	diff --git a/thys/Progress_Tracking/Exchange_Abadi.thy b/thys/Progress_Tracking/Exchange_Abadi.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/Exchange_Abadi.thy
	@@ -0,0 +1,908 @@
	+section \<open>Clocks Protocol\label{sec:clocks}\<close>
	+
	+(<)
	+theory Exchange_Abadi
	+ imports
	+ Auxiliary
	+begin
	+(>)
	+
	+type_synonym 't count_vec = "'t multiset"
	+type_synonym 't delta_vec = "'t zmultiset"
	+
	+definition vacant_upto :: "'t delta_vec \<Rightarrow> 't :: order \<Rightarrow> bool" where
	+ "vacant_upto a t = (\<forall>s. s \<le> t \<longrightarrow> zcount a s = 0)"
	+
	+abbreviation nonpos_upto :: "'t delta_vec \<Rightarrow> 't :: order \<Rightarrow> bool" where
	+ "nonpos_upto a t \<equiv> \<forall>s. s \<le> t \<longrightarrow> zcount a s \<le> 0"
	+
	+definition supported_strong :: "'t delta_vec \<Rightarrow> 't :: order \<Rightarrow> bool" where
	+ "supported_strong a t = (\<exists>s. s < t \<and> zcount a s < 0 \<and> nonpos_upto a s)"
	+
	+definition supported :: "'t delta_vec \<Rightarrow> 't :: order \<Rightarrow> bool" where
	+ "supported a t = (\<exists>s. s < t \<and> zcount a s < 0)"
	+
	+definition upright :: "'t :: order delta_vec \<Rightarrow> bool" where
	+ "upright a = (\<forall>t. zcount a t > 0 \<longrightarrow> supported a t)"
	+
	+lemma upright_alt: "upright a \<longleftrightarrow> (\<forall>t. zcount a t > 0 \<longrightarrow> supported_strong a t)"
	+ unfolding upright_def supported_def supported_strong_def
	+ by (rule iffI) (meson order.strict_trans2 order.strict_trans1 order_zmset_exists_foundation')+
	+
	+definition beta_upright :: "'t :: order delta_vec \<Rightarrow> 't :: order delta_vec \<Rightarrow> bool" where
	+ "beta_upright va vb = (\<forall>t. zcount va t > 0 \<longrightarrow> (\<exists>s. s < t \<and> (zcount va s < 0 \<or> zcount vb s < 0)))"
	+
	+lemma beta_upright_alt:
	+ "beta_upright va vb = (\<forall>t. zcount va t > 0 \<longrightarrow> (\<exists>s. s < t \<and> (zcount va s < 0 \<or> zcount vb s < 0) \<and> nonpos_upto va s))"
	+ unfolding beta_upright_def
	+ apply (rule iffI)
	+ apply clarsimp
	+ apply (drule order_zmset_exists_foundation)
	+ apply (metis le_less_linear less_le_trans order.strict_trans1)
	+ apply blast
	+ done
	+
	+(* count_vec: nrec, the occupancy vector
	+ ('p \<Rightarrow> delta_vec): temp, the local change in the occupancy vector due to ops performed at given processor
	+ ('p \<Rightarrow> 'p \<Rightarrow> delta_vec list): msg, queue of updates from one processor to another
	+ ('p \<Rightarrow> delta_vec): glob, given processors (delayed) view of the occupancy vector *)
	+record ('p, 't) configuration =
	+ c_records :: "'t delta_vec"
	+ c_temp :: "'p \<Rightarrow> 't delta_vec"
	+ c_msg :: "'p \<Rightarrow> 'p \<Rightarrow> 't delta_vec list"
	+ c_glob :: "'p \<Rightarrow> 't delta_vec"
	+
	+type_synonym ('p, 't) computation = "('p, 't) configuration stream"
	+
	+definition init_config :: "('p :: finite, 't :: order) configuration \<Rightarrow> bool" where
	+ "init_config c =
	+ ((\<forall>p. c_temp c p = {#}\<^sub>z) \<and>
	+ (\<forall>p1 p2. c_msg c p1 p2 = []) \<and>
	+ (\<forall>p. c_glob c p = c_records c) \<and>
	+ (\<forall>t. 0 \<le> zcount (c_records c) t))"
	+
	+definition next_performop' :: "('p, 't :: order) configuration \<Rightarrow> ('p, 't) configuration \<Rightarrow> 'p \<Rightarrow> 't count_vec \<Rightarrow> 't count_vec \<Rightarrow> bool" where
	+ "next_performop' c0 c1 p c r =
	+ (let \<Delta> = zmset_of r - zmset_of c in
	+ (\<forall>t. int (count c t) \<le> zcount (c_records c0) t)
	+ \<and> upright \<Delta>
	+ \<and> c1 = c0\<lparr>c_records := c_records c0 + \<Delta>,
	+ c_temp := (c_temp c0)(p := c_temp c0 p + \<Delta>)\<rparr>)"
	+
	+abbreviation next_performop where
	+ "next_performop s \<equiv> (\<exists>p (c :: 't :: order count_vec) (r::'t count_vec). next_performop' (shd s) (shd (stl s)) p c r)"
	+
	+definition next_sendupd' where
	+ "next_sendupd' c0 c1 p tt =
	+ (let \<gamma> = {#t \<in>#\<^sub>z c_temp c0 p. t \<in> tt#} in
	+ \<gamma> \<noteq> 0
	+ \<and> upright (c_temp c0 p - \<gamma>)
	+ \<and> c1 = c0\<lparr>c_msg := (c_msg c0)(p := \<lambda>q. c_msg c0 p q @ [\<gamma>]),
	+ c_temp := (c_temp c0)(p := c_temp c0 p - \<gamma>)\<rparr>)"
	+
	+abbreviation next_sendupd where
	+ "next_sendupd s \<equiv> (\<exists>p tt. next_sendupd' (shd s) (shd (stl s)) p tt)"
	+
	+definition next_recvupd' where
	+ "next_recvupd' c0 c1 p q =
	+ (c_msg c0 p q \<noteq> []
	+ \<and> c1 = c0\<lparr>c_msg := (c_msg c0)(p := (c_msg c0 p)(q := tl (c_msg c0 p q))),
	+ c_glob := (c_glob c0)(q := c_glob c0 q + hd (c_msg c0 p q))\<rparr>)"
	+
	+abbreviation next_recvupd where
	+ "next_recvupd s \<equiv> (\<exists>p q. next_recvupd' (shd s) (shd (stl s)) p q)"
	+
	+definition "next" where
	+ "next s = (next_performop s \<or> next_sendupd s \<or> next_recvupd s \<or> (shd (stl s) = shd s))"
	+
	+definition spec :: "('p :: finite, 't :: order) computation \<Rightarrow> bool" where
	+ "spec s = (holds init_config s \<and> alw next s)"
	+
	+abbreviation GlobVacantUpto where
	+ "GlobVacantUpto c q t \<equiv> vacant_upto (c_glob c q) t"
	+
	+abbreviation NrecVacantUpto where
	+ "NrecVacantUpto c t \<equiv> vacant_upto (c_records c) t"
	+
	+(* This is the main safety property (safe) *)
	+definition SafeGlobVacantUptoImpliesStickyNrec :: "('p :: finite, 't :: order) computation \<Rightarrow> bool" where
	+ "SafeGlobVacantUptoImpliesStickyNrec s =
	+ (let c = shd s in \<forall>t q. GlobVacantUpto c q t \<longrightarrow> alw (holds (\<lambda>c. NrecVacantUpto c t)) s)"
	+
	+(* This is safe2 *)
	+definition SafeStickyNrecVacantUpto :: "('p :: finite, 't :: order) computation \<Rightarrow> bool" where
	+ "SafeStickyNrecVacantUpto s =
	+ (let c = shd s in \<forall>t. NrecVacantUpto c t \<longrightarrow> alw (holds (\<lambda>c. NrecVacantUpto c t)) s)"
	+
	+(* This is inv1 *)
	+definition InvGlobVacantUptoImpliesNrec :: "('p :: finite, 't :: order) configuration \<Rightarrow> bool" where
	+ "InvGlobVacantUptoImpliesNrec c =
	+ (\<forall>t q. vacant_upto (c_glob c q) t \<longrightarrow> vacant_upto (c_records c) t)"
	+
	+definition InvTempUpright where
	+ "InvTempUpright c = (\<forall>p. upright (c_temp c p))"
	+
	+lemma init_InvTempUpright: "init_config c \<Longrightarrow> InvTempUpright c"
	+ by (simp add: InvTempUpright_def init_config_def upright_def)
	+
	+lemma upright_obtain_support:
	+ assumes "upright a"
	+ and "zcount a t > 0"
	+ obtains s where "s < t" "zcount a s < 0" "nonpos_upto a s"
	+ using assms unfolding upright_alt supported_strong_def
	+ apply atomize_elim
	+ using order.strict_implies_order apply blast
	+ done
	+
	+lemma upright_vec_add:
	+ assumes "upright v1"
	+ and "upright v2"
	+ shows "upright (v1 + v2)"
	+proof -
	+ let ?v0 = "v1 + v2"
	+ { fix t
	+ assume upr1: "upright v1"
	+ assume upr2: "upright v2"
	+ assume zcnt: "0 < zcount ?v0 t"
	+ { fix va vb :: "'a zmultiset"
	+ fix t
	+ assume upra: "upright va"
	+ assume uprb: "upright vb"
	+ assume zcnt: "0 < zcount va t"
	+ from upra zcnt obtain x where x: "x < t" "zcount va x < 0" "nonpos_upto va x"
	+ using upright_obtain_support by blast
	+ with uprb have "supported_strong (va+vb) t"
	+ apply (cases "\<exists>s. s \<le> x \<and> 0 < zcount vb s")
	+ apply (clarsimp simp: upright_alt supported_strong_def)
	+ apply (meson add_nonpos_neg less_imp_le order.strict_trans2 order.trans add_nonpos_nonpos)
	+ apply simp
	+ apply (force simp: supported_strong_def intro!: exI[of _ x])
	+ done
	+ }
	+ with upr1 upr2 zcnt have "supported_strong ?v0 t" unfolding supported_strong_def
	+ apply (cases "0 < zcount v1 t"; cases "0 < zcount v2 t")
	+ apply auto [2]
	+ apply (subst (1 2) add.commute)
	+ apply auto
	+ done
	+ }
	+ with assms show ?thesis
	+ by (simp add: upright_alt)
	+qed
	+
	+lemma next_InvTempUpright: "holds InvTempUpright s \<Longrightarrow> next s \<Longrightarrow> nxt (holds InvTempUpright) s"
	+ unfolding next_def apply simp
	+ apply (elim disjE)
	+ subgoal
	+ unfolding InvTempUpright_def next_performop'_def
	+ by (auto simp: Let_def upright_vec_add)
	+ subgoal
	+ unfolding InvTempUpright_def next_sendupd'_def
	+ by (auto simp: Let_def upright_vec_add)
	+ subgoal
	+ unfolding InvTempUpright_def next_recvupd'_def
	+ by (auto simp: upright_vec_add)
	+ subgoal by simp
	+ done
	+
	+lemma alw_InvTempUpright: "spec s \<Longrightarrow> alw (holds InvTempUpright) s"
	+ apply (rule alw_invar)
	+ apply (simp add: spec_def init_InvTempUpright)
	+ apply (metis (no_types, lifting) alw_iff_sdrop next_InvTempUpright spec_def)
	+ done
	+
	+definition IncomingInfo where
	+ "IncomingInfo c k p q = (sum_list (drop k (c_msg c p q)) + c_temp c p)"
	+
	+definition InvIncomingInfoUpright where
	+ "InvIncomingInfoUpright c = (\<forall>k p q. upright (IncomingInfo c k p q))"
	+
	+lemma upright_0: "upright 0"
	+ by (simp add: upright_def)
	+
	+lemma init_InvIncomingInfoUpright: "init_config c \<Longrightarrow> InvIncomingInfoUpright c"
	+ by (simp add: upright_0 upright_vec_add init_config_def InvIncomingInfoUpright_def IncomingInfo_def)
	+
	+lemma next_InvIncomingInfoUpright: "holds InvIncomingInfoUpright s \<Longrightarrow> next s \<Longrightarrow> nxt (holds InvIncomingInfoUpright) s"
	+ unfolding next_def
	+ apply simp
	+ apply (elim disjE)
	+ subgoal
	+ by (auto simp: add.assoc[symmetric] upright_vec_add next_performop'_def Let_def InvIncomingInfoUpright_def IncomingInfo_def)
	+ subgoal
	+ unfolding next_sendupd'_def Let_def InvIncomingInfoUpright_def IncomingInfo_def
	+ apply clarsimp
	+ subgoal for p tt k q
	+ apply (cases "k \<le> length (c_msg (shd s) p q)")
	+ apply auto
	+ done
	+ done
	+ subgoal
	+ unfolding next_recvupd'_def Let_def InvIncomingInfoUpright_def IncomingInfo_def
	+ apply (clarsimp simp: drop_Suc[symmetric])
	+ done
	+ subgoal
	+ by simp
	+ done
	+
	+lemma alw_InvIncomingInfoUpright: "spec s \<Longrightarrow> alw (holds InvIncomingInfoUpright) s"
	+ by (metis (mono_tags, lifting) alw_iff_sdrop alw_invar holds.elims(2) holds.elims(3) init_InvIncomingInfoUpright next_InvIncomingInfoUpright spec_def)
	+
	+definition GlobalIncomingInfo :: "('p :: finite, 't) configuration \<Rightarrow> nat \<Rightarrow> 'p \<Rightarrow> 'p \<Rightarrow> 't delta_vec" where
	+ "GlobalIncomingInfo c k p q = (\<Sum>p' \<in> UNIV. IncomingInfo c (if p' = p then k else 0) p' q)"
	+
	+(* (GlobalIncomingInfo c 0 q q) sums up all info incoming at q *)
	+abbreviation GlobalIncomingInfoAt where
	+ "GlobalIncomingInfoAt c q \<equiv> GlobalIncomingInfo c 0 q q"
	+
	+definition InvGlobalRecordCount where
	+ "InvGlobalRecordCount c = (\<forall>q. c_records c = GlobalIncomingInfoAt c q + c_glob c q)"
	+
	+lemma init_InvGlobalRecordCount: "holds init_config s \<Longrightarrow> holds InvGlobalRecordCount s"
	+ by (simp add: InvGlobalRecordCount_def init_config_def GlobalIncomingInfo_def IncomingInfo_def)
	+
	+lemma if_eq_same: "(if a = b then f b else f a) = f a"
	+ by auto
	+
	+lemma next_InvGlobalRecordCount: "holds InvGlobalRecordCount s \<Longrightarrow> next s \<Longrightarrow> nxt (holds InvGlobalRecordCount) s"
	+ unfolding InvGlobalRecordCount_def init_config_def GlobalIncomingInfo_def IncomingInfo_def next_def
	+ apply (elim disjE)
	+ subgoal
	+ apply (clarsimp simp: next_performop'_def Let_def)
	+ subgoal for p c q r
	+ apply (simp add: sum.distrib)
	+ apply (subst sum_if_distrib_add)
	+ apply (simp_all add: add.assoc)
	+ done
	+ done
	+ subgoal
	+ apply (clarsimp simp: next_sendupd'_def Let_def)
	+ subgoal for p tt q
	+ apply (simp add: if_distrib[of "\<lambda>f. f _"])
	+ apply (simp add: if_distrib[of sum_list])
	+ apply (subst sum_list_append)
	+ apply (simp add: sum.distrib)
	+ apply (subst sum_if_distrib_add)
	+ apply simp
	+ apply simp
	+ apply (subst diff_conv_add_uminus)
	+ apply (subst sum_if_distrib_add)
	+ apply (auto simp: sum_if_distrib_add)
	+ done
	+ done
	+ subgoal
	+ apply (clarsimp simp: next_recvupd'_def Let_def fun_upd_def)
	+ subgoal for p q q'
	+ apply (simp add: if_distrib[of "\<lambda>f. f _"])
	+ apply safe
	+ apply (simp add: if_distrib[of sum_list])
	+ apply (subst sum_list_hd_tl)
	+ apply simp
	+ apply (subst add.commute)
	+ apply (simp add: sum.distrib)
	+ apply (subst sum_if_distrib_add)
	+ apply simp
	+ apply simp
	+ apply (simp add: add.assoc)
	+ apply (subst if_eq_same)
	+ apply simp
	+ done
	+ done
	+ subgoal
	+ by simp
	+ done
	+
	+(* This is inv2 in the short paper *)
	+lemma alw_InvGlobalRecordCount: "spec s \<Longrightarrow> alw (holds InvGlobalRecordCount) s"
	+ by (metis (no_types, lifting) alw_iff_sdrop alw_invar init_InvGlobalRecordCount next_InvGlobalRecordCount spec_def)
	+
	+definition InvGlobalIncomingInfoUpright where
	+ "InvGlobalIncomingInfoUpright c = (\<forall>k p q. upright (GlobalIncomingInfo c k p q))"
	+
	+lemma upright_sum_upright: "finite X \<Longrightarrow> \<forall>x. upright (A x) \<Longrightarrow> upright (\<Sum>x\<in>X. A x)"
	+ by (induct X rule: finite_induct) (auto simp: upright_0 upright_vec_add)
	+
	+lemma InvIncomingInfoUpright_imp_InvGlobalIncomingInfoUpright: "holds InvIncomingInfoUpright s \<Longrightarrow> holds InvGlobalIncomingInfoUpright s"
	+ by (simp add: InvIncomingInfoUpright_def InvGlobalIncomingInfoUpright_def GlobalIncomingInfo_def upright_sum_upright)
	+
	+(* This is inv6 in the short paper *)
	+lemma alw_InvGlobalIncomingInfoUpright: "spec s \<Longrightarrow> alw (holds InvGlobalIncomingInfoUpright) s"
	+ using InvIncomingInfoUpright_imp_InvGlobalIncomingInfoUpright alw_InvIncomingInfoUpright alw_mono by blast
	+
	+abbreviation nrec_pos where
	+ "nrec_pos c \<equiv> \<forall>t. zcount (c_records c) t \<ge> 0"
	+
	+lemma init_nrec_pos: "holds init_config s \<Longrightarrow> holds nrec_pos s"
	+ by (simp add: init_config_def)
	+
	+lemma next_nrec_pos: "holds nrec_pos s \<Longrightarrow> next s \<Longrightarrow> nxt (holds nrec_pos) s"
	+ unfolding next_def
	+ apply simp
	+ apply clarify
	+ apply (elim disjE)
	+ subgoal for t
	+ unfolding next_performop'_def Let_def
	+ apply clarify
	+ subgoal for p c r
	+ apply (simp add: add_diff_eq add.commute add_increasing)
	+ done
	+ done
	+ subgoal for t
	+ by (auto simp: next_sendupd'_def Let_def)
	+ subgoal for t
	+ by (auto simp: next_recvupd'_def Let_def)
	+ subgoal
	+ by simp
	+ done
	+
	+lemma alw_nrec_pos: "spec s \<Longrightarrow> alw (holds nrec_pos) s"
	+ by (metis (mono_tags, lifting) alw_iff_sdrop alw_invar init_nrec_pos next_nrec_pos spec_def)
	+
	+lemma next_performop_vacant:
	+ "vacant_upto (c_records (shd s)) t \<Longrightarrow> next_performop s \<Longrightarrow> vacant_upto (c_records (shd (stl s))) t"
	+ unfolding next_performop'_def Let_def vacant_upto_def
	+ apply clarsimp
	+ subgoal for p c u r
	+ apply (clarsimp simp: upright_def supported_def)
	+ apply (metis (no_types, hide_lams) gr_implies_not_zero of_nat_le_0_iff order.strict_implies_order order_trans zero_less_iff_neq_zero)
	+ done
	+ done
	+
	+lemma next_sendupd_vacant:
	+ "vacant_upto (c_records (shd s)) t \<Longrightarrow> next_sendupd s \<Longrightarrow> vacant_upto (c_records (shd (stl s))) t"
	+ by (auto simp add: next_sendupd'_def Let_def)
	+
	+lemma next_recvupd_vacant:
	+ "vacant_upto (c_records (shd s)) t \<Longrightarrow> next_recvupd s \<Longrightarrow> vacant_upto (c_records (shd (stl s))) t"
	+ by (auto simp add: next_recvupd'_def Let_def)
	+
	+lemma spec_imp_SafeStickyNrecVacantUpto_aux: "alw next s \<Longrightarrow> alw SafeStickyNrecVacantUpto s"
	+ apply (coinduction arbitrary: s)
	+ subgoal for s
	+ unfolding spec_def next_def SafeStickyNrecVacantUpto_def Let_def
	+ apply (rule exI[of _ s])
	+ apply safe
	+ subgoal for t
	+ apply (coinduction arbitrary: s rule: alw.coinduct)
	+ apply clarsimp
	+ apply (rule conjI)
	+ apply blast
	+ apply (erule alw.cases)
	+ apply clarsimp
	+ apply (elim disjE)
	+ apply (simp_all add: next_performop_vacant next_sendupd_vacant next_recvupd_vacant)
	+ done
	+ by blast
	+ done
	+
	+lemma spec_imp_SafeStickyNrecVacantUpto: "spec s \<Longrightarrow> alw SafeStickyNrecVacantUpto s"
	+ unfolding spec_def
	+ by (blast intro: spec_imp_SafeStickyNrecVacantUpto_aux)
	+
	+lemma invs_imp_InvGlobVacantUptoImpliesNrec:
	+ assumes "holds InvGlobalIncomingInfoUpright s"
	+ assumes "holds InvGlobalRecordCount s"
	+ assumes "holds nrec_pos s"
	+ shows "holds InvGlobVacantUptoImpliesNrec s"
	+ using assms unfolding InvGlobVacantUptoImpliesNrec_def
	+ apply simp
	+ apply clarify
	+ apply (rule ccontr)
	+ apply (simp add: vacant_upto_def)
	+ apply clarify
	+ subgoal for t q u
	+ proof -
	+ assume globvut: "\<forall>sa\<le>t. zcount (c_glob (shd s) q) sa = 0"
	+ assume uleqt: "u \<le> t"
	+ assume "u \<in>#\<^sub>z c_records (shd s)"
	+ with assms(3) have "0 < zcount (c_records (shd s)) u"
	+ by (simp add: order.not_eq_order_implies_strict)
	+ with assms(2) globvut uleqt have *: "0 < zcount (GlobalIncomingInfoAt (shd s) q) u"
	+ unfolding InvGlobalRecordCount_def
	+ by (auto dest: spec[of _ q])
	+ from assms(1)[unfolded InvGlobalIncomingInfoUpright_def] have "upright (GlobalIncomingInfoAt (shd s) q)"
	+ by simp
	+ with * obtain v where **: "v \<le> u" "zcount (GlobalIncomingInfoAt (shd s) q) v < 0"
	+ by (meson order.strict_iff_order upright_def supported_def)
	+ with assms(2) have "zcount (c_records (shd s)) v < 0"
	+ by (metis (no_types, hide_lams) InvGlobalRecordCount_def add.right_neutral order.trans globvut holds.elims(2) uleqt zcount_union)
	+ with assms(3) show "False"
	+ using atLeastatMost_empty by auto
	+ qed
	+ done
	+
	+lemma spec_imp_inv1: "spec s \<Longrightarrow> alw (holds InvGlobVacantUptoImpliesNrec) s"
	+ by (metis (mono_tags, lifting) alw_iff_sdrop invs_imp_InvGlobVacantUptoImpliesNrec alw_InvGlobalIncomingInfoUpright alw_InvGlobalRecordCount alw_nrec_pos)
	+
	+lemma safe2_inv1_imp_safe: "SafeStickyNrecVacantUpto s \<Longrightarrow> holds InvGlobVacantUptoImpliesNrec s \<Longrightarrow> SafeGlobVacantUptoImpliesStickyNrec s"
	+ by (simp add: InvGlobVacantUptoImpliesNrec_def SafeStickyNrecVacantUpto_def SafeGlobVacantUptoImpliesStickyNrec_def)
	+
	+lemma spec_imp_safe: "spec s \<Longrightarrow> alw SafeGlobVacantUptoImpliesStickyNrec s"
	+ by (meson alw_iff_sdrop safe2_inv1_imp_safe spec_imp_SafeStickyNrecVacantUpto spec_imp_inv1)
	+
	+
	+
	+(* Second safety property from here on (glob stays vacant) *)
	+
	+lemma beta_upright_0: "beta_upright 0 vb"
	+ unfolding beta_upright_def
	+ by auto
	+
	+definition PositiveImplies where
	+ "PositiveImplies v w = (\<forall>t. zcount v t > 0 \<longrightarrow> zcount w t > 0)"
	+
	+lemma betaupright_PositiveImplies: "upright (va + vb) \<Longrightarrow> PositiveImplies va (va + vb) \<Longrightarrow> beta_upright va vb"
	+ unfolding beta_upright_def PositiveImplies_def
	+ apply clarify
	+ subgoal for t
	+ apply (erule upright_obtain_support[of _ t])
	+ apply simp
	+ subgoal for s
	+ apply (rule exI[of _ s])
	+ apply simp
	+ apply (simp add: add_less_zeroD)
	+ done
	+ done
	+ done
	+
	+lemma betaupright_obtain_support:
	+ assumes "beta_upright va vb"
	+ "zcount va t > 0"
	+ obtains s where "s < t" "zcount va s < 0 \<or> zcount vb s < 0" "nonpos_upto va s"
	+ using assms by (auto simp: beta_upright_alt)
	+
	+lemma betaupright_upright_vut:
	+ assumes "beta_upright va vb"
	+ and "upright vb"
	+ and "vacant_upto (va + vb) t"
	+ shows "vacant_upto va t"
	+proof -
	+ { fix s
	+ assume s: "s \<le> t" "zcount va s > 0"
	+ with assms obtain x where x: "x < s" "zcount va x < 0 \<or> zcount vb x < 0" "nonpos_upto va x"
	+ using betaupright_obtain_support by blast
	+ then have False
	+ proof (cases "zcount va x < 0")
	+ case True
	+ with assms(2,3) s x(1,3) show ?thesis
	+ unfolding vacant_upto_def
	+ apply clarsimp
	+ apply (erule upright_obtain_support[of vb x])
	+ apply (metis add_less_same_cancel2 order.trans order.strict_implies_order)
	+ apply (metis add_less_same_cancel1 add_neg_neg order.order_iff_strict order.trans less_irrefl)
	+ done
	+ next
	+ case False
	+ with assms s x have "x \<le> t" "zcount va x > 0"
	+ apply -
	+ apply simp
	+ apply (metis (no_types, hide_lams) add.left_neutral order.order_iff_strict order.trans vacant_upto_def zcount_union)
	+ done
	+ with assms(2,3) s x show ?thesis
	+ by force
	+ qed
	+ }
	+ note r = this
	+ from assms(2,3) show ?thesis
	+ unfolding vacant_upto_def
	+ apply clarsimp
	+ apply (metis (no_types, hide_lams) r add_cancel_right_left order.order_iff_strict order.trans le_less_linear less_add_same_cancel2 upright_obtain_support)
	+ done
	+qed
	+
	+lemma beta_upright_add:
	+ assumes "upright vb"
	+ and "upright vc"
	+ and "beta_upright va vb"
	+ shows "beta_upright va (vb + vc)"
	+proof -
	+ { fix t
	+ assume "0 < zcount va t"
	+ assume assm: "\<not>(\<exists>s<t. (zcount va s < 0 \<or> zcount vb s + zcount vc s < 0) \<and> \<not>(\<exists>u \<le> s. zcount va u > 0))"
	+ from \<open>0 < zcount va t\<close> assms(3) obtain x where x: "x < t \<and> (zcount va x < 0 \<or> zcount vb x < 0) \<and> nonpos_upto va x"
	+ using betaupright_obtain_support by blast
	+ then have "\<not> zcount va x < 0"
	+ using assm by force
	+ with x have "zcount vb x < 0"
	+ by blast
	+ from assm x have "\<not> zcount vb x + zcount vc x < 0"
	+ using not_le by blast
	+ with \<open>zcount vb x < 0\<close> have "zcount vc x > 0"
	+ by clarsimp
	+ with assms(2) obtain y where y: "y < x \<and> zcount vc y < 0 \<and> nonpos_upto vc y"
	+ using upright_obtain_support by blast
	+ with x have "y < t"
	+ using order.strict_trans by blast
	+ from assm x y have "\<not> zcount vb y + zcount vc y < 0"
	+ by (metis order.strict_implies_order order.strict_trans1 not_less)
	+ with y have "zcount vb y > 0"
	+ by linarith
	+ with assms(1) obtain z where z: "z < y \<and> zcount vb z < 0"
	+ by (auto simp: upright_def supported_def)
	+ with \<open>y < t\<close> have "z < t"
	+ using order.strict_trans by blast
	+ with x y z have "\<not> zcount vb z + zcount vc z < 0"
	+ by (metis assm less_imp_le not_less order.strict_trans order.strict_trans1)
	+ with z have "zcount vc z > 0"
	+ by linarith
	+ with y z have "False"
	+ using order.strict_implies_order not_less by blast
	+ }
	+ then show ?thesis
	+ using beta_upright_def zcount_union by fastforce
	+qed
	+
	+definition InfoAt where
	+ "InfoAt c k p q = (if 0 \<le> k \<and> k < length (c_msg c p q) then (c_msg c p q) ! k else 0)"
	+
	+definition InvInfoAtBetaUpright where
	+ "InvInfoAtBetaUpright c = (\<forall>k p q. beta_upright (InfoAt c k p q) (IncomingInfo c (k+1) p q))"
	+
	+lemma init_InvInfoAtBetaUpright: "init_config c \<Longrightarrow> InvInfoAtBetaUpright c"
	+ unfolding init_config_def InvInfoAtBetaUpright_def beta_upright_def IncomingInfo_def InfoAt_def
	+ by simp
	+
	+lemma next_inv[consumes 1, case_names next_performop next_sendupd next_recvupd stutter]:
	+ assumes "next s"
	+ and "next_performop s \<Longrightarrow> P"
	+ and "next_sendupd s \<Longrightarrow> P"
	+ and "next_recvupd s \<Longrightarrow> P"
	+ and "shd (stl s) = shd s \<Longrightarrow> P"
	+ shows "P"
	+ using assms unfolding next_def by blast
	+
	+
	+lemma next_InvInfoAtBetaUpright:
	+ assumes a1: "next s"
	+ and a2: "InvInfoAtBetaUpright (shd s)"
	+ and a3: "InvIncomingInfoUpright (shd s)"
	+ and a4: "InvTempUpright (shd s)"
	+ shows "InvInfoAtBetaUpright (shd (stl s))"
	+ using assms
	+proof (cases rule: next_inv)
	+ case next_performop
	+ then show ?thesis
	+ unfolding next_performop'_def Let_def InvInfoAtBetaUpright_def
	+ apply clarify
	+ subgoal for p c r k' p' q'
	+ proof (cases "p=p'")
	+ let ?\<Delta> = "zmset_of r - zmset_of c"
	+ assume upright_\<Delta>: "upright ?\<Delta>"
	+ assume conf: "shd (stl s) = shd s\<lparr>c_records := c_records (shd s) + (zmset_of r - zmset_of c),
	+ c_temp := (c_temp (shd s))(p := c_temp (shd s) p + (zmset_of r - zmset_of c))\<rparr>"
	+ case True
	+ then have iid: "IncomingInfo (shd (stl s)) (k'+1) p' q' = IncomingInfo (shd s) (k'+1) p' q' + ?\<Delta>"
	+ by (simp add: IncomingInfo_def conf)
	+ from a2 have bu: "beta_upright (InfoAt (shd s) k' p' q') (IncomingInfo (shd s) (k'+1) p' q')"
	+ using InvInfoAtBetaUpright_def by fastforce
	+ show ?thesis
	+ unfolding iid
	+ apply (rule beta_upright_add)
	+ apply (meson InvIncomingInfoUpright_def a3)
	+ apply (rule upright_\<Delta>)
	+ using bu unfolding conf InfoAt_def
	+ apply auto
	+ done
	+ next
	+ let ?\<Delta> = "zmset_of r - zmset_of c"
	+ assume conf: "shd (stl s) = shd s\<lparr>c_records := c_records (shd s) + (zmset_of r - zmset_of c),
	+ c_temp := (c_temp (shd s))(p := c_temp (shd s) p + (zmset_of r - zmset_of c))\<rparr>"
	+ from a2 have bu: "beta_upright (InfoAt (shd s) k p q) (IncomingInfo (shd s) (k + 1) p q)" for k p q
	+ using InvInfoAtBetaUpright_def by fastforce
	+ case False
	+ then have ii: "IncomingInfo (shd (stl s)) (k'+1) p' q' = IncomingInfo (shd s) (k'+1) p' q'"
	+ unfolding IncomingInfo_def by (simp add: conf)
	+ with bu[of k' p' q'] show ?thesis unfolding conf InfoAt_def
	+ by auto
	+ qed
	+ done
	+next
	+ case next_sendupd
	+ then show ?thesis
	+ unfolding next_sendupd'_def Let_def InvInfoAtBetaUpright_def
	+ apply clarify
	+ subgoal for p tt k' p' q'
	+ proof (cases "p=p'")
	+ let ?\<gamma> = "{#t \<in>#\<^sub>z c_temp (shd s) p. t \<in> tt#}"
	+ assume conf: "shd (stl s) = (shd s)\<lparr>c_msg := (c_msg (shd s))(p := \<lambda>q. c_msg (shd s) p q @ [?\<gamma>]),
	+ c_temp := (c_temp (shd s))(p := c_temp (shd s) p - ?\<gamma>)\<rparr>"
	+ from a2 have buia: "beta_upright (InfoAt (shd s) k' p' q') (IncomingInfo (shd s) (k'+1) p' q')"
	+ using InvInfoAtBetaUpright_def by force
	+ from a4 have tu: "upright (c_temp (shd s) p)"
	+ by (simp add: InvTempUpright_def)
	+ case True
	+ then show ?thesis
	+ proof (cases k' rule: linorder_cases[where y = "length (c_msg (shd s) p' q')"])
	+ case greater
	+ then have "InfoAt (shd (stl s)) k' p' q' = 0"
	+ by (auto simp: conf InfoAt_def)
	+ then show ?thesis
	+ by (simp add: beta_upright_0)
	+ next
	+ case equal
	+ with True conf have "InfoAt (shd (stl s)) k' p' q' = ?\<gamma>"
	+ by (simp add: InfoAt_def)
	+ then have pi: "PositiveImplies (InfoAt (shd (stl s)) k' p' q') (c_temp (shd s) p)"
	+ by (simp add: PositiveImplies_def)
	+ from conf have "c_temp (shd s) p = c_temp (shd (stl s)) p + ?\<gamma>"
	+ by simp
	+ with equal True conf tu pi have butemp: "beta_upright (InfoAt (shd (stl s)) k' p' q') (c_temp (shd (stl s)) p)"
	+ apply -
	+ apply (rule betaupright_PositiveImplies)
	+ apply (auto simp add: InfoAt_def)
	+ done
	+ with True equal conf have "IncomingInfo (shd (stl s)) (k'+1) p' q' = c_temp (shd (stl s)) p"
	+ by (simp add: IncomingInfo_def)
	+ with butemp show ?thesis
	+ by simp
	+ next
	+ case less
	+ with conf have unch_ia: "InfoAt (shd (stl s)) k' p' q' = InfoAt (shd s) k' p' q'"
	+ by (auto simp: nth_append InfoAt_def)
	+ from conf less have "IncomingInfo (shd (stl s)) (k'+1) p' q' = IncomingInfo (shd s) (k'+1) p' q'"
	+ by (auto simp: IncomingInfo_def)
	+ with buia unch_ia show ?thesis by simp
	+ qed
	+ next
	+ let ?\<gamma> = "{#t \<in>#\<^sub>z c_temp (shd s) p. t \<in> tt#}"
	+ assume conf: "shd (stl s) = (shd s)\<lparr>c_msg := (c_msg (shd s))(p := \<lambda>q. c_msg (shd s) p q @ [?\<gamma>]),
	+ c_temp := (c_temp (shd s))(p := c_temp (shd s) p - ?\<gamma>)\<rparr>"
	+ from a2 have buia: "beta_upright (InfoAt (shd s) k' p' q') (IncomingInfo (shd s) (k'+1) p' q')"
	+ using InvInfoAtBetaUpright_def by force
	+ case False
	+ with conf have unchia: "InfoAt (shd (stl s)) k' p' q' = InfoAt (shd s) k' p' q'"
	+ by (simp add: InfoAt_def)
	+ from False conf have unchii: "IncomingInfo (shd (stl s)) (k'+1) p' q' = IncomingInfo (shd s) (k'+1) p' q'"
	+ by (simp add: IncomingInfo_def)
	+ from unchia unchii buia show ?thesis
	+ by simp
	+ qed
	+ done
	+next
	+ case next_recvupd
	+ then show ?thesis
	+ unfolding next_recvupd'_def Let_def InvInfoAtBetaUpright_def
	+ apply clarify
	+ subgoal for p q k' p' q'
	+ proof (cases "p = p' \<and> q = q'")
	+ assume conf: "shd (stl s) = (shd s)\<lparr>c_msg := (c_msg (shd s))(p := (c_msg (shd s) p)(q := tl (c_msg (shd s) p q))),
	+ c_glob := (c_glob (shd s))(q := c_glob (shd s) q + hd (c_msg (shd s) p q))\<rparr>"
	+ case True
	+ with conf have iisuc: "IncomingInfo (shd (stl s)) (k'+1) p' q' = IncomingInfo (shd s) (k'+2) p' q'"
	+ by (simp add: drop_Suc IncomingInfo_def)
	+ with True conf have iasuc: "InfoAt (shd (stl s)) k' p' q' = InfoAt (shd s) (k'+1) p' q'"
	+ by (simp add: less_diff_conv nth_tl InfoAt_def)
	+ from a2 have "beta_upright (InfoAt (shd s) (k'+1) p' q') (IncomingInfo (shd s) (k'+2) p' q')"
	+ using InvInfoAtBetaUpright_def by fastforce
	+ with iisuc iasuc show ?thesis
	+ by simp
	+ next
	+ assume conf: "shd (stl s) = (shd s)\<lparr>c_msg := (c_msg (shd s))(p := (c_msg (shd s) p)(q := tl (c_msg (shd s) p q))),
	+ c_glob := (c_glob (shd s))(q := c_glob (shd s) q + hd (c_msg (shd s) p q))\<rparr>"
	+ from a2 have buia: "beta_upright (InfoAt (shd s) k' p' q') (IncomingInfo (shd s) (k'+1) p' q')"
	+ by (simp add: InvInfoAtBetaUpright_def)
	+ case False
	+ with conf have unchii: "IncomingInfo (shd (stl s)) (k'+1) p' q' = IncomingInfo (shd s) (k'+1) p' q'"
	+ by (auto simp: IncomingInfo_def)
	+ from False conf have unchia: "InfoAt (shd (stl s)) k' p' q' = InfoAt (shd s) k' p' q'"
	+ by (auto simp: InfoAt_def)
	+ from unchii unchia buia show ?thesis
	+ by simp
	+ qed
	+ done
	+qed simp
	+
	+lemma alw_InvInfoAtBetaUpright_aux: "alw (holds InvTempUpright) s \<Longrightarrow> alw (holds InvIncomingInfoUpright) s \<Longrightarrow> holds InvInfoAtBetaUpright s \<Longrightarrow> alw next s \<Longrightarrow> alw (holds InvInfoAtBetaUpright) s"
	+ by (coinduction arbitrary: s rule: alw.coinduct) (auto intro!: next_InvInfoAtBetaUpright)
	+
	+lemma alw_InvInfoAtBetaUpright: "spec s \<Longrightarrow> alw (holds InvInfoAtBetaUpright) s"
	+ by (simp add: alw_InvTempUpright alw_InvIncomingInfoUpright alw_InvInfoAtBetaUpright_aux init_InvInfoAtBetaUpright spec_def)
	+
	+definition InvGlobalInfoAtBetaUpright where
	+ "InvGlobalInfoAtBetaUpright c = (\<forall>k p q. beta_upright (InfoAt c k p q) (GlobalIncomingInfo c (k+1) p q))"
	+
	+lemma finite_induct_select [consumes 1, case_names empty select]:
	+ assumes "finite S"
	+ and empty: "P {}"
	+ and select: "\<And>T. finite T \<Longrightarrow> T \<subset> S \<Longrightarrow> P T \<Longrightarrow> \<exists>s\<in>S - T. P (insert s T)"
	+ shows "P S"
	+proof -
	+ from assms(1) have "P S \<and> finite S"
	+ by (induct S rule: finite_induct_select) (auto intro: empty select)
	+ then show ?thesis by blast
	+qed
	+
	+lemma predicate_sum_decompose:
	+ fixes f :: "'a \<Rightarrow> ('b :: ab_group_add)"
	+ assumes "finite X"
	+ and "x\<in>X"
	+ and "A (f x)"
	+ and "\<forall>Z. B (sum f Z)"
	+ and "\<And>x Z. A (f x) \<Longrightarrow> B (sum f Z) \<Longrightarrow> A (f x + sum f Z)"
	+ and "\<And>x Z. B (f x) \<Longrightarrow> A (sum f Z) \<Longrightarrow> A (f x + sum f Z)"
	+ shows "A (\<Sum>x\<in>X. f x)"
	+ using assms(1,2,3)
	+ apply (induct X rule: finite_induct_select)
	+ apply simp
	+ apply (simp only: sum.insert_remove)
	+ subgoal for T
	+ apply (cases "x \<in> T"; simp add: assms(3))
	+ apply (drule psubset_imp_ex_mem)
	+ apply clarsimp
	+ subgoal for z
	+ apply (rule bexI[of _ z])
	+ apply (rule assms(6)[of z T])
	+ apply (rule assms(4)[THEN spec, of "{z}", simplified])
	+ apply simp
	+ apply simp
	+ done
	+ apply clarsimp
	+ apply (drule bspec[of _ _ x])
	+ apply safe
	+ apply (rule assms(2))
	+ using assms(4,5) apply blast
	+ done
	+ done
	+
	+lemma invs_imp_InvGlobalInfoAtBetaUpright:
	+ assumes "holds InvInfoAtBetaUpright s"
	+ and "holds InvGlobalIncomingInfoUpright s"
	+ and "holds InvIncomingInfoUpright s"
	+ shows "holds InvGlobalInfoAtBetaUpright s"
	+proof -
	+ have uii: "\<forall>k p q. upright (IncomingInfo (shd s) k p q)"
	+ by (rule assms(3)[unfolded InvIncomingInfoUpright_def, simplified])
	+ have ugii: "\<forall>k p q. upright (GlobalIncomingInfo (shd s) k p q)"
	+ by (rule assms(2)[unfolded InvGlobalIncomingInfoUpright_def, simplified])
	+ have buia: "\<forall>k p q. beta_upright (InfoAt (shd s) k p q) (IncomingInfo (shd s) (Suc k) p q)"
	+ by (rule assms(1)[unfolded InvInfoAtBetaUpright_def, simplified])
	+ from uii ugii buia have "\<forall>k p q. beta_upright (InfoAt (shd s) k p q) (GlobalIncomingInfo (shd s) (Suc k) p q)"
	+ unfolding GlobalIncomingInfo_def
	+ apply -
	+ apply (rule allI)+
	+ subgoal for k p q
	+ apply (rule predicate_sum_decompose[of UNIV p "\<lambda>v. beta_upright (InfoAt (shd s) k p q) v" "\<lambda>p'. IncomingInfo (shd s) (if p' = p then Suc k else 0) p' q" upright])
	+ apply simp
	+ apply simp
	+ apply simp
	+ apply (simp add: upright_sum_upright)
	+ subgoal for p' X
	+ apply (rule beta_upright_add)
	+ apply simp
	+ apply simp
	+ apply simp
	+ done
	+ subgoal for p' X
	+ apply (subst add.commute)
	+ apply (rule beta_upright_add)
	+ apply simp
	+ apply (simp add: upright_sum_upright)
	+ apply clarsimp
	+ apply simp
	+ done
	+ done
	+ done
	+ then show ?thesis
	+ by (simp add: InvGlobalInfoAtBetaUpright_def)
	+qed
	+
	+lemma alw_InvGlobalInfoAtBetaUpright: "spec s \<Longrightarrow> alw (holds InvGlobalInfoAtBetaUpright) s"
	+ by (meson alw_InvGlobalIncomingInfoUpright alw_InvIncomingInfoUpright alw_InvInfoAtBetaUpright alw_iff_sdrop invs_imp_InvGlobalInfoAtBetaUpright)
	+
	+definition SafeStickyGlobVacantUpto :: "('p :: finite, 't :: order) computation \<Rightarrow> bool" where
	+ "SafeStickyGlobVacantUpto s = (\<forall>q t. GlobVacantUpto (shd s) q t \<longrightarrow> alw (holds (\<lambda>c. GlobVacantUpto c q t)) s)"
	+
	+lemma gvut1:
	+ "GlobVacantUpto (shd s) q t \<Longrightarrow> next_performop s \<Longrightarrow> GlobVacantUpto (shd (stl s)) q t"
	+ by (auto simp add: next_performop'_def Let_def vacant_upto_def upright_def)
	+
	+lemma gvut2:
	+ "GlobVacantUpto (shd s) q t \<Longrightarrow> next_sendupd s \<Longrightarrow> GlobVacantUpto (shd (stl s)) q t"
	+ by (auto simp add: next_sendupd'_def Let_def)
	+
	+lemma gvut3:
	+ assumes
	+ gvu: "GlobVacantUpto (shd s) q t" and
	+ igvuin: "InvGlobVacantUptoImpliesNrec (shd s)" and
	+ igrc: "InvGlobalRecordCount (shd s)" and
	+ igiiu: "InvGlobalIncomingInfoUpright (shd s)" and
	+ igiabu: "InvGlobalInfoAtBetaUpright (shd s)" and
	+ "next": "next_recvupd s"
	+ shows "GlobVacantUpto (shd (stl s)) q t"
	+proof -
	+ { fix p
	+ let ?GII0 = "GlobalIncomingInfo (shd s) 0 p q"
	+ let ?GII1 = "GlobalIncomingInfo (shd s) 1 p q"
	+ let ?\<kappa> = "hd (c_msg (shd s) p q)"
	+ from igiiu have uGII1: "upright ?GII1"
	+ unfolding InvGlobalIncomingInfoUpright_def by simp
	+ assume globk: "c_glob (shd (stl s)) q = c_glob (shd s) q + ?\<kappa>"
	+ assume nonempty: "c_msg (shd s) p q \<noteq> []"
	+ then have sumGIIsk: "?GII0 = ?GII1 + ?\<kappa>"
	+ unfolding GlobalIncomingInfo_def IncomingInfo_def
	+ by (auto simp: sum.remove ac_simps neq_Nil_conv)
	+ from nonempty have IA0k: "?\<kappa> = InfoAt (shd s) 0 p q"
	+ by (simp add: InfoAt_def hd_conv_nth)
	+ from igiabu nonempty have bukGII1: "beta_upright ?\<kappa> ?GII1"
	+ proof -
	+ note igiabu
	+ then have "beta_upright (InfoAt (shd s) 0 p q) (GlobalIncomingInfo (shd s) 1 p q)"
	+ by (simp add: InvGlobalInfoAtBetaUpright_def)
	+ with IA0k show ?thesis
	+ by simp
	+ qed
	+ from igvuin gvu have nvu: "NrecVacantUpto (shd s) t"
	+ unfolding InvGlobVacantUptoImpliesNrec_def by blast
	+ with igrc have "c_records (shd s) = c_glob (shd s) q + ?GII0"
	+ unfolding GlobalIncomingInfo_def IncomingInfo_def InvGlobalRecordCount_def
	+ by (simp add: add.commute)
	+ with gvu nvu have vuGII0: "vacant_upto ?GII0 t"
	+ by (simp add: vacant_upto_def)
	+ from bukGII1 uGII1 have "vacant_upto ?\<kappa> t"
	+ by (rule betaupright_upright_vut[of ?\<kappa> ?GII1]) (metis vuGII0 add.commute sumGIIsk)
	+ with gvu have "GlobVacantUpto (shd (stl s)) q t"
	+ by (simp add: globk vacant_upto_def)
	+ }
	+ then show ?thesis
	+ using assms unfolding next_recvupd'_def
	+ by auto
	+qed
	+
	+lemma spec_imp_SafeStickyGlobVacantUpto_aux:
	+ assumes
	+ "alw (holds (\<lambda>c. InvGlobVacantUptoImpliesNrec c)) s" and
	+ "alw (holds (\<lambda>c. InvGlobalRecordCount c)) s" and
	+ "alw (holds (\<lambda>c. InvGlobalIncomingInfoUpright c)) s" and
	+ "alw (holds (\<lambda>c. InvGlobalInfoAtBetaUpright c)) s" and
	+ "alw next s"
	+ shows "alw SafeStickyGlobVacantUpto s"
	+ using assms apply (coinduction arbitrary: s)
	+ subgoal for s
	+ unfolding spec_def next_def SafeStickyGlobVacantUpto_def Let_def
	+ apply (rule exI[of _ s])
	+ apply safe
	+ subgoal for q t
	+ apply (coinduction arbitrary: s rule: alw.coinduct)
	+ apply clarsimp
	+ apply (rule conjI)
	+ apply blast
	+ proof -
	+ fix sb :: "('a, 'b) configuration stream"
	+ assume a1: "alw (holds InvGlobVacantUptoImpliesNrec) sb"
	+ assume a2: "alw (holds InvGlobalRecordCount) sb"
	+ assume a3: "alw (holds InvGlobalIncomingInfoUpright) sb"
	+ assume a4: "alw (holds InvGlobalInfoAtBetaUpright) sb"
	+ assume a5: "alw (\<lambda>s. next_performop s \<or> next_sendupd s \<or> next_recvupd s \<or> shd (stl s) = shd s) sb"
	+ assume a6: "GlobVacantUpto (shd sb) q t"
	+ have "next_performop sb \<or> next_sendupd sb \<or> next_recvupd sb \<or> shd (stl sb) = shd sb"
	+ using a5 by blast
	+ then have "GlobVacantUpto (shd (stl sb)) q t"
	+ using a6 a4 a3 a2 a1 by (metis (no_types) alwD gvut1 gvut2 gvut3 holds.elims(2))
	+ then show "alw (holds InvGlobalRecordCount) (stl sb) \<and> alw (holds InvGlobalIncomingInfoUpright) (stl sb) \<and> alw (holds InvGlobalInfoAtBetaUpright) (stl sb) \<and> alw (\<lambda>s. next_performop s \<or> next_sendupd s \<or> next_recvupd s \<or> shd (stl s) = shd s) (stl sb) \<and> GlobVacantUpto (shd (stl sb)) q t"
	+ using a5 a4 a3 a2 by blast
	+ qed
	+ apply blast
	+ done
	+ done
	+
	+lemma spec_imp_SafeStickyGlobVacantUpto: "spec s \<Longrightarrow> alw SafeStickyGlobVacantUpto s"
	+ apply (rule spec_imp_SafeStickyGlobVacantUpto_aux)
	+ apply (simp add: spec_imp_inv1)
	+ apply (simp add: alw_InvGlobalRecordCount)
	+ apply (simp add: alw_InvGlobalIncomingInfoUpright)
	+ apply (simp add: alw_InvGlobalInfoAtBetaUpright)
	+ apply (simp add: spec_def)
	+ done
	+
	+definition SafeGlobMono where
	+ "SafeGlobMono c0 c1 = (\<forall>p t. GlobVacantUpto c0 p t \<longrightarrow> GlobVacantUpto c1 p t)"
	+
	+lemma alw_SafeGlobMono: "spec s \<Longrightarrow> alw (relates SafeGlobMono) s"
	+ apply (drule spec_imp_SafeStickyGlobVacantUpto)
	+ apply (erule alw_mono)
	+ apply (fastforce simp: SafeStickyGlobVacantUpto_def SafeGlobMono_def relates_def)
	+ done
	+
	+(<)
	+end
	+(>)
	diff --git a/thys/Progress_Tracking/Graph.thy b/thys/Progress_Tracking/Graph.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/Graph.thy
	@@ -0,0 +1,384 @@
	+section\<open>Multigraphs with Partially Ordered Weights\<close>
	+
	+(<)
	+theory Graph
	+ imports "HOL-Library.Sublist" Antichain
	+begin
	+(>)
	+
	+abbreviation (input) FROM where
	+ "FROM \<equiv> \<lambda>(s, l, t). s"
	+
	+abbreviation (input) LBL where
	+ "LBL \<equiv> \<lambda>(s, l, t). l"
	+
	+abbreviation (input) TO where
	+ "TO \<equiv> \<lambda>(s, l, t). t"
	+
	+notation subseq (infix "\<preceq>" 50)
	+
	+locale graph =
	+ fixes weights :: "'vtx :: finite \<Rightarrow> 'vtx \<Rightarrow> 'lbl :: {order, monoid_add} antichain"
	+ assumes zero_le[simp]: "0 \<le> (s::'lbl)"
	+ and plus_mono: "(s1::'lbl) \<le> s2 \<Longrightarrow> s3 \<le> s4 \<Longrightarrow> s1 + s3 \<le> s2 + s4"
	+ and summary_self: "weights loc loc = {}\<^sub>A"
	+begin
	+
	+lemma le_plus: "(s::'lbl) \<le> s + s'" "(s'::'lbl) \<le> s + s'"
	+ by (intro plus_mono[of s s 0 s', simplified] plus_mono[of 0 s s' s', simplified])+
	+
	+subsection\<open>Paths\<close>
	+
	+inductive path :: "'vtx \<Rightarrow> 'vtx \<Rightarrow> ('vtx \<times> 'lbl \<times> 'vtx) list \<Rightarrow> bool" where
	+ path0: "l1 = l2 \<Longrightarrow> path l1 l2 []"
	+\| path: "path l1 l2 xs \<Longrightarrow> lbl \<in>\<^sub>A weights l2 l3 \<Longrightarrow> path l1 l3 (xs @ [(l2, lbl, l3)])"
	+
	+inductive_cases path0E: "path l1 l2 []"
	+inductive_cases path_AppendE: "path l1 l3 (xs @ [(l2,s,l2')])"
	+
	+lemma path_trans: "path l1 l2 xs \<Longrightarrow> path l2 l3 ys \<Longrightarrow> path l1 l3 (xs @ ys)"
	+ by (rotate_tac, induct l2 l3 ys rule: path.induct)
	+ (auto intro: path.path simp flip: append_assoc)
	+
	+lemma path_take_from: "path l1 l2 xs \<Longrightarrow> m < length xs \<Longrightarrow> FROM (xs ! m) = l2' \<Longrightarrow> path l1 l2' (take m xs)"
	+proof (induct l1 l2 xs rule: path.induct)
	+ case (path l1 l2 xs lbl l3)
	+ then show ?case
	+ apply (unfold take_append)
	+ apply simp
	+ apply (cases "l2=l2'")
	+ apply (metis linorder_not_less nth_append take_all)
	+ apply (metis case_prod_conv less_Suc_eq nth_append nth_append_length)
	+ done
	+qed simp
	+
	+lemma path_take_to: "path l1 l2 xs \<Longrightarrow> m < length xs \<Longrightarrow> TO (xs ! m) = l2' \<Longrightarrow> path l1 l2' (take (m+1) xs)"
	+proof (induct l1 l2 xs rule: path.induct)
	+ case (path l1 l2 xs lbl l3)
	+ then show ?case
	+ apply (cases "m < length xs")
	+ apply (simp add: nth_append)
	+ apply clarsimp
	+ apply (metis case_prod_conv less_antisym nth_append_length path.path)
	+ done
	+qed simp
	+
	+lemma path_determines_loc: "path l1 l2 xs \<Longrightarrow> path l1 l3 xs \<Longrightarrow> l2 = l3"
	+ by (induct l1 l2 xs rule: path.induct) (auto elim: path.cases)
	+
	+lemma path_first_loc: "path loc loc' xs \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> FROM (xs ! 0) = loc"
	+proof (induct rule: path.induct)
	+ case (path l1 l2 xs lbl l3)
	+ then show ?case
	+ by (auto elim: path0E simp: nth_append)
	+qed simp
	+
	+lemma path_to_eq_from: "path loc1 loc2 xs \<Longrightarrow> i + 1 < length xs \<Longrightarrow> FROM (xs ! (i+1)) = TO (xs ! i)"
	+proof (induct rule: path.induct)
	+ case (path l1 l2 xs lbl l3)
	+ then show ?case
	+ apply (cases "i + 1 < length xs")
	+ apply (simp add: nth_append)
	+ apply (simp add: nth_append)
	+ apply (metis add.commute drop_eq_Nil hd_drop_conv_nth id_take_nth_drop linorder_not_less path_determines_loc path_take_to plus_1_eq_Suc take_hd_drop)
	+ done
	+qed simp
	+
	+lemma path_singleton[intro, simp]: "s \<in>\<^sub>A weights l1 l2 \<Longrightarrow> path l1 l2 [(l1,s,l2)]"
	+ by (subst path.simps) (auto simp: path.intros)
	+
	+lemma path_appendE: "path l1 l3 (xs @ ys) \<Longrightarrow> \<exists>l2. path l2 l3 ys \<and> path l1 l2 xs"
	+proof (induct l1 l3 "xs@ys" arbitrary: xs ys rule: path.induct)
	+ case (path0 l1 l2)
	+ then show ?case by (auto intro: path.intros)
	+next
	+ case (path l1 l2 xs lbl l3 xs' ys')
	+ from path(1,3-) show ?case
	+ apply -
	+ apply (subst (asm) append_eq_append_conv2[of xs "[(l2,lbl,l3)]" xs' ys'])
	+ apply (elim exE conjE disjE)
	+ subgoal for us
	+ using path(2)[of xs' us]
	+ by (auto intro: path.intros)
	+ subgoal for us
	+ by (cases "us=[]") (auto intro: path.intros simp: Cons_eq_append_conv)
	+ done
	+qed
	+
	+lemma path_replace_prefix:
	+ "path l1 l3 (xs @ zs) \<Longrightarrow> path l1 l2 ys \<Longrightarrow> path l1 l2 xs \<Longrightarrow> path l1 l3 (ys @ zs)"
	+ by (drule path_appendE) (auto elim!: path_trans dest: path_determines_loc)
	+
	+lemma drop_subseq: "n \<le> length xs \<Longrightarrow> drop n xs \<preceq> xs"
	+ by (auto simp: suffix_def intro!: exI[of _ "take n xs"])
	+
	+lemma take_subseq[simp, intro]: "take n xs \<preceq> xs"
	+ by (induct xs) auto
	+
	+lemma map_take_subseq[simp, intro]: "map f (take n xs) \<preceq> map f xs"
	+ by (rule subseq_map, induct xs) auto
	+
	+lemma path_distinct:
	+ "path l1 l2 xs \<Longrightarrow> \<exists>xs'. distinct xs' \<and> path l1 l2 xs' \<and> map LBL xs' \<preceq> map LBL xs"
	+proof (induct rule: path.induct)
	+ case (path0 l1 l2)
	+ then show ?case
	+ by (intro exI[of _ "[]"]) (auto intro: path.intros)
	+next
	+ case (path l1 l2 xs lbl l3)
	+ then obtain xs' where ih: "path l1 l2 xs'" "distinct xs'" "map LBL xs' \<preceq> map LBL xs"
	+ by blast
	+ then show ?case
	+ proof (cases "(l2, lbl, l3) \<in> set xs'")
	+ case True
	+ then obtain m where m: "m < length xs'" "xs' ! m = (l2, lbl, l3)"
	+ unfolding in_set_conv_nth by blast
	+ from m ih have "path l1 l2 (take m xs')"
	+ by (auto intro: path_take_from)
	+ with m ih path show ?thesis
	+ apply (intro exI[of _ "take m xs' @ [(l2, lbl, l3)]"])
	+ apply (rule conjI)
	+ apply (metis distinct_take take_Suc_conv_app_nth)
	+ apply (rule conjI)
	+ apply (rule path.intros)
	+ apply simp
	+ apply simp
	+ apply simp
	+ apply (metis ih(3) subseq_order.order.trans take_map take_subseq)
	+ done
	+ next
	+ case False
	+ with ih path(3) show ?thesis
	+ by (auto intro!: exI[of _ "xs' @ [(l2, lbl, l3)]"] intro: path.intros)
	+ qed
	+qed
	+
	+lemma path_edge: "(l1', lbl, l2') \<in> set xs \<Longrightarrow> path l1 l2 xs \<Longrightarrow> lbl \<in>\<^sub>A weights l1' l2'"
	+ by (rotate_tac, induct rule: path.induct) auto
	+
	+subsection\<open>Path Weights\<close>
	+
	+abbreviation sum_weights :: "'lbl list \<Rightarrow> 'lbl" where
	+ "sum_weights xs \<equiv> foldr (+) xs 0"
	+abbreviation "sum_path_weights xs \<equiv> sum_weights (map LBL xs)"
	+
	+definition "path_weightp l1 l2 s \<equiv> (\<exists>xs. path l1 l2 xs \<and> s = sum_path_weights xs)"
	+
	+lemma sum_not_less_zero[simp, dest]: "(s::'lbl) < 0 \<Longrightarrow> False"
	+ by (simp add: less_le_not_le)
	+
	+lemma sum_le_zero[simp]: "(s::'lbl) \<le> 0 \<longleftrightarrow> s = 0"
	+ by (simp add: eq_iff)
	+
	+lemma sum_le_zeroD[dest]: "(x::'lbl) \<le> 0 \<Longrightarrow> x = 0"
	+ by simp
	+
	+lemma foldr_plus_mono: "(n::'lbl) \<le> m \<Longrightarrow> foldr (+) xs n \<le> foldr (+) xs m"
	+ by (induct xs) (auto simp: plus_mono)
	+
	+lemma sum_weights_append:
	+ "sum_weights (ys @ xs) = sum_weights ys + sum_weights xs"
	+ by (induct ys) (auto simp: add.assoc)
	+
	+lemma sum_summary_prepend_le: "sum_path_weights ys \<le> sum_path_weights xs \<Longrightarrow> sum_path_weights (zs @ ys) \<le> sum_path_weights (zs @ xs)"
	+ by (induct zs arbitrary: xs ys) (auto intro: plus_mono)
	+
	+lemma sum_summary_append_le: "sum_path_weights ys \<le> sum_path_weights xs \<Longrightarrow> sum_path_weights (ys @ zs) \<le> sum_path_weights (xs @ zs)"
	+proof (induct zs arbitrary: xs ys)
	+ case (Cons a zs)
	+ then show ?case
	+ by (metis plus_mono map_append order_refl sum_weights_append)
	+qed simp
	+
	+lemma foldr_plus_zero_le: "foldr (+) xs (0::'lbl) \<le> foldr (+) xs a"
	+ by (induct xs) (simp_all add: plus_mono)
	+
	+lemma subseq_sum_weights_le:
	+ assumes "xs \<preceq> ys"
	+ shows "sum_weights xs \<le> sum_weights ys"
	+ using assms
	+proof (induct rule: list_emb.induct)
	+ case (list_emb_Nil ys)
	+ then show ?case by auto
	+next
	+ case (list_emb_Cons xs ys y)
	+ then show ?case by (auto elim!: order_trans simp: le_plus)
	+next
	+ case (list_emb_Cons2 x y xs ys)
	+ then show ?case by (auto elim!: order_trans simp: plus_mono)
	+qed
	+
	+lemma subseq_sum_path_weights_le:
	+ "map LBL xs \<preceq> map LBL ys \<Longrightarrow> sum_path_weights xs \<le> sum_path_weights ys"
	+ by (rule subseq_sum_weights_le)
	+
	+lemma sum_path_weights_take_le[simp, intro]: "sum_path_weights (take i xs) \<le> sum_path_weights xs"
	+ by (auto intro!: subseq_sum_path_weights_le)
	+
	+lemma sum_weights_append_singleton:
	+ "sum_weights (xs @ [x]) = sum_weights xs + x"
	+ by (induct xs) (simp_all add: add.assoc)
	+
	+lemma sum_path_weights_append_singleton:
	+ "sum_path_weights (xs @ [(l,x,l')]) = sum_path_weights xs + x"
	+ by (induct xs) (simp_all add: add.assoc)
	+
	+lemma path_weightp_ex_path:
	+ "path_weightp l1 l2 s \<Longrightarrow> \<exists>xs.
	+ (let s' = sum_path_weights xs in s' \<le> s \<and> path_weightp l1 l2 s' \<and> distinct xs \<and>
	+ (\<forall>(l1,s,l2) \<in> set xs. s \<in>\<^sub>A weights l1 l2))"
	+ unfolding path_weightp_def
	+ apply (erule exE conjE)+
	+ apply (drule path_distinct)
	+ apply (erule exE conjE)+
	+ subgoal for xs xs'
	+ apply (rule exI[of _ xs'])
	+ apply (auto simp: Let_def dest!: path_edge intro: subseq_sum_path_weights_le)
	+ done
	+ done
	+
	+lemma finite_set_summaries:
	+ "finite ((\<lambda>((l1,l2),s). (l1,s,l2)) ` (Sigma UNIV (\<lambda>(l1,l2). set_antichain (weights l1 l2))))"
	+ by force
	+
	+lemma finite_summaries: "finite {xs. distinct xs \<and> (\<forall>(l1, s, l2) \<in> set xs. s \<in>\<^sub>A weights l1 l2)}"
	+ apply (rule finite_subset[OF _ finite_distinct_bounded[of "((\<lambda>((l1,l2),s). (l1,s,l2)) ` (Sigma UNIV (\<lambda>(l1,l2). set_antichain (weights l1 l2))))"]])
	+ apply (force simp: finite_set_summaries)+
	+ done
	+
	+lemma finite_minimal_antichain_path_weightp:
	+ "finite (minimal_antichain {x. path_weightp l1 l2 x})"
	+ apply (rule finite_surj[OF finite_summaries, where f = sum_path_weights])
	+ apply (clarsimp simp: minimal_antichain_def image_iff dest!: path_weightp_ex_path)
	+ apply (fastforce simp: Let_def)
	+ done
	+
	+(* antichain of summaries along cycles-less paths (cycle-less = no edge repeated) *)
	+lift_definition path_weight :: "'vtx \<Rightarrow> 'vtx \<Rightarrow> 'lbl antichain"
	+ is "\<lambda>l1 l2. minimal_antichain {x. path_weightp l1 l2 x}"
	+ using finite_minimal_antichain_path_weightp
	+ by auto
	+
	+definition "reachable l1 l2 \<equiv> path_weight l1 l2 \<noteq> {}\<^sub>A"
	+
	+lemma in_path_weight: "s \<in>\<^sub>A path_weight loc1 loc2 \<longleftrightarrow> s \<in> minimal_antichain {s. path_weightp loc1 loc2 s}"
	+ by transfer simp
	+
	+lemma path_weight_refl[simp]: "0 \<in>\<^sub>A path_weight loc loc"
	+proof -
	+ have *: "path loc loc []"
	+ by (simp add: path0)
	+ then have "0 = sum_path_weights []" by auto
	+ with * have "path_weightp loc loc 0"
	+ using path_weightp_def by blast
	+ then show ?thesis
	+ by (auto simp: in_path_weight in_minimal_antichain)
	+qed
	+
	+lemma zero_in_minimal_antichain[simp]: "(0::'lbl) \<in> S \<Longrightarrow> 0 \<in> minimal_antichain S"
	+ by (auto simp: in_minimal_antichain intro: sum_not_less_zero)
	+
	+definition "path_weightp_distinct l1 l2 s \<equiv> (\<exists>xs. distinct xs \<and> path l1 l2 xs \<and> s = sum_path_weights xs)"
	+
	+lemma minimal_antichain_path_weightp_distinct:
	+ "minimal_antichain {xs. path_weightp l1 l2 xs} = minimal_antichain {xs. path_weightp_distinct l1 l2 xs}"
	+ unfolding path_weightp_def path_weightp_distinct_def minimal_antichain_def
	+ apply safe
	+ apply clarsimp
	+ apply (metis path_distinct order.strict_iff_order subseq_sum_path_weights_le)
	+ apply (blast+) [2]
	+ apply clarsimp
	+ apply (metis (no_types, lifting) le_less_trans path_distinct subseq_sum_weights_le)
	+ done
	+
	+lemma finite_path_weightp_distinct[simp, intro]: "finite {xs. path_weightp_distinct l1 l2 xs}"
	+ unfolding path_weightp_distinct_def
	+ apply (rule finite_subset[where B = "sum_path_weights ` {xs. distinct xs \<and> path l1 l2 xs}"])
	+ apply clarsimp
	+ apply (rule finite_imageI)
	+ apply (rule finite_subset[OF _ finite_summaries])
	+ apply (clarsimp simp: path_edge)
	+ done
	+
	+lemma path_weightp_distinct_nonempty:
	+ "{xs. path_weightp l1 l2 xs} \<noteq> {} \<longleftrightarrow> {xs. path_weightp_distinct l1 l2 xs} \<noteq> {}"
	+ by (auto dest: path_distinct simp: path_weightp_def path_weightp_distinct_def)
	+
	+lemma path_weightp_distinct_member:
	+ "s \<in> {s. path_weightp l1 l2 s} \<Longrightarrow> \<exists>u. u \<in> {s. path_weightp_distinct l1 l2 s} \<and> u \<le> s"
	+ apply (clarsimp simp: path_weightp_def path_weightp_distinct_def)
	+ apply (drule path_distinct)
	+ apply (auto dest: subseq_sum_path_weights_le)
	+ done
	+
	+lemma minimal_antichain_path_weightp_member:
	+ "s \<in> {xs. path_weightp l1 l2 xs} \<Longrightarrow> \<exists>u. u \<in> minimal_antichain {xs. path_weightp l1 l2 xs} \<and> u \<le> s"
	+proof -
	+ assume "s \<in> {xs. path_weightp l1 l2 xs}"
	+ then obtain u where u: "u \<in> {s. path_weightp_distinct l1 l2 s} \<and> u \<le> s"
	+ using path_weightp_distinct_member by blast
	+ have finite: "finite {xs. path_weightp_distinct l1 l2 xs}" ..
	+ from u finite obtain v where "v \<in> minimal_antichain {xs. path_weightp_distinct l1 l2 xs} \<and> v \<le> u"
	+ by atomize_elim (auto intro: minimal_antichain_member)
	+ with u show ?thesis
	+ by (auto simp: minimal_antichain_path_weightp_distinct)
	+qed
	+
	+lemma path_path_weight: "path l1 l2 xs \<Longrightarrow> \<exists>s. s \<in>\<^sub>A path_weight l1 l2 \<and> s \<le> sum_path_weights xs"
	+proof -
	+ assume "path l1 l2 xs"
	+ then have "sum_path_weights xs \<in> {x. path_weightp l1 l2 x}"
	+ by (auto simp: path_weightp_def)
	+ then obtain u where "u \<in> minimal_antichain {x. path_weightp l1 l2 x} \<and> u \<le> sum_path_weights xs"
	+ apply atomize_elim
	+ apply (drule minimal_antichain_path_weightp_member)
	+ apply auto
	+ done
	+ then show ?thesis
	+ by transfer auto
	+qed
	+
	+lemma path_weight_conv_path:
	+ "s \<in>\<^sub>A path_weight l1 l2 \<Longrightarrow> \<exists>xs. path l1 l2 xs \<and> s = sum_path_weights xs \<and> (\<forall>ys. path l1 l2 ys \<longrightarrow> \<not> sum_path_weights ys < sum_path_weights xs)"
	+ by transfer (auto simp: in_minimal_antichain path_weightp_def)
	+
	+abbreviation "optimal_path loc1 loc2 xs \<equiv> path loc1 loc2 xs \<and>
	+ (\<forall>ys. path loc1 loc2 ys \<longrightarrow> \<not> sum_path_weights ys < sum_path_weights xs)"
	+
	+lemma path_weight_path: "s \<in>\<^sub>A path_weight loc1 loc2 \<Longrightarrow>
	+ (\<And>xs. optimal_path loc1 loc2 xs \<Longrightarrow> distinct xs \<Longrightarrow> sum_path_weights xs = s \<Longrightarrow> P) \<Longrightarrow> P"
	+ apply atomize_elim
	+ apply transfer
	+ apply (clarsimp simp: in_minimal_antichain path_weightp_def)
	+ apply (drule path_distinct)
	+ apply (erule exE)
	+ subgoal for loc1 loc2 xs xs'
	+ apply (rule exI[of _ xs'])
	+ apply safe
	+ using order.strict_iff_order subseq_sum_path_weights_le apply metis
	+ using less_le subseq_sum_path_weights_le apply fastforce
	+ done
	+ done
	+
	+lemma path_weight_elem_trans:
	+ "s \<in>\<^sub>A path_weight l1 l2 \<Longrightarrow> s' \<in>\<^sub>A path_weight l2 l3 \<Longrightarrow> \<exists>u. u \<in>\<^sub>A path_weight l1 l3 \<and> u \<le> s + s'"
	+proof -
	+ assume ps1: "s \<in>\<^sub>A path_weight l1 l2"
	+ assume ps2: "s' \<in>\<^sub>A path_weight l2 l3"
	+ from ps1 obtain xs where path1: "path l1 l2 xs" "s = sum_path_weights xs"
	+ by (auto intro: path_weight_path)
	+ from ps2 obtain ys where path2: "path l2 l3 ys" "s' = sum_path_weights ys"
	+ by (auto intro: path_weight_path)
	+ from path1(1) path2(1) have "path l1 l3 (xs @ ys)"
	+ by (rule path_trans)
	+ with path1(2) path2(2) have "s + s' \<in> {s. path_weightp l1 l3 s}"
	+ by (auto simp: path_weightp_def sum_weights_append[symmetric])
	+ then show "\<exists>u. u \<in>\<^sub>A path_weight l1 l3 \<and> u \<le> s + s'"
	+ by transfer (simp add: minimal_antichain_path_weightp_member)
	+qed
	+
	+end
	+
	+(<)
	+end
	+(>)
	\ No newline at end of file
	diff --git a/thys/Progress_Tracking/Propagate.thy b/thys/Progress_Tracking/Propagate.thy
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/Propagate.thy
	@@ -0,0 +1,1703 @@
	+section \<open>Local Progress Propagation\label{sec:propagate}\<close>
	+
	+(<)
	+theory Propagate
	+ imports
	+ Graph
	+begin
	+(>)
	+
	+subsection \<open>Specification\<close>
	+
	+record (overloaded) ('loc, 't) configuration =
	+ c_work :: "'loc \<Rightarrow> 't zmultiset" (* worklists with not-yet-applied updates *)
	+ c_pts :: "'loc \<Rightarrow> 't zmultiset" (* tracked point-stamps *)
	+ c_imp :: "'loc \<Rightarrow> 't zmultiset" (* alive point-stamps ("implications") *)
	+
	+type_synonym ('loc, 't) computation = "('loc, 't) configuration stream"
	+
	+locale dataflow_topology = flow?: graph summary
	+ for summary :: "'loc \<Rightarrow> 'loc :: finite \<Rightarrow> 'sum :: {order, monoid_add} antichain" +
	+ fixes results_in :: "'t :: order \<Rightarrow> 'sum \<Rightarrow> 't"
	+ assumes results_in_zero: "results_in t 0 = t"
	+ and results_in_mono_raw: "t1 \<le> t2 \<Longrightarrow> s1 \<le> s2 \<Longrightarrow> results_in t1 s1 \<le> results_in t2 s2"
	+ and followed_by_summary: "results_in (results_in t s1) s2 = results_in t (s1 + s2)"
	+ and no_zero_cycle: "path loc loc xs \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> s = sum_path_weights xs \<Longrightarrow> t < results_in t s"
	+begin
	+
	+lemma results_in_mono:
	+ "t1 \<le> t2 \<Longrightarrow> results_in t1 s \<le> results_in t2 s"
	+ "s1 \<le> s2 \<Longrightarrow> results_in t s1 \<le> results_in t s2"
	+ using results_in_mono_raw by auto
	+
	+abbreviation "path_summary \<equiv> path_weight"
	+abbreviation followed_by :: "'sum \<Rightarrow> 'sum \<Rightarrow> 'sum" where
	+ "followed_by \<equiv> plus"
	+
	+definition safe :: "('loc, 't) configuration \<Rightarrow> bool" where
	+ "safe c \<equiv> \<forall>loc1 loc2 t s. zcount (c_pts c loc1) t > 0 \<and> s \<in>\<^sub>A path_summary loc1 loc2
	+ \<longrightarrow> (\<exists>t'\<le>results_in t s. t' \<in>\<^sub>A frontier (c_imp c loc2))"
	+
	+text \<open>Implications are always non-negative.\<close>
	+definition inv_implications_nonneg where
	+ "inv_implications_nonneg c = (\<forall>loc t. zcount (c_imp c loc) t \<ge> 0)"
	+
	+abbreviation "unchanged f c0 c1 \<equiv> f c1 = f c0"
	+
	+abbreviation zmset_frontier where
	+ "zmset_frontier M \<equiv> zmset_of (mset_set (set_antichain (frontier M)))"
	+
	+definition init_config where
	+ "init_config c \<equiv> \<forall>loc.
	+ c_imp c loc = {#}\<^sub>z \<and>
	+ c_work c loc = zmset_frontier (c_pts c loc)"
	+
	+
	+definition after_summary :: "'t zmultiset \<Rightarrow> 'sum antichain \<Rightarrow> 't zmultiset" where
	+ "after_summary M S \<equiv> (\<Sum>s \<in> set_antichain S. image_zmset (\<lambda>t. results_in t s) M)"
	+
	+abbreviation frontier_changes :: "'t zmultiset \<Rightarrow> 't zmultiset \<Rightarrow> 't zmultiset" where
	+ "frontier_changes M N \<equiv> zmset_frontier M - zmset_frontier N"
	+
	+definition next_change_multiplicity' :: "('loc, 't) configuration \<Rightarrow> ('loc, 't) configuration \<Rightarrow> 'loc \<Rightarrow> 't \<Rightarrow> int \<Rightarrow> bool" where
	+ "next_change_multiplicity' c0 c1 loc t n \<equiv>
	+ \<comment> \<open>n is the non-zero change in pointstamps at loc for timestamp t\<close>
	+ n \<noteq> 0 \<and>
	+ \<comment> \<open>change can only happen at timestamps not in advance of implication-frontier\<close>
	+ (\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c0 loc) \<and> t' \<le> t) \<and>
	+ \<comment> \<open>at loc, t is added to pointstamps n times\<close>
	+ c1 = c0\<lparr>c_pts := (c_pts c0)(loc := update_zmultiset (c_pts c0 loc) t n),
	+ \<comment> \<open>worklist at loc is adjusted by frontier changes\<close>
	+ c_work := (c_work c0)(loc := c_work c0 loc +
	+ frontier_changes (update_zmultiset (c_pts c0 loc) t n) (c_pts c0 loc))\<rparr>"
	+
	+abbreviation next_change_multiplicity :: "('loc, 't) configuration \<Rightarrow> ('loc, 't) configuration \<Rightarrow> bool" where
	+ "next_change_multiplicity c0 c1 \<equiv> \<exists>loc t n. next_change_multiplicity' c0 c1 loc t n"
	+
	+lemma cm_unchanged_worklist:
	+ assumes "next_change_multiplicity' c0 c1 loc t n"
	+ and "loc' \<noteq> loc"
	+ shows "c_work c1 loc' = c_work c0 loc'"
	+ using assms unfolding next_change_multiplicity'_def
	+ by auto
	+
	+definition next_propagate' :: "('loc, 't) configuration \<Rightarrow> ('loc, 't) configuration \<Rightarrow> 'loc \<Rightarrow> 't \<Rightarrow> bool" where
	+ "next_propagate' c0 c1 loc t \<equiv>
	+ \<comment> \<open>t is a least timestamp of all worklist entries\<close>
	+ (t \<in>#\<^sub>z c_work c0 loc \<and>
	+ (\<forall>t' loc'. t' \<in>#\<^sub>z c_work c0 loc' \<longrightarrow> \<not> t' < t) \<and>
	+ c1 = c0\<lparr>c_imp := (c_imp c0)(loc := c_imp c0 loc + {#t' \<in>#\<^sub>z c_work c0 loc. t' = t#}),
	+ c_work := (\<lambda>loc'.
	+ \<comment> \<open>worklist entries for t are removed from loc's worklist\<close>
	+ if loc' = loc then {#t' \<in>#\<^sub>z c_work c0 loc'. t' \<noteq> t#}
	+ \<comment> \<open>worklists at other locations change by the loc's frontier change after adding summaries\<close>
	+ else c_work c0 loc'
	+ + after_summary
	+ (frontier_changes (c_imp c0 loc + {#t' \<in>#\<^sub>z c_work c0 loc. t' = t#}) (c_imp c0 loc))
	+ (summary loc loc'))\<rparr>)"
	+
	+abbreviation next_propagate :: "('loc, 't :: order) configuration \<Rightarrow> ('loc, 't) configuration \<Rightarrow> bool" where
	+ "next_propagate c0 c1 \<equiv> \<exists>loc t. next_propagate' c0 c1 loc t"
	+
	+definition "next'" where
	+ "next' c0 c1 = (next_propagate c0 c1 \<or> next_change_multiplicity c0 c1 \<or> c1 = c0)"
	+
	+abbreviation "next" where
	+ "next s \<equiv> next' (shd s) (shd (stl s))"
	+
	+abbreviation cm_valid where
	+ "cm_valid \<equiv> nxt (\<lambda>s. next_change_multiplicity (shd s) (shd (stl s))) impl
	+ (\<lambda>s. next_change_multiplicity (shd s) (shd (stl s))) or nxt (holds (\<lambda>c. (\<forall>l. c_work c l = {#}\<^sub>z)))"
	+
	+definition spec :: "('loc, 't :: order) computation \<Rightarrow> bool" where
	+ "spec \<equiv> holds init_config aand alw next"
	+
	+lemma next'_inv[consumes 1, case_names next_change_multiplicity next_propagate next_finish_init]:
	+ assumes "next' c0 c1" "P c0"
	+ and "\<And>loc t n. P c0 \<Longrightarrow> next_change_multiplicity' c0 c1 loc t n \<Longrightarrow> P c1"
	+ and "\<And>loc t. P c0 \<Longrightarrow> next_propagate' c0 c1 loc t \<Longrightarrow> P c1"
	+ shows "P c1"
	+ using assms unfolding next'_def by auto
	+
	+subsection\<open>Auxiliary\<close>
	+
	+lemma next_change_multiplicity'_unique:
	+ assumes "n \<noteq> 0"
	+ and "\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc) \<and> t' \<le> t"
	+ shows "\<exists>!c'. next_change_multiplicity' c c' loc t n"
	+proof -
	+ let ?pointstamps' = "(c_pts c)(loc := update_zmultiset (c_pts c loc) t n)"
	+ let ?worklist' = "\<lambda>loc'. c_work c loc' + frontier_changes (?pointstamps' loc') (c_pts c loc')"
	+ let ?c' = "c\<lparr>c_pts := ?pointstamps', c_work := ?worklist'\<rparr>"
	+ from assms have "next_change_multiplicity' c ?c' loc t n"
	+ by (auto simp: next_change_multiplicity'_def intro!: configuration.equality)
	+ then show ?thesis
	+ by (rule ex1I[of _ ?c'])
	+ (auto simp: next_change_multiplicity'_def intro!: configuration.equality)
	+qed
	+
	+lemma frontier_change_zmset_frontier:
	+ assumes "t \<in>\<^sub>A frontier M1 - frontier M0"
	+ shows "zcount (zmset_frontier M1) t = 1 \<and> zcount (zmset_frontier M0) t = 0"
	+ using assms by (clarsimp simp: ac_Diff_iff) (simp add: member_antichain.rep_eq)
	+
	+lemma frontier_empty[simp]: "frontier {#}\<^sub>z = {}\<^sub>A"
	+ by transfer' simp
	+
	+lemma zmset_frontier_empty[simp]: "zmset_frontier {#}\<^sub>z = {#}\<^sub>z"
	+ by simp
	+
	+lemma after_summary_empty[simp]: "after_summary {#}\<^sub>z S = {#}\<^sub>z"
	+ by (simp add: after_summary_def)
	+
	+lemma after_summary_empty_summary[simp]: "after_summary M {}\<^sub>A = {#}\<^sub>z"
	+ by (simp add: after_summary_def)
	+
	+lemma mem_frontier_diff:
	+ assumes "t \<in>\<^sub>A frontier M - frontier N"
	+ shows "zcount (frontier_changes M N) t = 1"
	+proof -
	+ note assms
	+ then have t: "t \<in>\<^sub>A frontier M" "t \<notin>\<^sub>A frontier N"
	+ using ac_Diff_iff by blast+
	+ from t(1) have "zcount (zmset_frontier M) t = 1"
	+ by (simp add: member_antichain.rep_eq)
	+ moreover from t(2) have "zcount (zmset_frontier N) t = 0"
	+ by (simp add: member_antichain.rep_eq)
	+ ultimately show "zcount (frontier_changes M N) t = 1"
	+ by simp
	+qed
	+
	+lemma mem_frontier_diff':
	+ assumes "t \<in>\<^sub>A frontier N - frontier M"
	+ shows "zcount (frontier_changes M N) t = -1"
	+proof -
	+ note assms
	+ then have t: "t \<in>\<^sub>A frontier N" "t \<notin>\<^sub>A frontier M"
	+ using ac_Diff_iff by blast+
	+ from t(2) have "zcount (zmset_frontier M) t = 0"
	+ by (simp add: member_antichain.rep_eq)
	+ moreover from t(1) have "zcount (zmset_frontier N) t = 1"
	+ by (simp add: member_antichain.rep_eq)
	+ ultimately show "zcount (frontier_changes M N) t = -1"
	+ by simp
	+qed
	+
	+lemma not_mem_frontier_diff:
	+ assumes "t \<notin>\<^sub>A frontier M - frontier N"
	+ and "t \<notin>\<^sub>A frontier N - frontier M"
	+ shows "zcount (frontier_changes M N) t = 0"
	+proof -
	+ { assume M: "t \<in>\<^sub>A frontier M"
	+ with assms have N: "t \<in>\<^sub>A frontier N"
	+ by (auto dest: ac_notin_Diff)
	+ from M N have "zcount (zmset_frontier M) t = 1" "zcount (zmset_frontier N) t = 1"
	+ by (simp_all add: member_antichain.rep_eq)
	+ then have "zcount (frontier_changes M N) t = 0"
	+ by simp
	+ }
	+ moreover
	+ { assume M: "t \<notin>\<^sub>A frontier M"
	+ with assms have N: "t \<notin>\<^sub>A frontier N"
	+ by (auto dest: ac_notin_Diff)
	+ from M N have "zcount (zmset_frontier M) t = 0" "zcount (zmset_frontier N) t = 0"
	+ by (simp_all add: member_antichain.rep_eq)
	+ then have "zcount (frontier_changes M N) t = 0"
	+ by simp
	+ }
	+ ultimately show "zcount (frontier_changes M N) t = 0"
	+ by blast
	+qed
	+
	+lemma mset_neg_after_summary: "mset_neg M = {#} \<Longrightarrow> mset_neg (after_summary M S) = {#}"
	+ by (auto intro: mset_neg_image_zmset mset_neg_sum_set simp: after_summary_def)
	+
	+\<comment> \<open>Changes in loc's frontier are reflected in the worklist of loc'.\<close>
	+lemma next_p_frontier_change:
	+ assumes "next_propagate' c0 c1 loc t"
	+ and "summary loc loc' \<noteq> {}\<^sub>A"
	+ shows "c_work c1 loc' =
	+ c_work c0 loc'
	+ + after_summary
	+ (frontier_changes (c_imp c1 loc) (c_imp c0 loc))
	+ (summary loc loc')"
	+ using assms by (auto simp: summary_self next_propagate'_def intro!: configuration.equality)
	+
	+lemma after_summary_union: "after_summary (M + N) S = after_summary M S + after_summary N S"
	+ by (simp add: sum.distrib after_summary_def)
	+
	+
	+subsection\<open>Invariants\<close>
	+
	+subsubsection\<open>Invariant: @{term inv_imps_work_sum}\<close>
	+
	+\<comment> \<open>Get timestamps in frontiers of loc's predecessor locations, apply respective summaries and
	+ return union of results.\<close>
	+abbreviation union_frontiers :: "('loc, 't) configuration \<Rightarrow> 'loc \<Rightarrow> 't zmultiset" where
	+ "union_frontiers c loc \<equiv>
	+ (\<Sum>loc'\<in>UNIV. after_summary (zmset_frontier (c_imp c loc')) (summary loc' loc))"
	+
	+\<comment> \<open>Implications + worklist is equal to the frontiers of pointstamps and all preceding nodes
	+ (after accounting for summaries).\<close>
	+definition inv_imps_work_sum :: "('loc, 't) configuration \<Rightarrow> bool" where
	+ "inv_imps_work_sum c \<equiv>
	+ \<forall>loc. c_imp c loc + c_work c loc
	+ = zmset_frontier (c_pts c loc) + union_frontiers c loc"
	+
	+\<comment> \<open>Version with zcount is easier to reason with\<close>
	+definition inv_imps_work_sum_zcount :: "('loc, 't) configuration \<Rightarrow> bool" where
	+ "inv_imps_work_sum_zcount c \<equiv>
	+ \<forall>loc t. zcount (c_imp c loc + c_work c loc) t
	+ = zcount (zmset_frontier (c_pts c loc) + union_frontiers c loc) t"
	+
	+lemma inv_imps_work_sum_zcount: "inv_imps_work_sum c \<longleftrightarrow> inv_imps_work_sum_zcount c"
	+ unfolding inv_imps_work_sum_zcount_def inv_imps_work_sum_def
	+ by (simp add: zmultiset_eq_iff)
	+
	+
	+lemma union_frontiers_nonneg: "0 \<le> zcount (union_frontiers c loc) t"
	+ apply (subst zcount_sum)
	+ apply (rule sum_nonneg)
	+ apply simp
	+ apply (rule mset_neg_zcount_nonneg)
	+ apply (rule mset_neg_after_summary)
	+ apply simp
	+ done
	+
	+lemma next_p_union_frontier_change:
	+ assumes "next_propagate' c0 c1 loc t"
	+ and "summary loc loc' \<noteq> {}\<^sub>A"
	+ shows "union_frontiers c1 loc' =
	+ union_frontiers c0 loc'
	+ + after_summary
	+ (frontier_changes (c_imp c1 loc) (c_imp c0 loc))
	+ (summary loc loc')"
	+ using assms
	+ apply (subst zmultiset_eq_iff)
	+ apply (rule allI)
	+ subgoal for x
	+ apply (simp del: zcount_of_mset image_zmset_Diff)
	+ apply (subst (1 2) zcount_sum)
	+ apply (rule Sum_eq_pick_changed_elem[of UNIV loc])
	+ apply simp
	+ apply simp
	+ subgoal
	+ apply (subst zcount_union[symmetric])
	+ apply (subst after_summary_union[symmetric])
	+ apply simp
	+ done
	+ apply (auto simp: next_propagate'_def)
	+ done
	+ done
	+
	+\<comment> \<open>@{term init_config} satisfies @{term inv_imps_work_sum}\<close>
	+lemma init_imp_inv_imps_work_sum: "init_config c \<Longrightarrow> inv_imps_work_sum c"
	+ by (simp add: inv_imps_work_sum_def init_config_def)
	+
	+\<comment> \<open>CM preserves @{term inv_imps_work_sum}\<close>
	+lemma cm_preserves_inv_imps_work_sum:
	+ assumes "next_change_multiplicity' c0 c1 loc t n"
	+ and "inv_imps_work_sum c0"
	+ shows "inv_imps_work_sum c1"
	+proof -
	+ \<comment> \<open>Given CM at loc, t, we show result for loc', t'\<close>
	+ { fix loc t loc' t' n
	+ assume cm': "next_change_multiplicity' c0 c1 loc t n"
	+ note cm = this[unfolded next_change_multiplicity'_def]
	+ from cm have unchanged_imps: "unchanged c_imp c0 c1"
	+ by simp
	+ assume "inv_imps_work_sum c0"
	+ then have iiws': "inv_imps_work_sum_zcount c0"
	+ by (simp add: inv_imps_work_sum_zcount)
	+ note iiws = iiws'[unfolded inv_imps_work_sum_zcount_def, THEN spec2]
	+ have unchanged_union: "union_frontiers c1 locX = union_frontiers c0 locX" for locX
	+ using unchanged_imps by (auto intro: sum.cong)
	+ \<comment> \<open>For locations other than loc nothing changes.\<close>
	+ { assume loc: "loc' \<noteq> loc"
	+ note iiws = iiws'[unfolded inv_imps_work_sum_zcount_def, THEN spec2, of loc' t']
	+ from loc cm have unchanged_worklist:
	+ "zcount (c_work c1 loc') t' = zcount (c_work c0 loc') t'"
	+ by simp
	+ from loc cm have unchanged_frontier:
	+ "zcount (zmset_frontier (c_pts c1 loc')) t'
	+ = zcount (zmset_frontier (c_pts c0 loc')) t'"
	+ by simp
	+ with loc have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc')
	+ + union_frontiers c1 loc') t'"
	+ apply (subst (1 2) zcount_union)
	+ unfolding
	+ unchanged_imps
	+ unchanged_union
	+ unchanged_frontier
	+ unchanged_worklist
	+ apply (subst (1 2) zcount_union[symmetric])
	+ apply (rule iiws)
	+ done
	+ }
	+ moreover
	+ \<comment> \<open>For pointstamps at location loc we make a case distinction on whether their "status" in
	+ the frontier has changed.\<close>
	+ { assume loc: "loc' = loc"
	+ note iiws = iiws'[unfolded inv_imps_work_sum_zcount_def, simplified, THEN spec, of loc, simplified]
	+ \<comment> \<open>If t appeared in the frontier\<close>
	+ { assume t': "t' \<in>\<^sub>A frontier (c_pts c1 loc) - frontier (c_pts c0 loc)"
	+ note t'[THEN mem_frontier_diff]
	+ \<comment> \<open>then the worklist at t increased by 1\<close>
	+ then have "zcount (c_work c1 loc) t' = zcount (c_work c0 loc) t' + 1"
	+ using cm by auto
	+ \<comment> \<open>and the frontier at t increased by 1\<close>
	+ moreover
	+ have "zcount (zmset_frontier (c_pts c1 loc)) t'
	+ = zcount (zmset_frontier (c_pts c0 loc)) t' + 1"
	+ using t'[THEN frontier_change_zmset_frontier] by simp
	+ \<comment> \<open>and the sum didn't change\<close>
	+ moreover note unchanged_union
	+ \<comment> \<open>hence, the invariant is preserved.\<close>
	+ ultimately have
	+ "zcount (c_imp c1 loc + c_work c1 loc) t'
	+ = zcount (zmset_frontier (c_pts c1 loc)
	+ + union_frontiers c1 loc) t'"
	+ using iiws unchanged_imps by simp
	+ }
	+ moreover
	+ \<comment> \<open>If t disappeared from the frontier\<close>
	+ { assume t': "t' \<in>\<^sub>A frontier (c_pts c0 loc) - frontier (c_pts c1 loc)"
	+ note t'[THEN mem_frontier_diff']
	+ \<comment> \<open>then the worklist at t decreased by 1\<close>
	+ then have "zcount (c_work c1 loc) t' = zcount (c_work c0 loc) t' - 1"
	+ using cm by (auto simp: ac_Diff_iff)
	+ \<comment> \<open>and the frontier at t decreased by 1\<close>
	+ moreover
	+ have "zcount (zmset_frontier (c_pts c1 loc)) t'
	+ = zcount (zmset_frontier (c_pts c0 loc)) t' - 1"
	+ using t'[THEN frontier_change_zmset_frontier] by simp
	+ \<comment> \<open>and the sum didn't change\<close>
	+ moreover note unchanged_union
	+ \<comment> \<open>hence, the invariant is preserved.\<close>
	+ ultimately have
	+ "zcount (c_imp c1 loc + c_work c1 loc) t'
	+ = zcount (zmset_frontier (c_pts c1 loc)
	+ + union_frontiers c1 loc) t'"
	+ using iiws unchanged_imps by simp
	+ }
	+ moreover
	+ \<comment> \<open>If t's multiplicity in the frontier didn't change\<close>
	+ { assume a1: "\<not> t' \<in>\<^sub>A frontier (c_pts c1 loc) - frontier (c_pts c0 loc)"
	+ assume a2: "\<not> t' \<in>\<^sub>A frontier (c_pts c0 loc) - frontier (c_pts c1 loc)"
	+ from a1 a2 have "zcount (frontier_changes (c_pts c1 loc) (c_pts c0 loc)) t' = 0"
	+ by (intro not_mem_frontier_diff)
	+ \<comment> \<open>then the worklist at t didn't change\<close>
	+ with cm have "zcount (c_work c1 loc) t' = zcount (c_work c0 loc) t'"
	+ by (auto simp: ac_Diff_iff)
	+ \<comment> \<open>and the frontier at t didn't change\<close>
	+ moreover
	+ have "zcount (zmset_frontier (c_pts c1 loc)) t'
	+ = zcount (zmset_frontier (c_pts c0 loc)) t'"
	+ using a1 a2
	+ apply (clarsimp simp: member_antichain.rep_eq dest!: ac_notin_Diff)
	+ apply (metis ac_Diff_iff count_mset_set(1) count_mset_set(3) finite_set_antichain member_antichain.rep_eq)
	+ done
	+ \<comment> \<open>and the sum didn't change\<close>
	+ moreover note unchanged_union
	+ \<comment> \<open>hence, the invariant is preserved.\<close>
	+ ultimately have
	+ "zcount (c_imp c1 loc + c_work c1 loc) t'
	+ = zcount (zmset_frontier (c_pts c1 loc)
	+ + union_frontiers c1 loc) t'"
	+ using iiws unchanged_imps by simp
	+ }
	+ ultimately have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc')
	+ + union_frontiers c1 loc') t'"
	+ using loc by auto
	+ }
	+ ultimately have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc')
	+ + union_frontiers c1 loc') t'"
	+ by auto
	+ }
	+ with assms show ?thesis
	+ by (auto simp: Let_def inv_imps_work_sum_zcount inv_imps_work_sum_zcount_def)
	+qed
	+
	+\<comment> \<open>PR preserves @{term inv_imps_work_sum}\<close>
	+lemma p_preserves_inv_imps_work_sum:
	+ assumes "next_propagate' c0 c1 loc t"
	+ and "inv_imps_work_sum c0"
	+ shows "inv_imps_work_sum c1"
	+proof -
	+ \<comment> \<open>Given @{term next_propagate'} for loc, t, we show the result for loc', t'.\<close>
	+ { fix loc t loc' t'
	+ assume p': "next_propagate' c0 c1 loc t"
	+ note p = this[unfolded next_propagate'_def]
	+ from p have unchanged_ps: "unchanged c_pts c0 c1"
	+ by simp
	+ assume "inv_imps_work_sum c0"
	+ then have iiws': "inv_imps_work_sum_zcount c0"
	+ by (simp add: inv_imps_work_sum_zcount)
	+ note iiws = iiws'[unfolded inv_imps_work_sum_zcount_def, THEN spec2]
	+ { assume loc: "loc=loc'"
	+ note iiws
	+ moreover note unchanged_ps
	+ \<comment> \<open>The t entries in loc's worklist are shifted to the implications.\<close>
	+ moreover from p have "zcount (c_work c1 loc) t = 0"
	+ by simp
	+ moreover from p have
	+ "zcount (c_imp c1 loc) t
	+ = zcount (c_imp c0 loc) t + zcount (c_work c0 loc) t"
	+ by simp
	+ \<comment> \<open>Since the implications of other locations don't change and loc can't have an edge to
	+ itself, @{term union_frontiers} at loc doesn't change.\<close>
	+ moreover from p have "union_frontiers c1 loc = union_frontiers c0 loc"
	+ using summary_self by (auto intro!: sum.cong arg_cong[where f = Sum])
	+ \<comment> \<open>For all the other timestamps the worklist and implications don't change.\<close>
	+ moreover from p have
	+ "tX \<noteq> t \<Longrightarrow> zcount (c_work c1 loc) tX = zcount (c_work c0 loc) tX" for tX
	+ by simp
	+ moreover from p have
	+ "tX \<noteq> t \<Longrightarrow> zcount (c_imp c1 loc) tX = zcount (c_imp c0 loc) tX" for tX
	+ by simp
	+ ultimately have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc') + union_frontiers c1 loc') t'"
	+ unfolding loc
	+ by (cases "t=t'") simp_all
	+ }
	+ moreover
	+ { assume loc: "loc\<noteq>loc'"
	+ \<comment> \<open>The implications are unchanged at all locations other than loc.\<close>
	+ from p loc have unchanged_imps: "c_imp c1 loc' = c_imp c0 loc'"
	+ by simp
	+ { assume sum: "summary loc loc' = {}\<^sub>A"
	+ note iiws
	+ moreover note unchanged_ps
	+ moreover note unchanged_imps
	+ \<comment> \<open>The worklist only changes if loc, loc' are connected.\<close>
	+ moreover from p loc sum have "c_work c1 loc' = c_work c0 loc'"
	+ by simp
	+ \<comment> \<open>Since the implications only change at loc and loc is not connected to loc',
	+ @{term union_frontiers} doesn't change.\<close>
	+ moreover from p loc sum have "union_frontiers c1 loc' = union_frontiers c0 loc'"
	+ by (auto intro!: sum.cong arg_cong[where f = Sum])
	+ ultimately have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc') + union_frontiers c1 loc') t'"
	+ by simp
	+ }
	+ moreover
	+ { assume sum: "summary loc loc' \<noteq> {}\<^sub>A"
	+ \<comment> \<open>@{term union_frontiers} at loc' changed by whatever amount the frontier changed.\<close>
	+ note iiws
	+ unchanged_imps
	+ unchanged_ps
	+ moreover from p' sum have
	+ "union_frontiers c1 loc' =
	+ union_frontiers c0 loc'
	+ + after_summary
	+ (zmset_frontier (c_imp c1 loc) - zmset_frontier (c_imp c0 loc))
	+ (summary loc loc')"
	+ by (auto intro!: next_p_union_frontier_change)
	+ \<comment> \<open>The worklist at loc' changed by the same amount\<close>
	+ moreover from p' sum have
	+ "c_work c1 loc' =
	+ c_work c0 loc'
	+ + after_summary
	+ (zmset_frontier (c_imp c1 loc) - zmset_frontier (c_imp c0 loc))
	+ (summary loc loc')"
	+ by (auto intro!: next_p_frontier_change)
	+ \<comment> \<open>The two changes cancel out.\<close>
	+ ultimately have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc') + union_frontiers c1 loc') t'"
	+ by simp
	+ }
	+ ultimately have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc') + union_frontiers c1 loc') t'"
	+ by auto
	+ }
	+ ultimately have
	+ "zcount (c_imp c1 loc' + c_work c1 loc') t'
	+ = zcount (zmset_frontier (c_pts c1 loc') + union_frontiers c1 loc') t'"
	+ by (cases "loc=loc'") auto
	+ }
	+ with assms show ?thesis
	+ by (auto simp: next_propagate'_def Let_def inv_imps_work_sum_zcount inv_imps_work_sum_zcount_def)
	+qed
	+
	+lemma next_preserves_inv_imps_work_sum:
	+ assumes "next s"
	+ and "holds inv_imps_work_sum s"
	+ shows "nxt (holds inv_imps_work_sum) s"
	+ using assms
	+ cm_preserves_inv_imps_work_sum
	+ p_preserves_inv_imps_work_sum
	+ by (simp, cases rule: next'_inv)
	+
	+lemma spec_imp_iiws: "spec s \<Longrightarrow> alw (holds inv_imps_work_sum) s"
	+ using init_imp_inv_imps_work_sum next_preserves_inv_imps_work_sum
	+ by (auto intro: alw_invar simp: alw_mono spec_def)
	+
	+subsubsection\<open>Invariant: @{term inv_imp_plus_work_nonneg}\<close>
	+
	+text \<open>There is never an update in the worklist that could cause implications to become negative.\<close>
	+definition inv_imp_plus_work_nonneg where
	+ "inv_imp_plus_work_nonneg c \<equiv> \<forall>loc t. 0 \<le> zcount (c_imp c loc) t + zcount (c_work c loc) t"
	+
	+lemma iiws_imp_iipwn:
	+ assumes "inv_imps_work_sum c"
	+ shows "inv_imp_plus_work_nonneg c"
	+proof -
	+ {
	+ fix loc
	+ fix t
	+ assume "inv_imps_work_sum c"
	+ then have iiws': "inv_imps_work_sum_zcount c"
	+ by (simp add: inv_imps_work_sum_zcount)
	+ note iiws = iiws'[unfolded inv_imps_work_sum_zcount_def, THEN spec2]
	+ have "0 \<le> zcount (union_frontiers c loc) t"
	+ by (simp add: union_frontiers_nonneg)
	+ with iiws have "0 \<le> zcount (c_imp c loc + c_work c loc) t"
	+ by simp
	+ }
	+ with assms show ?thesis
	+ by (simp add: inv_imp_plus_work_nonneg_def)
	+qed
	+
	+lemma spec_imp_iipwn: "spec s \<Longrightarrow> alw (holds inv_imp_plus_work_nonneg) s"
	+ using spec_imp_iiws iiws_imp_iipwn
	+ alw_mono holds_mono
	+ by blast
	+
	+
	+subsubsection\<open>Invariant: @{term inv_implications_nonneg}\<close>
	+
	+lemma init_imp_inv_implications_nonneg:
	+ assumes "init_config c"
	+ shows "inv_implications_nonneg c"
	+ using assms by (simp add: init_config_def inv_implications_nonneg_def)
	+
	+lemma cm_preserves_inv_implications_nonneg:
	+ assumes "next_change_multiplicity' c0 c1 loc t n"
	+ and "inv_implications_nonneg c0"
	+ shows "inv_implications_nonneg c1"
	+ using assms by (simp add: next_change_multiplicity'_def inv_implications_nonneg_def)
	+
	+lemma p_preserves_inv_implications_nonneg:
	+ assumes "next_propagate' c0 c1 loc t"
	+ and "inv_implications_nonneg c0"
	+ and "inv_imp_plus_work_nonneg c0"
	+ shows "inv_implications_nonneg c1"
	+ using assms
	+ by (auto simp: next_propagate'_def Let_def inv_implications_nonneg_def inv_imp_plus_work_nonneg_def)
	+
	+lemma next_preserves_inv_implications_nonneg:
	+ assumes "next s"
	+ and "holds inv_implications_nonneg s"
	+ and "holds inv_imp_plus_work_nonneg s"
	+ shows "nxt (holds inv_implications_nonneg) s"
	+ using assms
	+ cm_preserves_inv_implications_nonneg
	+ p_preserves_inv_implications_nonneg
	+ by (simp, cases rule: next'_inv)
	+
	+lemma alw_inv_implications_nonneg: "spec s \<Longrightarrow> alw (holds inv_implications_nonneg) s"
	+ apply (frule spec_imp_iipwn)
	+ unfolding spec_def
	+ apply (rule alw_invar)
	+ using init_imp_inv_implications_nonneg apply auto []
	+ using next_preserves_inv_implications_nonneg
	+ apply (metis (no_types, lifting) alw_iff_sdrop)
	+ done
	+
	+lemma after_summary_Diff: "after_summary (M - N) S = after_summary M S - after_summary N S"
	+ by (simp add: sum_subtractf after_summary_def)
	+
	+lemma mem_zmset_frontier: "x \<in>#\<^sub>z zmset_frontier M \<longleftrightarrow> x \<in>\<^sub>A frontier M"
	+ by transfer simp
	+
	+lemma obtain_frontier_elem:
	+ assumes "0 < zcount M t"
	+ obtains u where "u \<in>\<^sub>A frontier M" "u \<le> t"
	+ using assms by (atomize_elim, transfer)
	+ (auto simp: minimal_antichain_def dest: order_zmset_exists_foundation)
	+
	+lemma frontier_unionD: "t \<in>\<^sub>A frontier (M+N) \<Longrightarrow> 0 < zcount M t \<or> 0 < zcount N t"
	+ by transfer' (auto simp: minimal_antichain_def)
	+
	+lemma ps_frontier_in_imps_wl:
	+ assumes "inv_imps_work_sum c"
	+ and "0 < zcount (zmset_frontier (c_pts c loc)) t"
	+ shows "0 < zcount (c_imp c loc + c_work c loc) t"
	+proof -
	+ have "0 \<le> zcount (union_frontiers c loc) t"
	+ by (rule union_frontiers_nonneg)
	+ with assms(2) show ?thesis
	+ using assms(1)[unfolded inv_imps_work_sum_def, THEN spec, of loc]
	+ by fastforce
	+qed
	+
	+lemma obtain_elem_frontier:
	+ assumes "0 < zcount M t"
	+ obtains s where "s \<le> t \<and> s \<in>\<^sub>A frontier M"
	+ by (rule order_finite_set_obtain_foundation[of "{s. zcount M s > 0}" t thesis])
	+ (auto simp: assms antichain_inverse frontier_def member_antichain.rep_eq
	+ in_minimal_antichain)
	+
	+lemma obtain_elem_zmset_frontier:
	+ assumes "0 < zcount M t"
	+ obtains s where "s \<le> t \<and> 0 < zcount (zmset_frontier M) s"
	+ using assms by (auto simp: member_antichain.rep_eq intro: obtain_elem_frontier)
	+
	+lemma ps_in_imps_wl:
	+ assumes "inv_imps_work_sum c"
	+ and "0 < zcount (c_pts c loc) t"
	+ obtains s where "s \<le> t \<and> 0 < zcount (c_imp c loc + c_work c loc) s"
	+proof atomize_elim
	+ note iiws = assms(1)[unfolded inv_imps_work_sum_def, THEN spec, of loc]
	+ obtain u where u: " u \<le> t \<and> u \<in>\<^sub>A frontier (c_pts c loc)"
	+ using assms(2) obtain_elem_frontier by blast
	+ with assms(1) have "0 < zcount (c_imp c loc + c_work c loc) u"
	+ apply (intro ps_frontier_in_imps_wl[of c loc u])
	+ apply (auto intro: iffD1[OF member_antichain.rep_eq])
	+ done
	+ with u show "\<exists>s\<le>t. 0 < zcount (c_imp c loc + c_work c loc) s"
	+ by (auto intro: exI[of _ u])
	+qed
	+
	+lemma zero_le_after_summary_single[simp]: "0 \<le> zcount (after_summary {#t#}\<^sub>z S) x"
	+ by (auto intro: zero_le_sum_single simp: after_summary_def)
	+
	+lemma one_le_zcount_after_summary: "s \<in>\<^sub>A S \<Longrightarrow> 1 \<le> zcount (after_summary {#t#}\<^sub>z S) (results_in t s)"
	+ unfolding image_zmset_single after_summary_def
	+ apply (subst zcount_sum)
	+ apply (subst forw_subst[of 1 "zcount {#results_in t s#}\<^sub>z (results_in t s)"])
	+ apply simp
	+ apply (rule sum_nonneg_leq_bound[of "set_antichain S" "\<lambda>u. zcount {#results_in t u#}\<^sub>z (results_in t s)" _ s])
	+ apply (auto simp: member_antichain.rep_eq)
	+ done
	+
	+lemma zero_lt_zcount_after_summary: "s \<in>\<^sub>A S \<Longrightarrow> 0 < zcount (after_summary {#t#}\<^sub>z S) (results_in t s)"
	+ apply (subst int_one_le_iff_zero_less[symmetric])
	+ apply (intro one_le_zcount_after_summary)
	+ apply simp
	+ done
	+
	+lemma pos_zcount_after_summary:
	+ "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 < zcount M t \<Longrightarrow> s \<in>\<^sub>A S \<Longrightarrow> 0 < zcount (after_summary M S) (results_in t s)"
	+ by (auto intro!: sum_pos2 pos_zcount_image_zmset simp: member_antichain.rep_eq zcount_sum after_summary_def)
	+
	+lemma after_summary_nonneg: "(\<And>t. 0 \<le> zcount M t) \<Longrightarrow> 0 \<le> zcount (after_summary M S) t"
	+ by (auto simp: zcount_sum after_summary_def intro: sum_nonneg)
	+
	+lemma after_summary_zmset_of_nonneg[simp, intro]: "0 \<le> zcount (after_summary (zmset_of M) S) t"
	+ by (simp add: mset_neg_image_zmset mset_neg_sum_set mset_neg_zcount_nonneg after_summary_def)
	+
	+lemma pos_zcount_union_frontiers:
	+ "zcount (after_summary (zmset_frontier (c_imp c l1)) (summary l1 l2)) (results_in t s)
	+ \<le> zcount (union_frontiers c l2) (results_in t s)"
	+ apply (subst zcount_sum)
	+ apply (rule member_le_sum)
	+ apply (auto intro!: pos_zcount_image_zmset)
	+ done
	+
	+lemma after_summary_Sum_fun: "finite MM \<Longrightarrow> after_summary (\<Sum>M\<in>MM. f M) A = (\<Sum>M\<in>MM. after_summary (f M) A)"
	+ by (induct MM rule: finite_induct) (auto simp: after_summary_union)
	+
	+lemma after_summary_obtain_pre:
	+ assumes "\<And>t. 0 \<le> zcount M t" (* could prove without this assumption *)
	+ and "0 < zcount (after_summary M S) t"
	+ obtains t' s where "0 < zcount M t'" "results_in t' s = t" "s \<in>\<^sub>A S"
	+ using assms unfolding after_summary_def
	+ apply atomize_elim
	+ apply (subst (asm) zcount_sum)
	+ apply (drule sum_pos_ex_elem_pos)
	+ apply clarify
	+ subgoal for s
	+ apply (subst ex_comm)
	+ apply (rule exI[of _ s])
	+ apply (drule pos_image_zmset_obtain_pre[rotated])
	+ apply simp
	+ apply (simp add: member_antichain.rep_eq)
	+ done
	+ done
	+
	+lemma empty_antichain[dest]: "x \<in>\<^sub>A antichain {} \<Longrightarrow> False"
	+ by (metis empty_antichain.abs_eq mem_antichain_nonempty)
	+
	+definition impWitnessPath where
	+ "impWitnessPath c loc1 loc2 xs t = (
	+ path loc1 loc2 xs \<and>
	+ distinct xs \<and>
	+ (\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc1) \<and> t = results_in t' (sum_path_weights xs) \<and>
	+ (\<forall>k<length xs. (\<exists>t. t \<in>\<^sub>A frontier (c_imp c (TO (xs ! k))) \<and> t = results_in t' (sum_path_weights (take (k+1) xs))))))"
	+
	+lemma impWitnessPathEx:
	+ assumes "t \<in>\<^sub>A frontier (c_imp c loc2)"
	+ shows "(\<exists>loc1 xs. impWitnessPath c loc1 loc2 xs t)"
	+proof -
	+ have 1: "path loc2 loc2 []" by (simp add: path0)
	+ have 2: "distinct []" by auto
	+ have "0 = sum_path_weights []" using foldr_Nil list.map(1) by auto
	+ then have 3: "t = results_in t (sum_path_weights [])" by (simp add: results_in_zero)
	+ with 1 2 assms show ?thesis
	+ unfolding impWitnessPath_def
	+ by (force simp: results_in_zero)
	+qed
	+
	+definition longestImpWitnessPath where
	+ "longestImpWitnessPath c loc1 loc2 xs t = (
	+ impWitnessPath c loc1 loc2 xs t \<and>
	+ (\<forall>loc' xs'. impWitnessPath c loc' loc2 xs' t \<longrightarrow> length (xs') \<le> length (xs)))"
	+
	+lemma finite_edges: "finite {(loc1,s,loc2). s \<in>\<^sub>A summary loc1 loc2}"
	+proof -
	+ let ?sums = "(\<Union> ((\<lambda>(loc1,loc2). set_antichain (summary loc1 loc2)) ` UNIV))"
	+ have "finite ?sums"
	+ by auto
	+ then have "finite ((UNIV::'loc set) \<times> ?sums \<times> (UNIV::'loc set))"
	+ by auto
	+ moreover have "{(loc1,s,loc2). s \<in>\<^sub>A summary loc1 loc2} \<subseteq> ((UNIV::'loc set) \<times> ?sums \<times> (UNIV::'loc set))"
	+ by (force simp: member_antichain.rep_eq)
	+ ultimately show ?thesis
	+ by (rule rev_finite_subset)
	+qed
	+
	+lemma longestImpWitnessPathEx:
	+ assumes "t \<in>\<^sub>A frontier (c_imp c loc2)"
	+ shows "(\<exists>loc1 xs. longestImpWitnessPath c loc1 loc2 xs t)"
	+proof -
	+ define paths where "paths = {(loc1, xs). impWitnessPath c loc1 loc2 xs t}"
	+ with impWitnessPathEx[OF assms] obtain p where "p \<in> paths" by auto
	+ have "\<forall>p. p \<in> paths \<longrightarrow> (length \<circ> snd) p < card {(loc1,s,loc2). s \<in>\<^sub>A summary loc1 loc2} + 1"
	+ proof (intro allI impI)
	+ fix p
	+ assume p: "p \<in> paths"
	+ then show "(length \<circ> snd) p < card {(loc1,s,loc2). s \<in>\<^sub>A summary loc1 loc2} + 1"
	+ by (auto simp: paths_def impWitnessPath_def less_Suc_eq_le finite_edges path_edge
	+ dest!: distinct_card[symmetric] intro!: card_mono)
	+ qed
	+ from ex_has_greatest_nat[OF \<open>p \<in> paths\<close> this] show ?thesis
	+ by (auto simp: paths_def longestImpWitnessPath_def)
	+qed
	+
	+lemma path_first_loc: "path l1 l2 xs \<Longrightarrow> xs \<noteq> [] \<Longrightarrow> xs ! 0 = (l1',s,l2') \<Longrightarrow> l1 = l1'"
	+proof (induct arbitrary: l1' s l2 rule: path.induct)
	+ case (path0 l1 l2)
	+ then show ?case by auto
	+next
	+ case (path l1 l2 xs lbl l3)
	+ then show ?case
	+ apply (cases "xs=[]")
	+ apply (auto elim: path0E) []
	+ apply (rule path(2)[of l1' s])
	+ by (auto simp: nth_append)
	+qed
	+
	+lemma find_witness_from_frontier:
	+ assumes "t \<in>\<^sub>A frontier (c_imp c loc2)"
	+ and "inv_imps_work_sum c"
	+ shows "\<exists>t' loc1 xs. (path loc1 loc2 xs \<and> t = results_in t' (sum_path_weights xs) \<and>
	+ (t' \<in>\<^sub>A frontier (c_pts c loc1) \<or> 0 > zcount (c_work c loc1) t'))"
	+proof -
	+ obtain loc1 xs where longestP: "longestImpWitnessPath c loc1 loc2 xs t"
	+ using assms(1) longestImpWitnessPathEx by blast
	+ then obtain t' where t': "t' \<in>\<^sub>A frontier (c_imp c loc1)" "t = results_in t' (sum_path_weights xs)"
	+ "(\<forall>k<length xs. (\<exists>t. t \<in>\<^sub>A frontier (c_imp c (TO (xs ! k))) \<and> t = results_in t' (sum_path_weights (take (k+1) xs))))"
	+ by (auto simp add: longestImpWitnessPath_def impWitnessPath_def)
	+ from t'(1) have cases: "0 > zcount (c_work c loc1) t' \<or>
	+ (t' \<in>#\<^sub>z (zmset_frontier (c_pts c loc1) + union_frontiers c loc1))"
	+ using assms(2)
	+ apply (clarsimp intro!: verit_forall_inst(6) simp: inv_imps_work_sum_def not_less)
	+ apply (metis add_pos_nonneg mem_zmset_frontier member_frontier_pos_zmset obtain_frontier_elem zcount_empty zcount_ne_zero_iff zcount_union zmset_frontier_empty)
	+ done
	+ then show ?thesis
	+ proof cases
	+ assume case1: "0 > zcount (c_work c loc1) t'"
	+ then show ?thesis using t' longestP
	+ using impWitnessPath_def longestImpWitnessPath_def dataflow_topology_axioms by blast
	+ next
	+ assume case2: "\<not>0 > zcount (c_work c loc1) t'"
	+ have "(t' \<in>#\<^sub>z (zmset_frontier (c_pts c loc1) + union_frontiers c loc1))"
	+ using case2 cases by auto
	+ then have case_split2: "(t' \<in>#\<^sub>z zmset_frontier (c_pts c loc1)) \<or> (t' \<in>#\<^sub>z union_frontiers c loc1)"
	+ by (metis (no_types, lifting) add_diff_cancel_left' in_diff_zcount zcount_ne_zero_iff)
	+ then show ?thesis
	+ proof cases
	+ assume case2_1: "t' \<in>#\<^sub>z zmset_frontier (c_pts c loc1)"
	+ have "t' \<in>\<^sub>A frontier (c_pts c loc1)"
	+ using case2_1 mem_zmset_frontier by blast
	+ then show ?thesis
	+ using t' impWitnessPath_def longestImpWitnessPath_def dataflow_topology_axioms longestP by blast
	+ next
	+ assume "\<not>t' \<in>#\<^sub>z zmset_frontier (c_pts c loc1)"
	+ then have case2_2: "t' \<in>#\<^sub>z union_frontiers c loc1" using case_split2 by blast
	+ then obtain loc0 t0 s0 where loc0 : "t0 \<in>\<^sub>A frontier (c_imp c loc0)"
	+ "s0 \<in>\<^sub>A (summary loc0 loc1)"
	+ "t' = results_in t0 s0"
	+ by (fastforce simp: after_summary_def set_zmset_def zcount_sum
	+ member_antichain.rep_eq[symmetric] zcount_image_zmset card_gt_0_iff
	+ simp del: zcount_ne_zero_iff
	+ elim!: sum.not_neutral_contains_not_neutral)
	+ let ?xs' = "(loc0, s0, loc1) # xs"
	+ have path_xs: "path loc1 loc2 xs"
	+ using impWitnessPath_def longestImpWitnessPath_def longestP by blast
	+ have is_path_xs': "path loc0 loc2 ?xs'" using longestP
	+ apply (simp add: longestImpWitnessPath_def impWitnessPath_def)
	+ by (metis append_Cons append_Nil path_singleton path_trans loc0(2))
	+ have "\<forall>k<length ?xs'.
	+ results_in t0 (sum_path_weights (take (k+1) ?xs'))
	+ \<in>\<^sub>A frontier (c_imp c (TO (?xs' ! k)))"
	+ apply clarify
	+ subgoal for k
	+ apply (cases "k=0")
	+ subgoal
	+ using loc0(3) t'(1) by (auto simp: results_in_zero)
	+ subgoal
	+ using t'(3)[rule_format, unfolded loc0(3) followed_by_summary, of "k-1", simplified]
	+ by auto
	+ done
	+ done
	+ note r = this[rule_format]
	+ have distinctxs: "distinct xs"
	+ using longestP
	+ by (simp add: longestImpWitnessPath_def impWitnessPath_def)
	+ then show ?thesis
	+ proof cases
	+ assume case_distinct: "distinct ?xs'"
	+ (* show that we have a longer longestImpWitnessPathEx \<longrightarrow> contradicition *)
	+ have "t = results_in t0 (sum_path_weights ?xs')" using longestP loc0(3)
	+ apply (simp add: longestImpWitnessPath_def impWitnessPath_def)
	+ by (simp add: followed_by_summary t'(2))
	+ then have impPath: "impWitnessPath c loc0 loc2 ?xs' t"
	+ using is_path_xs' case_distinct loc0(1)
	+ apply (simp add: impWitnessPath_def)
	+ using r by auto
	+ have "length ?xs' > length xs" by auto
	+ then have "\<not> longestImpWitnessPath c loc1 loc2 xs t"
	+ using impPath leD unfolding longestImpWitnessPath_def by blast
	+ then show ?thesis using longestP by blast
	+ next
	+ assume "\<not> distinct ?xs'"
	+ (* show that we have a non-increasing cycle along path (loc0, s0, loc1) # xs *)
	+ with distinctxs obtain k where k: "TO (?xs' ! k) = loc0" "k < length ?xs'"
	+ apply atomize_elim
	+ apply clarsimp
	+ apply (subst (asm) in_set_conv_nth)
	+ apply clarify
	+ subgoal for i
	+ apply (cases "i=0")
	+ subgoal
	+ using path_first_loc[OF path_xs]
	+ by force
	+ subgoal
	+ apply (rule exI[of _ i])
	+ using path_xs
	+ apply (auto dest: path_to_eq_from[of _ _ xs "i-1"])
	+ done
	+ done
	+ done
	+ have "results_in t0 (sum_path_weights (take (k+1) ?xs')) \<in>\<^sub>A frontier (c_imp c loc0)"
	+ by (rule r[OF k(2), unfolded k(1)])
	+ moreover have "t0 < results_in t0 (sum_path_weights (take (k+1) ?xs'))"
	+ apply simp
	+ apply (rule no_zero_cycle[of loc0 "take (k+1) ?xs'" "sum_path_weights (take (k+1) ?xs')" t0, simplified])
	+ using is_path_xs' k path_take_to by fastforce
	+ ultimately show ?thesis
	+ using loc0(1) frontier_comparable_False by blast
	+ qed
	+ qed
	+ qed
	+qed
	+
	+lemma implication_implies_pointstamp:
	+ assumes "t \<in>\<^sub>A frontier (c_imp c loc)"
	+ and "inv_imps_work_sum c"
	+ shows "\<exists>t' loc' s. s \<in>\<^sub>A path_summary loc' loc \<and> t \<ge> results_in t' s \<and>
	+ (t' \<in>\<^sub>A frontier (c_pts c loc') \<or> 0 > zcount (c_work c loc') t')"
	+proof -
	+ obtain loc' t' xs where witness:
	+ "path loc' loc xs"
	+ "t = results_in t' (sum_path_weights xs)"
	+ "t' \<in>\<^sub>A frontier (c_pts c loc') \<or> 0 > zcount (c_work c loc') t'"
	+ using assms find_witness_from_frontier by blast
	+ obtain s where s: "s \<in>\<^sub>A path_summary loc' loc" "s \<le> (sum_path_weights xs)"
	+ using witness(1) path_path_weight by blast
	+ then have "t \<ge> results_in t' s"
	+ using witness(2) results_in_mono(2) by blast
	+ then show ?thesis
	+ using witness(3) s by auto
	+qed
	+
	+
	+subsection\<open>Proof of Safety\<close>
	+
	+lemma results_in_sum_path_weights_append:
	+ "results_in t (sum_path_weights (xs @ [(loc2, s, loc3)])) = results_in (results_in t (sum_path_weights xs)) s"
	+ by (metis followed_by_summary sum_path_weights_append_singleton)
	+
	+context
	+ fixes c :: "('loc, 't) configuration"
	+begin
	+
	+inductive loc_imps_fw where
	+ "loc_imps_fw loc loc (c_imp c loc) []" \|
	+ "loc_imps_fw loc1 loc2 M xs \<Longrightarrow> s \<in>\<^sub>A summary loc2 loc3 \<Longrightarrow> distinct (xs @ [(loc2,s,loc3)]) \<Longrightarrow>
	+ loc_imps_fw loc1 loc3 ({# results_in t s. t \<in>#\<^sub>z M #} + c_imp c loc3) (xs @ [(loc2,s,loc3)])"
	+
	+end
	+
	+lemma loc_imps_fw_conv_path: "loc_imps_fw c loc1 loc2 M xs \<Longrightarrow> path loc1 loc2 xs"
	+ by (induct rule: loc_imps_fw.induct) (auto intro: path.intros)
	+
	+lemma path_conv_loc_imps_fw: "path loc1 loc2 xs \<Longrightarrow> distinct xs \<Longrightarrow> \<exists>M. loc_imps_fw c loc1 loc2 M xs"
	+proof (induct rule: path.induct)
	+ case (path0 l1 l2)
	+ then show ?case by (auto intro: loc_imps_fw.intros)
	+next
	+ case (path l1 l2 xs lbl l3)
	+ then obtain M where "loc_imps_fw c l1 l2 M xs"
	+ by auto
	+ with path show ?case
	+ by (force intro: loc_imps_fw.intros(2))
	+qed
	+
	+lemma path_summary_conv_loc_imps_fw:
	+ "s \<in>\<^sub>A path_summary loc1 loc2 \<Longrightarrow> \<exists>M xs. loc_imps_fw c loc1 loc2 M xs \<and> sum_path_weights xs = s"
	+proof -
	+ assume path_sum: "s \<in>\<^sub>A path_summary loc1 loc2"
	+ then obtain M xs where le: "path loc1 loc2 xs" "loc_imps_fw c loc1 loc2 M xs" "sum_path_weights xs \<le> s" "distinct xs"
	+ apply atomize_elim
	+ apply (drule path_weight_conv_path)
	+ apply clarsimp
	+ apply (drule path_distinct)
	+ apply clarsimp
	+ subgoal for ys xs
	+ apply (rule exI[of _ xs])
	+ apply (rule conjI, assumption)
	+ apply (drule path_conv_loc_imps_fw[of loc1 loc2 xs c])
	+ using subseq_sum_weights_le apply auto
	+ done
	+ done
	+ show ?thesis
	+ proof (cases "sum_path_weights xs = s")
	+ case True
	+ with le show ?thesis by auto
	+ next
	+ case False
	+ with le have "sum_path_weights xs < s"
	+ by auto
	+ with le(1) path_sum have False
	+ by (auto dest: path_weight_conv_path)
	+ then show ?thesis
	+ by blast
	+ qed
	+qed
	+
	+lemma image_zmset_id[simp]: "{#x. x \<in>#\<^sub>z M#} = M"
	+ by transfer (auto simp: equiv_zmset_def)
	+
	+lemma sum_pos: "finite M \<Longrightarrow> \<forall>x\<in>M. 0 \<le> f x \<Longrightarrow> y \<in> M \<Longrightarrow> 0 < (f y::_::ordered_comm_monoid_add) \<Longrightarrow> 0 < (\<Sum>x\<in>M. f x)"
	+proof (induct M rule: finite_induct)
	+ case empty
	+ then show ?case by simp
	+next
	+ case (insert x F)
	+ then show ?case
	+ by (cases "0 < f x") (auto intro: sum_nonneg add_pos_nonneg add_nonneg_pos)
	+qed
	+
	+lemma loc_imps_fw_M_in_implications:
	+ assumes "loc_imps_fw c loc1 loc2 M xs"
	+ and "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "\<And>loc. c_work c loc = {#}\<^sub>z"
	+ and "0 < zcount M t"
	+ shows "\<exists>s. s \<le> t \<and> s \<in>\<^sub>A frontier (c_imp c loc2)"
	+ using assms(1,5)
	+proof (induct arbitrary: t rule: loc_imps_fw.induct)
	+ note iiws = assms(2)[unfolded inv_imps_work_sum_def assms(4), simplified, rule_format]
	+ case (1 loc t)
	+ then show ?case
	+ by (auto elim: obtain_elem_frontier)
	+next
	+ note iiws = assms(2)[unfolded inv_imps_work_sum_def assms(4), simplified, rule_format]
	+ case (2 loc1 loc2 M xs s loc3 t)
	+ from 2(5) have disj: "0 < zcount {# results_in t s. t \<in>#\<^sub>z M #} t \<or> 0 < zcount (c_imp c loc3) t"
	+ by auto
	+ show ?case
	+ proof -
	+ { assume "0 < zcount {# results_in t s. t \<in>#\<^sub>z M #} t"
	+ then obtain t' where t': "results_in t' s = t" "0 < zcount M t'"
	+ apply atomize_elim
	+ apply (rule ccontr)
	+ apply (subst (asm) zcount_image_zmset)
	+ apply (clarsimp simp: vimage_def)
	+ apply (metis (mono_tags, lifting) Int_iff mem_Collect_eq sum_pos_ex_elem_pos)
	+ done
	+ obtain u where u: "u \<le> t'" "u \<in>\<^sub>A frontier (c_imp c loc2)"
	+ by atomize_elim (rule 2(2)[OF t'(2)])
	+ then have riu_le_rit': "results_in u s \<le> t"
	+ by (simp add: t'(1)[symmetric] results_in_mono)
	+ from u have "0 < zcount (union_frontiers c loc3) (results_in u s)"
	+ apply (subst zcount_sum)
	+ apply (rule sum_pos[where y=loc2])
	+ apply simp_all [3]
	+ apply (clarsimp simp: after_summary_def)
	+ apply (subst zcount_sum)
	+ apply (rule sum_pos[where y=s])
	+ using 2(3) apply simp_all [3]
	+ apply (subst zcount_image_zmset)
	+ apply simp
	+ apply (subst card_eq_sum)
	+ apply (rule sum_pos[where y=u])
	+ apply simp_all
	+ done
	+ then have "0 < zcount (zmset_frontier (c_pts c loc3)) (results_in u s) + zcount (union_frontiers c loc3) (results_in u s)"
	+ by (auto intro: add_nonneg_pos)
	+ with riu_le_rit' have ?thesis
	+ apply (subst (asm) zcount_union[symmetric])
	+ apply (subst iiws)
	+ apply (erule obtain_elem_frontier)
	+ subgoal for u'
	+ by (auto intro!: exI[of _ u'])
	+ done
	+ }
	+ moreover
	+ { \<comment> \<open>Same as induction base case\<close>
	+ assume "0 < zcount (c_imp c loc3) t"
	+ then have ?thesis
	+ by (auto elim: obtain_elem_frontier)
	+ }
	+ moreover note disj
	+ ultimately show ?thesis
	+ by blast
	+ qed
	+qed
	+
	+lemma loc_imps_fw_M_nonneg[simp]:
	+ assumes "loc_imps_fw c loc1 loc2 M xs"
	+ and "inv_implications_nonneg c"
	+ shows "0 \<le> zcount M t"
	+ using assms
	+ by (induct arbitrary: t rule: loc_imps_fw.induct)
	+ (auto intro!: add_nonneg_nonneg sum_nonneg simp: zcount_image_zmset assms(2)[unfolded inv_implications_nonneg_def])
	+
	+lemma loc_imps_fw_implication_in_M:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "loc_imps_fw c loc1 loc2 M xs"
	+ and "0 < zcount (c_imp c loc1) t"
	+ shows "0 < zcount M (results_in t (sum_path_weights xs))"
	+ using assms(3,4)
	+proof (induct rule: loc_imps_fw.induct)
	+ note iiws = assms(1)[unfolded inv_imps_work_sum_def assms(3), simplified, rule_format]
	+ case (1 loc)
	+ then show ?case
	+ by (simp add: results_in_zero)
	+next
	+ case (2 loc1 loc2 M xs s loc3)
	+ have "0 < zcount M (results_in t (sum_path_weights xs))"
	+ by (rule 2(2)[OF 2(5)])
	+ then show ?case
	+ apply (subst results_in_sum_path_weights_append)
	+ apply (subst zcount_union)
	+ apply (rule add_pos_nonneg)
	+ apply (subst zcount_image_zmset)
	+ apply (rule sum_pos[where y = "results_in t (sum_weights (map (\<lambda>(s, l, t). l) xs))"])
	+ apply simp
	+ apply (auto simp: loc_imps_fw_M_nonneg[OF 2(1) assms(2)] zcount_inI) [3]
	+ apply (auto simp: assms(2)[unfolded inv_implications_nonneg_def])
	+ done
	+qed
	+
	+definition impl_safe :: "('loc, 't) configuration \<Rightarrow> bool" where
	+ "impl_safe c \<equiv> \<forall>loc1 loc2 t s. zcount (c_imp c loc1) t > 0 \<and> s \<in>\<^sub>A path_summary loc1 loc2
	+ \<longrightarrow> (\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc2) \<and> t' \<le> results_in t s)"
	+
	+lemma impl_safe:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "\<And>loc. c_work c loc = {#}\<^sub>z"
	+ shows "impl_safe c"
	+ unfolding impl_safe_def
	+ apply clarify
	+proof -
	+ note iiws = assms(1)[unfolded inv_imps_work_sum_def assms(3), simplified, rule_format]
	+ fix loc1 loc2 t s
	+ assume "0 < zcount (c_imp c loc1) t"
	+ then obtain t' where t': "t' \<in>\<^sub>A frontier (c_imp c loc1)" "t' \<le> t"
	+ by (auto elim: obtain_elem_frontier)
	+ then have t'_zcount: "0 < zcount (c_imp c loc1) t'"
	+ by (simp add: member_frontier_pos_zmset)
	+ assume path_sum: "s \<in>\<^sub>A path_summary loc1 loc2"
	+ obtain M xs where Mxs: "loc_imps_fw c loc1 loc2 M xs" "sum_path_weights xs = s"
	+ by atomize_elim (rule path_summary_conv_loc_imps_fw[OF path_sum])
	+ have inM: "0 < zcount M (results_in t' (sum_path_weights xs))"
	+ by (rule loc_imps_fw_implication_in_M[OF assms(1,2) Mxs(1) t'_zcount])
	+ obtain u where u: "u \<le> results_in t' (sum_path_weights xs)" "u \<in>\<^sub>A frontier (c_imp c loc2)"
	+ by atomize_elim (rule loc_imps_fw_M_in_implications[OF Mxs(1) assms(1,2,3) inM])
	+ then show "\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c loc2) \<and> t' \<le> results_in t s"
	+ apply (intro exI[of _ u])
	+ apply (simp add: Mxs(2))
	+ using t'(2) apply (meson order.trans results_in_mono(1))
	+ done
	+qed
	+
	+\<comment> \<open>Safety for states where worklist is non-empty\<close>
	+
	+lemma cm_preserves_impl_safe:
	+ assumes "impl_safe c0"
	+ and "next_change_multiplicity' c0 c1 loc t n"
	+ shows "impl_safe c1"
	+ using assms
	+ by (auto simp: impl_safe_def next_change_multiplicity'_def)
	+
	+lemma cm_preserves_safe:
	+ assumes "safe c0"
	+ and "impl_safe c0"
	+ and "next_change_multiplicity' c0 c1 loc t n"
	+ shows "safe c1"
	+proof -
	+ from assms(1) have safe: "0 < zcount (c_pts c0 loc1) t \<Longrightarrow> s \<in>\<^sub>A path_summary loc1 loc2
	+ \<Longrightarrow> \<exists>t'\<le>results_in t s. t' \<in>\<^sub>A frontier (c_imp c0 loc2)" for loc1 loc2 t s
	+ by (auto simp: safe_def)
	+ from assms(2) have impl_safe: "0 < zcount (c_imp c0 loc1) t \<Longrightarrow> s \<in>\<^sub>A path_summary loc1 loc2
	+ \<Longrightarrow> \<exists>t'. t' \<in>\<^sub>A frontier (c_imp c0 loc2) \<and> t' \<le> results_in t s" for loc1 loc2 t s
	+ by (auto simp: impl_safe_def)
	+ from assms(3) have imps: "c_imp c1 = c_imp c0"
	+ unfolding next_change_multiplicity'_def by auto
	+ { fix loc1 loc2 u s \<comment> \<open>`safe c1` variables\<close>
	+ assume u: "0 < zcount (c_pts c1 loc1) u"
	+ then obtain u' where u': "u' \<in>\<^sub>A frontier (c_pts c1 loc1)" "u' \<le> u"
	+ using obtain_frontier_elem by blast
	+ assume path_sum: "s \<in>\<^sub>A path_summary loc1 loc2"
	+ \<comment> \<open>CM state changes:\<close>
	+ assume n_neq_zero: "n \<noteq> 0"
	+ assume impl: "\<exists>t'. t' \<in>\<^sub>A frontier (c_imp c0 loc) \<and> t' \<le> t"
	+ assume pointstamps:
	+ "\<forall>loc'. c_pts c1 loc' =
	+ (if loc' = loc then update_zmultiset (c_pts c0 loc') t n
	+ else c_pts c0 loc')"
	+ have "\<exists>t'\<le>results_in u s. t' \<in>\<^sub>A frontier (c_imp c1 loc2)"
	+ proof (cases "n < 0")
	+ case True \<comment> \<open>Trivial, because no new pointstamp could have appeared\<close>
	+ with u have u_c0: "0 < zcount (c_pts c0 loc1) u"
	+ unfolding pointstamps[rule_format]
	+ by (cases "loc1=loc"; cases "t=u") (auto simp: zcount_update_zmultiset)
	+ show ?thesis
	+ unfolding imps
	+ by (rule safe[OF u_c0 path_sum])
	+ next
	+ case False
	+ with n_neq_zero have "n > 0"
	+ by linarith
	+ then show ?thesis
	+ unfolding imps
	+ apply (cases "loc=loc1"; cases "t=u")
	+ using impl
	+ apply (elim exE conjE)
	+ subgoal for t'
	+ apply simp
	+ apply (drule member_frontier_pos_zmset)
	+ apply (drule impl_safe[rotated, OF path_sum])
	+ apply (elim exE)
	+ subgoal for t''
	+ apply (rule exI[of _ t''])
	+ using results_in_mono(1) order_trans apply blast
	+ done
	+ done
	+ using u path_sum apply (auto simp: zcount_update_zmultiset pointstamps[rule_format] intro: safe)
	+ done
	+ qed
	+ }
	+ note r = this
	+ show ?thesis
	+ unfolding safe_def
	+ apply clarify
	+ subgoal for loc1 loc2 t s
	+ using assms(3)[unfolded next_change_multiplicity'_def]
	+ by (intro r[of loc1 t s loc2]) auto
	+ done
	+qed
	+
	+subsection\<open>A Better (More Invariant) Safety\<close>
	+
	+definition worklists_vacant_to :: "('loc, 't) configuration \<Rightarrow> 't \<Rightarrow> bool" where
	+ "worklists_vacant_to c t =
	+ (\<forall>loc1 loc2 s t'. s \<in>\<^sub>A path_summary loc1 loc2 \<and> t' \<in>#\<^sub>z c_work c loc1 \<longrightarrow> \<not> results_in t' s \<le> t)"
	+
	+definition inv_safe :: "('loc, 't) configuration \<Rightarrow> bool" where
	+ "inv_safe c = (\<forall>loc1 loc2 t s. 0 < zcount (c_pts c loc1) t
	+ \<and> s \<in>\<^sub>A path_summary loc1 loc2
	+ \<and> worklists_vacant_to c (results_in t s)
	+ \<longrightarrow> (\<exists>t' \<le> results_in t s. t' \<in>\<^sub>A frontier (c_imp c loc2)))"
	+
	+text\<open>Intuition: Unlike safe, @{term inv_safe} is an invariant because it only claims the safety property
	+@{term "t' \<in>\<^sub>A frontier (c_imp c loc2)"} for pointstamps that can't be modified by future propagated
	+updates anymore (i.e. there are no upstream worklist entries which can result in a less or equal pointstamp).\<close>
	+
	+lemma in_frontier_diff: "\<forall>y\<in>#\<^sub>zN. \<not> y \<le> x \<Longrightarrow> x \<in>\<^sub>A frontier (M - N) \<longleftrightarrow> x \<in>\<^sub>A frontier M"
	+ apply transfer'
	+ unfolding in_minimal_antichain
	+ apply (metis (mono_tags, lifting) diff_zero le_less mem_Collect_eq set_zmset_def zcount_diff)
	+ done
	+
	+lemma worklists_vacant_to_trans:
	+ "worklists_vacant_to c t \<Longrightarrow> t' \<le> t \<Longrightarrow> worklists_vacant_to c t'"
	+ unfolding worklists_vacant_to_def
	+ using order.trans by blast
	+
	+lemma loc_imps_fw_M_in_implications':
	+ assumes "loc_imps_fw c loc1 loc2 M xs"
	+ and "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "worklists_vacant_to c t"
	+ and "0 < zcount M t"
	+ shows "\<exists>s\<le>t. s \<in>\<^sub>A frontier (c_imp c loc2)"
	+ using assms(1,4,5)
	+proof (induct arbitrary: t rule: loc_imps_fw.induct)
	+ note iiws = assms(2)[unfolded inv_imps_work_sum_def, rule_format]
	+ case (1 loc t)
	+ then show ?case
	+ by (auto elim: obtain_elem_frontier)
	+next
	+ note iiws = assms(2)[unfolded inv_imps_work_sum_def eq_diff_eq[symmetric], rule_format]
	+ case (2 loc1 loc2 M xs s loc3 t)
	+ from 2(6) consider "0 < zcount {# results_in t s. t \<in>#\<^sub>z M #} t" \| "0 < zcount (c_imp c loc3) t"
	+ by atomize_elim auto
	+ then show ?case
	+ proof cases
	+ case 1
	+ then obtain t' where t': "results_in t' s = t" "0 < zcount M t'"
	+ apply atomize_elim
	+ apply (rule ccontr)
	+ apply (subst (asm) zcount_image_zmset)
	+ apply (clarsimp simp: vimage_def)
	+ apply (metis (mono_tags, lifting) Int_iff mem_Collect_eq sum_pos_ex_elem_pos)
	+ done
	+ have vacant_to: "worklists_vacant_to c t'"
	+ apply (rule worklists_vacant_to_trans)
	+ apply (rule 2(5))
	+ using zero_le results_in_mono(2) results_in_zero t'(1) apply fastforce
	+ done
	+ obtain u where u: "u \<le> t'" "u \<in>\<^sub>A frontier (c_imp c loc2)"
	+ using 2(2)[OF vacant_to t'(2)] by fast
	+ then have riu_le_rit': "results_in u s \<le> t"
	+ by (simp add: t'(1)[symmetric] results_in_mono)
	+ from u have "0 < zcount (union_frontiers c loc3) (results_in u s)"
	+ apply (subst zcount_sum)
	+ apply (rule sum_pos[where y=loc2])
	+ apply simp_all [3]
	+ apply (clarsimp simp: after_summary_def)
	+ apply (subst zcount_sum)
	+ apply (rule sum_pos[where y=s])
	+ using 2(3) apply simp_all [3]
	+ apply (subst zcount_image_zmset)
	+ apply simp
	+ apply (subst card_eq_sum)
	+ apply (rule sum_pos[where y=u])
	+ apply simp_all
	+ done
	+ then have "0 < zcount (zmset_frontier (c_pts c loc3)) (results_in u s) + zcount (union_frontiers c loc3) (results_in u s)"
	+ by (auto intro: add_nonneg_pos)
	+ with riu_le_rit' show ?thesis
	+ apply (subst (asm) zcount_union[symmetric])
	+ apply (subst iiws)
	+ apply (erule obtain_elem_frontier)
	+ subgoal for u'
	+ apply (rule exI[of _ u'])
	+ apply (subst in_frontier_diff)
	+ apply clarify
	+ subgoal for t'
	+ using 2(5)[unfolded worklists_vacant_to_def, rule_format, of 0 loc3 loc3 t']
	+ apply -
	+ apply (drule meta_mp)
	+ apply (intro conjI)
	+ apply simp
	+ apply simp
	+ apply (metis order_trans results_in_zero)
	+ done
	+ apply auto
	+ done
	+ done
	+ next
	+ case 2
	+ then show ?thesis
	+ by (auto elim: obtain_elem_frontier)
	+ qed
	+qed
	+
	+lemma inv_safe:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ shows "inv_safe c"
	+ unfolding inv_safe_def
	+ apply clarify
	+proof -
	+ note iiws = assms(1)[unfolded inv_imps_work_sum_def, rule_format]
	+ fix loc1 loc2 t s
	+ assume vacant: "worklists_vacant_to c (results_in t s)"
	+ assume "0 < zcount (c_pts c loc1) t"
	+ then obtain t' where t': "t' \<in>\<^sub>A frontier (c_pts c loc1)" "t' \<le> t"
	+ using obtain_frontier_elem by blast
	+ have zcount_wl: "zcount (c_work c loc1) t' = 0"
	+ using vacant[unfolded worklists_vacant_to_def, rule_format, of 0 loc1 loc1 t', simplified]
	+ by (metis add.left_neutral order.trans le_plus(1) results_in_mono(2) results_in_zero t'(2) zcount_ne_zero_iff)
	+ obtain t'' where t'': "t'' \<in>\<^sub>A frontier (c_imp c loc1)" "t'' \<le> t'"
	+ proof atomize_elim
	+ from t'(1) have "0 < zcount (zmset_frontier (c_pts c loc1)) t' + zcount (union_frontiers c loc1) t'"
	+ by (auto intro: add_pos_nonneg simp: union_frontiers_nonneg)
	+ then show "\<exists>t''. t'' \<in>\<^sub>A frontier (c_imp c loc1) \<and> t'' \<le> t'"
	+ apply (subst (asm) zcount_union[symmetric])
	+ apply (subst (asm) iiws[symmetric])
	+ using zcount_wl
	+ apply (auto elim: obtain_frontier_elem)
	+ done
	+ qed
	+ then have t''_zcount: "0 < zcount (c_imp c loc1) t''"
	+ by (simp add: member_frontier_pos_zmset)
	+ assume path_sum: "s \<in>\<^sub>A path_summary loc1 loc2"
	+ obtain M xs where Mxs: "loc_imps_fw c loc1 loc2 M xs" "sum_path_weights xs = s"
	+ by atomize_elim (rule path_summary_conv_loc_imps_fw[OF path_sum])
	+ have inM: "0 < zcount M (results_in t'' (sum_path_weights xs))"
	+ by (rule loc_imps_fw_implication_in_M[OF assms(1,2) Mxs(1) t''_zcount])
	+ have vacant2: "worklists_vacant_to c (results_in t'' (sum_weights (map (\<lambda>(s, l, t). l) xs)))"
	+ apply (subst Mxs(2))
	+ apply (meson results_in_mono(1) worklists_vacant_to_trans t''(2) t'(2) vacant)
	+ done
	+ obtain u where u: "u \<le> results_in t'' (sum_path_weights xs)" "u \<in>\<^sub>A frontier (c_imp c loc2)"
	+ by atomize_elim (rule loc_imps_fw_M_in_implications'[OF Mxs(1) assms(1,2) vacant2 inM])
	+ then show "\<exists>t'\<le>results_in t s. t' \<in>\<^sub>A frontier (c_imp c loc2)"
	+ apply (intro exI[of _ u])
	+ apply (simp add: Mxs(2))
	+ using t''(2) t'(2) apply (meson order.trans results_in_mono(1))
	+ done
	+qed
	+
	+lemma alw_conjI: "alw P s \<Longrightarrow> alw Q s \<Longrightarrow> alw (\<lambda>s. P s \<and> Q s) s"
	+ by (coinduction arbitrary: s) auto
	+
	+lemma alw_inv_safe: "spec s \<Longrightarrow> alw (holds inv_safe) s"
	+ apply (frule spec_imp_iiws)
	+ apply (drule alw_inv_implications_nonneg)
	+ apply (rule alw_mp[where \<phi> = "\<lambda>s. holds inv_imps_work_sum s \<and> holds inv_implications_nonneg s"])
	+ apply (rule alw_conjI)
	+ apply assumption+
	+ apply (simp add: alw_mono inv_safe)
	+ done
	+
	+lemma empty_worklists_vacant_to: "\<forall>loc. c_work c loc = {#}\<^sub>z \<Longrightarrow> worklists_vacant_to c t"
	+ unfolding worklists_vacant_to_def
	+ by auto
	+
	+lemma inv_safe_safe: "(\<And>loc. c_work c loc = {#}\<^sub>z) \<Longrightarrow> inv_safe c \<Longrightarrow> safe c"
	+ unfolding inv_safe_def safe_def worklists_vacant_to_def by auto
	+
	+lemma safe:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "\<And>loc. c_work c loc = {#}\<^sub>z"
	+ shows "safe c"
	+ by (rule inv_safe_safe[OF assms(3) inv_safe[OF assms(1,2)]])
	+
	+subsection \<open>Implied Frontier\<close>
	+
	+abbreviation zmset_pos where "zmset_pos M \<equiv> zmset_of (mset_pos M)"
	+
	+definition implied_frontier where
	+ "implied_frontier P loc = frontier (\<Sum>loc'\<in>UNIV. after_summary (zmset_pos (P loc')) (path_summary loc' loc))"
	+
	+definition implied_frontier_alt where
	+ "implied_frontier_alt c loc = frontier (\<Sum>loc'\<in>UNIV. after_summary (zmset_frontier (c_pts c loc')) (path_summary loc' loc))"
	+
	+lemma in_frontier_least: "x \<in>\<^sub>A frontier M \<Longrightarrow> \<forall>y. 0 < zcount M y \<longrightarrow> \<not> y < x"
	+ by transfer' (auto simp: minimal_antichain_def)
	+
	+lemma in_frontier_trans: "0 < zcount M y \<Longrightarrow> x \<in>\<^sub>A frontier M \<Longrightarrow> y \<le> x \<Longrightarrow> y \<in>\<^sub>A frontier M"
	+ by transfer (simp add: le_less minimal_antichain_def)
	+
	+lemma implied_frontier_alt_least:
	+ assumes "b \<in>\<^sub>A implied_frontier_alt c loc2"
	+ shows "\<forall>loc a' s'. a' \<in>\<^sub>A frontier (c_pts c loc) \<longrightarrow> s' \<in>\<^sub>A path_summary loc loc2 \<longrightarrow> \<not> results_in a' s' < b"
	+proof (intro allI impI notI)
	+ fix loc a' s'
	+ assume a': "a' \<in>\<^sub>A frontier (c_pts c loc)"
	+ assume s': "s' \<in>\<^sub>A path_summary loc loc2"
	+ assume lt: "results_in a' s' < b"
	+ have "0 < zcount (after_summary (zmset_frontier (c_pts c loc)) (path_summary loc loc2)) (results_in a' s')"
	+ using a' s' by (auto intro!: pos_zcount_after_summary)
	+ then have "0 < zcount (\<Sum>loc'\<in>UNIV. after_summary (zmset_frontier (c_pts c loc')) (path_summary loc' loc2)) (results_in a' s')"
	+ by (auto intro!: sum_pos[where y = loc] simp: zcount_sum)
	+ then have "results_in a' s' \<in>\<^sub>A implied_frontier_alt c loc2"
	+ using assms lt unfolding implied_frontier_alt_def
	+ by (auto dest!: in_frontier_trans[where y = "results_in a' s'" and x = b])
	+ with lt assms show "False"
	+ unfolding implied_frontier_alt_def
	+ using frontier_comparable_False
	+ by blast
	+qed
	+
	+lemma implied_frontier_alt_in_pointstamps:
	+ assumes "b \<in>\<^sub>A implied_frontier_alt c loc2"
	+ obtains a s loc1 where
	+ "a \<in>\<^sub>A frontier (c_pts c loc1)" "s \<in>\<^sub>A path_summary loc1 loc2" "results_in a s = b"
	+ using assms apply atomize_elim
	+ unfolding implied_frontier_alt_def
	+ apply (drule member_frontier_pos_zmset)
	+ apply (subst (asm) zcount_sum)
	+ apply (drule sum_pos_ex_elem_pos)
	+ apply clarify
	+ apply (rule after_summary_obtain_pre[rotated])
	+ apply simp
	+ subgoal for loc1 a s
	+ by (auto intro!: exI[of _ loc1] exI[of _ a] exI[of _ s])
	+ apply simp
	+ done
	+
	+lemma in_implied_frontier_alt_in_implication_frontier:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "worklists_vacant_to c b"
	+ and "b \<in>\<^sub>A implied_frontier_alt c loc2"
	+ shows "b \<in>\<^sub>A frontier (c_imp c loc2)"
	+proof -
	+ have safe: "0 < zcount (c_pts c loc1) t \<Longrightarrow> s \<in>\<^sub>A path_summary loc1 loc2 \<Longrightarrow> results_in t s \<le> b
	+ \<Longrightarrow> \<exists>t'\<le>results_in t s. t' \<in>\<^sub>A frontier (c_imp c loc2)" for loc1 loc2 t s
	+ by (rule inv_safe[OF assms(1,2), unfolded inv_safe_def, rule_format])
	+ (auto elim: worklists_vacant_to_trans[OF assms(3)])
	+ \<comment> \<open>Pointstamp @{term b} in the @{term implied_frontier_alt} is caused by a pointstamp @{term a} and summary @{term s}
	+ and @{term "results_in a s"} is least among such pointstamps\<close>
	+ from assms(4) obtain loc1 a s where loc1_a_s:
	+ "a \<in>\<^sub>A frontier (c_pts c loc1)" "s \<in>\<^sub>A path_summary loc1 loc2" "results_in a s = b"
	+ "\<forall>loc a' s'. a' \<in>\<^sub>A frontier (c_pts c loc) \<longrightarrow> s' \<in>\<^sub>A path_summary loc loc2 \<longrightarrow> \<not> results_in a' s' < b"
	+ apply atomize_elim
	+ apply (rule implied_frontier_alt_in_pointstamps)
	+ apply simp
	+ apply (drule implied_frontier_alt_least)
	+ apply fast
	+ done
	+ then have zcount_ps: "0 < zcount (c_pts c loc1) a"
	+ using member_frontier_pos_zmset by blast
	+ \<comment> \<open>From `safe` we know that pointstamp @{term a} is reflected in the implications by some
	+ poinstamp @{term "b' \<le> b"}\<close>
	+ obtain b' where b': "b' \<in>\<^sub>A frontier (c_imp c loc2)" "b' \<le> results_in a s"
	+ using safe[OF zcount_ps loc1_a_s(2)] loc1_a_s(3) by blast
	+ have "b' = results_in a s"
	+ proof -
	+ have "zcount (c_work c loc) t = 0" if "results_in t s \<le> b'" for t s loc
	+ proof -
	+ have "results_in t s \<le> b"
	+ using b'(2) loc1_a_s(3) that by force
	+ then show ?thesis
	+ by (meson assms(3) results_in_mono(2) worklists_vacant_to_def flow.zero_le order_trans
	+ path_weight_refl zcount_inI)
	+ qed
	+ \<comment> \<open>but the pointstamp can't be strictly less, because we know that @{term "results_in a s"} is least\<close>
	+ then obtain a' loc1' s' where a':
	+ "s' \<in>\<^sub>A path_summary loc1' loc2" "results_in a' s' \<le> b'" "a' \<in>\<^sub>A frontier (c_pts c loc1')"
	+ using implication_implies_pointstamp[OF b'(1) assms(1), simplified] by force
	+ { assume "b' \<noteq> results_in a s"
	+ with b'(2) have b'_lt: "b' < results_in a s"
	+ by simp
	+ note loc1_a_s(4)[rule_format, unfolded loc1_a_s(3)[symmetric], OF a'(3,1)]
	+ with b'_lt a'(2) have False
	+ by (simp add: leD less_le order_trans)
	+ }
	+ then show ?thesis
	+ by (rule ccontr)
	+ qed
	+ \<comment> \<open>Hence, the @{term implied_frontier_alt} pointstamp @{term b} is reflected in the implications\<close>
	+ with b' show "b \<in>\<^sub>A frontier (c_imp c loc2)"
	+ by (auto simp: loc1_a_s(3))
	+qed
	+
	+lemma in_implication_frontier_in_implied_frontier_alt:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "worklists_vacant_to c b"
	+ and "b \<in>\<^sub>A frontier (c_imp c loc2)"
	+ shows "b \<in>\<^sub>A implied_frontier_alt c loc2"
	+proof -
	+ have safe: "0 < zcount (c_pts c loc1) t \<Longrightarrow> s \<in>\<^sub>A path_summary loc1 loc2 \<Longrightarrow> results_in t s \<le> b
	+ \<Longrightarrow> \<exists>t'\<le>results_in t s. t' \<in>\<^sub>A frontier (c_imp c loc2)" for loc1 loc2 t s
	+ by (rule inv_safe[OF assms(1,2), unfolded inv_safe_def, rule_format])
	+ (auto elim: worklists_vacant_to_trans[OF assms(3)])
	+ have "zcount (c_work c loc) t = 0" if "results_in t s \<le> b" for t s loc
	+ using that by (meson assms(3) results_in_mono(2) worklists_vacant_to_def flow.zero_le
	+ order_trans path_weight_refl zcount_inI)
	+ \<comment> \<open>Pointstamp @{term b} in the implications is caused by a pointstamp @{term a} and a summary @{term s}\<close>
	+ then obtain loc1 a s where loc1_a_s:
	+ "s \<in>\<^sub>A path_summary loc1 loc2" "results_in a s \<le> b" "a \<in>\<^sub>A frontier (c_pts c loc1)"
	+ using implication_implies_pointstamp[OF assms(4) assms(1), simplified] by force
	+ then have zcount_a: "0 < zcount (c_pts c loc1) a"
	+ using member_frontier_pos_zmset by blast
	+ have b_ria: "results_in a s = b"
	+ proof (rule ccontr)
	+ assume "results_in a s \<noteq> b"
	+ with loc1_a_s(2) have "results_in a s < b"
	+ by simp
	+ then show False
	+ using safe[OF zcount_a loc1_a_s(1)] assms(4) loc1_a_s(2)
	+ using order.strict_trans1 frontier_comparable_False by blast
	+ qed
	+ \<comment> \<open>@{term "results_in a s"} is a candidate for inclusion in the @{term implied_frontier_alt}..\<close>
	+ have "0 < zcount (\<Sum>loc'\<in>UNIV. after_summary (zmset_frontier (c_pts c loc')) (path_summary loc' loc2)) (results_in a s)"
	+ unfolding after_summary_def
	+ apply (subst zcount_sum)
	+ apply (rule sum_pos[of _ _ loc1])
	+ apply simp
	+ apply (clarsimp simp: zcount_sum)
	+ apply (rule sum_nonneg)
	+ apply (subst zcount_image_zmset)
	+ apply auto [2]
	+ apply (subst zcount_sum)
	+ apply (rule sum_pos[of _ _ s])
	+ using loc1_a_s(1) apply simp_all [3]
	+ apply (subst zcount_image_zmset)
	+ apply (rule sum_pos[of _ _ a])
	+ using loc1_a_s(3) apply auto
	+ done
	+ \<comment> \<open>..which means a pointstamp @{term "b' \<le> results_in a s"} must exist in the @{term implied_frontier_alt}..\<close>
	+ then obtain b' where b': "b' \<in>\<^sub>A implied_frontier_alt c loc2" "b' \<le> results_in a s"
	+ by (auto simp: implied_frontier_alt_def elim: obtain_frontier_elem)
	+ then have "worklists_vacant_to c b'"
	+ using loc1_a_s(2) by (auto intro: worklists_vacant_to_trans[OF assms(3)])
	+ with b' have b'_frontier: "b' \<in>\<^sub>A frontier (c_imp c loc2)"
	+ using in_implied_frontier_alt_in_implication_frontier assms by blast
	+ \<comment> \<open>..and this pointstamp must be equal to @{term b'}\<close>
	+ have b'_ria: "b' = results_in a s"
	+ proof (rule ccontr)
	+ assume "b' \<noteq> results_in a s"
	+ with b'(2) have b'_lt: "b' < results_in a s"
	+ by simp
	+ from b'_frontier b'_lt b_ria assms(4) show False
	+ using frontier_comparable_False by blast
	+ qed
	+ \<comment> \<open>Hence, the implication frontier pointstamp @{term b} is reflected in the @{term implied_frontier_alt}\<close>
	+ from b' b'_ria b_ria show "b \<in>\<^sub>A implied_frontier_alt c loc2"
	+ by (auto simp: implied_frontier_alt_def)
	+qed
	+
	+lemma implication_frontier_iff_implied_frontier_alt_vacant:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "worklists_vacant_to c b"
	+ shows "b \<in>\<^sub>A frontier (c_imp c loc) \<longleftrightarrow> b \<in>\<^sub>A implied_frontier_alt c loc"
	+ using
	+ ac_eq_iff
	+ in_implication_frontier_in_implied_frontier_alt[OF assms]
	+ in_implied_frontier_alt_in_implication_frontier[OF assms]
	+ by blast
	+
	+lemma next_propagate_implied_frontier_alt_def:
	+ "next_propagate c c' \<Longrightarrow> implied_frontier_alt c loc = implied_frontier_alt c' loc"
	+ by (auto simp: next_propagate'_def implied_frontier_alt_def)
	+
	+lemma implication_frontier_eq_implied_frontier_alt:
	+ assumes "inv_imps_work_sum c"
	+ and "inv_implications_nonneg c"
	+ and "\<And>loc. c_work c loc = {#}\<^sub>z"
	+ shows "frontier (c_imp c loc) = implied_frontier_alt c loc"
	+ using ac_eq_iff implication_frontier_iff_implied_frontier_alt_vacant empty_worklists_vacant_to assms
	+ by blast
	+
	+lemma alw_implication_frontier_eq_implied_frontier_alt_empty: "spec s \<Longrightarrow>
	+ alw (holds (\<lambda>c. (\<forall>loc. c_work c loc = {#}\<^sub>z) \<longrightarrow> frontier (c_imp c loc) = implied_frontier_alt c loc)) s"
	+ apply (frule spec_imp_iiws)
	+ apply (drule alw_inv_implications_nonneg)
	+ apply (drule (1) alw_conjI)
	+ apply (erule thin_rl)
	+ apply (auto elim!: alw_mono simp: implication_frontier_eq_implied_frontier_alt)
	+ done
	+
	+lemma alw_implication_frontier_eq_implied_frontier_alt_vacant: "spec s \<Longrightarrow>
	+ alw (holds (\<lambda>c. worklists_vacant_to c b \<longrightarrow> b \<in>\<^sub>A frontier (c_imp c loc) \<longleftrightarrow> b \<in>\<^sub>A implied_frontier_alt c loc)) s"
	+ apply (frule spec_imp_iiws)
	+ apply (drule alw_inv_implications_nonneg)
	+ apply (drule (1) alw_conjI)
	+ apply (erule thin_rl)
	+ apply (auto elim!: alw_mono simp: implication_frontier_iff_implied_frontier_alt_vacant)
	+ done
	+
	+lemma antichain_eqI: "(\<And>b. b \<in>\<^sub>A A \<longleftrightarrow> b \<in>\<^sub>A B) \<Longrightarrow> A = B"
	+ by transfer auto
	+
	+lemma zmset_frontier_zmset_pos: "zmset_frontier A \<subseteq>#\<^sub>z zmset_pos A"
	+ unfolding subseteq_zmset_def
	+ by transfer' (auto simp: count_mset_set_if minimal_antichain_def)
	+
	+lemma image_mset_mono_pos:
	+ "\<forall>b. 0 \<le> zcount A b \<Longrightarrow> \<forall>b. 0 \<le> zcount B b \<Longrightarrow> A \<subseteq>#\<^sub>z B \<Longrightarrow> image_zmset f A \<subseteq>#\<^sub>z image_zmset f B"
	+ unfolding subseteq_zmset_def zcount_image_zmset
	+ apply (intro allI)
	+ apply (rule order_trans[OF sum_mono sum_mono2])
	+ apply simp_all
	+ by (metis Int_subset_iff antisym subsetI zcount_ne_zero_iff)
	+
	+lemma sum_mono_subseteq:
	+ "(\<And>i. i\<in>K \<Longrightarrow> f i \<subseteq>#\<^sub>z g i) \<Longrightarrow> (\<Sum>i\<in>K. f i) \<subseteq>#\<^sub>z (\<Sum>i\<in>K. g i)"
	+ by (simp add: subseteq_zmset_def sum_mono zcount_sum)
	+
	+lemma after_summary_zmset_frontier:
	+ "after_summary (zmset_frontier A) S \<subseteq>#\<^sub>z after_summary (zmset_pos A) S"
	+ unfolding after_summary_def
	+ apply (rule sum_mono_subseteq)
	+ apply (rule image_mset_mono_pos[OF _ _ zmset_frontier_zmset_pos])
	+ apply auto
	+ done
	+
	+lemma frontier_eqI: "\<forall>b. 0 \<le> zcount A b \<Longrightarrow> \<forall>b. 0 \<le> zcount B b \<Longrightarrow>
	+ A \<subseteq>#\<^sub>z B \<Longrightarrow> (\<And>b. b \<in>#\<^sub>z B \<Longrightarrow> \<exists>a. a \<in>#\<^sub>z A \<and> a \<le> b) \<Longrightarrow> frontier A = frontier B"
	+ apply (transfer fixing: A B)
	+ apply (clarsimp simp: minimal_antichain_def subseteq_zmset_def)
	+ apply safe
	+ apply (metis less_le_trans)
	+ apply (metis less_le less_le_trans zcount_ne_zero_iff)
	+ apply (metis antisym less_le zcount_ne_zero_iff)
	+ apply (meson less_le_trans)
	+ done
	+
	+lemma implied_frontier_implied_frontier_alt: "implied_frontier (c_pts c) loc = implied_frontier_alt c loc"
	+ unfolding implied_frontier_alt_def implied_frontier_def
	+ apply (rule frontier_eqI[symmetric])
	+ subgoal by (auto simp: zcount_sum sum_nonneg)
	+ subgoal by (auto simp: zcount_sum sum_nonneg)
	+ subgoal by (rule sum_mono_subseteq[OF after_summary_zmset_frontier])
	+ apply (simp flip: zcount_ne_zero_iff add: zcount_sum)
	+ apply (erule sum.not_neutral_contains_not_neutral)
	+ apply (simp flip: zcount_ne_zero_iff add: after_summary_def zcount_sum)
	+ apply (erule sum.not_neutral_contains_not_neutral)
	+ apply (simp flip: zcount_ne_zero_iff add: zcount_image_zmset split: if_splits)
	+ apply (erule sum.not_neutral_contains_not_neutral)
	+ apply (simp flip: zcount_ne_zero_iff)
	+ subgoal for u loc s t
	+ apply (rule obtain_elem_frontier[of "c_pts c loc" t])
	+ apply (metis le_less)
	+ subgoal for a
	+ apply (rule exI[of _ "results_in a s"])
	+ apply (rule conjI[rotated])
	+ using results_in_mono(1) apply blast
	+ apply (subst sum_nonneg_eq_0_iff; simp add: sum_nonneg)
	+ apply (rule exI[of _ loc])
	+ apply (subst sum_nonneg_eq_0_iff; simp)
	+ apply (rule bexI[of _ s])
	+ apply auto
	+ done
	+ done
	+ done
	+
	+lemmas alw_implication_frontier_eq_implied_frontier_vacant =
	+ alw_implication_frontier_eq_implied_frontier_alt_vacant[folded implied_frontier_implied_frontier_alt]
	+lemmas implication_frontier_iff_implied_frontier_vacant =
	+ implication_frontier_iff_implied_frontier_alt_vacant[folded implied_frontier_implied_frontier_alt]
	+
	+end
	+
	+(<)
	+end
	+(>)
	\ No newline at end of file
	diff --git a/thys/Progress_Tracking/ROOT b/thys/Progress_Tracking/ROOT
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/ROOT
	@@ -0,0 +1,13 @@
	+chapter AFP
	+
	+session Progress_Tracking (AFP) = Nested_Multisets_Ordinals +
	+ description \<open>Safety of Timely Dataflow's Progress Tracking Protocol\<close>
	+ options [timeout = 1200]
	+ sessions
	+ "HOL-Library"
	+ theories
	+ Exchange_Abadi
	+ Combined
	+ document_files
	+ "root.tex"
	+ "root.bib"
	diff --git a/thys/Progress_Tracking/document/root.bib b/thys/Progress_Tracking/document/root.bib
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/document/root.bib
	@@ -0,0 +1,52 @@
	+@inproceedings{BrunDLT-ITP21,
	+ author = {Matthias Brun and S\'ara Decova and Andrea Lattuada and
	+ Dmitriy Traytel},
	+ editor = {Liron Cohen and Cezary Kaliszyk},
	+ title = {Verified Progress Tracking for Timely Dataflow},
	+ booktitle = {12th International Conference on Interactive Theorem Proving, {ITP}
	+ 2021},
	+ series = {LIPIcs},
	+ publisher = {Schloss Dagstuhl - Leibniz-Zentrum f{\"{u}}r Informatik},
	+ year = {2021},
	+ note = {To appear},
	+ url = {https://traytel.bitbucket.io/papers/itp21-progress_tracking/safe.pdf}
	+}
	+
	+@inproceedings{DBLP:conf/forte/AbadiMMR13,
	+ author = {Mart{\'{\i}}n Abadi and
	+ Frank McSherry and
	+ Derek Gordon Murray and
	+ Thomas L. Rodeheffer},
	+ editor = {Dirk Beyer and
	+ Michele Boreale},
	+ title = {Formal Analysis of a Distributed Algorithm for Tracking Progress},
	+ booktitle = {{FMOODS/FORTE} 2013},
	+ series = {LNCS},
	+ volume = {7892},
	+ pages = {5--19},
	+ publisher = {Springer},
	+ year = {2013},
	+ doi = {10.1007/978-3-642-38592-6_2},
	+}
	+
	+@inproceedings{DBLP:conf/sosp/MurrayMIIBA13,
	+ author = {Derek Gordon Murray and
	+ Frank McSherry and
	+ Rebecca Isaacs and
	+ Michael Isard and
	+ Paul Barham and
	+ Mart{\'{\i}}n Abadi},
	+ editor = {Michael Kaminsky and
	+ Mike Dahlin},
	+ title = {Naiad: a timely dataflow system},
	+ booktitle = {{SOSP} 2013},
	+ pages = {439--455},
	+ publisher = {{ACM}},
	+ year = {2013},
	+ doi = {10.1145/2517349.2522738},
	+}
	+
	+@misc{URL:timely-dataflow,
	+ title = {GitHub: Timely Dataflow},
	+ url = {https://github.com/TimelyDataflow/timely-dataflow/},
	+}
	\ No newline at end of file
	diff --git a/thys/Progress_Tracking/document/root.tex b/thys/Progress_Tracking/document/root.tex
	new file mode 100644
	--- /dev/null
	+++ b/thys/Progress_Tracking/document/root.tex
	@@ -0,0 +1,83 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage{isabelle,isabellesym}
	+
	+\usepackage{cite}
	+\usepackage{amssymb}
	+
	+\usepackage{pdfsetup}
	+
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+
	+\begin{document}
	+
	+\title{Formalization of Timely Dataflow's\\ Progress Tracking Protocol}
	+\author{Matthias Brun, S\'ara Decova, Andrea Lattuada, and Dmitriy Traytel}
	+
	+\maketitle
	+
	+\begin{abstract}
	+Large-scale stream processing systems often follow the dataflow paradigm, which enforces a program
	+structure that exposes a high degree of parallelism. The Timely Dataflow distributed system supports
	+expressive cyclic dataflows for which it offers low-latency data- and pipeline-parallel stream processing.
	+To achieve high expressiveness and performance, Timely Dataflow uses an intricate distributed protocol
	+for tracking the computation’s progress. We formalize this progress tracking protocol and verify its safety.
	+Our formalization is described in detail in the forthcoming ITP'21 paper~\cite{BrunDLT-ITP21}.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+\section{Introduction}
	+
	+The dataflow programming model represents a program as a directed graph of interconnected operators
	+that perform per-tuple data transformations. A message (an incoming datum) arrives at an input (a
	+root of the dataflow) and flows along the graph's edges into operators. Each operator takes the
	+message, processes it, and emits any resulting derived messages.
	+
	+In a dataflow system, all messages are associated with a timestamp, and operator instances need to
	+know up-to-date (timestamp) \textit{frontiers}---lower bounds on what timestamps may still appear as
	+their inputs. When informed that all data for a range of timestamps has been delivered, an operator
	+instance can complete the computation on input data for that range of timestamps, produce the
	+resulting output, and retire those timestamps.
	+
	+A \textit{progress tracking mechanism} is a core component of the dataflow system. It receives
	+information on outstanding timestamps from operator instances, exchanges this information with other
	+system workers (cores, nodes) and disseminates up-to-date approximations of the frontiers to all
	+operator instances. This AFP entry formally models and proves the safety of the progress
	+tracking protocol of \textit{Timely
	+Dataflow}~\cite{DBLP:conf/sosp/MurrayMIIBA13,URL:timely-dataflow}, a dataflow programming
	+model and a state-of-the-art streaming, data-parallel, distributed data processor.
	+Specifically, we
	+prove that the progress tracking protocol computes frontiers that always constitute safe lower bounds on what
	+timestamps may still appear on the operator inputs.
	+The formalization is described in detail in the forthcoming ITP'21 paper~\cite{BrunDLT-ITP21}.
	+
	+The ITP paper~\cite{BrunDLT-ITP21} closely follows this formalization's structure. In particular, the paper's presentation
	+is split into four main sections each of which is present in the formalization (each in a separate
	+theory file):
	+\begin{center}
	+\begin{tabular}{@{}p{0.27\textwidth}p{0.215\textwidth}p{0.168\textwidth}p{0.243\textwidth}@{}}
	+Algorithm/protocol&Section in this proof document&Section in \cite{BrunDLT-ITP21}&Theory file\\\hline
	+Abadi et al.~\cite{DBLP:conf/forte/AbadiMMR13}'s clocks protocol&Section~\ref{sec:clocks}&Section 3&Exchange\_Abadi\\
	+Exchange protocol&Section~\ref{sec:exchange}&Section 4&Exchange\\
	+Local propagation algorithm&Section~\ref{sec:propagate}&Section 5&Propagate\\
	+Combined protocol&Section~\ref{sec:combined}&Section 6&Combined
	+\end{tabular}
	+\end{center}
	+
	+\input{session}
	+
	+% optional bibliography
	+\bibliographystyle{abbrv}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/thys/ROOTS b/thys/ROOTS
	--- a/thys/ROOTS
	+++ b/thys/ROOTS
	@@ -1,592 +1,600 @@
	ADS_Functor
	AI_Planning_Languages_Semantics
	AODV
	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
	Amicable_Numbers
	Amortized_Complexity
	AnselmGod
	Applicative_Lifting
	Approximation_Algorithms
	Architectural_Design_Patterns
	Aristotles_Assertoric_Syllogistic
	Arith_Prog_Rel_Primes
	ArrowImpossibilityGS
	Attack_Trees
	Auto2_HOL
	Auto2_Imperative_HOL
	AutoFocus-Stream
	Automated_Stateful_Protocol_Verification
	Automatic_Refinement
	AxiomaticCategoryTheory
	BDD
	BNF_CC
	BNF_Operations
	BTree
	Banach_Steinhaus
	Bell_Numbers_Spivey
	+BenOr_Kozen_Reif
	Berlekamp_Zassenhaus
	Bernoulli
	Bertrands_Postulate
	Bicategory
	BinarySearchTree
	Binding_Syntax_Theory
	Binomial-Heaps
	Binomial-Queues
	BirdKMP
	Blue_Eyes
	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
	Chandy_Lamport
	Chord_Segments
	Circus
	Clean
	ClockSynchInst
	Closest_Pair_Points
	CofGroups
	Coinductive
	Coinductive_Languages
	Collections
	Comparison_Sort_Lower_Bound
	Compiling-Exceptions-Correctly
	Complete_Non_Orders
	Completeness
	Complex_Geometry
	Complx
	ComponentDependencies
	ConcurrentGC
	ConcurrentIMP
	Concurrent_Ref_Alg
	Concurrent_Revisions
	Consensus_Refined
	Constructive_Cryptography
	Constructive_Cryptography_CM
	Constructor_Funs
	Containers
	CoreC++
	Core_DOM
	Core_SC_DOM
	Count_Complex_Roots
	CryptHOL
	CryptoBasedCompositionalProperties
	CSP_RefTK
	DFS_Framework
	DPT-SAT-Solver
	DataRefinementIBP
	Datatype_Order_Generator
	Decl_Sem_Fun_PL
	Decreasing-Diagrams
	Decreasing-Diagrams-II
	Deep_Learning
	Delta_System_Lemma
	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
	DiscretePricing
	Discrete_Summation
	DiskPaxos
	DOM_Components
	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
	Extended_Finite_State_Machine_Inference
	Extended_Finite_State_Machines
	FFT
	FLP
	FOL-Fitting
	FOL_Harrison
	FOL_Seq_Calc1
	Factored_Transition_System_Bounding
	Falling_Factorial_Sum
	Farkas
	FeatherweightJava
	Featherweight_OCL
	Fermat3_4
	FileRefinement
	FinFun
	Finger-Trees
	Finite-Map-Extras
	Finite_Automata_HF
	First_Order_Terms
	First_Welfare_Theorem
	Fishburn_Impossibility
	Fisher_Yates
	Flow_Networks
	Floyd_Warshall
	Flyspeck-Tame
	FocusStreamsCaseStudies
	Forcing
	Formal_Puiseux_Series
	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
	+GaleStewart_Games
	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
	Goedel_HFSet_Semantic
	Goedel_HFSet_Semanticless
	Goedel_Incompleteness
	Goodstein_Lambda
	GraphMarkingIBP
	Graph_Saturation
	Graph_Theory
	Green
	Groebner_Bases
	Groebner_Macaulay
	Gromov_Hyperbolicity
	+Grothendieck_Schemes
	Group-Ring-Module
	HOL-CSP
	HOLCF-Prelude
	HRB-Slicing
	Heard_Of
	Hello_World
	HereditarilyFinite
	Hermite
	Hermite_Lindemann
	Hidden_Markov_Models
	Higher_Order_Terms
	Hoare_Time
	Hood_Melville_Queue
	HotelKeyCards
	Huffman
	Hybrid_Logic
	Hybrid_Multi_Lane_Spatial_Logic
	Hybrid_Systems_VCs
	HyperCTL
	IEEE_Floating_Point
	+IFC_Tracking
	IMAP-CRDT
	IMO2019
	IMP2
	IMP2_Binary_Heap
	IP_Addresses
	Imperative_Insertion_Sort
	Impossible_Geometry
	Incompleteness
	Incredible_Proof_Machine
	Inductive_Confidentiality
	Inductive_Inference
	InfPathElimination
	InformationFlowSlicing
	InformationFlowSlicing_Inter
	Integration
	Interpreter_Optimizations
	Interval_Arithmetic_Word32
	Iptables_Semantics
	Irrational_Series_Erdos_Straus
	Irrationality_J_Hancl
	Isabelle_C
	Isabelle_Marries_Dirac
	Isabelle_Meta_Model
	IsaGeoCoq
	Jacobson_Basic_Algebra
	Jinja
	JinjaDCI
	JinjaThreads
	JiveDataStoreModel
	Jordan_Hoelder
	Jordan_Normal_Form
	KAD
	KAT_and_DRA
	KBPs
	KD_Tree
	Key_Agreement_Strong_Adversaries
	Kleene_Algebra
	Knuth_Bendix_Order
	Knot_Theory
	Knuth_Bendix_Order
	Knuth_Morris_Pratt
	Koenigsberg_Friendship
	Kruskal
	Kuratowski_Closure_Complement
	LLL_Basis_Reduction
	LLL_Factorization
	LOFT
	LTL
	LTL_Master_Theorem
	LTL_Normal_Form
	LTL_to_DRA
	LTL_to_GBA
	Lam-ml-Normalization
	LambdaAuth
	LambdaMu
	Lambda_Free_EPO
	Lambda_Free_KBOs
	Lambda_Free_RPOs
	Lambert_W
	Landau_Symbols
	Laplace_Transform
	Latin_Square
	LatticeProperties
	Launchbury
	Laws_of_Large_Numbers
	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
	MFODL_Monitor_Optimized
	MFOTL_Monitor
	MSO_Regex_Equivalence
	Markov_Models
	Marriage
	Mason_Stothers
	Matrices_for_ODEs
	Matrix
	Matrix_Tensor
	Matroids
	Max-Card-Matching
	Median_Of_Medians_Selection
	Menger
	Mereology
	Mersenne_Primes
	+Metalogic_ProofChecker
	MiniML
	Minimal_SSA
	Minkowskis_Theorem
	Minsky_Machines
	Modal_Logics_for_NTS
	Modular_arithmetic_LLL_and_HNF_algorithms
	Modular_Assembly_Kit_Security
	Monad_Memo_DP
	Monad_Normalisation
	MonoBoolTranAlgebra
	MonoidalCategory
	Monomorphic_Monad
	MuchAdoAboutTwo
	Multi_Party_Computation
	Multirelations
	Myhill-Nerode
	Name_Carrying_Type_Inference
	Nash_Williams
	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
	OpSets
	Open_Induction
	Optics
	Optimal_BST
	Orbit_Stabiliser
	Order_Lattice_Props
	Ordered_Resolution_Prover
	Ordinal
	Ordinal_Partitions
	Ordinals_and_Cardinals
	Ordinary_Differential_Equations
	PAC_Checker
	PCF
	PLM
	POPLmark-deBruijn
	PSemigroupsConvolution
	+Padic_Ints
	Pairing_Heap
	Paraconsistency
	Parity_Game
	Partial_Function_MR
	Partial_Order_Reduction
	Password_Authentication_Protocol
	Pell
	Perfect-Number-Thm
	Perron_Frobenius
	Physical_Quantities
	Pi_Calculus
	Pi_Transcendental
	Planarity_Certificates
	Poincare_Bendixson
	Poincare_Disc
	Polynomial_Factorization
	Polynomial_Interpolation
	Polynomials
	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
	Program-Conflict-Analysis
	+Progress_Tracking
	Projective_Geometry
	Projective_Measurements
	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
	Random_Graph_Subgraph_Threshold
	Randomised_BSTs
	Randomised_Social_Choice
	Rank_Nullity_Theorem
	Real_Impl
	Recursion-Addition
	Recursion-Theory-I
	Refine_Imperative_HOL
	Refine_Monadic
	RefinementReactive
	Regex_Equivalence
	+Regression_Test_Selection
	Regular-Sets
	Regular_Algebras
	Relation_Algebra
	Relational-Incorrectness-Logic
	Relational_Disjoint_Set_Forests
	Relational_Method
	Relational_Minimum_Spanning_Trees
	Relational_Paths
	Rep_Fin_Groups
	Residuated_Lattices
	Resolution_FOL
	Rewriting_Z
	Ribbon_Proofs
	Robbins-Conjecture
	Robinson_Arithmetic
	Root_Balanced_Tree
	Routing
	Roy_Floyd_Warshall
	SATSolverVerification
	SC_DOM_Components
	SDS_Impossibility
	SIFPL
	SIFUM_Type_Systems
	SPARCv8
	Safe_Distance
	Safe_OCL
	Saturation_Framework
	Saturation_Framework_Extensions
	Shadow_DOM
	Secondary_Sylow
	Security_Protocol_Refinement
	Selection_Heap_Sort
	SenSocialChoice
	Separata
	Separation_Algebra
	Separation_Logic_Imperative_HOL
	SequentInvertibility
	Shadow_SC_DOM
	Shivers-CFA
	ShortestPath
	Show
	Sigma_Commit_Crypto
	Signature_Groebner
	Simpl
	Simple_Firewall
	Simplex
	Skew_Heap
	Skip_Lists
	Slicing
	Sliding_Window_Algorithm
	Smith_Normal_Form
	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
	Sunflowers
	SuperCalc
	Surprise_Paradox
	Symmetric_Polynomials
	Syntax_Independent_Logic
	Szpilrajn
	TESL_Language
	TLA
	Tail_Recursive_Functions
	Tarskis_Geometry
	Taylor_Models
	Timed_Automata
	Topological_Semantics
	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
	UPF
	UPF_Firewall
	UTP
	Universal_Turing_Machine
	UpDown_Scheme
	Valuation
	VectorSpace
	VeriComp
	Verified-Prover
	Verified_SAT_Based_AI_Planning
	VerifyThis2018
	VerifyThis2019
	Vickrey_Clarke_Groves
	VolpanoSmith
	WHATandWHERE_Security
	WOOT_Strong_Eventual_Consistency
	WebAssembly
	Weight_Balanced_Trees
	Well_Quasi_Orders
	Winding_Number_Eval
	Word_Lib
	WorkerWrapper
	XML
	ZFC_in_HOL
	Zeta_3_Irrational
	Zeta_Function
	pGCL
	diff --git a/thys/Regression_Test_Selection/Common/CollectionBasedRTS.thy b/thys/Regression_Test_Selection/Common/CollectionBasedRTS.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/Common/CollectionBasedRTS.thy
	@@ -0,0 +1,32 @@
	+(* Title: RTS/Common/CollectionBasedRTS.thy *)
	+(* Author: Susannah Mansky, UIUC 2020 *)
	+
	+section "Collection-based RTS"
	+
	+theory CollectionBasedRTS
	+imports RTS_safe CollectionSemantics
	+begin
	+
	+locale CollectionBasedRTS_base = RTS_safe + CollectionSemantics
	+
	+text "General model for Regression Test Selection based on
	+ @{term CollectionSemantics}:"
	+locale CollectionBasedRTS = CollectionBasedRTS_base where
	+ small = "small :: 'prog \<Rightarrow> 'state \<Rightarrow> 'state set" and
	+ collect = "collect :: 'prog \<Rightarrow> 'state \<Rightarrow> 'state \<Rightarrow> 'coll" and
	+ out = "out :: 'prog \<Rightarrow> 'test \<Rightarrow> ('state \<times> 'coll) set"
	+ for small collect out
	++
	+ fixes
	+ make_test_prog :: "'prog \<Rightarrow> 'test \<Rightarrow> 'prog" and
	+ collect_start :: "'prog \<Rightarrow> 'coll"
	+ assumes
	+ out_cbig:
	+ "\<exists>i. out P t = {(\<sigma>',coll'). \<exists>coll. (\<sigma>',coll) \<in> cbig (make_test_prog P t) i
	+ \<and> coll' = combine coll (collect_start P) }"
	+
	+context CollectionBasedRTS begin
	+
	+end \<comment> \<open> CollectionBasedRTS \<close>
	+
	+end
	diff --git a/thys/Regression_Test_Selection/Common/CollectionSemantics.thy b/thys/Regression_Test_Selection/Common/CollectionSemantics.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/Common/CollectionSemantics.thy
	@@ -0,0 +1,258 @@
	+(* Title: RTS/Common/CollectionSemantics.thy *)
	+(* Author: Susannah Mansky, UIUC 2020 *)
	+
	+section "Collection Semantics"
	+
	+theory CollectionSemantics
	+imports Semantics
	+begin
	+
	+text "General model for small step semantics instrumented
	+ with an information collection mechanism:"
	+locale CollectionSemantics = Semantics +
	+ constrains
	+ small :: "'prog \<Rightarrow> 'state \<Rightarrow> 'state set" and
	+ endset :: "'state set"
	+ fixes
	+ collect :: "'prog \<Rightarrow> 'state \<Rightarrow> 'state \<Rightarrow> 'coll" and
	+ combine :: "'coll \<Rightarrow> 'coll \<Rightarrow> 'coll" and
	+ collect_id :: "'coll"
	+ assumes
	+ combine_assoc: "combine (combine c1 c2) c3 = combine c1 (combine c2 c3)" and
	+ collect_idl[simp]: "combine collect_id c = c" and
	+ collect_idr[simp]: "combine c collect_id = c"
	+
	+context CollectionSemantics begin
	+
	+subsection "Small-Step Collection Semantics"
	+
	+definition csmall :: "'prog \<Rightarrow> 'state \<Rightarrow> ('state \<times> 'coll) set" where
	+"csmall P \<sigma> \<equiv> { (\<sigma>', coll). \<sigma>' \<in> small P \<sigma> \<and> collect P \<sigma> \<sigma>' = coll }"
	+
	+lemma small_det_csmall_det:
	+assumes "\<forall>\<sigma>. small P \<sigma> = {} \<or> (\<exists>\<sigma>'. small P \<sigma> = {\<sigma>'})"
	+shows "\<forall>\<sigma>. csmall P \<sigma> = {} \<or> (\<exists>o'. csmall P \<sigma> = {o'})"
	+using assms by(fastforce simp: csmall_def)
	+
	+subsection "Extending @{term csmall} to multiple steps"
	+
	+primrec csmall_nstep :: "'prog \<Rightarrow> 'state \<Rightarrow> nat \<Rightarrow> ('state \<times> 'coll) set" where
	+csmall_nstep_base:
	+ "csmall_nstep P \<sigma> 0 = {(\<sigma>, collect_id)}" \|
	+csmall_nstep_Rec:
	+ "csmall_nstep P \<sigma> (Suc n) =
	+ { (\<sigma>2, coll). \<exists>\<sigma>1 coll1 coll2. (\<sigma>1, coll1) \<in> csmall_nstep P \<sigma> n
	+ \<and> (\<sigma>2, coll2) \<in> csmall P \<sigma>1 \<and> combine coll1 coll2 = coll }"
	+
	+lemma small_nstep_csmall_nstep_equiv:
	+ "small_nstep P \<sigma> n
	+ = { \<sigma>'. \<exists>coll. (\<sigma>', coll) \<in> csmall_nstep P \<sigma> n }"
	+proof (induct n) qed(simp_all add: csmall_def)
	+
	+lemma csmall_nstep_exists:
	+ "\<sigma>' \<in> big P \<sigma> \<Longrightarrow> \<exists>n coll. (\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<and> \<sigma>' \<in> endset"
	+proof(drule bigD) qed(clarsimp simp: small_nstep_csmall_nstep_equiv)
	+
	+lemma csmall_det_csmall_nstep_det:
	+assumes "\<forall>\<sigma>. csmall P \<sigma> = {} \<or> (\<exists>o'. csmall P \<sigma> = {o'})"
	+shows "\<forall>\<sigma>. csmall_nstep P \<sigma> n = {} \<or> (\<exists>o'. csmall_nstep P \<sigma> n = {o'})"
	+using assms
	+proof(induct n)
	+ case (Suc n) then show ?case by fastforce
	+qed(simp)
	+
	+lemma csmall_nstep_Rec2:
	+ "csmall_nstep P \<sigma> (Suc n) =
	+ { (\<sigma>2, coll). \<exists>\<sigma>1 coll1 coll2. (\<sigma>1, coll1) \<in> csmall P \<sigma>
	+ \<and> (\<sigma>2, coll2) \<in> csmall_nstep P \<sigma>1 n \<and> combine coll1 coll2 = coll }"
	+proof(induct n arbitrary: \<sigma>)
	+ case (Suc n)
	+ have right: "\<And>\<sigma>' coll'. (\<sigma>', coll') \<in> csmall_nstep P \<sigma> (Suc(Suc n))
	+ \<Longrightarrow> \<exists>\<sigma>1 coll1 coll2. (\<sigma>1, coll1) \<in> csmall P \<sigma>
	+ \<and> (\<sigma>', coll2) \<in> csmall_nstep P \<sigma>1 (Suc n) \<and> combine coll1 coll2 = coll'"
	+ proof -
	+ fix \<sigma>' coll'
	+ assume "(\<sigma>', coll') \<in> csmall_nstep P \<sigma> (Suc(Suc n))"
	+ then obtain \<sigma>1 coll1 coll2 where Sucnstep: "(\<sigma>1, coll1) \<in> csmall_nstep P \<sigma> (Suc n)"
	+ "(\<sigma>', coll2) \<in> csmall P \<sigma>1" "combine coll1 coll2 = coll'" by fastforce
	+ obtain \<sigma>12 coll12 coll22 where nstep: "(\<sigma>12, coll12) \<in> csmall P \<sigma>
	+ \<and> (\<sigma>1, coll22) \<in> csmall_nstep P \<sigma>12 n \<and> combine coll12 coll22 = coll1"
	+ using Suc Sucnstep(1) by fastforce
	+ then show "\<exists>\<sigma>1 coll1 coll2. (\<sigma>1, coll1) \<in> csmall P \<sigma>
	+ \<and> (\<sigma>', coll2) \<in> csmall_nstep P \<sigma>1 (Suc n) \<and> combine coll1 coll2 = coll'"
	+ using combine_assoc[of coll12 coll22 coll2] Sucnstep by fastforce
	+ qed
	+ have left: "\<And>\<sigma>' coll'. \<exists>\<sigma>1 coll1 coll2. (\<sigma>1, coll1) \<in> csmall P \<sigma>
	+ \<and> (\<sigma>', coll2) \<in> csmall_nstep P \<sigma>1 (Suc n) \<and> combine coll1 coll2 = coll'
	+ \<Longrightarrow> (\<sigma>', coll') \<in> csmall_nstep P \<sigma> (Suc(Suc n))"
	+ proof -
	+ fix \<sigma>' coll'
	+ assume "\<exists>\<sigma>1 coll1 coll2. (\<sigma>1, coll1) \<in> csmall P \<sigma>
	+ \<and> (\<sigma>', coll2) \<in> csmall_nstep P \<sigma>1 (Suc n) \<and> combine coll1 coll2 = coll'"
	+ then obtain \<sigma>1 coll1 coll2 where Sucnstep: "(\<sigma>1, coll1) \<in> csmall P \<sigma>"
	+ "(\<sigma>', coll2) \<in> csmall_nstep P \<sigma>1 (Suc n)" "combine coll1 coll2 = coll'"
	+ by fastforce
	+ obtain \<sigma>12 coll12 coll22 where nstep: "(\<sigma>12, coll12) \<in> csmall_nstep P \<sigma>1 n
	+ \<and> (\<sigma>', coll22) \<in> csmall P \<sigma>12 \<and> combine coll12 coll22 = coll2"
	+ using Sucnstep(2) by auto
	+ then show "(\<sigma>', coll') \<in> csmall_nstep P \<sigma> (Suc(Suc n))"
	+ using combine_assoc[of coll1 coll12 coll22] Suc Sucnstep by fastforce
	+ qed
	+ show ?case using right left by fast
	+qed(simp)
	+
	+lemma csmall_nstep_SucD:
	+assumes "(\<sigma>',coll') \<in> csmall_nstep P \<sigma> (Suc n)"
	+shows "\<exists>\<sigma>1 coll1. (\<sigma>1, coll1) \<in> csmall P \<sigma>
	+ \<and> (\<exists>coll. coll' = combine coll1 coll \<and> (\<sigma>',coll) \<in> csmall_nstep P \<sigma>1 n)"
	+ using csmall_nstep_Rec2 CollectionSemantics_axioms case_prodD assms by fastforce
	+
	+lemma csmall_nstep_Suc_nend: "o' \<in> csmall_nstep P \<sigma> (Suc n1) \<Longrightarrow> \<sigma> \<notin> endset"
	+ using endset_final csmall_nstep_SucD CollectionSemantics.csmall_def CollectionSemantics_axioms
	+ by fastforce
	+
	+lemma small_to_csmall_nstep_pres:
	+assumes Qpres: "\<And>P \<sigma> \<sigma>'. Q P \<sigma> \<Longrightarrow> \<sigma>' \<in> small P \<sigma> \<Longrightarrow> Q P \<sigma>'"
	+shows "Q P \<sigma> \<Longrightarrow> (\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<Longrightarrow> Q P \<sigma>'"
	+proof(induct n arbitrary: \<sigma> \<sigma>' coll)
	+ case (Suc n)
	+ then obtain \<sigma>1 coll1 coll2 where nstep: "(\<sigma>1, coll1) \<in> csmall_nstep P \<sigma> n
	+ \<and> (\<sigma>', coll2) \<in> csmall P \<sigma>1 \<and> combine coll1 coll2 = coll" by clarsimp
	+ then show ?case using Suc Qpres[where P=P and \<sigma>=\<sigma>1 and \<sigma>'=\<sigma>'] by(auto simp: csmall_def)
	+qed(simp)
	+
	+lemma csmall_to_csmall_nstep_prop:
	+assumes cond: "\<And>P \<sigma> \<sigma>' coll. (\<sigma>', coll) \<in> csmall P \<sigma> \<Longrightarrow> R P coll \<Longrightarrow> Q P \<sigma> \<Longrightarrow> R' P \<sigma> \<sigma>' coll"
	+ and Rcomb: "\<And>P coll1 coll2. R P (combine coll1 coll2) = (R P coll1 \<and> R P coll2)"
	+ and Qpres: "\<And>P \<sigma> \<sigma>'. Q P \<sigma> \<Longrightarrow> \<sigma>' \<in> small P \<sigma> \<Longrightarrow> Q P \<sigma>'"
	+ and Rtrans': "\<And>P \<sigma> \<sigma>1 \<sigma>' coll1 coll2.
	+ R' P \<sigma> \<sigma>1 coll1 \<and> R' P \<sigma>1 \<sigma>' coll2 \<Longrightarrow> R' P \<sigma> \<sigma>' (combine coll1 coll2)"
	+ and base: "\<And>\<sigma>. R' P \<sigma> \<sigma> collect_id"
	+shows "(\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<Longrightarrow> R P coll \<Longrightarrow> Q P \<sigma> \<Longrightarrow> R' P \<sigma> \<sigma>' coll"
	+proof(induct n arbitrary: \<sigma> \<sigma>' coll)
	+ case (Suc n)
	+ then obtain \<sigma>1 coll1 coll2 where nstep: "(\<sigma>1, coll1) \<in> csmall_nstep P \<sigma> n
	+ \<and> (\<sigma>', coll2) \<in> csmall P \<sigma>1 \<and> combine coll1 coll2 = coll" by clarsimp
	+ then have "Q P \<sigma>1" using small_to_csmall_nstep_pres[where Q=Q] Qpres Suc by blast
	+ then show ?case using nstep assms Suc by auto blast
	+qed(simp add: base)
	+
	+lemma csmall_to_csmall_nstep_prop2:
	+assumes cond: "\<And>P P' \<sigma> \<sigma>' coll. (\<sigma>', coll) \<in> csmall P \<sigma>
	+ \<Longrightarrow> R P P' coll \<Longrightarrow> Q \<sigma> \<Longrightarrow> (\<sigma>', coll) \<in> csmall P' \<sigma>"
	+ and Rcomb: "\<And>P P' coll1 coll2. R P P' (combine coll1 coll2) = (R P P' coll1 \<and> R P P' coll2)"
	+ and Qpres: "\<And>P \<sigma> \<sigma>'. Q \<sigma> \<Longrightarrow> \<sigma>' \<in> small P \<sigma> \<Longrightarrow> Q \<sigma>'"
	+shows "(\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<Longrightarrow> R P P' coll \<Longrightarrow> Q \<sigma> \<Longrightarrow> (\<sigma>', coll) \<in> csmall_nstep P' \<sigma> n"
	+proof(induct n arbitrary: \<sigma> \<sigma>' coll)
	+ case (Suc n)
	+ then obtain \<sigma>1 coll1 coll2 where nstep: "(\<sigma>1, coll1) \<in> csmall_nstep P \<sigma> n
	+ \<and> (\<sigma>', coll2) \<in> csmall P \<sigma>1 \<and> combine coll1 coll2 = coll" by clarsimp
	+ then have "Q \<sigma>1" using small_to_csmall_nstep_pres[where Q="\<lambda>P. Q"] Qpres Suc by blast
	+ then show ?case using nstep assms Suc by auto blast
	+qed(simp)
	+
	+subsection "Extending @{term csmall} to a big-step semantics"
	+
	+definition cbig :: "'prog \<Rightarrow> 'state \<Rightarrow> ('state \<times> 'coll) set" where
	+"cbig P \<sigma> \<equiv>
	+ { (\<sigma>', coll). \<exists>n. (\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<and> \<sigma>' \<in> endset }"
	+
	+lemma cbigD:
	+ "\<lbrakk> (\<sigma>',coll') \<in> cbig P \<sigma> \<rbrakk> \<Longrightarrow> \<exists>n. (\<sigma>',coll') \<in> csmall_nstep P \<sigma> n \<and> \<sigma>' \<in> endset"
	+ by(simp add: cbig_def)
	+
	+lemma cbigD':
	+ "\<lbrakk> o' \<in> cbig P \<sigma> \<rbrakk> \<Longrightarrow> \<exists>n. o' \<in> csmall_nstep P \<sigma> n \<and> fst o' \<in> endset"
	+ by(cases o', simp add: cbig_def)
	+
	+lemma cbig_def2:
	+ "(\<sigma>', coll) \<in> cbig P \<sigma> \<longleftrightarrow> (\<exists>n. (\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<and> \<sigma>' \<in> endset)"
	+proof(rule iffI)
	+ assume "(\<sigma>', coll) \<in> cbig P \<sigma>"
	+ then show "\<exists>n. (\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<and> \<sigma>' \<in> endset" using bigD cbig_def by auto
	+next
	+ assume "\<exists>n. (\<sigma>', coll) \<in> csmall_nstep P \<sigma> n \<and> \<sigma>' \<in> endset"
	+ then show "(\<sigma>', coll) \<in> cbig P \<sigma>" using big_def cbig_def small_nstep_csmall_nstep_equiv by auto
	+qed
	+
	+lemma cbig_big_equiv:
	+ "(\<exists>coll. (\<sigma>', coll) \<in> cbig P \<sigma>) \<longleftrightarrow> \<sigma>' \<in> big P \<sigma>"
	+proof(rule iffI)
	+ assume "\<exists>coll. (\<sigma>', coll) \<in> cbig P \<sigma>"
	+ then show "\<sigma>' \<in> big P \<sigma>" by (auto simp: big_def cbig_def small_nstep_csmall_nstep_equiv)
	+next
	+ assume "\<sigma>' \<in> big P \<sigma>"
	+ then show "\<exists>coll. (\<sigma>', coll) \<in> cbig P \<sigma>" by (fastforce simp: cbig_def dest: csmall_nstep_exists)
	+qed
	+
	+lemma cbig_big_implies:
	+ "(\<sigma>', coll) \<in> cbig P \<sigma> \<Longrightarrow> \<sigma>' \<in> big P \<sigma>"
	+using cbig_big_equiv by blast
	+
	+lemma csmall_to_cbig_prop:
	+assumes "\<And>P \<sigma> \<sigma>' coll. (\<sigma>', coll) \<in> csmall P \<sigma> \<Longrightarrow> R P coll \<Longrightarrow> Q P \<sigma> \<Longrightarrow> R' P \<sigma> \<sigma>' coll"
	+ and "\<And>P coll1 coll2. R P (combine coll1 coll2) = (R P coll1 \<and> R P coll2)"
	+ and "\<And>P \<sigma> \<sigma>'. Q P \<sigma> \<Longrightarrow> \<sigma>' \<in> small P \<sigma> \<Longrightarrow> Q P \<sigma>'"
	+ and "\<And>P \<sigma> \<sigma>1 \<sigma>' coll1 coll2.
	+ R' P \<sigma> \<sigma>1 coll1 \<and> R' P \<sigma>1 \<sigma>' coll2 \<Longrightarrow> R' P \<sigma> \<sigma>' (combine coll1 coll2)"
	+ and "\<And>\<sigma>. R' P \<sigma> \<sigma> collect_id"
	+shows "(\<sigma>', coll) \<in> cbig P \<sigma> \<Longrightarrow> R P coll \<Longrightarrow> Q P \<sigma> \<Longrightarrow> R' P \<sigma> \<sigma>' coll"
	+using assms csmall_to_csmall_nstep_prop[where R=R and Q=Q and R'=R' and \<sigma>=\<sigma>]
	+ by(auto simp: cbig_def2)
	+
	+lemma csmall_to_cbig_prop2:
	+assumes "\<And>P P' \<sigma> \<sigma>' coll. (\<sigma>', coll) \<in> csmall P \<sigma> \<Longrightarrow> R P P' coll \<Longrightarrow> Q \<sigma> \<Longrightarrow> (\<sigma>', coll) \<in> csmall P' \<sigma>"
	+ and "\<And>P P' coll1 coll2. R P P' (combine coll1 coll2) = (R P P' coll1 \<and> R P P' coll2)"
	+ and Qpres: "\<And>P \<sigma> \<sigma>'. Q \<sigma> \<Longrightarrow> \<sigma>' \<in> small P \<sigma> \<Longrightarrow> Q \<sigma>'"
	+shows "(\<sigma>', coll) \<in> cbig P \<sigma> \<Longrightarrow> R P P' coll \<Longrightarrow> Q \<sigma> \<Longrightarrow> (\<sigma>', coll) \<in> cbig P' \<sigma>"
	+using assms csmall_to_csmall_nstep_prop2[where R=R and Q=Q] by(auto simp: cbig_def2) blast
	+
	+lemma cbig_stepD:
	+assumes cbig: "(\<sigma>',coll') \<in> cbig P \<sigma>" and nend: "\<sigma> \<notin> endset"
	+shows "\<exists>\<sigma>1 coll1. (\<sigma>1, coll1) \<in> csmall P \<sigma>
	+ \<and> (\<exists>coll. coll' = combine coll1 coll \<and> (\<sigma>',coll) \<in> cbig P \<sigma>1)"
	+proof -
	+ obtain n where n: "(\<sigma>', coll') \<in> csmall_nstep P \<sigma> n" "\<sigma>' \<in> endset"
	+ using cbig_def2 cbig by auto
	+ then show ?thesis using csmall_nstep_SucD nend cbig_def2 by(cases n, simp) blast
	+qed
	+
	+(****)
	+
	+lemma csmall_nstep_det_last_eq:
	+assumes det: "\<forall>\<sigma>. small P \<sigma> = {} \<or> (\<exists>\<sigma>'. small P \<sigma> = {\<sigma>'})"
	+shows "\<lbrakk> (\<sigma>',coll') \<in> cbig P \<sigma>; (\<sigma>',coll') \<in> csmall_nstep P \<sigma> n; (\<sigma>',coll'') \<in> csmall_nstep P \<sigma> n' \<rbrakk>
	+ \<Longrightarrow> n = n'"
	+proof(induct n arbitrary: n' \<sigma> \<sigma>' coll' coll'')
	+ case 0
	+ have "\<sigma>' = \<sigma>" using "0.prems"(2) csmall_nstep_base by blast
	+ then have endset: "\<sigma> \<in> endset" using "0.prems"(1) cbigD by blast
	+ show ?case
	+ proof(cases n')
	+ case Suc then show ?thesis using "0.prems"(3) csmall_nstep_Suc_nend endset by blast
	+ qed(simp)
	+next
	+ case (Suc n1)
	+ then have endset: "\<sigma>' \<in> endset" using Suc.prems(1) cbigD by blast
	+ have nend: "\<sigma> \<notin> endset" using csmall_nstep_Suc_nend[OF Suc.prems(2)] by simp
	+ then have neq: "\<sigma>' \<noteq> \<sigma>" using endset by auto
	+ obtain \<sigma>1 coll coll1 where \<sigma>1: "(\<sigma>1,coll1) \<in> csmall P \<sigma>" "coll' = combine coll1 coll"
	+ "(\<sigma>',coll) \<in> csmall_nstep P \<sigma>1 n1"
	+ using csmall_nstep_SucD[OF Suc.prems(2)] by clarsimp
	+ then have cbig: "(\<sigma>',coll) \<in> cbig P \<sigma>1" using endset by(auto simp: cbig_def)
	+ show ?case
	+ proof(cases n')
	+ case 0 then show ?thesis using neq Suc.prems(3) using csmall_nstep_base by simp
	+ next
	+ case Suc': (Suc n1')
	+ then obtain \<sigma>1' coll2 coll1' where \<sigma>1': "(\<sigma>1',coll1') \<in> csmall P \<sigma>" "coll'' = combine coll1' coll2"
	+ "(\<sigma>',coll2) \<in> csmall_nstep P \<sigma>1' n1'"
	+ using csmall_nstep_SucD[where \<sigma>=\<sigma> and \<sigma>'=\<sigma>' and coll'=coll'' and n=n1'] Suc.prems(3) by blast
	+ then have "\<sigma>1=\<sigma>1'" using \<sigma>1 det csmall_def by auto
	+ then show ?thesis using Suc.hyps(1)[OF cbig \<sigma>1(3)] \<sigma>1'(3) Suc' by blast
	+ qed
	+qed
	+
	+end \<comment> \<open> CollectionSemantics \<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/Common/RTS_safe.thy b/thys/Regression_Test_Selection/Common/RTS_safe.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/Common/RTS_safe.thy
	@@ -0,0 +1,86 @@
	+(* Title: RTS/Common/RTS_safe.thy *)
	+(* Author: Susannah Mansky, UIUC 2020 *)
	+
	+section "Regression Test Selection algorithm model"
	+
	+theory RTS_safe
	+imports Main
	+begin
	+
	+text \<open> This describes an \emph{existence safe} RTS algorithm: if a test
	+ is deselected based on an output, there is SOME equivalent output
	+ under the changed program. \<close>
	+locale RTS_safe =
	+ fixes
	+ out :: "'prog \<Rightarrow> 'test \<Rightarrow> 'prog_out set" and
	+ equiv_out :: "'prog_out \<Rightarrow> 'prog_out \<Rightarrow> bool" and
	+ deselect :: "'prog \<Rightarrow> 'prog_out \<Rightarrow> 'prog \<Rightarrow> bool" and
	+ progs :: "'prog set" and
	+ tests :: "'test set"
	+ assumes
	+ existence_safe: "\<lbrakk> P \<in> progs; P' \<in> progs; t \<in> tests; o1 \<in> out P t; deselect P o1 P' \<rbrakk>
	+ \<Longrightarrow> (\<exists>o2 \<in> out P' t. equiv_out o1 o2)" and
	+ equiv_out_equiv: "equiv UNIV {(x,y). equiv_out x y}" and
	+ equiv_out_deselect: "\<lbrakk> equiv_out o1 o2; deselect P o1 P' \<rbrakk> \<Longrightarrow> deselect P o2 P'"
	+
	+context RTS_safe begin
	+
	+lemma equiv_out_refl: "equiv_out a a"
	+using equiv_class_eq_iff equiv_out_equiv by fastforce
	+
	+lemma equiv_out_trans: "\<lbrakk> equiv_out a b; equiv_out b c \<rbrakk> \<Longrightarrow> equiv_out a c"
	+using equiv_class_eq_iff equiv_out_equiv by fastforce
	+
	+text "This shows that it is safe to continue deselecting a test based
	+ on its output under a previous program, to an arbitrary number of
	+ program changes, as long as the test is continually deselected. This
	+ is useful because it means changed programs don't need to generate new
	+ outputs for deselected tests to ensure safety of future deselections."
	+lemma existence_safe_trans:
	+assumes Pst_in: "Ps \<noteq> []" "set Ps \<subseteq> progs" "t \<in> tests" and
	+ o0: "o\<^sub>0 \<in> out (Ps!0) t" and
	+ des: "\<forall>n < (length Ps) - 1. deselect (Ps!n) o\<^sub>0 (Ps!(Suc n))"
	+shows "\<exists>o\<^sub>n \<in> out (last Ps) t. equiv_out o\<^sub>0 o\<^sub>n"
	+using assms proof(induct "length Ps" arbitrary: Ps)
	+ case 0 with Pst_in show ?case by simp
	+next
	+ case (Suc x) then show ?case
	+ proof(induct x)
	+ case z: 0
	+ from z.prems(2,3) have "Ps ! (length Ps - 2) = last Ps"
	+ by (simp add: last_conv_nth numeral_2_eq_2)
	+ with equiv_out_refl z.prems(2,6) show ?case by auto
	+ next
	+ case Suc':(Suc x')
	+ let ?Ps = "take (Suc x') Ps"
	+ have len': "Suc x' = length (take (Suc x') Ps)" using Suc'.prems(2) by auto
	+ moreover have nmt': "take (Suc x') Ps \<noteq> []" using len' by auto
	+ moreover have sub': "set (take (Suc x') Ps) \<subseteq> progs" using Suc.prems(2)
	+ by (meson order_trans set_take_subset)
	+ moreover have "t \<in> tests" using Pst_in(3) by simp
	+ moreover have "o\<^sub>0 \<in> out (take (Suc x') Ps ! 0) t" using Suc.prems(4) by simp
	+ moreover have "\<forall>n<length (take (Suc x') Ps) - 1.
	+ deselect (take (Suc x') Ps ! n) o\<^sub>0 (take (Suc x') Ps ! (Suc n))"
	+ using Suc.prems(5) len' by simp
	+ ultimately have "\<exists>o'\<in>out (last ?Ps) t. equiv_out o\<^sub>0 o'" by(rule Suc'.prems(1)[of ?Ps])
	+ then obtain o' where o': "o' \<in> out (last ?Ps) t" and eo: "equiv_out o\<^sub>0 o'" by clarify
	+ from Suc.prems(1) Suc'.prems(2) len' nmt'
	+ have "last (take (Suc x') Ps) = Ps!x'" "last Ps = Ps!(Suc x')"
	+ by (metis diff_Suc_1 last_conv_nth lessI nth_take)+
	+ moreover have "x' < length Ps - 1" using Suc'.prems(2) by linarith
	+ ultimately have des':"deselect (last (take (Suc x') Ps)) o\<^sub>0 (last Ps)"
	+ using Suc.prems(5) by simp
	+ from Suc.prems(1,2) sub' nmt' last_in_set
	+ have Ps_in: "last (take (Suc x') Ps) \<in> progs" "last Ps \<in> progs" by blast+
	+ have "\<exists>o\<^sub>n \<in> out (last Ps) t. equiv_out o' o\<^sub>n"
	+ by(rule existence_safe[where P="last (take (Suc x') Ps)" and P'="last Ps" and t=t,
	+ OF Ps_in Pst_in(3) o' equiv_out_deselect[OF eo des']])
	+ then obtain o\<^sub>n where oN: "o\<^sub>n \<in> out (last Ps) t" and eo': "equiv_out o' o\<^sub>n" by clarify
	+ moreover from eo eo' have "equiv_out o\<^sub>0 o\<^sub>n" by(rule equiv_out_trans)
	+ ultimately show ?case by auto
	+ qed
	+qed
	+
	+end \<comment> \<open> @{text RTS_safe} \<close>
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/Common/Semantics.thy b/thys/Regression_Test_Selection/Common/Semantics.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/Common/Semantics.thy
	@@ -0,0 +1,135 @@
	+(* Title: RTS/Common/Semantics.thy *)
	+(* Author: Susannah Mansky, UIUC 2020 *)
	+
	+section "Semantics model"
	+
	+theory Semantics
	+imports Main
	+begin
	+
	+text "General model for small-step semantics:"
	+locale Semantics =
	+ fixes
	+ small :: "'prog \<Rightarrow> 'state \<Rightarrow> 'state set" and
	+ endset :: "'state set"
	+ assumes
	+ endset_final: "\<sigma> \<in> endset \<Longrightarrow> \<forall>P. small P \<sigma> = {}"
	+
	+context Semantics begin
	+
	+subsection "Extending @{term small} to multiple steps"
	+
	+primrec small_nstep :: "'prog \<Rightarrow> 'state \<Rightarrow> nat \<Rightarrow> 'state set" where
	+small_nstep_base:
	+ "small_nstep P \<sigma> 0 = {\<sigma>}" \|
	+small_nstep_Rec:
	+ "small_nstep P \<sigma> (Suc n) =
	+ { \<sigma>2. \<exists>\<sigma>1. \<sigma>1 \<in> small_nstep P \<sigma> n \<and> \<sigma>2 \<in> small P \<sigma>1 }"
	+
	+lemma small_nstep_Rec2:
	+ "small_nstep P \<sigma> (Suc n) =
	+ { \<sigma>2. \<exists>\<sigma>1. \<sigma>1 \<in> small P \<sigma> \<and> \<sigma>2 \<in> small_nstep P \<sigma>1 n }"
	+proof(induct n arbitrary: \<sigma>)
	+ case (Suc n)
	+ have right: "\<And>\<sigma>'. \<sigma>' \<in> small_nstep P \<sigma> (Suc(Suc n))
	+ \<Longrightarrow> \<exists>\<sigma>1. \<sigma>1 \<in> small P \<sigma> \<and> \<sigma>' \<in> small_nstep P \<sigma>1 (Suc n)"
	+ proof -
	+ fix \<sigma>'
	+ assume "\<sigma>' \<in> small_nstep P \<sigma> (Suc(Suc n))"
	+ then obtain \<sigma>1 where Sucnstep: "\<sigma>1 \<in> small_nstep P \<sigma> (Suc n)" "\<sigma>' \<in> small P \<sigma>1" by fastforce
	+ obtain \<sigma>12 where nstep: "\<sigma>12 \<in> small P \<sigma> \<and> \<sigma>1 \<in> small_nstep P \<sigma>12 n"
	+ using Suc Sucnstep(1) by fastforce
	+ then show "\<exists>\<sigma>1. \<sigma>1 \<in> small P \<sigma> \<and> \<sigma>' \<in> small_nstep P \<sigma>1 (Suc n)"
	+ using Sucnstep by fastforce
	+ qed
	+ have left: "\<And>\<sigma>' . \<exists>\<sigma>1. \<sigma>1 \<in> small P \<sigma> \<and> \<sigma>' \<in> small_nstep P \<sigma>1 (Suc n)
	+ \<Longrightarrow> \<sigma>' \<in> small_nstep P \<sigma> (Suc(Suc n))"
	+ proof -
	+ fix \<sigma>'
	+ assume "\<exists>\<sigma>1. \<sigma>1 \<in> small P \<sigma> \<and> \<sigma>' \<in> small_nstep P \<sigma>1 (Suc n)"
	+ then obtain \<sigma>1 where Sucnstep: "\<sigma>1 \<in> small P \<sigma>" "\<sigma>' \<in> small_nstep P \<sigma>1 (Suc n)"
	+ by fastforce
	+ obtain \<sigma>12 where nstep: "\<sigma>12 \<in> small_nstep P \<sigma>1 n \<and> \<sigma>' \<in> small P \<sigma>12"
	+ using Sucnstep(2) by auto
	+ then show "\<sigma>' \<in> small_nstep P \<sigma> (Suc(Suc n))" using Suc Sucnstep by fastforce
	+ qed
	+ show ?case using right left by fast
	+qed(simp)
	+
	+lemma small_nstep_SucD:
	+assumes "\<sigma>' \<in> small_nstep P \<sigma> (Suc n)"
	+shows "\<exists>\<sigma>1. \<sigma>1 \<in> small P \<sigma> \<and> \<sigma>' \<in> small_nstep P \<sigma>1 n"
	+ using small_nstep_Rec2 case_prodD assms by fastforce
	+
	+lemma small_nstep_Suc_nend: "\<sigma>' \<in> small_nstep P \<sigma> (Suc n1) \<Longrightarrow> \<sigma> \<notin> endset"
	+ using endset_final small_nstep_SucD by fastforce
	+
	+subsection "Extending @{term small} to a big-step semantics"
	+
	+definition big :: "'prog \<Rightarrow> 'state \<Rightarrow> 'state set" where
	+"big P \<sigma> \<equiv> { \<sigma>'. \<exists>n. \<sigma>' \<in> small_nstep P \<sigma> n \<and> \<sigma>' \<in> endset }"
	+
	+lemma bigI:
	+ "\<lbrakk> \<sigma>' \<in> small_nstep P \<sigma> n; \<sigma>' \<in> endset \<rbrakk> \<Longrightarrow> \<sigma>' \<in> big P \<sigma>"
	+by (fastforce simp add: big_def)
	+
	+lemma bigD:
	+ "\<lbrakk> \<sigma>' \<in> big P \<sigma> \<rbrakk> \<Longrightarrow> \<exists>n. \<sigma>' \<in> small_nstep P \<sigma> n \<and> \<sigma>' \<in> endset"
	+by (simp add: big_def)
	+
	+lemma big_def2:
	+ "\<sigma>' \<in> big P \<sigma> \<longleftrightarrow> (\<exists>n. \<sigma>' \<in> small_nstep P \<sigma> n \<and> \<sigma>' \<in> endset)"
	+proof(rule iffI)
	+ assume "\<sigma>' \<in> big P \<sigma>"
	+ then show "\<exists>n. \<sigma>' \<in> small_nstep P \<sigma> n \<and> \<sigma>' \<in> endset" using bigD big_def by auto
	+next
	+ assume "\<exists>n. \<sigma>' \<in> small_nstep P \<sigma> n \<and> \<sigma>' \<in> endset"
	+ then show "\<sigma>' \<in> big P \<sigma>" using big_def big_def by auto
	+qed
	+
	+lemma big_stepD:
	+assumes big: "\<sigma>' \<in> big P \<sigma>" and nend: "\<sigma> \<notin> endset"
	+shows "\<exists>\<sigma>1. \<sigma>1 \<in> small P \<sigma> \<and> \<sigma>' \<in> big P \<sigma>1"
	+proof -
	+ obtain n where n: "\<sigma>' \<in> small_nstep P \<sigma> n" "\<sigma>' \<in> endset"
	+ using big_def2 big by auto
	+ then show ?thesis using small_nstep_SucD nend big_def2 by(cases n, simp) blast
	+qed
	+
	+(***)
	+
	+lemma small_nstep_det_last_eq:
	+assumes det: "\<forall>\<sigma>. small P \<sigma> = {} \<or> (\<exists>\<sigma>'. small P \<sigma> = {\<sigma>'})"
	+shows "\<lbrakk> \<sigma>' \<in> big P \<sigma>; \<sigma>' \<in> small_nstep P \<sigma> n; \<sigma>' \<in> small_nstep P \<sigma> n' \<rbrakk> \<Longrightarrow> n = n'"
	+proof(induct n arbitrary: n' \<sigma> \<sigma>')
	+ case 0
	+ have "\<sigma>' = \<sigma>" using "0.prems"(2) small_nstep_base by blast
	+ then have endset: "\<sigma> \<in> endset" using "0.prems"(1) bigD by blast
	+ show ?case
	+ proof(cases n')
	+ case Suc then show ?thesis using "0.prems"(3) small_nstep_SucD endset_final[OF endset] by blast
	+ qed(simp)
	+next
	+ case (Suc n1)
	+ then have endset: "\<sigma>' \<in> endset" using Suc.prems(1) bigD by blast
	+ have nend: "\<sigma> \<notin> endset" using small_nstep_Suc_nend[OF Suc.prems(2)] by simp
	+ then have neq: "\<sigma>' \<noteq> \<sigma>" using endset by auto
	+ obtain \<sigma>1 where \<sigma>1: "\<sigma>1 \<in> small P \<sigma>" "\<sigma>' \<in> small_nstep P \<sigma>1 n1"
	+ using small_nstep_SucD[OF Suc.prems(2)] by clarsimp
	+ then have big: "\<sigma>' \<in> big P \<sigma>1" using endset by(auto simp: big_def)
	+ show ?case
	+ proof(cases n')
	+ case 0 then show ?thesis using neq Suc.prems(3) using small_nstep_base by blast
	+ next
	+ case Suc': (Suc n1')
	+ then obtain \<sigma>1' where \<sigma>1': "\<sigma>1' \<in> small P \<sigma>" "\<sigma>' \<in> small_nstep P \<sigma>1' n1'"
	+ using small_nstep_SucD[where \<sigma>=\<sigma> and \<sigma>'=\<sigma>' and n=n1'] Suc.prems(3) by blast
	+ then have "\<sigma>1=\<sigma>1'" using \<sigma>1(1) det by auto
	+ then show ?thesis using Suc.hyps(1)[OF big \<sigma>1(2)] \<sigma>1'(2) Suc' by blast
	+ qed
	+qed
	+
	+end \<comment> \<open> Semantics \<close>
	+
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/JVM_RTS/JVMCollectionBasedRTS.thy b/thys/Regression_Test_Selection/JVM_RTS/JVMCollectionBasedRTS.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/JVM_RTS/JVMCollectionBasedRTS.thy
	@@ -0,0 +1,2342 @@
	+(* File: RTS/JVM_RTS/JVMCollectionBasedRTS.thy *)
	+(* Author: Susannah Mansky, UIUC 2020 *)
	+(* Proof of safety of certain collection based RTS algorithms for Jinja JVM *)
	+
	+section "Instantiating @{term CollectionBasedRTS} with Jinja JVM"
	+
	+theory JVMCollectionBasedRTS
	+imports "../Common/CollectionBasedRTS" JVMCollectionSemantics
	+ JinjaDCI.BVSpecTypeSafe "../JinjaSuppl/JVMExecStepInductive"
	+
	+begin
	+
	+lemma eq_equiv[simp]: "equiv UNIV {(x, y). x = y}"
	+by(simp add: equiv_def refl_on_def sym_def trans_def)
	+
	+(**********************************************)
	+subsection \<open> Some @{text "classes_above"} lemmas \<close>
	+(* here because they require ClassAdd/StartProg *)
	+
	+lemma start_prog_classes_above_Start:
	+ "classes_above (start_prog P C M) Start = {Object,Start}"
	+using start_prog_Start_super[of C M P] subcls1_confluent by auto
	+
	+lemma class_add_classes_above:
	+assumes ns: "\<not> is_class P C" and "\<not>P \<turnstile> D \<preceq>\<^sup>* C"
	+shows "classes_above (class_add P (C, cdec)) D = classes_above P D"
	+using assms by(auto intro: class_add_subcls class_add_subcls_rev)
	+
	+lemma class_add_classes_above_xcpts:
	+assumes ns: "\<not> is_class P C"
	+ and ncp: "\<And>D. D \<in> sys_xcpts \<Longrightarrow> \<not>P \<turnstile> D \<preceq>\<^sup>* C"
	+shows "classes_above_xcpts (class_add P (C, cdec)) = classes_above_xcpts P"
	+using assms class_add_classes_above by simp
	+
	+(*********)
	+subsection "JVM next-step lemmas for initialization calling"
	+
	+lemma JVM_New_next_step:
	+assumes step: "\<sigma>' \<in> JVMsmall P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = New C"
	+ and nDone: "\<not>(\<exists>sfs i. sheap \<sigma> C = Some(sfs,i) \<and> i = Done)"
	+ and ics: "ics_of(hd(frames_of \<sigma>)) = No_ics"
	+shows "ics_of (hd(frames_of \<sigma>')) = Calling C [] \<and> sheap \<sigma> = sheap \<sigma>' \<and> \<sigma>' \<notin> JVMendset"
	+proof -
	+ obtain xp h frs sh where \<sigma>: "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then obtain f1 frs1 where frs: "frs=f1#frs1" using nend by(cases frs, simp_all add: JVMendset_def)
	+ then obtain stk loc C' M' pc ics where f1:"f1=(stk,loc,C',M',pc,ics)" by(cases f1)
	+ have xp: "xp = None" using \<sigma> nend by(simp add: JVMendset_def)
	+ obtain xp' h' frs' sh' where \<sigma>': "\<sigma>'=(xp',h',frs',sh')" by(cases \<sigma>')
	+ have "ics_of (hd frs') = Calling C [] \<and> sh = sh' \<and> frs' \<noteq> [] \<and> xp' = None"
	+ proof(cases "sh C")
	+ case None then show ?thesis using \<sigma>' xp f1 frs \<sigma> assms by auto
	+ next
	+ case (Some a)
	+ then obtain sfs i where a: "a=(sfs,i)" by(cases a)
	+ then have nDone': "i \<noteq> Done" using nDone Some f1 frs \<sigma> by simp
	+ show ?thesis using a Some \<sigma>' xp f1 frs \<sigma> assms by(auto split: init_state.splits)
	+ qed
	+ then show ?thesis using ics \<sigma> \<sigma>' by(cases frs', auto simp: JVMendset_def)
	+qed
	+
	+lemma JVM_Getstatic_next_step:
	+assumes step: "\<sigma>' \<in> JVMsmall P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = Getstatic C F D"
	+ and fC: "P \<turnstile> C has F,Static:t in D"
	+ and nDone: "\<not>(\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done)"
	+ and ics: "ics_of(hd(frames_of \<sigma>)) = No_ics"
	+shows "ics_of (hd(frames_of \<sigma>')) = Calling D [] \<and> sheap \<sigma> = sheap \<sigma>' \<and> \<sigma>' \<notin> JVMendset"
	+proof -
	+ obtain xp h frs sh where \<sigma>: "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then obtain f1 frs1 where frs: "frs=f1#frs1" using nend by(cases frs, simp_all add: JVMendset_def)
	+ then obtain stk loc C' M' pc ics where f1:"f1=(stk,loc,C',M',pc,ics)" by(cases f1)
	+ have xp: "xp = None" using \<sigma> nend by(simp add: JVMendset_def)
	+ obtain xp' h' frs' sh' where \<sigma>': "\<sigma>'=(xp',h',frs',sh')" by(cases \<sigma>')
	+ have ex': "\<exists>t b. P \<turnstile> C has F,b:t in D" using fC by auto
	+ have field: "\<exists>t. field P D F = (D,Static,t)"
	+ using fC field_def2 has_field_idemp has_field_sees by blast
	+ have nCalled': "\<forall>Cs. ics \<noteq> Called Cs" using ics f1 frs \<sigma> by simp
	+ have "ics_of (hd frs') = Calling D [] \<and> sh = sh' \<and> frs' \<noteq> [] \<and> xp' = None"
	+ proof(cases "sh D")
	+ case None then show ?thesis using field ex' \<sigma>' xp f1 frs \<sigma> assms by auto
	+ next
	+ case (Some a)
	+ then obtain sfs i where a: "a=(sfs,i)" by(cases a)
	+ show ?thesis using field ex' a Some \<sigma>' xp f1 frs \<sigma> assms by(auto split: init_state.splits)
	+ qed
	+ then show ?thesis using ics \<sigma> \<sigma>' by(auto simp: JVMendset_def)
	+qed
	+
	+lemma JVM_Putstatic_next_step:
	+assumes step: "\<sigma>' \<in> JVMsmall P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = Putstatic C F D"
	+ and fC: "P \<turnstile> C has F,Static:t in D"
	+ and nDone: "\<not>(\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done)"
	+ and ics: "ics_of(hd(frames_of \<sigma>)) = No_ics"
	+shows "ics_of (hd(frames_of \<sigma>')) = Calling D [] \<and> sheap \<sigma> = sheap \<sigma>' \<and> \<sigma>' \<notin> JVMendset"
	+proof -
	+ obtain xp h frs sh where \<sigma>: "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then obtain f1 frs1 where frs: "frs=f1#frs1" using nend by(cases frs, simp_all add: JVMendset_def)
	+ then obtain stk loc C' M' pc ics where f1:"f1=(stk,loc,C',M',pc,ics)" by(cases f1)
	+ have xp: "xp = None" using \<sigma> nend by(simp add: JVMendset_def)
	+ obtain xp' h' frs' sh' where \<sigma>': "\<sigma>'=(xp',h',frs',sh')" by(cases \<sigma>')
	+ have ex': "\<exists>t b. P \<turnstile> C has F,b:t in D" using fC by auto
	+ have field: "field P D F = (D,Static,t)"
	+ using fC field_def2 has_field_idemp has_field_sees by blast
	+ have ics': "ics_of (hd frs') = Calling D [] \<and> sh = sh' \<and> frs' \<noteq> [] \<and> xp' = None"
	+ proof(cases "sh D")
	+ case None then show ?thesis using field ex' \<sigma>' xp f1 frs \<sigma> assms by auto
	+ next
	+ case (Some a)
	+ then obtain sfs i where a: "a=(sfs,i)" by(cases a)
	+ show ?thesis using field ex' a Some \<sigma>' xp f1 frs \<sigma> assms by(auto split: init_state.splits)
	+ qed
	+ then show ?thesis using ics \<sigma> \<sigma>' by(auto simp: JVMendset_def)
	+qed
	+
	+lemma JVM_Invokestatic_next_step:
	+assumes step: "\<sigma>' \<in> JVMsmall P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = Invokestatic C M n"
	+ and mC: "P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D"
	+ and nDone: "\<not>(\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done)"
	+ and ics: "ics_of(hd(frames_of \<sigma>)) = No_ics"
	+shows "ics_of (hd(frames_of \<sigma>')) = Calling D [] \<and> sheap \<sigma> = sheap \<sigma>' \<and> \<sigma>' \<notin> JVMendset"
	+proof -
	+ obtain xp h frs sh where \<sigma>: "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then obtain f1 frs1 where frs: "frs=f1#frs1" using nend by(cases frs, simp_all add: JVMendset_def)
	+ then obtain stk loc C' M' pc ics where f1:"f1=(stk,loc,C',M',pc,ics)" by(cases f1)
	+ have xp: "xp = None" using \<sigma> nend by(simp add: JVMendset_def)
	+ obtain xp' h' frs' sh' where \<sigma>': "\<sigma>'=(xp',h',frs',sh')" by(cases \<sigma>')
	+ have ex': "\<exists>Ts T m D b. P \<turnstile> C sees M,b:Ts \<rightarrow> T = m in D" using mC by fastforce
	+ have method: "\<exists>m. method P C M = (D,Static,m)" using mC by(cases m, auto)
	+ have ics': "ics_of (hd frs') = Calling D [] \<and> sh = sh' \<and> frs' \<noteq> [] \<and> xp' = None"
	+ proof(cases "sh D")
	+ case None then show ?thesis using method ex' \<sigma>' xp f1 frs \<sigma> assms by auto
	+ next
	+ case (Some a)
	+ then obtain sfs i where a: "a=(sfs,i)" by(cases a)
	+ then have nDone': "i \<noteq> Done" using nDone Some f1 frs \<sigma> by simp
	+ show ?thesis using method ex' a Some \<sigma>' xp f1 frs \<sigma> assms by(auto split: init_state.splits)
	+ qed
	+ then show ?thesis using ics \<sigma> \<sigma>' by(auto simp: JVMendset_def)
	+qed
	+
	+(***********************************************)
	+subsection "Definitions"
	+
	+definition main :: "string" where "main = ''main''"
	+definition Test :: "string" where "Test = ''Test''"
	+definition test_oracle :: "string" where "test_oracle = ''oracle''"
	+
	+type_synonym jvm_class = "jvm_method cdecl"
	+type_synonym jvm_prog_out = "jvm_state \<times> cname set"
	+
	+text "A deselection algorithm based on classes that have changed from
	+ @{text P1} to @{text P2}:"
	+primrec jvm_deselect :: "jvm_prog \<Rightarrow> jvm_prog_out \<Rightarrow> jvm_prog \<Rightarrow> bool" where
	+"jvm_deselect P1 (\<sigma>, cset) P2 = (cset \<inter> (classes_changed P1 P2) = {})"
	+
	+definition jvm_progs :: "jvm_prog set" where
	+"jvm_progs \<equiv> {P. wf_jvm_prog P \<and> \<not>is_class P Start \<and> \<not>is_class P Test
	+ \<and> (\<forall>b' Ts' T' m' D'. P \<turnstile> Object sees start_m, b' : Ts'\<rightarrow>T' = m' in D'
	+ \<longrightarrow> b' = Static \<and> Ts' = [] \<and> T' = Void) }"
	+
	+definition jvm_tests :: "jvm_class set" where
	+"jvm_tests = {t. fst t = Test
	+ \<and> (\<forall>P \<in> jvm_progs. wf_jvm_prog (t#P) \<and> (\<exists>m. t#P \<turnstile> Test sees main,Static: [] \<rightarrow> Void = m in Test)) }"
	+
	+abbreviation jvm_make_test_prog :: "jvm_prog \<Rightarrow> jvm_class \<Rightarrow> jvm_prog" where
	+"jvm_make_test_prog P t \<equiv> start_prog (t#P) (fst t) main"
	+
	+declare jvm_progs_def [simp]
	+declare jvm_tests_def [simp]
	+
	+(*****************************************************************************************)
	+subsection "Definition lemmas"
	+
	+lemma jvm_progs_tests_nStart:
	+assumes P: "P \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+shows "\<not>is_class (t#P) Start"
	+using assms by(simp add: is_class_def class_def Start_def Test_def)
	+
	+lemma jvm_make_test_prog_classes_above_xcpts:
	+assumes P: "P \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+shows "classes_above_xcpts (jvm_make_test_prog P t) = classes_above_xcpts P"
	+proof -
	+ have nS: "\<not>is_class (t#P) Start" by(rule jvm_progs_tests_nStart[OF P t])
	+ from P have nT: "\<not>is_class P Test" by simp
	+ from P t have "wf_syscls (t#P) \<and> wf_syscls P"
	+ by(simp add: wf_jvm_prog_def wf_jvm_prog_phi_def wf_prog_def)
	+
	+ then have [simp]: "\<And>D. D \<in> sys_xcpts \<Longrightarrow> is_class (t#P) D \<and> is_class P D"
	+ by(cases t, auto simp: wf_syscls_def is_class_def class_def dest!: weak_map_of_SomeI)
	+ from wf_nclass_nsub[OF _ _ nS] P t have nspS: "\<And>D. D \<in> sys_xcpts \<Longrightarrow> \<not>(t#P) \<turnstile> D \<preceq>\<^sup>* Start"
	+ by(auto simp: wf_jvm_prog_def wf_jvm_prog_phi_def)
	+ from wf_nclass_nsub[OF _ _ nT] P have nspT: "\<And>D. D \<in> sys_xcpts \<Longrightarrow> \<not>P \<turnstile> D \<preceq>\<^sup>* Test"
	+ by(auto simp: wf_jvm_prog_def wf_jvm_prog_phi_def)
	+
	+ from class_add_classes_above_xcpts[where P="t#P" and C=Start, OF nS nspS]
	+ have "classes_above_xcpts (jvm_make_test_prog P t) = classes_above_xcpts (t#P)" by simp
	+ also from class_add_classes_above_xcpts[where P=P and C=Test, OF nT nspT] t
	+ have "\<dots> = classes_above_xcpts P" by(cases t, simp)
	+ finally show ?thesis by simp
	+qed
	+
	+lemma jvm_make_test_prog_sees_Test_main:
	+assumes P: "P \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+shows "\<exists>m. jvm_make_test_prog P t \<turnstile> Test sees main, Static : []\<rightarrow>Void = m in Test"
	+proof -
	+ let ?P = "jvm_make_test_prog P t"
	+ from P t obtain m where
	+ meth: "t#P \<turnstile> Test sees main,Static:[] \<rightarrow> Void = m in Test" and
	+ nstart: "\<not> is_class (t # P) Start"
	+ by(auto simp: is_class_def class_def Start_def Test_def)
	+ from class_add_sees_method[OF meth nstart] show ?thesis by fastforce
	+qed
	+
	+(************************************************)
	+subsection "Naive RTS algorithm"
	+
	+subsubsection "Definitions"
	+
	+fun jvm_naive_out :: "jvm_prog \<Rightarrow> jvm_class \<Rightarrow> jvm_prog_out set" where
	+"jvm_naive_out P t = JVMNaiveCollectionSemantics.cbig (jvm_make_test_prog P t) (start_state (t#P))"
	+
	+abbreviation jvm_naive_collect_start :: "jvm_prog \<Rightarrow> cname set" where
	+"jvm_naive_collect_start P \<equiv> {}"
	+
	+lemma jvm_naive_out_xcpts_collected:
	+assumes "o1 \<in> jvm_naive_out P t"
	+shows "classes_above_xcpts (start_prog (t # P) (fst t) main) \<subseteq> snd o1"
	+using assms
	+proof -
	+ obtain \<sigma>' coll' where "o1 = (\<sigma>', coll')" and
	+ cbig: "(\<sigma>', coll') \<in> JVMNaiveCollectionSemantics.cbig (start_prog (t#P) (fst t) main) (start_state (t#P))"
	+ using assms by(cases o1, simp)
	+ with JVMNaiveCollectionSemantics.cbig_stepD[OF cbig start_state_nend]
	+ show ?thesis by(auto simp: JVMNaiveCollectionSemantics.csmall_def start_state_def)
	+qed
	+
	+(***********************************************************)
	+subsubsection "Naive algorithm correctness"
	+
	+text "We start with correctness over @{term exec_instr}, then all the
	+ functions/pieces that are used by naive @{term csmall} (that is, pieces
	+ used by @{term exec} - such as which frames are used based on @{term ics}
	+ - and all functions used by the collection function). We then prove that
	+ @{term csmall} is existence safe, extend this result to @{term cbig}, and
	+ finally prove the @{term existence_safe} statement over the locale pieces."
	+
	+\<comment> \<open> if collected classes unchanged, @{term exec_instr} unchanged \<close>
	+lemma ncollect_exec_instr:
	+assumes "JVMinstr_ncollect P i h stk \<inter> classes_changed P P' = {}"
	+ and above_C: "classes_above P C \<inter> classes_changed P P' = {}"
	+ and ics: "ics = Called [] \<or> ics = No_ics"
	+ and i: "i = instrs_of P C M ! pc"
	+shows "exec_instr i P h stk loc C M pc ics frs sh = exec_instr i P' h stk loc C M pc ics frs sh"
	+using assms proof(cases i)
	+ case (New C1) then show ?thesis using assms classes_above_blank[of C1 P P']
	+ by(auto split: init_state.splits option.splits)
	+next
	+ case (Getfield F1 C1) show ?thesis
	+ proof(cases "hd stk = Null")
	+ case True then show ?thesis using Getfield assms by simp
	+ next
	+ case False
	+ let ?D = "(cname_of h (the_Addr (hd stk)))"
	+ have D: "classes_above P ?D \<inter> classes_changed P P' = {}"
	+ using False Getfield assms by simp
	+ show ?thesis
	+ proof(cases "\<exists>b t. P \<turnstile> ?D has F1,b:t in C1")
	+ case True
	+ then obtain b1 t1 where "P \<turnstile> ?D has F1,b1:t1 in C1" by auto
	+ then have has: "P' \<turnstile> ?D has F1,b1:t1 in C1"
	+ using Getfield assms classes_above_has_field[OF D] by auto
	+ have "P \<turnstile> ?D \<preceq>\<^sup>* C1" using has_field_decl_above True by auto
	+ then have "classes_above P C1 \<subseteq> classes_above P ?D" by(rule classes_above_subcls_subset)
	+ then have C1: "classes_above P C1 \<inter> classes_changed P P' = {}" using D by auto
	+ then show ?thesis using has True Getfield assms classes_above_field[of C1 P P' F1]
	+ by(cases "field P' C1 F1", cases "the (h (the_Addr (hd stk)))", auto)
	+ next
	+ case nex: False
	+ then have "\<nexists>b t. P' \<turnstile> ?D has F1,b:t in C1"
	+ using False Getfield assms
	+ classes_above_has_field2[where C="?D" and P=P and P'=P' and F=F1 and C'=C1]
	+ by auto
	+ then show ?thesis using nex Getfield assms classes_above_field[of C1 P P' F1]
	+ by(cases "field P' C1 F1", cases "the (h (the_Addr (hd stk)))", auto)
	+ qed
	+ qed
	+next
	+ case (Getstatic C1 F1 D1)
	+ then have C1: "classes_above P C1 \<inter> classes_changed P P' = {}" using assms by auto
	+ show ?thesis
	+ proof(cases "\<exists>b t. P \<turnstile> C1 has F1,b:t in D1")
	+ case True
	+ then obtain b t where meth: "P \<turnstile> C1 has F1,b:t in D1" by auto
	+ then have "P \<turnstile> C1 \<preceq>\<^sup>* D1" by(rule has_field_decl_above)
	+ then have D1: "classes_above P D1 \<inter> classes_changed P P' = {}"
	+ using C1 rtrancl_trans by fastforce
	+ have "P' \<turnstile> C1 has F1,b:t in D1"
	+ using meth Getstatic assms classes_above_has_field[OF C1] by auto
	+ then show ?thesis using True D1 Getstatic assms classes_above_field[of D1 P P' F1]
	+ by(cases "field P' D1 F1", auto)
	+ next
	+ case False
	+ then have "\<nexists>b t. P' \<turnstile> C1 has F1,b:t in D1"
	+ using Getstatic assms
	+ classes_above_has_field2[where C=C1 and P=P and P'=P' and F=F1 and C'=D1]
	+ by auto
	+ then show ?thesis using False Getstatic assms
	+ by(cases "field P' D1 F1", auto)
	+ qed
	+next
	+ case (Putfield F1 C1) show ?thesis
	+ proof(cases "hd(tl stk) = Null")
	+ case True then show ?thesis using Putfield assms by simp
	+ next
	+ case False
	+ let ?D = "(cname_of h (the_Addr (hd (tl stk))))"
	+ have D: "classes_above P ?D \<inter> classes_changed P P' = {}" using False Putfield assms by simp
	+ show ?thesis
	+ proof(cases "\<exists>b t. P \<turnstile> ?D has F1,b:t in C1")
	+ case True
	+ then obtain b1 t1 where "P \<turnstile> ?D has F1,b1:t1 in C1" by auto
	+ then have has: "P' \<turnstile> ?D has F1,b1:t1 in C1"
	+ using Putfield assms classes_above_has_field[OF D] by auto
	+ have "P \<turnstile> ?D \<preceq>\<^sup>* C1" using has_field_decl_above True by auto
	+ then have "classes_above P C1 \<subseteq> classes_above P ?D" by(rule classes_above_subcls_subset)
	+ then have C1: "classes_above P C1 \<inter> classes_changed P P' = {}" using D by auto
	+ then show ?thesis using has True Putfield assms classes_above_field[of C1 P P' F1]
	+ by(cases "field P' C1 F1", cases "the (h (the_Addr (hd (tl stk))))", auto)
	+ next
	+ case nex: False
	+ then have "\<nexists>b t. P' \<turnstile> ?D has F1,b:t in C1"
	+ using False Putfield assms
	+ classes_above_has_field2[where C="?D" and P=P and P'=P' and F=F1 and C'=C1]
	+ by auto
	+ then show ?thesis using nex Putfield assms classes_above_field[of C1 P P' F1]
	+ by(cases "field P' C1 F1", cases "the (h (the_Addr (hd (tl stk))))", auto)
	+ qed
	+ qed
	+next
	+ case (Putstatic C1 F1 D1)
	+ then have C1: "classes_above P C1 \<inter> classes_changed P P' = {}" using Putstatic assms by auto
	+ show ?thesis
	+ proof(cases "\<exists>b t. P \<turnstile> C1 has F1,b:t in D1")
	+ case True
	+ then obtain b t where meth: "P \<turnstile> C1 has F1,b:t in D1" by auto
	+ then have "P \<turnstile> C1 \<preceq>\<^sup>* D1" by(rule has_field_decl_above)
	+ then have D1: "classes_above P D1 \<inter> classes_changed P P' = {}"
	+ using C1 rtrancl_trans by fastforce
	+ then have "P' \<turnstile> C1 has F1,b:t in D1"
	+ using meth Putstatic assms classes_above_has_field[OF C1] by auto
	+ then show ?thesis using True D1 Putstatic assms classes_above_field[of D1 P P' F1]
	+ by(cases "field P' D1 F1", auto)
	+ next
	+ case False
	+ then have "\<nexists>b t. P' \<turnstile> C1 has F1,b:t in D1"
	+ using Putstatic assms classes_above_has_field2[where C=C1 and P=P and P'=P' and F=F1 and C'=D1]
	+ by auto
	+ then show ?thesis using False Putstatic assms
	+ by(cases "field P' D1 F1", auto)
	+ qed
	+next
	+ case (Checkcast C1)
	+ then show ?thesis using assms
	+ proof(cases "hd stk = Null")
	+ case False then show ?thesis
	+ using Checkcast assms classes_above_subcls classes_above_subcls2
	+ by(simp add: cast_ok_def) blast
	+ qed(simp add: cast_ok_def)
	+next
	+ case (Invoke M n)
	+ let ?C = "cname_of h (the_Addr (stk ! n))"
	+ show ?thesis
	+ proof(cases "stk ! n = Null")
	+ case True then show ?thesis using Invoke assms by simp
	+ next
	+ case False
	+ then have above: "classes_above P ?C \<inter> classes_changed P P' = {}"
	+ using Invoke assms by simp
	+ obtain D b Ts T mxs mxl ins xt where meth: "method P' ?C M = (D,b,Ts,T,mxs,mxl,ins,xt)"
	+ by(cases "method P' ?C M", clarsimp)
	+ have meq: "method P ?C M = method P' ?C M"
	+ using classes_above_method[OF above] by simp
	+ then show ?thesis
	+ proof(cases "\<exists>Ts T m D b. P \<turnstile> ?C sees M,b:Ts \<rightarrow> T = m in D")
	+ case nex: False
	+ then have "\<not>(\<exists>Ts T m D b. P' \<turnstile> ?C sees M,b:Ts \<rightarrow> T = m in D)"
	+ using classes_above_sees_method2[OF above, of M] by clarsimp
	+ then show ?thesis using nex False Invoke by simp
	+ next
	+ case True
	+ then have "\<exists>Ts T m D b. P' \<turnstile> ?C sees M,b:Ts \<rightarrow> T = m in D"
	+ by(fastforce dest!: classes_above_sees_method[OF above, of M])
	+ then show ?thesis using meq meth True Invoke by simp
	+ qed
	+ qed
	+next
	+ case (Invokestatic C1 M n)
	+ then have above: "classes_above P C1 \<inter> classes_changed P P' = {}"
	+ using assms by simp
	+ obtain D b Ts T mxs mxl ins xt where meth: "method P' C1 M = (D,b,Ts,T,mxs,mxl,ins,xt)"
	+ by(cases "method P' C1 M", clarsimp)
	+ have meq: "method P C1 M = method P' C1 M"
	+ using classes_above_method[OF above] by simp
	+ show ?thesis
	+ proof(cases "\<exists>Ts T m D b. P \<turnstile> C1 sees M,b:Ts \<rightarrow> T = m in D")
	+ case False
	+ then have "\<not>(\<exists>Ts T m D b. P' \<turnstile> C1 sees M,b:Ts \<rightarrow> T = m in D)"
	+ using classes_above_sees_method2[OF above, of M] by clarsimp
	+ then show ?thesis using False Invokestatic by simp
	+ next
	+ case True
	+ then have "\<exists>Ts T m D b. P' \<turnstile> C1 sees M,b:Ts \<rightarrow> T = m in D"
	+ by(fastforce dest!: classes_above_sees_method[OF above, of M])
	+ then show ?thesis using meq meth True Invokestatic by simp
	+ qed
	+next
	+ case Return then show ?thesis using assms classes_above_method[OF above_C]
	+ by(cases frs, auto)
	+next
	+ case (Load x1) then show ?thesis using assms by auto
	+next
	+ case (Store x2) then show ?thesis using assms by auto
	+next
	+ case (Push x3) then show ?thesis using assms by auto
	+next
	+ case (Goto x15) then show ?thesis using assms by auto
	+next
	+ case (IfFalse x17) then show ?thesis using assms by auto
	+qed(auto)
	+
	+
	+\<comment> \<open> if collected classes unchanged, instruction collection unchanged \<close>
	+lemma ncollect_JVMinstr_ncollect:
	+assumes "JVMinstr_ncollect P i h stk \<inter> classes_changed P P' = {}"
	+shows "JVMinstr_ncollect P i h stk = JVMinstr_ncollect P' i h stk"
	+proof(cases i)
	+ case (New C1)
	+ then show ?thesis using assms classes_above_set[of C1 P P'] by auto
	+next
	+ case (Getfield F C1) show ?thesis
	+ proof(cases "hd stk = Null")
	+ case True then show ?thesis using Getfield assms by simp
	+ next
	+ case False
	+ let ?D = "cname_of h (the_Addr (hd stk))"
	+ have "classes_above P ?D \<inter> classes_changed P P' = {}" using False Getfield assms by auto
	+ then have "classes_above P ?D = classes_above P' ?D"
	+ using classes_above_set by blast
	+ then show ?thesis using assms Getfield by auto
	+ qed
	+next
	+ case (Getstatic C1 P1 D1)
	+ then have "classes_above P C1 \<inter> classes_changed P P' = {}" using assms by auto
	+ then have "classes_above P C1 = classes_above P' C1"
	+ using classes_above_set assms Getstatic by blast
	+ then show ?thesis using assms Getstatic by auto
	+next
	+ case (Putfield F C1) show ?thesis
	+ proof(cases "hd(tl stk) = Null")
	+ case True then show ?thesis using Putfield assms by simp
	+ next
	+ case False
	+ let ?D = "cname_of h (the_Addr (hd (tl stk)))"
	+ have "classes_above P ?D \<inter> classes_changed P P' = {}" using False Putfield assms by auto
	+ then have "classes_above P ?D = classes_above P' ?D"
	+ using classes_above_set by blast
	+ then show ?thesis using assms Putfield by auto
	+ qed
	+next
	+ case (Putstatic C1 F D1)
	+ then have "classes_above P C1 \<inter> classes_changed P P' = {}" using assms by auto
	+ then have "classes_above P C1 = classes_above P' C1"
	+ using classes_above_set assms Putstatic by blast
	+ then show ?thesis using assms Putstatic by auto
	+next
	+ case (Checkcast C1)
	+ then show ?thesis using assms
	+ classes_above_set[of "cname_of h (the_Addr (hd stk))" P P'] by auto
	+next
	+ case (Invoke M n)
	+ then show ?thesis using assms
	+ classes_above_set[of "cname_of h (the_Addr (stk ! n))" P P'] by auto
	+next
	+ case (Invokestatic C1 M n)
	+ then show ?thesis using assms classes_above_set[of C1 P P'] by auto
	+next
	+ case Return
	+ then show ?thesis using assms classes_above_set[of _ P P'] by auto
	+next
	+ case Throw
	+ then show ?thesis using assms
	+ classes_above_set[of "cname_of h (the_Addr (hd stk))" P P'] by auto
	+qed(auto)
	+
	+\<comment> \<open> if collected classes unchanged, @{term exec_step} unchanged \<close>
	+lemma ncollect_exec_step:
	+assumes "JVMstep_ncollect P h stk C M pc ics \<inter> classes_changed P P' = {}"
	+ and above_C: "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "exec_step P h stk loc C M pc ics frs sh = exec_step P' h stk loc C M pc ics frs sh"
	+proof(cases ics)
	+ case No_ics then show ?thesis
	+ using ncollect_exec_instr assms classes_above_method[OF above_C, THEN sym]
	+ by simp
	+next
	+ case (Calling C1 Cs)
	+ then have above_C1: "classes_above P C1 \<inter> classes_changed P P' = {}"
	+ using assms(1) by auto
	+ show ?thesis
	+ proof(cases "sh C1")
	+ case None
	+ then show ?thesis using Calling assms classes_above_sblank[OF above_C1] by simp
	+ next
	+ case (Some a)
	+ then obtain sfs i where sfsi: "a = (sfs, i)" by(cases a)
	+ then show ?thesis using Calling Some assms
	+ proof(cases i)
	+ case Prepared then show ?thesis
	+ using above_C1 sfsi Calling Some assms classes_above_method[OF above_C1]
	+ by(simp add: split_beta classes_above_class classes_changed_class[where cn=C1])
	+ next
	+ case Error then show ?thesis
	+ using above_C1 sfsi Calling Some assms classes_above_method[of C1 P P']
	+ by(simp add: split_beta classes_above_class classes_changed_class[where cn=C1])
	+ qed(auto)
	+ qed
	+next
	+ case (Called Cs) show ?thesis
	+ proof(cases Cs)
	+ case Nil then show ?thesis
	+ using ncollect_exec_instr assms classes_above_method[OF above_C, THEN sym] Called
	+ by simp
	+ next
	+ case (Cons C1 Cs1)
	+ then have above_C': "classes_above P C1 \<inter> classes_changed P P' = {}" using assms Called by auto
	+ show ?thesis using assms classes_above_method[OF above_C'] Cons Called by simp
	+ qed
	+next
	+ case (Throwing Cs a) then show ?thesis using assms by(cases Cs; simp)
	+qed
	+
	+\<comment> \<open> if collected classes unchanged, @{term exec_step} collection unchanged \<close>
	+lemma ncollect_JVMstep_ncollect:
	+assumes "JVMstep_ncollect P h stk C M pc ics \<inter> classes_changed P P' = {}"
	+ and above_C: "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "JVMstep_ncollect P h stk C M pc ics = JVMstep_ncollect P' h stk C M pc ics"
	+proof(cases ics)
	+ case No_ics then show ?thesis
	+ using assms ncollect_JVMinstr_ncollect classes_above_method[OF above_C]
	+ by simp
	+next
	+ case (Calling C1 Cs)
	+ then have above_C: "classes_above P C1 \<inter> classes_changed P P' = {}"
	+ using assms(1) by auto
	+ let ?C = "fst(method P C1 clinit)"
	+ show ?thesis using Calling assms classes_above_method[OF above_C]
	+ classes_above_set[OF above_C] by auto
	+next
	+ case (Called Cs) show ?thesis
	+ proof(cases Cs)
	+ case Nil then show ?thesis
	+ using assms ncollect_JVMinstr_ncollect classes_above_method[OF above_C] Called
	+ by simp
	+ next
	+ case (Cons C1 Cs1)
	+ then have above_C1: "classes_above P C1 \<inter> classes_changed P P' = {}"
	+ and above_C': "classes_above P (fst (method P C1 clinit)) \<inter> classes_changed P P' = {}"
	+ using assms Called by auto
	+ show ?thesis using assms Cons Called classes_above_set[OF above_C1]
	+ classes_above_set[OF above_C'] classes_above_method[OF above_C1]
	+ by simp
	+ qed
	+next
	+ case (Throwing Cs a) then show ?thesis
	+ using assms classes_above_set[of "cname_of h a" P P'] by simp
	+qed
	+
	+\<comment> \<open> if collected classes unchanged, @{term classes_above_frames} unchanged \<close>
	+lemma ncollect_classes_above_frames:
	+ "JVMexec_ncollect P (None, h, (stk,loc,C,M,pc,ics)#frs, sh) \<inter> classes_changed P P' = {}
	+ \<Longrightarrow> classes_above_frames P frs = classes_above_frames P' frs"
	+proof(induct frs)
	+ case (Cons f frs')
	+ then obtain stk loc C M pc ics where f: "f = (stk,loc,C,M,pc,ics)" by(cases f)
	+ then have above_C: "classes_above P C \<inter> classes_changed P P' = {}" using Cons by auto
	+ show ?case using f Cons classes_above_subcls[OF above_C]
	+ classes_above_subcls2[OF above_C] by auto
	+qed(auto)
	+
	+\<comment> \<open> if collected classes unchanged, @{term classes_above_xcpts} unchanged \<close>
	+lemma ncollect_classes_above_xcpts:
	+assumes "JVMexec_ncollect P (None, h, (stk,loc,C,M,pc,ics)#frs, sh) \<inter> classes_changed P P' = {}"
	+shows "classes_above_xcpts P = classes_above_xcpts P'"
	+proof -
	+ have left: "\<And>x x'. x' \<in> sys_xcpts \<Longrightarrow> P \<turnstile> x' \<preceq>\<^sup>* x \<Longrightarrow> \<exists>xa\<in>sys_xcpts. P' \<turnstile> xa \<preceq>\<^sup>* x"
	+ proof -
	+ fix x x'
	+ assume x': "x' \<in> sys_xcpts" and above: "P \<turnstile> x' \<preceq>\<^sup>* x"
	+ then show "\<exists>xa\<in>sys_xcpts. P' \<turnstile> xa \<preceq>\<^sup>* x" using assms classes_above_subcls[OF _ above]
	+ by(rule_tac x=x' in bexI) auto
	+ qed
	+ have right: "\<And>x x'. x' \<in> sys_xcpts \<Longrightarrow> P' \<turnstile> x' \<preceq>\<^sup>* x \<Longrightarrow> \<exists>xa\<in>sys_xcpts. P \<turnstile> xa \<preceq>\<^sup>* x"
	+ proof -
	+ fix x x'
	+ assume x': "x' \<in> sys_xcpts" and above: "P' \<turnstile> x' \<preceq>\<^sup>* x"
	+ then show "\<exists>xa\<in>sys_xcpts. P \<turnstile> xa \<preceq>\<^sup>* x" using assms classes_above_subcls2[OF _ above]
	+ by(rule_tac x=x' in bexI) auto
	+ qed
	+ show ?thesis using left right by auto
	+qed
	+
	+\<comment> \<open> if collected classes unchanged, @{term exec} collection unchanged \<close>
	+lemma ncollect_JVMexec_ncollect:
	+assumes "JVMexec_ncollect P \<sigma> \<inter> classes_changed P P' = {}"
	+shows "JVMexec_ncollect P \<sigma> = JVMexec_ncollect P' \<sigma>"
	+proof -
	+ obtain xp h frs sh where \<sigma>: "\<sigma> = (xp,h,frs,sh)" by(cases \<sigma>)
	+ then show ?thesis using assms
	+ proof(cases "\<exists>x. xp = Some x \<or> frs = []")
	+ case False
	+ then obtain stk loc C M pc ics frs' where frs: "frs = (stk,loc,C,M,pc,ics)#frs'"
	+ by(cases frs, auto)
	+ have step: "JVMstep_ncollect P h stk C M pc ics \<inter> classes_changed P P' = {}"
	+ using False \<sigma> frs assms by(cases ics, auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ have above_C: "classes_above P C \<inter> classes_changed P P' = {}"
	+ using False \<sigma> frs assms by(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ have frames: "classes_above_frames P frs' = classes_above_frames P' frs'"
	+ using ncollect_classes_above_frames frs \<sigma> False assms by simp
	+ have xcpts: "classes_above_xcpts P = classes_above_xcpts P'"
	+ using ncollect_classes_above_xcpts frs \<sigma> False assms by simp
	+ show ?thesis using False xcpts frames frs \<sigma> ncollect_JVMstep_ncollect[OF step above_C]
	+ classes_above_subcls[OF above_C] classes_above_subcls2[OF above_C]
	+ by auto
	+ qed(auto)
	+qed
	+
	+\<comment> \<open> if collected classes unchanged, classes above an exception returned
	+ by @{term exec_instr} unchanged \<close>
	+lemma ncollect_exec_instr_xcpts:
	+assumes collect: "JVMinstr_ncollect P i h stk \<inter> classes_changed P P' = {}"
	+ and xpcollect: "classes_above_xcpts P \<inter> classes_changed P P' = {}"
	+ and prealloc: "preallocated h"
	+ and \<sigma>': "\<sigma>' = exec_instr i P h stk loc C M pc ics' frs sh"
	+ and xp: "fst \<sigma>' = Some a"
	+ and i: "i = instrs_of P C M ! pc"
	+shows "classes_above P (cname_of h a) \<inter> classes_changed P P' = {}"
	+using assms exec_instr_xcpts[OF \<sigma>' xp]
	+proof(cases i)
	+ case Throw then show ?thesis using assms by(cases "hd stk", fastforce+)
	+qed(fastforce+)
	+
	+\<comment> \<open> if collected classes unchanged, classes above an exception returned
	+ by @{term exec_step} unchanged \<close>
	+lemma ncollect_exec_step_xcpts:
	+assumes collect: "JVMstep_ncollect P h stk C M pc ics \<inter> classes_changed P P' = {}"
	+ and xpcollect: "classes_above_xcpts P \<inter> classes_changed P P' = {}"
	+ and prealloc: "preallocated h"
	+ and \<sigma>': "\<sigma>' = exec_step P h stk loc C M pc ics frs sh"
	+ and xp: "fst \<sigma>' = Some a"
	+shows "classes_above P (cname_of h a) \<inter> classes_changed P P' = {}"
	+proof(cases ics)
	+ case No_ics then show ?thesis using assms ncollect_exec_instr_xcpts by simp
	+next
	+ case (Calling x21 x22)
	+ then show ?thesis using assms by(clarsimp split: option.splits init_state.splits if_split_asm)
	+next
	+ case (Called Cs) then show ?thesis using assms ncollect_exec_instr_xcpts by(cases Cs; simp)
	+next
	+ case (Throwing Cs a) then show ?thesis using assms by(cases Cs; simp)
	+qed
	+
	+\<comment> \<open> if collected classes unchanged, if @{term csmall} returned a result
	+ under @{term P}, @{term P'} returns the same \<close>
	+lemma ncollect_JVMsmall:
	+assumes collect: "(\<sigma>', cset) \<in> JVMNaiveCollectionSemantics.csmall P \<sigma>"
	+ and intersect: "cset \<inter> classes_changed P P' = {}"
	+ and prealloc: "preallocated (fst(snd \<sigma>))"
	+shows "(\<sigma>', cset) \<in> JVMNaiveCollectionSemantics.csmall P' \<sigma>"
	+proof -
	+ obtain xp h frs sh where \<sigma>: "\<sigma> = (xp,h,frs,sh)" by(cases \<sigma>)
	+ then have prealloc': "preallocated h" using prealloc by simp
	+ show ?thesis using \<sigma> assms
	+ proof(cases "\<exists>x. xp = Some x \<or> frs = []")
	+ case False
	+ then obtain stk loc C M pc ics frs' where frs: "frs = (stk,loc,C,M,pc,ics)#frs'"
	+ by(cases frs, auto)
	+ have step: "JVMstep_ncollect P h stk C M pc ics \<inter> classes_changed P P' = {}"
	+ using False \<sigma> frs assms by(cases ics, auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ have above_C: "classes_above P C \<inter> classes_changed P P' = {}"
	+ using False \<sigma> frs assms by(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ obtain xp1 h1 frs1 sh1 where exec: "exec_step P' h stk loc C M pc ics frs' sh = (xp1,h1,frs1,sh1)"
	+ by(cases "exec_step P' h stk loc C M pc ics frs' sh")
	+ have collect: "JVMexec_ncollect P \<sigma> = JVMexec_ncollect P' \<sigma>"
	+ using assms ncollect_JVMexec_ncollect by(simp add: JVMNaiveCollectionSemantics.csmall_def)
	+ have exec_instr: "exec_step P h stk loc C M pc ics frs' sh
	+ = exec_step P' h stk loc C M pc ics frs' sh"
	+ using ncollect_exec_step[OF step above_C] \<sigma> frs False by simp
	+ show ?thesis
	+ proof(cases xp1)
	+ case None then show ?thesis
	+ using None \<sigma> frs step False assms ncollect_exec_step[OF step above_C] collect exec
	+ by(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ next
	+ case (Some a)
	+ then show ?thesis using \<sigma> assms
	+ proof(cases xp)
	+ case None
	+ have frames: "classes_above_frames P (frames_of \<sigma>) \<inter> classes_changed P P' = {}"
	+ using None Some frs \<sigma> assms by(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ have frsi: "classes_above_frames P frs \<inter> classes_changed P P' = {}" using \<sigma> frames by simp
	+ have xpcollect: "classes_above_xcpts P \<inter> classes_changed P P' = {}"
	+ using None Some frs \<sigma> assms by(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ have xp: "classes_above P (cname_of h a) \<inter> classes_changed P P' = {}"
	+ using ncollect_exec_step_xcpts[OF step xpcollect prealloc',
	+ where \<sigma>' = "(xp1,h1,frs1,sh1)" and frs=frs' and loc=loc and a=a and sh=sh]
	+ exec exec_instr Some assms by auto
	+ show ?thesis using Some exec \<sigma> frs False assms exec_instr collect
	+ classes_above_find_handler[where h=h and sh=sh, OF xp frsi]
	+ by(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ qed(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+ qed
	+ qed(auto simp: JVMNaiveCollectionSemantics.csmall_def)
	+qed
	+
	+\<comment> \<open> if collected classes unchanged, if @{term cbig} returned a result
	+ under @{term P}, @{term P'} returns the same \<close>
	+lemma ncollect_JVMbig:
	+assumes collect: "(\<sigma>', cset) \<in> JVMNaiveCollectionSemantics.cbig P \<sigma>"
	+ and intersect: "cset \<inter> classes_changed P P' = {}"
	+ and prealloc: "preallocated (fst(snd \<sigma>))"
	+shows "(\<sigma>', cset) \<in> JVMNaiveCollectionSemantics.cbig P' \<sigma>"
	+using JVMNaiveCollectionSemantics.csmall_to_cbig_prop2[where R="\<lambda>P P' cset. cset \<inter> classes_changed P P' = {}"
	+ and Q="\<lambda>\<sigma>. preallocated (fst(snd \<sigma>))" and P=P and P'=P' and \<sigma>=\<sigma> and \<sigma>'=\<sigma>' and coll=cset]
	+ ncollect_JVMsmall JVMsmall_prealloc_pres assms by auto
	+
	+\<comment> \<open> and finally, RTS algorithm based on @{term ncollect} is existence safe \<close>
	+theorem jvm_naive_existence_safe:
	+assumes p: "P \<in> jvm_progs" and "P' \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+ and out: "o1 \<in> jvm_naive_out P t" and "jvm_deselect P o1 P'"
	+shows "\<exists>o2 \<in> jvm_naive_out P' t. o1 = o2"
	+using assms
	+proof -
	+ let ?P = "start_prog (t#P) (fst t) main"
	+ let ?P' = "start_prog (t#P') (fst t) main"
	+ obtain wf_md where wf': "wf_prog wf_md (t#P)" using p t
	+ by(auto simp: wf_jvm_prog_def wf_jvm_prog_phi_def)
	+ have ns: "\<not>is_class (t#P) Start" using p t
	+ by(clarsimp simp: is_class_def class_def Start_def Test_def)
	+ obtain \<sigma>1 coll1 where o1: "o1 = (\<sigma>1, coll1)" by(cases o1)
	+ then have cbig: "(\<sigma>1, coll1) \<in> JVMNaiveCollectionSemantics.cbig ?P (start_state (t # P))"
	+ using assms by simp
	+ have "coll1 \<inter> classes_changed P P' = {}" using cbig o1 assms by auto
	+ then have changed: "coll1 \<inter> classes_changed (t#P) (t#P') = {}" by(rule classes_changed_int_Cons)
	+ then have changed': "coll1 \<inter> classes_changed ?P ?P' = {}" by(rule classes_changed_int_Cons)
	+ have "classes_above_xcpts ?P = classes_above_xcpts (t#P)"
	+ using class_add_classes_above[OF ns wf_sys_xcpt_nsub_Start[OF wf' ns]] by simp
	+ then have "classes_above_xcpts (t#P) \<inter> classes_changed (t#P) (t#P') = {}"
	+ using jvm_naive_out_xcpts_collected[OF out] o1 changed by auto
	+ then have ss_eq: "start_state (t#P) = start_state (t#P')"
	+ using classes_above_start_state by simp
	+ show ?thesis using ncollect_JVMbig[OF cbig changed']
	+ preallocated_start_state changed' ss_eq o1 assms by auto
	+qed
	+
	+\<comment> \<open> ...thus @{term JVMNaiveCollection} is an instance of @{term CollectionBasedRTS} \<close>
	+interpretation JVMNaiveCollectionRTS :
	+ CollectionBasedRTS "(=)" jvm_deselect jvm_progs jvm_tests
	+ JVMendset JVMcombine JVMcollect_id JVMsmall JVMNaiveCollect jvm_naive_out
	+ jvm_make_test_prog jvm_naive_collect_start
	+ by unfold_locales (rule jvm_naive_existence_safe, auto simp: start_state_def)
	+
	+(***********************************************************************************************)
	+subsection "Smarter RTS algorithm"
	+
	+subsubsection "Definitions and helper lemmas"
	+
	+fun jvm_smart_out :: "jvm_prog \<Rightarrow> jvm_class \<Rightarrow> jvm_prog_out set" where
	+"jvm_smart_out P t
	+ = {(\<sigma>',coll'). \<exists>coll. (\<sigma>',coll) \<in> JVMSmartCollectionSemantics.cbig
	+ (jvm_make_test_prog P t) (start_state (t#P))
	+ \<and> coll' = coll \<union> classes_above_xcpts P \<union> {Object,Start}}"
	+
	+abbreviation jvm_smart_collect_start :: "jvm_prog \<Rightarrow> cname set" where
	+"jvm_smart_collect_start P \<equiv> classes_above_xcpts P \<union> {Object,Start}"
	+
	+
	+lemma jvm_naive_iff_smart:
	+"(\<exists>cset\<^sub>n. (\<sigma>',cset\<^sub>n) \<in> jvm_naive_out P t) \<longleftrightarrow> (\<exists>cset\<^sub>s. (\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t)"
	+ by(auto simp: JVMNaiveCollectionSemantics.cbig_big_equiv
	+ JVMSmartCollectionSemantics.cbig_big_equiv)
	+
	+(**************************************************)
	+
	+lemma jvm_smart_out_classes_above_xcpts:
	+assumes s: "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t" and P: "P \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+shows "classes_above_xcpts (jvm_make_test_prog P t) \<subseteq> cset\<^sub>s"
	+ using jvm_make_test_prog_classes_above_xcpts[OF P t] s by clarsimp
	+
	+lemma jvm_smart_collect_start_make_test_prog:
	+ "\<lbrakk> P \<in> jvm_progs; t \<in> jvm_tests \<rbrakk>
	+ \<Longrightarrow> jvm_smart_collect_start (jvm_make_test_prog P t) = jvm_smart_collect_start P"
	+ using jvm_make_test_prog_classes_above_xcpts by simp
	+
	+lemma jvm_smart_out_classes_above_start_heap:
	+assumes s: "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t" and h: "start_heap (t#P) a = Some(C,fs)"
	+ and P: "P \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+shows "classes_above (jvm_make_test_prog P t) C \<subseteq> cset\<^sub>s"
	+using start_heap_classes[OF h] jvm_smart_out_classes_above_xcpts[OF s P t] by auto
	+
	+lemma jvm_smart_out_classes_above_start_sheap:
	+assumes "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t" and "start_sheap C = Some(sfs,i)"
	+shows "classes_above (jvm_make_test_prog P t) C \<subseteq> cset\<^sub>s"
	+using assms start_prog_classes_above_Start by(clarsimp split: if_split_asm)
	+
	+lemma jvm_smart_out_classes_above_frames:
	+ "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t
	+ \<Longrightarrow> classes_above_frames (jvm_make_test_prog P t) (frames_of (start_state (t#P))) \<subseteq> cset\<^sub>s"
	+using start_prog_classes_above_Start by(clarsimp split: if_split_asm simp: start_state_def)
	+
	+(**************************************************)
	+subsubsection "Additional well-formedness conditions"
	+
	+\<comment> \<open> returns class to be initialized by given instruction, if applicable \<close>
	+(* NOTE: similar to exp-taking init_class from J/EConform - but requires field existence checks *)
	+fun coll_init_class :: "'m prog \<Rightarrow> instr \<Rightarrow> cname option" where
	+"coll_init_class P (New C) = Some C" \|
	+"coll_init_class P (Getstatic C F D) = (if \<exists>t. P \<turnstile> C has F,Static:t in D
	+ then Some D else None)" \|
	+"coll_init_class P (Putstatic C F D) = (if \<exists>t. P \<turnstile> C has F,Static:t in D
	+ then Some D else None)" \|
	+"coll_init_class P (Invokestatic C M n) = seeing_class P C M" \|
	+"coll_init_class _ _ = None"
	+
	+\<comment> \<open> checks whether the given value is a pointer; if it's an address,
	+ checks whether it points to an object in the given heap \<close>
	+fun is_ptr :: "heap \<Rightarrow> val \<Rightarrow> bool" where
	+"is_ptr h Null = True" \|
	+"is_ptr h (Addr a) = (\<exists>Cfs. h a = Some Cfs)" \|
	+"is_ptr h _ = False"
	+
	+lemma is_ptrD: "is_ptr h v \<Longrightarrow> v = Null \<or> (\<exists>a. v = Addr a \<and> (\<exists>Cfs. h a = Some Cfs))"
	+ by(cases v, auto)
	+
	+\<comment> \<open> shorthand for: given stack has entries required by given instr,
	+ including pointer where necessary \<close>
	+fun stack_safe :: "instr \<Rightarrow> heap \<Rightarrow> val list \<Rightarrow> bool" where
	+"stack_safe (Getfield F C) h stk = (length stk > 0 \<and> is_ptr h (hd stk))" \|
	+"stack_safe (Putfield F C) h stk = (length stk > 1 \<and> is_ptr h (hd (tl stk)))" \|
	+"stack_safe (Checkcast C) h stk = (length stk > 0 \<and> is_ptr h (hd stk))" \|
	+"stack_safe (Invoke M n) h stk = (length stk > n \<and> is_ptr h (stk ! n))" \|
	+"stack_safe JVMInstructions.Throw h stk = (length stk > 0 \<and> is_ptr h (hd stk))" \|
	+"stack_safe i h stk = True"
	+
	+lemma well_formed_stack_safe:
	+assumes wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P" and correct: "P,\<Phi> \<turnstile> (xp,h,(stk,loc,C,M,pc,ics)#frs,sh)\<surd>"
	+shows "stack_safe (instrs_of P C M ! pc) h stk"
	+proof -
	+ from correct obtain b Ts T mxs mxl\<^sub>0 ins xt where
	+ mC: "P \<turnstile> C sees M,b:Ts\<rightarrow>T=(mxs,mxl\<^sub>0,ins,xt) in C" and
	+ pc: "pc < length ins" by clarsimp
	+ from sees_wf_mdecl[OF _ mC] wtp have "wt_method P C b Ts T mxs mxl\<^sub>0 ins xt (\<Phi> C M)"
	+ by(auto simp: wf_jvm_prog_phi_def wf_mdecl_def)
	+ with pc have wt: "P,T,mxs,length ins,xt \<turnstile> ins ! pc,pc :: \<Phi> C M" by(simp add: wt_method_def)
	+ from mC correct obtain ST LT where
	+ \<Phi>: "\<Phi> C M ! pc = Some (ST,LT)" and
	+ stk: "P,h \<turnstile> stk [:\<le>] ST" by fastforce
	+ show ?thesis
	+ proof(cases "instrs_of P C M ! pc")
	+ case (Getfield F D)
	+ with mC \<Phi> wt stk obtain oT ST' where
	+ oT: "P \<turnstile> oT \<le> Class D" and
	+ ST: "ST = oT # ST'" by fastforce
	+ with stk obtain ref stk' where
	+ stk': "stk = ref#stk'" and
	+ ref: "P,h \<turnstile> ref :\<le> oT" by auto
	+ with ref oT have "ref = Null \<or> (ref \<noteq> Null \<and> P,h \<turnstile> ref :\<le> Class D)" by auto
	+ with Getfield mC have "is_ptr h ref" by(fastforce dest: non_npD)
	+ with stk' Getfield show ?thesis by auto
	+ next
	+ case (Putfield F D)
	+ with mC \<Phi> wt stk obtain vT oT ST' where
	+ oT: "P \<turnstile> oT \<le> Class D" and
	+ ST: "ST = vT # oT # ST'" by fastforce
	+ with stk obtain v ref stk' where
	+ stk': "stk = v#ref#stk'" and
	+ ref: "P,h \<turnstile> ref :\<le> oT" by auto
	+ with ref oT have "ref = Null \<or> (ref \<noteq> Null \<and> P,h \<turnstile> ref :\<le> Class D)" by auto
	+ with Putfield mC have "is_ptr h ref" by(fastforce dest: non_npD)
	+ with stk' Putfield show ?thesis by auto
	+ next
	+ case (Checkcast D)
	+ with mC \<Phi> wt stk obtain oT ST' where
	+ oT: "is_refT oT" and
	+ ST: "ST = oT # ST'" by fastforce
	+ with stk obtain ref stk' where
	+ stk': "stk = ref#stk'" and
	+ ref: "P,h \<turnstile> ref :\<le> oT" by auto
	+ with ref oT have "ref = Null \<or> (ref \<noteq> Null \<and> (\<exists>D'. P,h \<turnstile> ref :\<le> Class D'))"
	+ by(auto simp: is_refT_def)
	+ with Checkcast mC have "is_ptr h ref" by(fastforce dest: non_npD)
	+ with stk' Checkcast show ?thesis by auto
	+ next
	+ case (Invoke M1 n)
	+ with mC \<Phi> wt stk have
	+ ST: "n < size ST" and
	+ oT: "ST!n = NT \<or> (\<exists>D. ST!n = Class D)" by auto
	+ with stk have stk': "n < size stk" by (auto simp: list_all2_lengthD)
	+ with stk ST oT list_all2_nthD2
	+ have "stk!n = Null \<or> (stk!n \<noteq> Null \<and> (\<exists>D. P,h \<turnstile> stk!n :\<le> Class D))" by fastforce
	+ with Invoke mC have "is_ptr h (stk!n)" by(fastforce dest: non_npD)
	+ with stk' Invoke show ?thesis by auto
	+ next
	+ case Throw
	+ with mC \<Phi> wt stk obtain oT ST' where
	+ oT: "is_refT oT" and
	+ ST: "ST = oT # ST'" by fastforce
	+ with stk obtain ref stk' where
	+ stk': "stk = ref#stk'" and
	+ ref: "P,h \<turnstile> ref :\<le> oT" by auto
	+ with ref oT have "ref = Null \<or> (ref \<noteq> Null \<and> (\<exists>D'. P,h \<turnstile> ref :\<le> Class D'))"
	+ by(auto simp: is_refT_def)
	+ with Throw mC have "is_ptr h ref" by(fastforce dest: non_npD)
	+ with stk' Throw show ?thesis by auto
	+ qed(simp_all)
	+qed
	+
	+(******************************************)
	+subsubsection \<open> Proving naive @{text "\<subseteq>"} smart \<close>
	+
	+text \<open> We prove that, given well-formedness of the program and state, and "promises"
	+ about what has or will be collected in previous or future steps, @{term jvm_smart}
	+ collects everything @{term jvm_naive} does. We prove that promises about previously-
	+ collected classes ("backward promises") are maintained by execution, and promises
	+ about to-be-collected classes ("forward promises") are met by the end of execution.
	+ We then show that the required initial conditions (well-formedness and backward
	+ promises) are met by the defined start states, and thus that a run test will
	+ collect at least those classes collected by the naive algorithm. \<close>
	+
	+\<comment> \<open> Backward promises (classes that should already be collected) \<close>
	+ \<comment> \<open> - Classes of objects in the heap are collected \<close>
	+ \<comment> \<open> - Non-@{term None} classes on the static heap are collected \<close>
	+ \<comment> \<open> - Current classes from the frame stack are collected \<close>
	+ \<comment> \<open> - Classes of system exceptions are collected \<close>
	+
	+text "If backward promises have been kept, a single step preserves this property;
	+ i.e., any classes that have been added to this set (new heap objects, newly prepared
	+ sheap classes, new frames) are collected by the smart collection algorithm in that
	+ step or by forward promises:"
	+lemma backward_coll_promises_kept:
	+assumes
	+\<comment> \<open> well-formedness \<close>
	+ wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
	+ and correct: "P,\<Phi> \<turnstile> (xp,h,frs,sh)\<surd>"
	+\<comment> \<open> defs \<close>
	+ and f': "hd frs = (stk,loc,C',M',pc,ics)"
	+\<comment> \<open> backward promises - will be collected prior \<close>
	+ and heap: "\<And>C fs. \<exists>a. h a = Some(C,fs) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and sheap: "\<And>C sfs i. sh C = Some(sfs,i) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and xcpts: "classes_above_xcpts P \<subseteq> cset"
	+ and frames: "classes_above_frames P frs \<subseteq> cset"
	+\<comment> \<open> forward promises - will be collected after if not already \<close>
	+ and init_class_prom: "\<And>C. ics = Called [] \<or> ics = No_ics
	+ \<Longrightarrow> coll_init_class P (instrs_of P C' M' ! pc) = Some C \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and Calling_prom: "\<And>C' Cs'. ics = Calling C' Cs' \<Longrightarrow> classes_above P C' \<subseteq> cset"
	+\<comment> \<open> collection and step \<close>
	+ and smart: "JVMexec_scollect P (xp,h,frs,sh) \<subseteq> cset"
	+ and small: "(xp',h',frs',sh') \<in> JVMsmall P (xp,h,frs,sh)"
	+shows "(h' a = Some(C,fs) \<longrightarrow> classes_above P C \<subseteq> cset)
	+ \<and> (sh' C = Some(sfs',i') \<longrightarrow> classes_above P C \<subseteq> cset)
	+ \<and> (classes_above_frames P frs' \<subseteq> cset)"
	+using assms
	+proof(cases frs)
	+ case (Cons f1 frs1)
	+(****)
	+ then have cr': "P,\<Phi> \<turnstile> (xp,h,(stk,loc,C',M',pc,ics)#frs1,sh)\<surd>" using correct f' by simp
	+ let ?i = "instrs_of P C' M' ! pc"
	+ from well_formed_stack_safe[OF wtp cr'] correct_state_Throwing_ex[OF cr'] obtain
	+ stack_safe: "stack_safe ?i h stk" and
	+ Throwing_ex: "\<And>Cs a. ics = Throwing Cs a \<Longrightarrow> \<exists>obj. h a = Some obj" by simp
	+ have confc: "conf_clinit P sh frs" using correct Cons by simp
	+ have Called_prom: "\<And>C' Cs'. ics = Called (C'#Cs')
	+ \<Longrightarrow> classes_above P C' \<subseteq> cset \<and> classes_above P (fst(method P C' clinit)) \<subseteq> cset"
	+ proof -
	+ fix C' Cs' assume [simp]: "ics = Called (C'#Cs')"
	+ then have "C' \<in> set(clinit_classes frs)" using f' Cons by simp
	+ then obtain sfs where shC': "sh C' = Some(sfs, Processing)" and "is_class P C'"
	+ using confc by(auto simp: conf_clinit_def)
	+ then have C'eq: "C' = fst(method P C' clinit)" using wf_sees_clinit wtp
	+ by(fastforce simp: is_class_def wf_jvm_prog_phi_def)
	+ then show "classes_above P C' \<subseteq> cset \<and> classes_above P (fst(method P C' clinit)) \<subseteq> cset"
	+ using sheap shC' by auto
	+ qed
	+ have Called_prom2: "\<And>Cs. ics = Called Cs \<Longrightarrow> \<exists>C1 sobj. Called_context P C1 ?i \<and> sh C1 = Some sobj"
	+ using cr' by(auto simp: conf_f_def2)
	+ have Throwing_prom: "\<And>C' Cs a. ics = Throwing (C'#Cs) a \<Longrightarrow> \<exists>sfs. sh C' = Some(sfs, Processing)"
	+ proof -
	+ fix C' Cs a assume [simp]: "ics = Throwing (C'#Cs) a"
	+ then have "C' \<in> set(clinit_classes frs)" using f' Cons by simp
	+ then show "\<exists>sfs. sh C' = Some(sfs, Processing)" using confc by(clarsimp simp: conf_clinit_def)
	+ qed
	+(****)
	+ show ?thesis using Cons assms
	+ proof(cases xp)
	+ case None
	+ then have exec: "exec (P, None, h, (stk,loc,C',M',pc,ics)#frs1, sh) = Some (xp',h',frs',sh')"
	+ using small f' Cons by auto
	+ obtain si where si: "exec_step_input P C' M' pc ics = si" by simp
	+ obtain xp\<^sub>0 h\<^sub>0 frs\<^sub>0 sh\<^sub>0 where
	+ exec_step: "exec_step P h stk loc C' M' pc ics frs1 sh = (xp\<^sub>0, h\<^sub>0, frs\<^sub>0, sh\<^sub>0)"
	+ by(cases "exec_step P h stk loc C' M' pc ics frs1 sh")
	+ then have ind: "exec_step_ind si P h stk loc C' M' pc ics frs1 sh
	+ (xp\<^sub>0, h\<^sub>0, frs\<^sub>0, sh\<^sub>0)" using exec_step_ind_equiv si by auto
	+ then show ?thesis using heap sheap frames exec exec_step f' Cons
	+ si init_class_prom stack_safe Calling_prom Called_prom Called_prom2 Throwing_prom
	+ proof(induct rule: exec_step_ind.induct)
	+ case exec_step_ind_Load show ?case using exec_step_ind_Load.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Store show ?case using exec_step_ind_Store.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Push show ?case using exec_step_ind_Push.prems(1-7) by auto
	+ next
	+ case exec_step_ind_NewOOM_Called show ?case using exec_step_ind_NewOOM_Called.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_NewOOM_Done show ?case using exec_step_ind_NewOOM_Done.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_New_Called show ?case
	+ using exec_step_ind_New_Called.hyps exec_step_ind_New_Called.prems(1-9)
	+ by(auto split: if_split_asm simp: blank_def dest!: exec_step_input_StepID) blast+
	+ next
	+ case exec_step_ind_New_Done show ?case
	+ using exec_step_ind_New_Done.hyps exec_step_ind_New_Done.prems(1-9)
	+ by(auto split: if_split_asm simp: blank_def dest!: exec_step_input_StepID) blast+
	+ next
	+ case exec_step_ind_New_Init show ?case
	+ using exec_step_ind_New_Init.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Getfield_Null show ?case using exec_step_ind_Getfield_Null.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Getfield_NoField show ?case
	+ using exec_step_ind_Getfield_NoField.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Getfield_Static show ?case
	+ using exec_step_ind_Getfield_Static.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Getfield show ?case
	+ using exec_step_ind_Getfield.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Getstatic_NoField show ?case
	+ using exec_step_ind_Getstatic_NoField.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Getstatic_NonStatic show ?case
	+ using exec_step_ind_Getstatic_NonStatic.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Getstatic_Called show ?case
	+ using exec_step_ind_Getstatic_Called.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Getstatic_Done show ?case
	+ using exec_step_ind_Getstatic_Done.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Getstatic_Init show ?case
	+ using exec_step_ind_Getstatic_Init.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Putfield_Null show ?case
	+ using exec_step_ind_Putfield_Null.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Putfield_NoField show ?case
	+ using exec_step_ind_Putfield_NoField.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Putfield_Static show ?case
	+ using exec_step_ind_Putfield_Static.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case (exec_step_ind_Putfield v stk r a D fs h D' b t P C F loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ obtain a C1 fs where addr: "hd (tl stk) = Null \<or> (hd (tl stk) = Addr a \<and> h a = Some(C1,fs))"
	+ using exec_step_ind_Putfield.prems(8,10) by(auto dest!: exec_step_input_StepID is_ptrD)
	+ then have "\<And>a. hd(tl stk) = Addr a \<Longrightarrow> classes_above P C1 \<subseteq> cset"
	+ using exec_step_ind_Putfield.prems(1) addr by auto
	+ then show ?case using exec_step_ind_Putfield.hyps exec_step_ind_Putfield.prems(1-7) addr
	+ by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Putstatic_NoField show ?case
	+ using exec_step_ind_Putstatic_NoField.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Putstatic_NonStatic show ?case
	+ using exec_step_ind_Putstatic_NonStatic.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case (exec_step_ind_Putstatic_Called D' b t P D F C sh sfs i h stk loc C\<^sub>0 M\<^sub>0 pc Cs frs)
	+ then have "P \<turnstile> D sees F,Static:t in D" by(simp add: has_field_sees[OF has_field_idemp])
	+ then have D'eq: "D' = D" using exec_step_ind_Putstatic_Called.hyps(1) by simp
	+ obtain sobj where "sh D = Some sobj"
	+ using exec_step_ind_Putstatic_Called.hyps(2) exec_step_ind_Putstatic_Called.prems(8,13)
	+ by(fastforce dest!: exec_step_input_StepID)
	+ then show ?case using exec_step_ind_Putstatic_Called.hyps
	+ exec_step_ind_Putstatic_Called.prems(1-7) D'eq
	+ by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Putstatic_Done show ?case
	+ using exec_step_ind_Putstatic_Done.hyps exec_step_ind_Putstatic_Done.prems(1-7)
	+ by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Putstatic_Init show ?case
	+ using exec_step_ind_Putstatic_Init.hyps exec_step_ind_Putstatic_Init.prems(1-7)
	+ by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Checkcast show ?case
	+ using exec_step_ind_Checkcast.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Checkcast_Error show ?case using exec_step_ind_Checkcast_Error.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Invoke_Null show ?case using exec_step_ind_Invoke_Null.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Invoke_NoMethod show ?case using exec_step_ind_Invoke_NoMethod.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Invoke_Static show ?case using exec_step_ind_Invoke_Static.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case (exec_step_ind_Invoke ps n stk r C h D b Ts T mxs mxl\<^sub>0 ins xt P)
	+ have "classes_above P D \<subseteq> cset"
	+ using exec_step_ind_Invoke.hyps(2,3,5) exec_step_ind_Invoke.prems(1,8,10,13)
	+ rtrancl_trans[OF sees_method_decl_above[OF exec_step_ind_Invoke.hyps(6)]]
	+ by(auto dest!: exec_step_input_StepID is_ptrD) blast+
	+ then show ?case
	+ using exec_step_ind_Invoke.hyps(7) exec_step_ind_Invoke.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Invokestatic_NoMethod
	+ show ?case using exec_step_ind_Invokestatic_NoMethod.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Invokestatic_NonStatic
	+ show ?case using exec_step_ind_Invokestatic_NonStatic.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case (exec_step_ind_Invokestatic_Called ps n stk D b Ts T mxs mxl\<^sub>0 ins xt P C M)
	+ have "seeing_class P C M = Some D" using exec_step_ind_Invokestatic_Called.hyps(2,3)
	+ by(fastforce simp: seeing_class_def)
	+ then have "classes_above P D \<subseteq> cset" using exec_step_ind_Invokestatic_Called.prems(8-9)
	+ by(fastforce dest!: exec_step_input_StepID)
	+ then show ?case
	+ using exec_step_ind_Invokestatic_Called.hyps exec_step_ind_Invokestatic_Called.prems(1-7)
	+ by(auto simp: seeing_class_def)
	+ next
	+ case (exec_step_ind_Invokestatic_Done ps n stk D b Ts T mxs mxl\<^sub>0 ins xt P C M)
	+ have "seeing_class P C M = Some D" using exec_step_ind_Invokestatic_Done.hyps(2,3)
	+ by(fastforce simp: seeing_class_def)
	+ then have "classes_above P D \<subseteq> cset" using exec_step_ind_Invokestatic_Done.prems(8-9)
	+ by(fastforce dest!: exec_step_input_StepID)
	+ then show ?case
	+ using exec_step_ind_Invokestatic_Done.hyps exec_step_ind_Invokestatic_Done.prems(1-7)
	+ by auto blast+
	+ next
	+ case exec_step_ind_Invokestatic_Init show ?case
	+ using exec_step_ind_Invokestatic_Init.hyps exec_step_ind_Invokestatic_Init.prems(1-7)
	+ by auto blast+
	+ next
	+ case exec_step_ind_Return_Last_Init show ?case
	+ using exec_step_ind_Return_Last_Init.prems(1-7) by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Return_Last show ?case
	+ using exec_step_ind_Return_Last.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Return_Init show ?case
	+ using exec_step_ind_Return_Init.prems(1-7) by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Return_NonStatic show ?case
	+ using exec_step_ind_Return_NonStatic.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Return_Static show ?case
	+ using exec_step_ind_Return_Static.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Pop show ?case using exec_step_ind_Pop.prems(1-7) by auto
	+ next
	+ case exec_step_ind_IAdd show ?case using exec_step_ind_IAdd.prems(1-7)by auto
	+ next
	+ case exec_step_ind_IfFalse_False show ?case
	+ using exec_step_ind_IfFalse_False.prems(1-7) by auto
	+ next
	+ case exec_step_ind_IfFalse_nFalse show ?case
	+ using exec_step_ind_IfFalse_nFalse.prems(1-7) by auto
	+ next
	+ case exec_step_ind_CmpEq show ?case using exec_step_ind_CmpEq.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Goto show ?case using exec_step_ind_Goto.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Throw show ?case using exec_step_ind_Throw.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case exec_step_ind_Throw_Null show ?case using exec_step_ind_Throw_Null.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ next
	+ case (exec_step_ind_Init_None_Called sh C Cs P)
	+ have "classes_above P C \<subseteq> cset" using exec_step_ind_Init_None_Called.prems(8,11)
	+ by(auto dest!: exec_step_input_StepCD)
	+ then show ?case using exec_step_ind_Init_None_Called.prems(1-7)
	+ by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Init_Done show ?case
	+ using exec_step_ind_Init_Done.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Init_Processing show ?case
	+ using exec_step_ind_Init_Processing.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Init_Error show ?case
	+ using exec_step_ind_Init_Error.prems(1-7) by auto
	+ next
	+ case exec_step_ind_Init_Prepared_Object show ?case
	+ using exec_step_ind_Init_Prepared_Object.hyps
	+ exec_step_ind_Init_Prepared_Object.prems(1-7,10)
	+ by(auto split: if_split_asm dest!: exec_step_input_StepCD) blast+
	+ next
	+ case exec_step_ind_Init_Prepared_nObject show ?case
	+ using exec_step_ind_Init_Prepared_nObject.hyps exec_step_ind_Init_Prepared_nObject.prems(1-7)
	+ by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_Init show ?case
	+ using exec_step_ind_Init.prems(1-7,8,12)
	+ by(auto simp: split_beta dest!: exec_step_input_StepC2D)
	+ next
	+ case (exec_step_ind_InitThrow C Cs a P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ obtain sfs where "sh C = Some(sfs,Processing)"
	+ using exec_step_ind_InitThrow.prems(8,14) by(fastforce dest!: exec_step_input_StepTD)
	+ then show ?case using exec_step_ind_InitThrow.prems(1-7)
	+ by(auto split: if_split_asm) blast+
	+ next
	+ case exec_step_ind_InitThrow_End show ?case using exec_step_ind_InitThrow_End.prems(1-7)
	+ by(auto simp del: find_handler.simps dest!: find_handler_pieces) blast+
	+ qed
	+ qed(simp)
	+qed(simp)
	+
	+\<comment> \<open> Forward promises (classes that will be collected by the end of execution) \<close>
	+ \<comment> \<open> - Classes that the current instruction will check initialization for will be collected \<close>
	+ \<comment> \<open> - Class whose initialization is actively being called by the current frame will be collected \<close>
	+
	+text \<open> We prove that an @{term ics} of @{text "Calling C Cs"} (meaning @{text C}'s
	+ initialization procedure is actively being called) means that classes above @{text C}
	+ will be collected by @{term cbig} (i.e., by the end of execution) using proof by
	+ induction, proving the base and IH separately. \<close>
	+
	+\<comment> \<open> base case: @{term Object} \<close>
	+lemma Calling_collects_base:
	+assumes big: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and ics: "ics_of (hd(frames_of \<sigma>)) = Calling Object Cs"
	+shows "classes_above P Object \<subseteq> cset \<union> cset'"
	+proof(cases "frames_of \<sigma>")
	+ case Nil then show ?thesis using nend by(clarsimp simp: JVMendset_def)
	+next
	+ case (Cons f1 frs1)
	+ then obtain stk loc C M pc ics where "f1 = (stk,loc,C,M,pc,ics)" by(cases f1)
	+ then show ?thesis
	+ using JVMSmartCollectionSemantics.cbig_stepD[OF big nend] nend ics Cons
	+ by(clarsimp simp: JVMSmartCollectionSemantics.csmall_def JVMendset_def)
	+qed
	+
	+\<comment> \<open> IH case where @{text C} has not been prepared yet \<close>
	+lemma Calling_None_next_state:
	+assumes ics: "ics_of (hd(frames_of \<sigma>)) = Calling C Cs"
	+ and none: "sheap \<sigma> C = None"
	+ and set: "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ and \<sigma>': "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+shows "\<sigma>' \<notin> JVMendset \<and> ics_of (hd(frames_of \<sigma>')) = Calling C Cs
	+ \<and> (\<exists>sfs. sheap \<sigma>' C = Some(sfs,Prepared))
	+ \<and> (\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> C \<noteq> C'
	+ \<longrightarrow> (\<exists>sfs i. sheap \<sigma>' C' = Some(sfs,i)) \<longrightarrow> classes_above P C' \<subseteq> cset)"
	+proof(cases "frames_of \<sigma> = [] \<or> (\<exists>x. fst \<sigma> = Some x)")
	+ case True then show ?thesis using assms
	+ by(cases \<sigma>, auto simp: JVMSmartCollectionSemantics.csmall_def)
	+next
	+ case False
	+ then obtain f1 frs1 where frs: "frames_of \<sigma> = f1#frs1" by(cases "frames_of \<sigma>", auto)
	+ obtain stk loc C' M pc ics where f1: "f1 = (stk,loc,C',M,pc,ics)" by(cases f1)
	+ show ?thesis using f1 frs False assms
	+ by(cases \<sigma>, cases "method P C clinit")
	+ (clarsimp simp: split_beta JVMSmartCollectionSemantics.csmall_def JVMendset_def)
	+qed
	+
	+\<comment> \<open> IH case where @{text C} has been prepared (and has a direct superclass
	+ - i.e., is not @{term Object}) \<close>
	+lemma Calling_Prepared_next_state:
	+assumes sub: "P \<turnstile> C \<prec>\<^sup>1 D"
	+ and obj: "P \<turnstile> D \<preceq>\<^sup>* Object"
	+ and ics: "ics_of (hd(frames_of \<sigma>)) = Calling C Cs"
	+ and prep: "sheap \<sigma> C = Some(sfs,Prepared)"
	+ and set: "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> C \<noteq> C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ and \<sigma>': "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+shows "\<sigma>' \<notin> JVMendset \<and> ics_of (hd (frames_of \<sigma>')) = Calling D (C#Cs)
	+ \<and> (\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>' C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset)"
	+using sub
	+proof(cases "C=Object")
	+ case nobj:False show ?thesis
	+ proof(cases "frames_of \<sigma> = [] \<or> (\<exists>x. fst \<sigma> = Some x)")
	+ case True then show ?thesis using assms
	+ by(cases \<sigma>, auto simp: JVMSmartCollectionSemantics.csmall_def)
	+ next
	+ case False
	+ then obtain f1 frs1 where frs: "frames_of \<sigma> = f1#frs1" by(cases "frames_of \<sigma>", auto)
	+ obtain stk loc C' M pc ics where f1: "f1 = (stk,loc,C',M,pc,ics)" by(cases f1)
	+ have "C \<noteq> D" using sub obj subcls_self_superclass by auto
	+ then have dimp: "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> P \<turnstile> C \<preceq>\<^sup>* C' \<and> C \<noteq> C'"
	+ using sub subcls_of_Obj_acyclic[OF obj] by fastforce
	+ have "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> C \<noteq> C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>' C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ using f1 frs False nobj assms
	+ by(cases \<sigma>, cases "method P C clinit")
	+ (auto simp: JVMSmartCollectionSemantics.csmall_def JVMendset_def)
	+ then have "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>' C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset" using sub dimp by auto
	+ then show ?thesis using f1 frs False nobj assms
	+ by(cases \<sigma>, cases "method P C clinit")
	+ (auto dest:subcls1D simp: JVMSmartCollectionSemantics.csmall_def JVMendset_def)
	+ qed
	+qed(simp)
	+
	+\<comment> \<open> completed IH case: non-@{term Object} (pulls together above IH cases) \<close>
	+lemma Calling_collects_IH:
	+assumes sub: "P \<turnstile> C \<prec>\<^sup>1 D"
	+ and obj: "P \<turnstile> D \<preceq>\<^sup>* Object"
	+ and step: "\<And>\<sigma> cset' Cs. (\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma> \<Longrightarrow> \<sigma> \<notin> JVMendset
	+ \<Longrightarrow> ics_of (hd(frames_of \<sigma>)) = Calling D Cs
	+ \<Longrightarrow> \<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset
	+ \<Longrightarrow> classes_above P D \<subseteq> cset \<union> cset'"
	+ and big: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "ics_of (hd(frames_of \<sigma>)) = Calling C Cs"
	+ and set: "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+shows "classes_above P C \<subseteq> cset \<union> cset'"
	+proof(cases "frames_of \<sigma>")
	+ case Nil then show ?thesis using nend by(clarsimp simp: JVMendset_def)
	+next
	+ case (Cons f1 frs1)
	+ show ?thesis using sub
	+ proof(cases "\<exists>sfs i. sheap \<sigma> C = Some(sfs,i)")
	+ case True then show ?thesis using set by auto
	+ next
	+ case False
	+ obtain stk loc C' M pc ics where f1: "f1 = (stk,loc,C',M,pc,ics)" by(cases f1)
	+ then obtain \<sigma>1 coll1 coll where \<sigma>1: "(\<sigma>1, coll1) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+ "cset' = coll1 \<union> coll" "(\<sigma>', coll) \<in> JVMSmartCollectionSemantics.cbig P \<sigma>1"
	+ using JVMSmartCollectionSemantics.cbig_stepD[OF big nend] by clarsimp
	+ show ?thesis
	+ proof(cases "\<exists>sfs. sheap \<sigma> C = Some(sfs,Prepared)")
	+ case True
	+ then obtain sfs where sfs: "sheap \<sigma> C = Some(sfs,Prepared)" by clarsimp
	+ have set': "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> C\<noteq>C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset" using set by auto
	+ then have "\<sigma>1 \<notin> JVMendset \<and> ics_of (hd (frames_of \<sigma>1)) = Calling D (C#Cs)"
	+ "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ using Calling_Prepared_next_state[OF sub obj curr sfs set' \<sigma>1(1)]
	+ by(auto simp: JVMSmartCollectionSemantics.csmall_def)
	+ then show ?thesis using step[of coll \<sigma>1] classes_above_def2[OF sub] \<sigma>1 f1 Cons nend curr
	+ by(clarsimp simp: JVMSmartCollectionSemantics.csmall_def JVMendset_def)
	+ next
	+ case none: False \<comment> \<open> @{text "Calling C Cs"} is the next @{text ics}, but after that is @{text "Calling D (C#Cs)"} \<close>
	+ then have sNone: "sheap \<sigma> C = None" using False by(cases "sheap \<sigma> C", auto)
	+ then have nend1: "\<sigma>1 \<notin> JVMendset" and curr1: "ics_of (hd (frames_of \<sigma>1)) = Calling C Cs"
	+ and prep: "\<exists>sfs. sheap \<sigma>1 C = \<lfloor>(sfs, Prepared)\<rfloor>"
	+ and set1: "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> C \<noteq> C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C' = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ using Calling_None_next_state[OF curr sNone set \<sigma>1(1)] by simp+
	+ then obtain f2 frs2 where frs2: "frames_of \<sigma>1 = f2#frs2"
	+ by(cases \<sigma>1, cases "frames_of \<sigma>1", clarsimp simp: JVMendset_def)
	+ obtain sfs1 where sfs1: "sheap \<sigma>1 C = Some(sfs1,Prepared)" using prep by clarsimp
	+ obtain stk2 loc2 C2 M2 pc2 ics2 where f2: "f2 = (stk2,loc2,C2,M2,pc2,ics2)" by(cases f2)
	+ then obtain \<sigma>2 coll2 coll' where \<sigma>2: "(\<sigma>2, coll2) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>1"
	+ "coll = coll2 \<union> coll'" "(\<sigma>', coll') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>2"
	+ using JVMSmartCollectionSemantics.cbig_stepD[OF \<sigma>1(3) nend1] by clarsimp
	+ then have "\<sigma>2 \<notin> JVMendset \<and> ics_of (hd (frames_of \<sigma>2)) = Calling D (C#Cs)"
	+ "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>2 C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ using Calling_Prepared_next_state[OF sub obj curr1 sfs1 set1 \<sigma>2(1)]
	+ by(auto simp: JVMSmartCollectionSemantics.csmall_def)
	+ then show ?thesis using step[of coll' \<sigma>2] classes_above_def2[OF sub] \<sigma>2 \<sigma>1 f2 frs2 f1 Cons
	+ nend1 nend curr1 curr
	+ by(clarsimp simp: JVMSmartCollectionSemantics.csmall_def JVMendset_def)
	+ qed
	+ qed
	+qed
	+
	+\<comment> \<open>pulls together above base and IH cases \<close>
	+lemma Calling_collects:
	+assumes sub: "P \<turnstile> C \<preceq>\<^sup>* Object"
	+ and "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+ and "\<sigma> \<notin> JVMendset"
	+ and "ics_of (hd(frames_of \<sigma>)) = Calling C Cs"
	+ and "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ and "cset' \<subseteq> cset"
	+shows "classes_above P C \<subseteq> cset"
	+proof -
	+ have base: "\<forall>\<sigma> cset' Cs.
	+ (\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma> \<longrightarrow> \<sigma> \<notin> JVMendset
	+ \<longrightarrow> ics_of (hd (frames_of \<sigma>)) = Calling Object Cs
	+ \<longrightarrow> (\<forall>C'. P \<turnstile> Object \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C' \<subseteq> cset)
	+ \<longrightarrow> classes_above P Object \<subseteq> JVMcombine cset cset'" using Calling_collects_base by simp
	+ have IH: "\<And>y z. P \<turnstile> y \<prec>\<^sup>1 z \<Longrightarrow>
	+ P \<turnstile> z \<preceq>\<^sup>* Object \<Longrightarrow>
	+ \<forall>\<sigma> cset' Cs. (\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma> \<longrightarrow> \<sigma> \<notin> JVMendset
	+ \<longrightarrow> ics_of (hd(frames_of \<sigma>)) = Calling z Cs
	+ \<longrightarrow> (\<forall>C'. P \<turnstile> z \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset)
	+ \<longrightarrow> classes_above P z \<subseteq> cset \<union> cset' \<Longrightarrow>
	+ \<forall>\<sigma> cset' Cs. (\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma> \<longrightarrow> \<sigma> \<notin> JVMendset
	+ \<longrightarrow> ics_of (hd(frames_of \<sigma>)) = Calling y Cs
	+ \<longrightarrow> (\<forall>C'. P \<turnstile> y \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset)
	+ \<longrightarrow> classes_above P y \<subseteq> cset \<union> cset'"
	+ using Calling_collects_IH by blast
	+ have result: "\<forall>\<sigma> cset' Cs.
	+ (\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma> \<longrightarrow> \<sigma> \<notin> JVMendset
	+ \<longrightarrow> ics_of (hd(frames_of \<sigma>)) = Calling C Cs
	+ \<longrightarrow> (\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset)
	+ \<longrightarrow> classes_above P C \<subseteq> cset \<union> cset'"
	+ using converse_rtrancl_induct[OF sub,
	+ where P="\<lambda>C. \<forall>\<sigma> cset' Cs. (\<sigma>',cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma> \<longrightarrow> \<sigma> \<notin> JVMendset
	+ \<longrightarrow> ics_of (hd(frames_of \<sigma>)) = Calling C Cs
	+ \<longrightarrow> (\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset)
	+ \<longrightarrow> classes_above P C \<subseteq> cset \<union> cset'"]
	+ using base IH by blast
	+ then show ?thesis using assms by blast
	+qed
	+
	+(*******************)
	+text "Instructions that call the initialization procedure will collect classes above
	+ the class initialized by the end of execution (using the above @{text Calling_collects})."
	+
	+lemma New_collects:
	+assumes sub: "P \<turnstile> C \<preceq>\<^sup>* Object"
	+ and cbig: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = New C"
	+ and ics: "ics_of (hd(frames_of \<sigma>)) = No_ics"
	+ and sheap: "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ and smart: "cset' \<subseteq> cset"
	+shows "classes_above P C \<subseteq> cset"
	+proof(cases "(\<exists>sfs i. sheap \<sigma> C = Some(sfs,i) \<and> i = Done)")
	+ case True then show ?thesis using sheap by auto
	+next
	+ case False
	+ obtain n where nstep: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma> n"
	+ and "n \<noteq> 0" using nend cbig JVMSmartCollectionSemantics.cbig_def2
	+ JVMSmartCollectionSemantics.csmall_nstep_base by (metis empty_iff insert_iff)
	+ then show ?thesis
	+ proof(cases n)
	+ case (Suc n1)
	+ then obtain \<sigma>1 cset0 cset1 where \<sigma>1: "(\<sigma>1,cset1) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+ "cset' = cset1 \<union> cset0" "(\<sigma>',cset0) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>1 n1"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD nstep by blast
	+ obtain xp h frs sh where "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then have ics1: "ics_of (hd(frames_of \<sigma>1)) = Calling C []"
	+ and sheap': "sheap \<sigma> = sheap \<sigma>1" and nend1: "\<sigma>1 \<notin> JVMendset"
	+ using JVM_New_next_step[OF _ nend curr] \<sigma>1(1) False ics
	+ by(simp add: JVMSmartCollectionSemantics.csmall_def)+
	+ have "\<sigma>' \<in> JVMendset" using cbig JVMSmartCollectionSemantics.cbig_def2 by blast
	+ then have cbig1: "(\<sigma>', cset0) \<in> JVMSmartCollectionSemantics.cbig P \<sigma>1"
	+ using JVMSmartCollectionSemantics.cbig_def2 \<sigma>1(3) by blast
	+ have sheap1: "\<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C' = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C' \<subseteq> cset" using sheap' sheap by simp
	+ have "cset0 \<subseteq> cset" using \<sigma>1(2) smart by blast
	+ then have "classes_above P C \<subseteq> cset"
	+ using Calling_collects[OF sub cbig1 nend1 ics1 sheap1] by simp
	+ then show ?thesis using \<sigma>1(2) smart by auto
	+ qed(simp)
	+qed
	+
	+lemma Getstatic_collects:
	+assumes sub: "P \<turnstile> D \<preceq>\<^sup>* Object"
	+ and cbig: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = Getstatic C F D"
	+ and ics: "ics_of (hd(frames_of \<sigma>)) = No_ics"
	+ and fC: "P \<turnstile> C has F,Static:t in D"
	+ and sheap: "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ and smart: "cset' \<subseteq> cset"
	+shows "classes_above P D \<subseteq> cset"
	+proof(cases "(\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done)
	+ \<or> (ics_of(hd(frames_of \<sigma>)) = Called [])")
	+ case True then show ?thesis
	+ proof(cases "\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done")
	+ case True then show ?thesis using sheap by auto
	+ next
	+ case False
	+ then have "ics_of(hd(frames_of \<sigma>)) = Called []" using True by clarsimp
	+ then show ?thesis using ics by auto
	+ qed
	+next
	+ case False
	+ obtain n where nstep: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma> n"
	+ and "n \<noteq> 0" using nend cbig JVMSmartCollectionSemantics.cbig_def2
	+ JVMSmartCollectionSemantics.csmall_nstep_base by (metis empty_iff insert_iff)
	+ then show ?thesis
	+ proof(cases n)
	+ case (Suc n1)
	+ then obtain \<sigma>1 cset0 cset1 where \<sigma>1: "(\<sigma>1,cset1) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+ "cset' = cset1 \<union> cset0" "(\<sigma>',cset0) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>1 n1"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD nstep by blast
	+ obtain xp h frs sh where "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then have curr1: "ics_of (hd(frames_of \<sigma>1)) = Calling D []"
	+ and sheap': "sheap \<sigma> = sheap \<sigma>1" and nend1: "\<sigma>1 \<notin> JVMendset"
	+ using JVM_Getstatic_next_step[OF _ nend curr fC] \<sigma>1(1) False ics
	+ by(simp add: JVMSmartCollectionSemantics.csmall_def)+
	+ have "\<sigma>' \<in> JVMendset" using cbig JVMSmartCollectionSemantics.cbig_def2 by blast
	+ then have cbig1: "(\<sigma>', cset0) \<in> JVMSmartCollectionSemantics.cbig P \<sigma>1"
	+ using JVMSmartCollectionSemantics.cbig_def2 \<sigma>1(3) by blast
	+ have sheap1: "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C' = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C' \<subseteq> cset" using sheap' sheap by simp
	+ have "cset0 \<subseteq> cset" using \<sigma>1(2) smart by blast
	+ then have "classes_above P D \<subseteq> cset"
	+ using Calling_collects[OF sub cbig1 nend1 curr1 sheap1] by simp
	+ then show ?thesis using \<sigma>1(2) smart by auto
	+ qed(simp)
	+qed
	+
	+lemma Putstatic_collects:
	+assumes sub: "P \<turnstile> D \<preceq>\<^sup>* Object"
	+ and cbig: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = Putstatic C F D"
	+ and ics: "ics_of (hd(frames_of \<sigma>)) = No_ics"
	+ and fC: "P \<turnstile> C has F,Static:t in D"
	+ and sheap: "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+ and smart: "cset' \<subseteq> cset"
	+shows "classes_above P D \<subseteq> cset"
	+proof(cases "(\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done)
	+ \<or> (ics_of(hd(frames_of \<sigma>)) = Called [])")
	+ case True then show ?thesis
	+ proof(cases "\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done")
	+ case True then show ?thesis using sheap by auto
	+ next
	+ case False
	+ then have "ics_of(hd(frames_of \<sigma>)) = Called []" using True by clarsimp
	+ then show ?thesis using ics by auto
	+ qed
	+next
	+ case False
	+ obtain n where nstep: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma> n"
	+ and "n \<noteq> 0" using nend cbig JVMSmartCollectionSemantics.cbig_def2
	+ JVMSmartCollectionSemantics.csmall_nstep_base by (metis empty_iff insert_iff)
	+ then show ?thesis
	+ proof(cases n)
	+ case (Suc n1)
	+ then obtain \<sigma>1 cset0 cset1 where \<sigma>1: "(\<sigma>1,cset1) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+ "cset' = cset1 \<union> cset0" "(\<sigma>',cset0) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>1 n1"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD nstep by blast
	+ obtain xp h frs sh where "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then have curr1: "ics_of (hd(frames_of \<sigma>1)) = Calling D []"
	+ and sheap': "sheap \<sigma> = sheap \<sigma>1" and nend1: "\<sigma>1 \<notin> JVMendset"
	+ using JVM_Putstatic_next_step[OF _ nend curr fC] \<sigma>1(1) False ics
	+ by(simp add: JVMSmartCollectionSemantics.csmall_def)+
	+ have "\<sigma>' \<in> JVMendset" using cbig JVMSmartCollectionSemantics.cbig_def2 by blast
	+ then have cbig1: "(\<sigma>', cset0) \<in> JVMSmartCollectionSemantics.cbig P \<sigma>1"
	+ using JVMSmartCollectionSemantics.cbig_def2 \<sigma>1(3) by blast
	+ have sheap1: "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C' = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C' \<subseteq> cset" using sheap' sheap by simp
	+ have "cset0 \<subseteq> cset" using \<sigma>1(2) smart by blast
	+ then have "classes_above P D \<subseteq> cset"
	+ using Calling_collects[OF sub cbig1 nend1 curr1 sheap1] by simp
	+ then show ?thesis using \<sigma>1(2) smart by auto
	+ qed(simp)
	+qed
	+
	+lemma Invokestatic_collects:
	+assumes sub: "P \<turnstile> D \<preceq>\<^sup>* Object"
	+ and cbig: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+ and smart: "cset' \<subseteq> cset"
	+ and nend: "\<sigma> \<notin> JVMendset"
	+ and curr: "curr_instr P (hd(frames_of \<sigma>)) = Invokestatic C M n"
	+ and ics: "ics_of (hd(frames_of \<sigma>)) = No_ics"
	+ and mC: "P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D"
	+ and sheap: "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above P C' \<subseteq> cset"
	+shows "classes_above P D \<subseteq> cset"
	+proof(cases "(\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done)
	+ \<or> (ics_of(hd(frames_of \<sigma>)) = Called [])")
	+ case True then show ?thesis
	+ proof(cases "\<exists>sfs i. sheap \<sigma> D = Some(sfs,i) \<and> i = Done")
	+ case True then show ?thesis using sheap by auto
	+ next
	+ case False
	+ then have "ics_of(hd(frames_of \<sigma>)) = Called []" using True by clarsimp
	+ then show ?thesis using ics by auto
	+ qed
	+next
	+ case False
	+ obtain n where nstep: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma> n"
	+ and "n \<noteq> 0" using nend cbig JVMSmartCollectionSemantics.cbig_def2
	+ JVMSmartCollectionSemantics.csmall_nstep_base by (metis empty_iff insert_iff)
	+ then show ?thesis
	+ proof(cases n)
	+ case (Suc n1)
	+ then obtain \<sigma>1 cset0 cset1 where \<sigma>1: "(\<sigma>1,cset1) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+ "cset' = cset1 \<union> cset0" "(\<sigma>',cset0) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>1 n1"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD nstep by blast
	+ obtain xp h frs sh where "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then have curr1: "ics_of (hd(frames_of \<sigma>1)) = Calling D []"
	+ and sheap': "sheap \<sigma> = sheap \<sigma>1" and nend1: "\<sigma>1 \<notin> JVMendset"
	+ using JVM_Invokestatic_next_step[OF _ nend curr mC] \<sigma>1(1) False ics
	+ by(simp add: JVMSmartCollectionSemantics.csmall_def)+
	+ have "\<sigma>' \<in> JVMendset" using cbig JVMSmartCollectionSemantics.cbig_def2 by blast
	+ then have cbig1: "(\<sigma>', cset0) \<in> JVMSmartCollectionSemantics.cbig P \<sigma>1"
	+ using JVMSmartCollectionSemantics.cbig_def2 \<sigma>1(3) by blast
	+ have sheap1: "\<forall>C'. P \<turnstile> D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C' = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C' \<subseteq> cset" using sheap' sheap by simp
	+ have "cset0 \<subseteq> cset" using \<sigma>1(2) smart by blast
	+ then have "classes_above P D \<subseteq> cset"
	+ using Calling_collects[OF sub cbig1 nend1 curr1 sheap1] by simp
	+ then show ?thesis using \<sigma>1(2) smart by auto
	+ qed(simp)
	+qed
	+
	+(*********)
	+
	+text "The @{text smart_out} execution function keeps the promise to
	+ collect above the initial class (@{term Test}):"
	+lemma jvm_smart_out_classes_above_Test:
	+assumes s: "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t" and P: "P \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+shows "classes_above (jvm_make_test_prog P t) Test \<subseteq> cset\<^sub>s"
	+ (is "classes_above ?P ?D \<subseteq> ?cset")
	+proof -
	+ let ?\<sigma> = "start_state (t#P)" and ?M = main
	+ let ?ics = "ics_of (hd(frames_of ?\<sigma>))"
	+ have called: "?ics = Called [] \<Longrightarrow> classes_above ?P ?D \<subseteq> ?cset"
	+ by(simp add: start_state_def)
	+ then show ?thesis
	+ proof(cases "?ics = Called []")
	+ case True then show ?thesis using called by simp
	+ next
	+ case False
	+ from P t obtain wf_md where wf: "wf_prog wf_md (t#P)"
	+ by(auto simp: wf_jvm_prog_phi_def wf_jvm_prog_def)
	+ from jvm_make_test_prog_sees_Test_main[OF P t] obtain m where
	+ mC: "?P \<turnstile> ?D sees ?M,Static:[] \<rightarrow> Void = m in ?D" by fast
	+ (****)
	+ then have "?P \<turnstile> ?D \<preceq>\<^sup>* Object" by(rule sees_method_sub_Obj)
	+ moreover from s obtain cset' where
	+ cbig: "(\<sigma>', cset') \<in> JVMSmartCollectionSemantics.cbig ?P ?\<sigma>" and "cset' \<subseteq> ?cset" by clarsimp
	+ moreover have nend: "?\<sigma> \<notin> JVMendset" by(rule start_state_nend)
	+ moreover from start_prog_start_m_instrs[OF wf] t
	+ have curr: "curr_instr ?P (hd(frames_of ?\<sigma>)) = Invokestatic ?D ?M 0"
	+ by(simp add: start_state_def)
	+ moreover have ics: "?ics = No_ics"
	+ by(simp add: start_state_def)
	+ moreover note mC
	+ moreover from jvm_smart_out_classes_above_start_sheap[OF s]
	+ have sheap: "\<forall>C'. ?P \<turnstile> ?D \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap ?\<sigma> C' = Some(sfs,i))
	+ \<longrightarrow> classes_above ?P C' \<subseteq> ?cset" by(simp add: start_state_def)
	+ ultimately show ?thesis by(rule Invokestatic_collects)
	+ qed
	+qed
	+
	+(**********************************************)
	+text "Using lemmas proving preservation of backward promises and keeping
	+ of forward promises, we prove that the smart algorithm collects at least
	+ the classes as the naive algorithm does."
	+
	+\<comment> \<open> first over a single execution step (assumes promises) \<close>
	+lemma jvm_naive_to_smart_exec_collect:
	+assumes
	+\<comment> \<open> well-formedness \<close>
	+ wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
	+ and correct: "P,\<Phi> \<turnstile> (xp,h,frs,sh)\<surd>"
	+\<comment> \<open> defs \<close>
	+ and f': "hd frs = (stk,loc,C',M',pc,ics)"
	+\<comment> \<open> backward promises - will be collected prior \<close>
	+ and heap: "\<And>C fs. \<exists>a. h a = Some(C,fs) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and sheap: "\<And>C sfs i. sh C = Some(sfs,i) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and xcpts: "classes_above_xcpts P \<subseteq> cset"
	+ and frames: "classes_above_frames P frs \<subseteq> cset"
	+\<comment> \<open> forward promises - will be collected after if not already \<close>
	+ and init_class_prom: "\<And>C. ics = Called [] \<or> ics = No_ics
	+ \<Longrightarrow> coll_init_class P (instrs_of P C' M' ! pc) = Some C \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and Calling_prom: "\<And>C' Cs'. ics = Calling C' Cs' \<Longrightarrow> classes_above P C' \<subseteq> cset"
	+\<comment> \<open> collection \<close>
	+ and smart: "JVMexec_scollect P (xp,h,frs,sh) \<subseteq> cset"
	+shows "JVMexec_ncollect P (xp,h,frs,sh) \<subseteq> cset"
	+using assms
	+proof(cases frs)
	+ case (Cons f' frs')
	+ then have [simp]: "classes_above P C' \<subseteq> cset" using frames f' by simp
	+ let ?i = "instrs_of P C' M' ! pc"
	+ have cr': "P,\<Phi> \<turnstile> (xp,h,(stk,loc,C',M',pc,ics)#frs',sh)\<surd>" using correct f' Cons by simp
	+ from well_formed_stack_safe[OF wtp cr'] correct_state_Throwing_ex[OF cr'] obtain
	+ stack_safe: "stack_safe ?i h stk" and
	+ Throwing_ex: "\<And>Cs a. ics = Throwing Cs a \<Longrightarrow> \<exists>obj. h a = Some obj" by simp
	+ have confc: "conf_clinit P sh frs" using correct Cons by simp
	+ have Called_prom: "\<And>C' Cs'. ics = Called (C'#Cs')
	+ \<Longrightarrow> classes_above P C' \<subseteq> cset \<and> classes_above P (fst(method P C' clinit)) \<subseteq> cset"
	+ proof -
	+ fix C' Cs' assume [simp]: "ics = Called (C'#Cs')"
	+ then have "C' \<in> set(clinit_classes frs)" using f' Cons by simp
	+ then obtain sfs where shC': "sh C' = Some(sfs, Processing)" and "is_class P C'"
	+ using confc by(auto simp: conf_clinit_def)
	+ then have C'eq: "C' = fst(method P C' clinit)" using wf_sees_clinit wtp
	+ by(fastforce simp: is_class_def wf_jvm_prog_phi_def)
	+ then show "classes_above P C' \<subseteq> cset \<and> classes_above P (fst(method P C' clinit)) \<subseteq> cset"
	+ using sheap shC' by auto
	+ qed
	+ show ?thesis using Cons assms
	+ proof(cases xp)
	+ case None
	+ { assume ics: "ics = Called [] \<or> ics = No_ics"
	+ then have [simp]: "JVMexec_ncollect P (xp,h,frs,sh)
	+ = JVMinstr_ncollect P ?i h stk \<union> classes_above P C'
	+ \<union> classes_above_frames P frs \<union> classes_above_xcpts P"
	+ and [simp]: "JVMexec_scollect P (xp,h,frs,sh) = JVMinstr_scollect P ?i"
	+ using f' None Cons by auto
	+ have ?thesis using assms
	+ proof(cases ?i)
	+ case (New C)
	+ then have "classes_above P C \<subseteq> cset" using ics New assms by simp
	+ then show ?thesis using New xcpts frames smart f' by auto
	+ next
	+ case (Getfield F C) show ?thesis
	+ proof(cases "hd stk = Null")
	+ case True then show ?thesis using Getfield assms by simp
	+ next
	+ case False
	+ let ?C = "cname_of h (the_Addr (hd stk))"
	+ have above_stk: "classes_above P ?C \<subseteq> cset"
	+ using stack_safe heap f' False Cons Getfield by(auto dest!: is_ptrD) blast
	+ then show ?thesis using Getfield assms by auto
	+ qed
	+ next
	+ case (Getstatic C F D)
	+ show ?thesis
	+ proof(cases "\<exists>t. P \<turnstile> C has F,Static:t in D")
	+ case True
	+ then have above_D: "classes_above P D \<subseteq> cset" using ics init_class_prom Getstatic by simp
	+ have sub: "P \<turnstile> C \<preceq>\<^sup>* D" using has_field_decl_above True by blast
	+ then have above_C: "classes_between P C D - {D} \<subseteq> cset"
	+ using True Getstatic above_D smart f' by simp
	+ then have "classes_above P C \<subseteq> cset"
	+ using classes_above_sub_classes_between_eq[OF sub] above_D above_C by auto
	+ then show ?thesis using Getstatic assms by auto
	+ next
	+ case False then show ?thesis using Getstatic assms by auto
	+ qed
	+ next
	+ case (Putfield F C) show ?thesis
	+ proof(cases "hd(tl stk) = Null")
	+ case True then show ?thesis using Putfield assms by simp
	+ next
	+ case False
	+ let ?C = "cname_of h (the_Addr (hd (tl stk)))"
	+ have above_stk: "classes_above P ?C \<subseteq> cset"
	+ using stack_safe heap f' False Cons Putfield by(auto dest!: is_ptrD) blast
	+ then show ?thesis using Putfield assms by auto
	+ qed
	+ next
	+ case (Putstatic C F D)
	+ show ?thesis
	+ proof(cases "\<exists>t. P \<turnstile> C has F,Static:t in D")
	+ case True
	+ then have above_D: "classes_above P D \<subseteq> cset" using ics init_class_prom Putstatic by simp
	+ have sub: "P \<turnstile> C \<preceq>\<^sup>* D" using has_field_decl_above True by blast
	+ then have above_C: "classes_between P C D - {D} \<subseteq> cset"
	+ using True Putstatic above_D smart f' by simp
	+ then have "classes_above P C \<subseteq> cset"
	+ using classes_above_sub_classes_between_eq[OF sub] above_D above_C by auto
	+ then show ?thesis using Putstatic assms by auto
	+ next
	+ case False then show ?thesis using Putstatic assms by auto
	+ qed
	+ next
	+ case (Checkcast C) show ?thesis
	+ proof(cases "hd stk = Null")
	+ case True then show ?thesis using Checkcast assms by simp
	+ next
	+ case False
	+ let ?C = "cname_of h (the_Addr (hd stk))"
	+ have above_stk: "classes_above P ?C \<subseteq> cset"
	+ using stack_safe heap False Cons f' Checkcast by(auto dest!: is_ptrD) blast
	+ then show ?thesis using above_stk Checkcast assms by(cases "hd stk = Null", auto)
	+ qed
	+ next
	+ case (Invoke M n) show ?thesis
	+ proof(cases "stk ! n = Null")
	+ case True then show ?thesis using Invoke assms by simp
	+ next
	+ case False
	+ let ?C = "cname_of h (the_Addr (stk ! n))"
	+ have above_stk: "classes_above P ?C \<subseteq> cset" using stack_safe heap False Cons f' Invoke
	+ by(auto dest!: is_ptrD) blast
	+ then show ?thesis using Invoke assms by auto
	+ qed
	+ next
	+ case (Invokestatic C M n)
	+ let ?D = "fst (method P C M)"
	+ show ?thesis
	+ proof(cases "\<exists>Ts T m D. P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D")
	+ case True
	+ then have above_D: "classes_above P ?D \<subseteq> cset" using ics init_class_prom Invokestatic
	+ by(simp add: seeing_class_def)
	+ have sub: "P \<turnstile> C \<preceq>\<^sup>* ?D" using method_def2 sees_method_decl_above True by auto
	+ then show ?thesis
	+ proof(cases "C = ?D")
	+ case True then show ?thesis
	+ using Invokestatic above_D xcpts frames smart f' by auto
	+ next
	+ case False
	+ then have above_C: "classes_between P C ?D - {?D} \<subseteq> cset"
	+ using True Invokestatic above_D smart f' by simp
	+ then have "classes_above P C \<subseteq> cset"
	+ using classes_above_sub_classes_between_eq[OF sub] above_D above_C by auto
	+ then show ?thesis using Invokestatic assms by auto
	+ qed
	+ next
	+ case False then show ?thesis using Invokestatic assms by auto
	+ qed
	+ next
	+ case Throw show ?thesis
	+ proof(cases "hd stk = Null")
	+ case True then show ?thesis using Throw assms by simp
	+ next
	+ case False
	+ let ?C = "cname_of h (the_Addr (hd stk))"
	+ have above_stk: "classes_above P ?C \<subseteq> cset"
	+ using stack_safe heap False Cons f' Throw by(auto dest!: is_ptrD) blast
	+ then show ?thesis using above_stk Throw assms by auto
	+ qed
	+ next
	+ case Load then show ?thesis using assms by auto
	+ next
	+ case Store then show ?thesis using assms by auto
	+ next
	+ case Push then show ?thesis using assms by auto
	+ next
	+ case Goto then show ?thesis using assms by auto
	+ next
	+ case IfFalse then show ?thesis using assms by auto
	+ qed(auto)
	+ }
	+ moreover
	+ { fix C1 Cs1 assume ics: "ics = Called (C1#Cs1)"
	+ then have ?thesis using None Cons Called_prom[OF ics] xcpts frames f' by simp
	+ }
	+ moreover
	+ { fix Cs1 a assume ics: "ics = Throwing Cs1 a"
	+ then obtain C fs where "h a = Some(C,fs)" using Throwing_ex by fastforce
	+ then have above_stk: "classes_above P (cname_of h a) \<subseteq> cset" using heap by auto
	+ then have ?thesis using ics None Cons xcpts frames f' by simp
	+ }
	+ moreover
	+ { fix C1 Cs1 assume ics: "ics = Calling C1 Cs1"
	+ then have ?thesis using None Cons Calling_prom[OF ics] xcpts frames f' by simp
	+ }
	+ ultimately show ?thesis by (metis ics_classes.cases list.exhaust)
	+ qed(simp)
	+qed(simp)
	+
	+\<comment> \<open> ... which is the same as @{term csmall} \<close>
	+lemma jvm_naive_to_smart_csmall:
	+assumes
	+\<comment> \<open> well-formedness \<close>
	+ wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
	+ and correct: "P,\<Phi> \<turnstile> (xp,h,frs,sh)\<surd>"
	+\<comment> \<open> defs \<close>
	+ and f': "hd frs = (stk,loc,C',M',pc,ics)"
	+\<comment> \<open> backward promises - will be collected prior \<close>
	+ and heap: "\<And>C fs. \<exists>a. h a = Some(C,fs) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and sheap: "\<And>C sfs i. sh C = Some(sfs,i) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and xcpts: "classes_above_xcpts P \<subseteq> cset"
	+ and frames: "classes_above_frames P frs \<subseteq> cset"
	+\<comment> \<open> forward promises - will be collected after if not already \<close>
	+ and init_class_prom: "\<And>C. ics = Called [] \<or> ics = No_ics
	+ \<Longrightarrow> coll_init_class P (instrs_of P C' M' ! pc) = Some C \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and Calling_prom: "\<And>C' Cs'. ics = Calling C' Cs' \<Longrightarrow> classes_above P C' \<subseteq> cset"
	+\<comment> \<open> collections \<close>
	+ and smart_coll: "(\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall P (xp,h,frs,sh)"
	+ and naive_coll: "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall P (xp,h,frs,sh)"
	+ and smart: "cset\<^sub>s \<subseteq> cset"
	+shows "cset\<^sub>n \<subseteq> cset"
	+using jvm_naive_to_smart_exec_collect[where h=h and sh=sh, OF assms(1-9)]
	+ smart smart_coll naive_coll
	+ by(fastforce simp: JVMNaiveCollectionSemantics.csmall_def
	+ JVMSmartCollectionSemantics.csmall_def)
	+
	+\<comment> \<open> ...which means over @{term csmall_nstep}, stepping from the end state
	+ (the point by which future promises will have been fulfilled) (uses backward
	+ and forward promise lemmas) \<close>
	+lemma jvm_naive_to_smart_csmall_nstep:
	+"\<lbrakk> wf_jvm_prog\<^bsub>\<Phi>\<^esub> P;
	+ P,\<Phi> \<turnstile> (xp,h,frs,sh)\<surd>;
	+ hd frs = (stk,loc,C',M',pc,ics);
	+ \<And>C fs. \<exists>a. h a = Some(C,fs) \<Longrightarrow> classes_above P C \<subseteq> cset;
	+ \<And>C sfs i. sh C = Some(sfs,i) \<Longrightarrow> classes_above P C \<subseteq> cset;
	+ classes_above_xcpts P \<subseteq> cset;
	+ classes_above_frames P frs \<subseteq> cset;
	+ \<And>C. ics = Called [] \<or> ics = No_ics
	+ \<Longrightarrow> coll_init_class P (instrs_of P C' M' ! pc) = Some C \<Longrightarrow> classes_above P C \<subseteq> cset;
	+ \<And>C' Cs'. ics = Calling C' Cs' \<Longrightarrow> classes_above P C' \<subseteq> cset;
	+ (\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall_nstep P (xp,h,frs,sh) n;
	+ (\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall_nstep P (xp,h,frs,sh) n;
	+ cset\<^sub>s \<subseteq> cset;
	+ \<sigma>' \<in> JVMendset \<rbrakk>
	+ \<Longrightarrow> cset\<^sub>n \<subseteq> cset"
	+proof(induct n arbitrary: xp h frs sh stk loc C' M' pc ics \<sigma>' cset\<^sub>n cset\<^sub>s cset)
	+ case 0 then show ?case
	+ using JVMNaiveCollectionSemantics.csmall_nstep_base subsetI old.prod.inject singletonD
	+ by (metis (no_types, lifting) equals0D)
	+next
	+ case (Suc n1)
	+ let ?\<sigma> = "(xp,h,frs,sh)"
	+ obtain \<sigma>1 cset1 cset' where \<sigma>1: "(\<sigma>1, cset1) \<in> JVMNaiveCollectionSemantics.csmall P ?\<sigma>"
	+ "cset\<^sub>n = cset1 \<union> cset'" "(\<sigma>', cset') \<in> JVMNaiveCollectionSemantics.csmall_nstep P \<sigma>1 n1"
	+ using JVMNaiveCollectionSemantics.csmall_nstep_SucD[OF Suc.prems(10)] by clarsimp+
	+ obtain \<sigma>1' cset1' cset'' where \<sigma>1': "(\<sigma>1', cset1') \<in> JVMSmartCollectionSemantics.csmall P ?\<sigma>"
	+ "cset\<^sub>s = cset1' \<union> cset''" "(\<sigma>', cset'') \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>1' n1"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD[OF Suc.prems(11)] by clarsimp+
	+ have \<sigma>_eq: "\<sigma>1 = \<sigma>1'" using \<sigma>1(1) \<sigma>1'(1) by(simp add: JVMNaiveCollectionSemantics.csmall_def
	+ JVMSmartCollectionSemantics.csmall_def)
	+ have sub1': "cset1' \<subseteq> cset" and sub'': "cset'' \<subseteq> cset" using Suc.prems(12) \<sigma>1'(2) by auto
	+ then have sub1: "cset1 \<subseteq> cset"
	+ using jvm_naive_to_smart_csmall[where h=h and sh=sh and \<sigma>'=\<sigma>1, OF Suc.prems(1-9) _ _ sub1']
	+ Suc.prems(11,12) \<sigma>1(1) \<sigma>1'(1) \<sigma>_eq by fastforce
	+ show ?case
	+ proof(cases n1)
	+ case 0 then show ?thesis using \<sigma>1(2,3) sub1 by auto
	+ next
	+ case Suc2: (Suc n2)
	+ then have nend1: "\<sigma>1 \<notin> JVMendset"
	+ using JVMNaiveCollectionSemantics.csmall_nstep_Suc_nend \<sigma>1(3) by blast
	+ obtain xp1 h1 frs1 sh1 where \<sigma>1_case [simp]: "\<sigma>1 = (xp1,h1,frs1,sh1)" by(cases \<sigma>1)
	+ obtain stk1 loc1 C1' M1' pc1 ics1 where f1': "hd frs1 = (stk1,loc1,C1',M1',pc1,ics1)"
	+ by(cases "hd frs1")
	+ then obtain frs1' where [simp]: "frs1 = (stk1,loc1,C1',M1',pc1,ics1)#frs1'"
	+ using JVMendset_def nend1 by(cases frs1, auto)
	+ have cbig1: "(\<sigma>', cset') \<in> JVMNaiveCollectionSemantics.cbig P \<sigma>1"
	+ "(\<sigma>', cset'') \<in> JVMSmartCollectionSemantics.cbig P \<sigma>1" using \<sigma>1(3) \<sigma>1'(3) Suc.prems(13) \<sigma>_eq
	+ using JVMNaiveCollectionSemantics.cbig_def2
	+ JVMSmartCollectionSemantics.cbig_def2 by blast+
	+ obtain \<sigma>2' cset2' cset2'' where \<sigma>2': "(\<sigma>2', cset2') \<in> JVMSmartCollectionSemantics.csmall P \<sigma>1"
	+ "cset'' = cset2' \<union> cset2''" "(\<sigma>', cset2'') \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>2' n2"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD \<sigma>1'(3) Suc2 \<sigma>_eq by blast
	+(*****)
	+ have wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P" by fact
	+ let ?i1 = "instrs_of P C1' M1' ! pc1"
	+ let ?ics1 = "ics_of (hd (frames_of \<sigma>1))"
	+ have step: "P \<turnstile> (xp,h,frs,sh) -jvm\<rightarrow> (xp1,h1,frs1,sh1)"
	+ proof -
	+ have "exec (P, ?\<sigma>) = \<lfloor>\<sigma>1'\<rfloor>" using JVMsmart_csmallD[OF \<sigma>1'(1)] by simp
	+ then have "P \<turnstile> ?\<sigma> -jvm\<rightarrow> \<sigma>1'" using jvm_one_step1[OF exec_1.exec_1I] by simp
	+ then show ?thesis using Suc.prems(12) \<sigma>_eq by fastforce
	+ qed
	+ have correct1: "P,\<Phi> \<turnstile> (xp1,h1,frs1,sh1)\<surd>" by(rule BV_correct[OF wtp step Suc.prems(2)])
	+(**)
	+ have vics1: "P,h1,sh1 \<turnstile>\<^sub>i (C1', M1', pc1, ics1)"
	+ using correct1 Suc.prems(7) by(auto simp: conf_f_def2)
	+ from correct1 obtain b Ts T mxs mxl\<^sub>0 ins xt ST LT where
	+ meth1: "P \<turnstile> C1' sees M1',b:Ts\<rightarrow>T=(mxs,mxl\<^sub>0,ins,xt) in C1'" and
	+ pc1: "pc1 < length ins" and
	+ \<Phi>_pc1: "\<Phi> C1' M1'!pc1 = Some (ST,LT)" by(auto dest: sees_method_fun)
	+ then have wt1: "P,T,mxs,size ins,xt \<turnstile> ins!pc1,pc1 :: \<Phi> C1' M1'"
	+ using wt_jvm_prog_impl_wt_instr[OF wtp meth1] by fast
	+(**)
	+ have "\<And>a C fs sfs' i'. (h1 a = \<lfloor>(C, fs)\<rfloor> \<longrightarrow> classes_above P C \<subseteq> cset) \<and>
	+ (sh1 C = \<lfloor>(sfs', i')\<rfloor> \<longrightarrow> classes_above P C \<subseteq> cset) \<and>
	+ classes_above_frames P frs1 \<subseteq> cset"
	+ proof -
	+ fix a C fs sfs' i'
	+ show "(h1 a = \<lfloor>(C, fs)\<rfloor> \<longrightarrow> classes_above P C \<subseteq> cset) \<and>
	+ (sh1 C = \<lfloor>(sfs', i')\<rfloor> \<longrightarrow> classes_above P C \<subseteq> cset) \<and>
	+ (classes_above_frames P frs1 \<subseteq> cset)"
	+ using Suc.prems(11-12) \<sigma>1' \<sigma>_eq[THEN sym] JVMsmart_csmallD[OF \<sigma>1'(1)]
	+ backward_coll_promises_kept[where h=h and xp=xp and sh=sh and frs=frs and frs'=frs1
	+ and xp'=xp1 and h'=h1 and sh'=sh1, OF Suc.prems(1-9)] by auto
	+ qed
	+ then have heap1: "\<And>C fs. \<exists>a. h1 a = Some(C,fs) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and sheap1: "\<And>C sfs i. sh1 C = Some(sfs,i) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and frames1: "classes_above_frames P frs1 \<subseteq> cset" by blast+
	+ have xcpts1: "classes_above_xcpts P \<subseteq> cset" using Suc.prems(6) by auto
	+\<comment> \<open> @{text init_class} promise \<close>
	+ have sheap2: "\<And>C. coll_init_class P ?i1 = Some C
	+ \<Longrightarrow> \<forall>C'. P \<turnstile> C \<preceq>\<^sup>* C' \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C' = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C' \<subseteq> cset" using sheap1 by auto
	+ have called: "\<And>C. coll_init_class P ?i1 = Some C
	+ \<Longrightarrow> ics_of (hd (frames_of \<sigma>1)) = Called [] \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ proof -
	+ fix C assume cic: "coll_init_class P ?i1 = Some C" and
	+ ics: "ics_of (hd (frames_of \<sigma>1)) = Called []"
	+ then obtain sobj where "sh1 C = Some sobj" using vics1 f1'
	+ by(cases ?i1, auto simp: seeing_class_def split: if_split_asm)
	+ then show "classes_above P C \<subseteq> cset" using sheap1 by(cases sobj, simp)
	+ qed
	+ have init_class_prom1: "\<And>C. ics1 = Called [] \<or> ics1 = No_ics
	+ \<Longrightarrow> coll_init_class P ?i1 = Some C \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ proof -
	+ fix C assume "ics1 = Called [] \<or> ics1 = No_ics" and cic: "coll_init_class P ?i1 = Some C"
	+ then have ics: "?ics1 = Called [] \<or> ?ics1 = No_ics" using f1' by simp
	+ then show "classes_above P C \<subseteq> cset" using cic
	+ proof(cases "?ics1 = Called []")
	+ case True then show ?thesis using cic called by simp
	+ next
	+ case False
	+ then have ics': "?ics1 = No_ics" using ics by simp
	+ then show ?thesis using cic
	+ proof(cases ?i1)
	+ case (New C1)
	+ then have "is_class P C1" using \<Phi>_pc1 wt1 meth1 by auto
	+ then have "P \<turnstile> C1 \<preceq>\<^sup>* Object" using wtp is_class_is_subcls
	+ by(auto simp: wf_jvm_prog_phi_def)
	+ then show ?thesis using New_collects[OF _ cbig1(2) nend1 _ ics' sheap2 sub'']
	+ f1' ics cic New by auto
	+ next
	+ case (Getstatic C1 F1 D1)
	+ then obtain t where mC1: "P \<turnstile> C1 has F1,Static:t in D1" and eq: "C = D1"
	+ using cic by (metis coll_init_class.simps(2) option.inject option.simps(3))
	+ then have "is_class P C" using has_field_is_class'[OF mC1] by simp
	+ then have "P \<turnstile> C \<preceq>\<^sup>* Object" using wtp is_class_is_subcls
	+ by(auto simp: wf_jvm_prog_phi_def)
	+ then show ?thesis using Getstatic_collects[OF _ cbig1(2) nend1 _ ics' _ sheap2 sub'']
	+ eq f1' Getstatic ics cic by fastforce
	+ next
	+ case (Putstatic C1 F1 D1)
	+ then obtain t where mC1: "P \<turnstile> C1 has F1,Static:t in D1" and eq: "C = D1"
	+ using cic by (metis coll_init_class.simps(3) option.inject option.simps(3))
	+ then have "is_class P C" using has_field_is_class'[OF mC1] by simp
	+ then have "P \<turnstile> C \<preceq>\<^sup>* Object" using wtp is_class_is_subcls
	+ by(auto simp: wf_jvm_prog_phi_def)
	+ then show ?thesis using Putstatic_collects[OF _ cbig1(2) nend1 _ ics' _ sheap2 sub'']
	+ eq f1' Putstatic ics cic by fastforce
	+ next
	+ case (Invokestatic C1 M1 n')
	+ then obtain Ts T m where mC: "P \<turnstile> C1 sees M1, Static : Ts\<rightarrow>T = m in C"
	+ using cic by(fastforce simp: seeing_class_def split: if_split_asm)
	+ then have "is_class P C" by(rule sees_method_is_class')
	+ then have Obj: "P \<turnstile> C \<preceq>\<^sup>* Object" using wtp is_class_is_subcls
	+ by(auto simp: wf_jvm_prog_phi_def)
	+ show ?thesis using Invokestatic_collects[OF _ cbig1(2) sub'' nend1 _ ics' mC sheap2]
	+ Obj mC f1' Invokestatic ics cic by auto
	+ qed(simp+)
	+ qed
	+ qed
	+\<comment> \<open> Calling promise \<close>
	+ have Calling_prom1: "\<And>C' Cs'. ics1 = Calling C' Cs' \<Longrightarrow> classes_above P C' \<subseteq> cset"
	+ proof -
	+ fix C' Cs' assume ics: "ics1 = Calling C' Cs'"
	+ then have "is_class P C'" using vics1 by simp
	+ then have obj: "P \<turnstile> C' \<preceq>\<^sup>* Object" using wtp is_class_is_subcls
	+ by(auto simp: wf_jvm_prog_phi_def)
	+ have sheap3: "\<forall>C1. P \<turnstile> C' \<preceq>\<^sup>* C1 \<longrightarrow> (\<exists>sfs i. sheap \<sigma>1 C1 = \<lfloor>(sfs, i)\<rfloor>)
	+ \<longrightarrow> classes_above P C1 \<subseteq> cset" using sheap1 by auto
	+ show "classes_above P C' \<subseteq> cset"
	+ using Calling_collects[OF obj cbig1(2) nend1 _ sheap3 sub''] ics f1' by simp
	+ qed
	+ have in_naive: "(\<sigma>', cset') \<in> JVMNaiveCollectionSemantics.csmall_nstep P (xp1, h1, frs1, sh1) n1"
	+ and in_smart: "(\<sigma>', cset'') \<in> JVMSmartCollectionSemantics.csmall_nstep P (xp1, h1, frs1, sh1) n1"
	+ using \<sigma>1(3) \<sigma>1'(3) \<sigma>_eq[THEN sym] by simp+
	+ have sub2: "cset' \<subseteq> cset"
	+ by(rule Suc.hyps[OF wtp correct1 f1' heap1 sheap1 xcpts1 frames1 init_class_prom1
	+ Calling_prom1 in_naive in_smart sub'' Suc.prems(13)]) simp_all
	+ then show ?thesis using \<sigma>1(2) \<sigma>1'(2) sub1 sub2 by fastforce
	+ qed
	+qed
	+
	+\<comment> \<open> ...which means over @{term cbig} \<close>
	+lemma jvm_naive_to_smart_cbig:
	+assumes
	+\<comment> \<open> well-formedness \<close>
	+ wtp: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> P"
	+ and correct: "P,\<Phi> \<turnstile> (xp,h,frs,sh)\<surd>"
	+\<comment> \<open> defs \<close>
	+ and f': "hd frs = (stk,loc,C',M',pc,ics)"
	+\<comment> \<open> backward promises - will be collected/maintained prior \<close>
	+ and heap: "\<And>C fs. \<exists>a. h a = Some(C,fs) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and sheap: "\<And>C sfs i. sh C = Some(sfs,i) \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and xcpts: "classes_above_xcpts P \<subseteq> cset"
	+ and frames: "classes_above_frames P frs \<subseteq> cset"
	+\<comment> \<open> forward promises - will be collected after if not already \<close>
	+ and init_class_prom: "\<And>C. ics = Called [] \<or> ics = No_ics
	+ \<Longrightarrow> coll_init_class P (instrs_of P C' M' ! pc) = Some C \<Longrightarrow> classes_above P C \<subseteq> cset"
	+ and Calling_prom: "\<And>C' Cs'. ics = Calling C' Cs' \<Longrightarrow> classes_above P C' \<subseteq> cset"
	+\<comment> \<open> collections \<close>
	+ and n: "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.cbig P (xp,h,frs,sh)"
	+ and s: "(\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.cbig P (xp,h,frs,sh)"
	+ and smart: "cset\<^sub>s \<subseteq> cset"
	+shows "cset\<^sub>n \<subseteq> cset"
	+proof -
	+ let ?\<sigma> = "(xp,h,frs,sh)"
	+ have nend: "\<sigma>' \<in> JVMendset" using n by(simp add: JVMNaiveCollectionSemantics.cbig_def)
	+ obtain n where n': "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall_nstep P ?\<sigma> n" "\<sigma>' \<in> JVMendset"
	+ using JVMNaiveCollectionSemantics.cbig_def2 n by auto
	+ obtain s where s': "(\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall_nstep P ?\<sigma> s" "\<sigma>' \<in> JVMendset"
	+ using JVMSmartCollectionSemantics.cbig_def2 s by auto
	+ have "n=s" using jvm_naive_to_smart_csmall_nstep_last_eq[OF n n'(1) s'(1)] by simp
	+ then have sn: "(\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall_nstep P ?\<sigma> n" using s'(1) by simp
	+ then show ?thesis
	+ using jvm_naive_to_smart_csmall_nstep[OF assms(1-9) n'(1) sn assms(12) nend] by fast
	+qed
	+
	+\<comment> \<open>...thus naive @{text "\<subseteq>"} smart over the out function, since all conditions will be met - and promises
	+ kept - by the defined starting point \<close>
	+lemma jvm_naive_to_smart_collection:
	+assumes naive: "(\<sigma>',cset\<^sub>n) \<in> jvm_naive_out P t" and smart: "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t"
	+ and P: "P \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+shows "cset\<^sub>n \<subseteq> cset\<^sub>s"
	+proof -
	+ let ?P = "jvm_make_test_prog P t"
	+ let ?\<sigma> = "start_state (t#P)"
	+ let ?i = "instrs_of ?P Start start_m ! 0" and ?ics = No_ics
	+ obtain xp h frs sh where
	+ [simp]: "?\<sigma> = (xp,h,frs,sh)" and
	+ [simp]: "h = start_heap (t#P)" and
	+ [simp]: "frs = [([], [], Start, start_m, 0, No_ics)]" and
	+ [simp]: "sh = start_sheap"
	+ by(clarsimp simp: start_state_def)
	+
	+ from P t have nS: "\<not> is_class (t # P) Start"
	+ by(simp add: is_class_def class_def Start_def Test_def)
	+ from P have nT: "\<not> is_class P Test" by simp
	+ from P t obtain m where tPm: "t # P \<turnstile> (fst t) sees main, Static : []\<rightarrow>Void = m in (fst t)"
	+ by auto
	+ have nclinit: "main \<noteq> clinit" by(simp add: main_def clinit_def)
	+ have Objp: "\<And>b' Ts' T' m' D'.
	+ t#P \<turnstile> Object sees start_m, b' : Ts'\<rightarrow>T' = m' in D' \<Longrightarrow> b' = Static \<and> Ts' = [] \<and> T' = Void"
	+ proof -
	+ fix b' Ts' T' m' D'
	+ assume mObj: "t#P \<turnstile> Object sees start_m, b' : Ts'\<rightarrow>T' = m' in D'"
	+ from P have ot_nsub: "\<not> P \<turnstile> Object \<preceq>\<^sup>* Test"
	+ by(clarsimp simp: wf_jvm_prog_def wf_jvm_prog_phi_def)
	+ from class_add_sees_method_rev[OF _ ot_nsub] mObj t
	+ have "P \<turnstile> Object sees start_m, b' : Ts'\<rightarrow>T' = m' in D'" by(cases t, auto)
	+ with P jvm_progs_def show "b' = Static \<and> Ts' = [] \<and> T' = Void" by blast
	+ qed
	+ from P t obtain \<Phi> where wtp0: "wf_jvm_prog\<^bsub>\<Phi>\<^esub> (t#P)" by(auto simp: wf_jvm_prog_def)
	+ let ?\<Phi>' = "\<lambda>C f. if C = Start \<and> (f = start_m \<or> f = clinit) then start_\<phi>\<^sub>m else \<Phi> C f"
	+ from wtp0 have wtp: "wf_jvm_prog\<^bsub>?\<Phi>'\<^esub> ?P"
	+ proof -
	+ note wtp0 nS tPm nclinit
	+ moreover obtain "\<And>C. C \<noteq> Start \<Longrightarrow> ?\<Phi>' C = \<Phi> C" "?\<Phi>' Start start_m = start_\<phi>\<^sub>m"
	+ "?\<Phi>' Start clinit = start_\<phi>\<^sub>m" by simp
	+ moreover note Objp
	+ ultimately show ?thesis by(rule start_prog_wf_jvm_prog_phi)
	+ qed
	+ have cic: "coll_init_class ?P ?i = Some Test"
	+ proof -
	+ from wtp0 obtain wf_md where wf: "wf_prog wf_md (t#P)"
	+ by(clarsimp dest!: wt_jvm_progD)
	+ with start_prog_start_m_instrs t have i: "?i = Invokestatic Test main 0" by simp
	+ from jvm_make_test_prog_sees_Test_main[OF P t] obtain m where
	+ "?P \<turnstile> Test sees main, Static : []\<rightarrow>Void = m in Test" by fast
	+ with t have "seeing_class (jvm_make_test_prog P t) Test main = \<lfloor>Test\<rfloor>"
	+ by(cases m, fastforce simp: seeing_class_def)
	+ with i show ?thesis by simp
	+ qed
	+\<comment> \<open> well-formedness \<close>
	+ note wtp
	+ moreover have correct: "?P,?\<Phi>' \<turnstile> (xp,h,frs,sh)\<surd>"
	+ proof -
	+ note wtp0 nS tPm nclinit
	+ moreover have "?\<Phi>' Start start_m = start_\<phi>\<^sub>m" by simp
	+ ultimately have "?P,?\<Phi>' \<turnstile> ?\<sigma>\<surd>" by(rule BV_correct_initial)
	+ then show ?thesis by simp
	+ qed
	+\<comment> \<open> defs \<close>
	+ moreover have "hd frs = ([], [], Start, start_m, 0, No_ics)" by simp
	+\<comment> \<open> backward promises \<close>
	+ moreover from jvm_smart_out_classes_above_start_heap[OF smart _ P t]
	+ have heap: "\<And>C fs. \<exists>a. h a = Some(C,fs) \<Longrightarrow> classes_above ?P C \<subseteq> cset\<^sub>s" by auto
	+ moreover from jvm_smart_out_classes_above_start_sheap[OF smart]
	+ have sheap: "\<And>C sfs i. sh C = Some(sfs,i) \<Longrightarrow> classes_above ?P C \<subseteq> cset\<^sub>s" by simp
	+ moreover from jvm_smart_out_classes_above_xcpts[OF smart P t]
	+ have xcpts: "classes_above_xcpts ?P \<subseteq> cset\<^sub>s" by simp
	+ moreover from jvm_smart_out_classes_above_frames[OF smart]
	+ have frames: "classes_above_frames ?P frs \<subseteq> cset\<^sub>s" by simp
	+\<comment> \<open> forward promises - will be collected after if not already \<close>
	+ moreover from jvm_smart_out_classes_above_Test[OF smart P t] cic
	+ have init_class_prom: "\<And>C. ?ics = Called [] \<or> ?ics = No_ics
	+ \<Longrightarrow> coll_init_class ?P ?i = Some C \<Longrightarrow> classes_above ?P C \<subseteq> cset\<^sub>s" by simp
	+ moreover have "\<And>C' Cs'. ?ics = Calling C' Cs' \<Longrightarrow> classes_above ?P C' \<subseteq> cset\<^sub>s" by simp
	+\<comment> \<open> collections \<close>
	+ moreover from naive
	+ have n: "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.cbig ?P (xp,h,frs,sh)" by simp
	+ moreover from smart obtain cset\<^sub>s' where
	+ s: "(\<sigma>', cset\<^sub>s') \<in> JVMSmartCollectionSemantics.cbig ?P (xp,h,frs,sh)" and
	+ "cset\<^sub>s' \<subseteq> cset\<^sub>s"
	+ by clarsimp
	+ ultimately show "cset\<^sub>n \<subseteq> cset\<^sub>s" by(rule jvm_naive_to_smart_cbig; simp)
	+qed
	+
	+
	+(******************************************)
	+subsubsection \<open> Proving smart @{text "\<subseteq>"} naive \<close>
	+
	+text "We prove that @{term jvm_naive} collects everything @{term jvm_smart}
	+ does. Combined with the other direction, this shows that the naive and smart
	+ algorithms collect the same set of classes."
	+
	+lemma jvm_smart_to_naive_exec_collect:
	+ "JVMexec_scollect P \<sigma> \<subseteq> JVMexec_ncollect P \<sigma>"
	+proof -
	+ obtain xp h frs sh where \<sigma>: "\<sigma>=(xp,h,frs,sh)" by(cases \<sigma>)
	+ then show ?thesis
	+ proof(cases "\<exists>x. xp = Some x \<or> frs = []")
	+ case False
	+ then obtain stk loc C M pc ics frs'
	+ where none: "xp = None" and frs: "frs=(stk,loc,C,M,pc,ics)#frs'"
	+ by(cases xp, auto, cases frs, auto)
	+ have instr_case: "ics = Called [] \<or> ics = No_ics \<Longrightarrow> ?thesis"
	+ proof -
	+ assume ics: "ics = Called [] \<or> ics = No_ics"
	+ then show ?thesis using \<sigma> none frs
	+ proof(cases "curr_instr P (stk,loc,C,M,pc,ics)") qed(auto split: if_split_asm)
	+ qed
	+ then show ?thesis using \<sigma> none frs
	+ proof(cases ics)
	+ case(Called Cs) then show ?thesis using instr_case \<sigma> none frs by(cases Cs, auto)
	+ qed(auto)
	+ qed(auto)
	+qed
	+
	+lemma jvm_smart_to_naive_csmall:
	+assumes "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall P \<sigma>"
	+ and "(\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+shows "cset\<^sub>s \<subseteq> cset\<^sub>n"
	+using jvm_smart_to_naive_exec_collect assms
	+ by(auto simp: JVMNaiveCollectionSemantics.csmall_def
	+ JVMSmartCollectionSemantics.csmall_def)
	+
	+lemma jvm_smart_to_naive_csmall_nstep:
	+"\<lbrakk> (\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall_nstep P \<sigma> n;
	+ (\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma> n \<rbrakk>
	+ \<Longrightarrow> cset\<^sub>s \<subseteq> cset\<^sub>n"
	+proof(induct n arbitrary: \<sigma> \<sigma>' cset\<^sub>n cset\<^sub>s)
	+ case (Suc n')
	+ obtain \<sigma>1 cset1 cset' where \<sigma>1: "(\<sigma>1, cset1) \<in> JVMNaiveCollectionSemantics.csmall P \<sigma>"
	+ "cset\<^sub>n = cset1 \<union> cset'" "(\<sigma>', cset') \<in> JVMNaiveCollectionSemantics.csmall_nstep P \<sigma>1 n'"
	+ using JVMNaiveCollectionSemantics.csmall_nstep_SucD [OF Suc.prems(1)] by clarsimp+
	+ obtain \<sigma>1' cset1' cset'' where \<sigma>1': "(\<sigma>1', cset1') \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+ "cset\<^sub>s = cset1' \<union> cset''" "(\<sigma>', cset'') \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>1' n'"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD [OF Suc.prems(2)] by clarsimp+
	+ have \<sigma>_eq: "\<sigma>1 = \<sigma>1'" using \<sigma>1(1) \<sigma>1'(1) by(simp add: JVMNaiveCollectionSemantics.csmall_def
	+ JVMSmartCollectionSemantics.csmall_def)
	+ then have sub1: "cset1' \<subseteq> cset1" using \<sigma>1(1) \<sigma>1'(1) jvm_smart_to_naive_csmall by blast
	+ have sub2: "cset'' \<subseteq> cset'" using \<sigma>1(3) \<sigma>1'(3) \<sigma>_eq Suc.hyps by blast
	+ then show ?case using \<sigma>1(2) \<sigma>1'(2) sub1 sub2 by blast
	+qed(simp)
	+
	+lemma jvm_smart_to_naive_cbig:
	+assumes n: "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.cbig P \<sigma>"
	+ and s: "(\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.cbig P \<sigma>"
	+shows "cset\<^sub>s \<subseteq> cset\<^sub>n"
	+proof -
	+ obtain n where n': "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall_nstep P \<sigma> n" "\<sigma>' \<in> JVMendset"
	+ using JVMNaiveCollectionSemantics.cbig_def2 n by auto
	+ obtain s where s': "(\<sigma>', cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma> s" "\<sigma>' \<in> JVMendset"
	+ using JVMSmartCollectionSemantics.cbig_def2 s by auto
	+ have "n=s" using jvm_naive_to_smart_csmall_nstep_last_eq[OF n n'(1) s'(1)] by simp
	+ then show ?thesis using jvm_smart_to_naive_csmall_nstep n'(1) s'(1) by blast
	+qed
	+
	+lemma jvm_smart_to_naive_collection:
	+assumes naive: "(\<sigma>',cset\<^sub>n) \<in> jvm_naive_out P t" and smart: "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t"
	+ and "P \<in> jvm_progs" and "t \<in> jvm_tests"
	+shows "cset\<^sub>s \<subseteq> cset\<^sub>n"
	+proof -
	+ have nend: "start_state (t#P) \<notin> JVMendset" by(simp add: JVMendset_def start_state_def)
	+ from naive obtain n where
	+ nstep: "(\<sigma>', cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall_nstep
	+ (jvm_make_test_prog P t) (start_state (t#P)) n"
	+ by(auto dest!: JVMNaiveCollectionSemantics.cbigD)
	+ with nend naive obtain n' where n': "n = Suc n'"
	+ by(cases n; simp add: JVMNaiveCollectionSemantics.cbig_def)
	+ from start_prog_classes_above_Start
	+ have "classes_above_frames (jvm_make_test_prog P t) (frames_of (start_state (t#P))) = {Object,Start}"
	+ by(simp add: start_state_def)
	+ with nstep n'
	+ have "jvm_smart_collect_start (jvm_make_test_prog P t) \<subseteq> cset\<^sub>n"
	+ by(auto simp: start_state_def JVMNaiveCollectionSemantics.csmall_def
	+ dest!: JVMNaiveCollectionSemantics.csmall_nstep_SucD
	+ simp del: JVMNaiveCollectionSemantics.csmall_nstep_Rec)
	+ with jvm_smart_to_naive_cbig[where P="jvm_make_test_prog P t" and \<sigma>="start_state (t#P)" and \<sigma>'=\<sigma>']
	+ jvm_smart_collect_start_make_test_prog assms show ?thesis by auto
	+qed
	+
	+(**************************************************)
	+subsubsection "Safety of the smart algorithm"
	+
	+text "Having proved containment in both directions, we get naive = smart:"
	+lemma jvm_naive_eq_smart_collection:
	+assumes naive: "(\<sigma>',cset\<^sub>n) \<in> jvm_naive_out P t" and smart: "(\<sigma>',cset\<^sub>s) \<in> jvm_smart_out P t"
	+ and "P \<in> jvm_progs" and "t \<in> jvm_tests"
	+shows "cset\<^sub>n = cset\<^sub>s"
	+using jvm_naive_to_smart_collection[OF assms] jvm_smart_to_naive_collection[OF assms] by simp
	+
	+text "Thus, since the RTS algorithm based on @{term ncollect} is existence safe,
	+ the algorithm based on @{term scollect} is as well."
	+theorem jvm_smart_existence_safe:
	+assumes P: "P \<in> jvm_progs" and P': "P' \<in> jvm_progs" and t: "t \<in> jvm_tests"
	+ and out: "o1 \<in> jvm_smart_out P t" and dss: "jvm_deselect P o1 P'"
	+shows "\<exists>o2 \<in> jvm_smart_out P' t. o1 = o2"
	+proof -
	+ obtain \<sigma>' cset\<^sub>s where o1[simp]: "o1=(\<sigma>',cset\<^sub>s)" by(cases o1)
	+ with jvm_naive_iff_smart out obtain cset\<^sub>n where n: "(\<sigma>',cset\<^sub>n) \<in> jvm_naive_out P t" by blast
	+
	+ from jvm_naive_eq_smart_collection[OF n _ P t] out have eq: "cset\<^sub>n = cset\<^sub>s" by simp
	+ with jvm_naive_existence_safe[OF P P' t n] dss have n': "(\<sigma>',cset\<^sub>n) \<in> jvm_naive_out P' t" by simp
	+ with jvm_naive_iff_smart obtain cset\<^sub>s' where s': "(\<sigma>', cset\<^sub>s') \<in> jvm_smart_out P' t" by blast
	+
	+ from jvm_naive_eq_smart_collection[OF n' s' P' t] eq have "cset\<^sub>s = cset\<^sub>s'" by simp
	+ then show ?thesis using s' by simp
	+qed
	+
	+text "...thus @{term JVMSmartCollection} is an instance of @{term CollectionBasedRTS}:"
	+interpretation JVMSmartCollectionRTS :
	+ CollectionBasedRTS "(=)" jvm_deselect jvm_progs jvm_tests
	+ JVMendset JVMcombine JVMcollect_id JVMsmall JVMSmartCollect jvm_smart_out
	+ jvm_make_test_prog jvm_smart_collect_start
	+ by unfold_locales (rule jvm_smart_existence_safe, auto simp: start_state_def)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/JVM_RTS/JVMCollectionSemantics.thy b/thys/Regression_Test_Selection/JVM_RTS/JVMCollectionSemantics.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/JVM_RTS/JVMCollectionSemantics.thy
	@@ -0,0 +1,221 @@
	+(* File: RTS/JVM_RTS/JVMCollectionSemantics.thy *)
	+(* Author: Susannah Mansky, UIUC 2020 *)
	+
	+section "Instantiating @{term CollectionSemantics} with Jinja JVM"
	+
	+theory JVMCollectionSemantics
	+imports "../Common/CollectionSemantics" JVMSemantics "../JinjaSuppl/ClassesAbove"
	+
	+begin
	+
	+abbreviation JVMcombine :: "cname set \<Rightarrow> cname set \<Rightarrow> cname set" where
	+"JVMcombine C C' \<equiv> C \<union> C'"
	+
	+abbreviation JVMcollect_id :: "cname set" where
	+"JVMcollect_id \<equiv> {}"
	+
	+(*******************************************)
	+subsection \<open> JVM-specific @{text "classes_above"} theory \<close>
	+
	+fun classes_above_frames :: "'m prog \<Rightarrow> frame list \<Rightarrow> cname set" where
	+"classes_above_frames P ((stk,loc,C,M,pc,ics)#frs) = classes_above P C \<union> classes_above_frames P frs" \|
	+"classes_above_frames P [] = {}"
	+
	+lemma classes_above_start_state:
	+assumes above_xcpts: "classes_above_xcpts P \<inter> classes_changed P P' = {}"
	+shows "start_state P = start_state P'"
	+using assms classes_above_start_heap by(simp add: start_state_def)
	+
	+lemma classes_above_matches_ex_entry:
	+ "classes_above P C \<inter> classes_changed P P' = {}
	+ \<Longrightarrow> matches_ex_entry P C pc xcp = matches_ex_entry P' C pc xcp"
	+using classes_above_subcls classes_above_subcls2
	+ by(auto simp: matches_ex_entry_def)
	+
	+lemma classes_above_match_ex_table:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "match_ex_table P C pc es = match_ex_table P' C pc es"
	+using classes_above_matches_ex_entry[OF assms] proof(induct es) qed(auto)
	+
	+lemma classes_above_find_handler:
	+assumes "classes_above P (cname_of h a) \<inter> classes_changed P P' = {}"
	+shows "classes_above_frames P frs \<inter> classes_changed P P' = {}
	+ \<Longrightarrow> find_handler P a h frs sh = find_handler P' a h frs sh"
	+proof(induct frs)
	+ case (Cons fr' frs')
	+ obtain stk loc C M pc ics where fr': "fr' = (stk,loc,C,M,pc,ics)" by(cases fr')
	+ with Cons have
	+ intC: "classes_above P C \<inter> classes_changed P P' = {}"
	+ and int: "classes_above_frames P frs' \<inter> classes_changed P P' = {}" by auto
	+ show ?case using Cons fr' int classes_above_method[OF intC]
	+ classes_above_match_ex_table[OF assms(1)] by(auto split: bool.splits)
	+qed(simp)
	+
	+lemma find_handler_classes_above_frames:
	+ "find_handler P a h frs sh = (xp',h',frs',sh')
	+ \<Longrightarrow> classes_above_frames P frs' \<subseteq> classes_above_frames P frs"
	+proof(induct frs)
	+ case (Cons f1 frs1)
	+ then obtain stk loc C M pc ics where f1: "f1 = (stk,loc,C,M,pc,ics)" by(cases f1)
	+ show ?case
	+ proof(cases "match_ex_table P (cname_of h a) pc (ex_table_of P C M)")
	+ case None then show ?thesis using f1 None Cons
	+ by(auto split: bool.splits list.splits init_call_status.splits)
	+ next
	+ case (Some a) then show ?thesis using f1 Some Cons by auto
	+ qed
	+qed(simp)
	+
	+lemma find_handler_pieces:
	+ "find_handler P a h frs sh = (xp',h',frs',sh')
	+ \<Longrightarrow> h = h' \<and> sh = sh' \<and> classes_above_frames P frs' \<subseteq> classes_above_frames P frs"
	+using find_handler_classes_above_frames by(auto dest: find_handler_heap find_handler_sheap)
	+
	+(**************************************)
	+
	+subsection "Naive RTS algorithm"
	+
	+fun JVMinstr_ncollect ::
	+ "[jvm_prog, instr, heap, val list] \<Rightarrow> cname set" where
	+"JVMinstr_ncollect P (New C) h stk = classes_above P C" \|
	+"JVMinstr_ncollect P (Getfield F C) h stk =
	+ (if (hd stk) = Null then {}
	+ else classes_above P (cname_of h (the_Addr (hd stk))))" \|
	+"JVMinstr_ncollect P (Getstatic C F D) h stk = classes_above P C" \|
	+"JVMinstr_ncollect P (Putfield F C) h stk =
	+ (if (hd (tl stk)) = Null then {}
	+ else classes_above P (cname_of h (the_Addr (hd (tl stk)))))" \|
	+"JVMinstr_ncollect P (Putstatic C F D) h stk = classes_above P C" \|
	+"JVMinstr_ncollect P (Checkcast C) h stk =
	+ (if (hd stk) = Null then {}
	+ else classes_above P (cname_of h (the_Addr (hd stk))))" \|
	+"JVMinstr_ncollect P (Invoke M n) h stk =
	+ (if (stk ! n) = Null then {}
	+ else classes_above P (cname_of h (the_Addr (stk ! n))))" \|
	+"JVMinstr_ncollect P (Invokestatic C M n) h stk = classes_above P C" \|
	+"JVMinstr_ncollect P Throw h stk =
	+ (if (hd stk) = Null then {}
	+ else classes_above P (cname_of h (the_Addr (hd stk))))" \|
	+"JVMinstr_ncollect P _ h stk = {}"
	+
	+fun JVMstep_ncollect ::
	+ "[jvm_prog, heap, val list, cname, mname, pc, init_call_status] \<Rightarrow> cname set" where
	+"JVMstep_ncollect P h stk C M pc (Calling C' Cs) = classes_above P C'" \|
	+"JVMstep_ncollect P h stk C M pc (Called (C'#Cs))
	+ = classes_above P C' \<union> classes_above P (fst(method P C' clinit))" \|
	+"JVMstep_ncollect P h stk C M pc (Throwing Cs a) = classes_above P (cname_of h a)" \|
	+"JVMstep_ncollect P h stk C M pc ics = JVMinstr_ncollect P (instrs_of P C M ! pc) h stk"
	+
	+\<comment> \<open> naive collection function \<close>
	+fun JVMexec_ncollect :: "jvm_prog \<Rightarrow> jvm_state \<Rightarrow> cname set" where
	+"JVMexec_ncollect P (None, h, (stk,loc,C,M,pc,ics)#frs, sh) =
	+ (JVMstep_ncollect P h stk C M pc ics
	+ \<union> classes_above P C \<union> classes_above_frames P frs \<union> classes_above_xcpts P
	+ )"
	+\| "JVMexec_ncollect P _ = {}"
	+
	+(****)
	+
	+fun JVMNaiveCollect :: "jvm_prog \<Rightarrow> jvm_state \<Rightarrow> jvm_state \<Rightarrow> cname set" where
	+"JVMNaiveCollect P \<sigma> \<sigma>' = JVMexec_ncollect P \<sigma>"
	+
	+interpretation JVMNaiveCollectionSemantics:
	+ CollectionSemantics JVMsmall JVMendset JVMNaiveCollect JVMcombine JVMcollect_id
	+ by unfold_locales auto
	+
	+(**************************************)
	+
	+subsection "Smarter RTS algorithm"
	+
	+fun JVMinstr_scollect ::
	+ "[jvm_prog, instr] \<Rightarrow> cname set" where
	+"JVMinstr_scollect P (Getstatic C F D)
	+ = (if \<not>(\<exists>t. P \<turnstile> C has F,Static:t in D) then classes_above P C
	+ else classes_between P C D - {D})" \|
	+"JVMinstr_scollect P (Putstatic C F D)
	+ = (if \<not>(\<exists>t. P \<turnstile> C has F,Static:t in D) then classes_above P C
	+ else classes_between P C D - {D})" \|
	+"JVMinstr_scollect P (Invokestatic C M n)
	+ = (if \<not>(\<exists>Ts T m D. P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D) then classes_above P C
	+ else classes_between P C (fst(method P C M)) - {fst(method P C M)})" \|
	+"JVMinstr_scollect P _ = {}"
	+
	+fun JVMstep_scollect ::
	+ "[jvm_prog, instr, init_call_status] \<Rightarrow> cname set" where
	+"JVMstep_scollect P i (Calling C' Cs) = {C'}" \|
	+"JVMstep_scollect P i (Called (C'#Cs)) = {}" \|
	+"JVMstep_scollect P i (Throwing Cs a) = {}" \|
	+"JVMstep_scollect P i ics = JVMinstr_scollect P i"
	+
	+\<comment> \<open> smarter collection function \<close>
	+fun JVMexec_scollect :: "jvm_prog \<Rightarrow> jvm_state \<Rightarrow> cname set" where
	+"JVMexec_scollect P (None, h, (stk,loc,C,M,pc,ics)#frs, sh) =
	+ JVMstep_scollect P (instrs_of P C M ! pc) ics"
	+\| "JVMexec_scollect P _ = {}"
	+
	+(****)
	+
	+fun JVMSmartCollect :: "jvm_prog \<Rightarrow> jvm_state \<Rightarrow> jvm_state \<Rightarrow> cname set" where
	+"JVMSmartCollect P \<sigma> \<sigma>' = JVMexec_scollect P \<sigma>"
	+
	+interpretation JVMSmartCollectionSemantics:
	+ CollectionSemantics JVMsmall JVMendset JVMSmartCollect JVMcombine JVMcollect_id
	+ by unfold_locales
	+
	+(***********************************************)
	+
	+subsection "A few lemmas using the instantiations"
	+
	+lemma JVMnaive_csmallD:
	+"(\<sigma>', cset) \<in> JVMNaiveCollectionSemantics.csmall P \<sigma>
	+ \<Longrightarrow> JVMexec_ncollect P \<sigma> = cset \<and> \<sigma>' \<in> JVMsmall P \<sigma>"
	+ by(simp add: JVMNaiveCollectionSemantics.csmall_def)
	+
	+lemma JVMsmart_csmallD:
	+"(\<sigma>', cset) \<in> JVMSmartCollectionSemantics.csmall P \<sigma>
	+ \<Longrightarrow> JVMexec_scollect P \<sigma> = cset \<and> \<sigma>' \<in> JVMsmall P \<sigma>"
	+ by(simp add: JVMSmartCollectionSemantics.csmall_def)
	+
	+
	+lemma jvm_naive_to_smart_csmall_nstep_last_eq:
	+ "\<lbrakk> (\<sigma>',cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.cbig P \<sigma>;
	+ (\<sigma>',cset\<^sub>n) \<in> JVMNaiveCollectionSemantics.csmall_nstep P \<sigma> n;
	+ (\<sigma>',cset\<^sub>s) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma> n' \<rbrakk>
	+ \<Longrightarrow> n = n'"
	+proof(induct n arbitrary: n' \<sigma> \<sigma>' cset\<^sub>n cset\<^sub>s)
	+ case 0
	+ have "\<sigma>' = \<sigma>" using "0.prems"(2) JVMNaiveCollectionSemantics.csmall_nstep_base by blast
	+ then have endset: "\<sigma> \<in> JVMendset" using "0.prems"(1) JVMNaiveCollectionSemantics.cbigD by blast
	+ show ?case
	+ proof(cases n')
	+ case Suc then show ?thesis using "0.prems"(3) JVMSmartCollectionSemantics.csmall_nstep_Suc_nend
	+ endset by blast
	+ qed(simp)
	+next
	+ case (Suc n1)
	+ then have endset: "\<sigma>' \<in> JVMendset" using Suc.prems(1) JVMNaiveCollectionSemantics.cbigD by blast
	+ have nend: "\<sigma> \<notin> JVMendset"
	+ using JVMNaiveCollectionSemantics.csmall_nstep_Suc_nend[OF Suc.prems(2)] by simp
	+ then have neq: "\<sigma>' \<noteq> \<sigma>" using endset by auto
	+ obtain \<sigma>1 cset cset1 where \<sigma>1: "(\<sigma>1,cset1) \<in> JVMNaiveCollectionSemantics.csmall P \<sigma>"
	+ "cset\<^sub>n = cset1 \<union> cset" "(\<sigma>',cset) \<in> JVMNaiveCollectionSemantics.csmall_nstep P \<sigma>1 n1"
	+ using JVMNaiveCollectionSemantics.csmall_nstep_SucD[OF Suc.prems(2)] by clarsimp
	+ then have cbig: "(\<sigma>',cset) \<in> JVMNaiveCollectionSemantics.cbig P \<sigma>1"
	+ using endset by(auto simp: JVMNaiveCollectionSemantics.cbig_def)
	+ show ?case
	+ proof(cases n')
	+ case 0 then show ?thesis
	+ using neq Suc.prems(3) JVMSmartCollectionSemantics.csmall_nstep_base by blast
	+ next
	+ case Suc': (Suc n1')
	+ then obtain \<sigma>1' cset2 cset1' where \<sigma>1': "(\<sigma>1',cset1') \<in> JVMSmartCollectionSemantics.csmall P \<sigma>"
	+ "cset\<^sub>s = cset1' \<union> cset2" "(\<sigma>',cset2) \<in> JVMSmartCollectionSemantics.csmall_nstep P \<sigma>1' n1'"
	+ using JVMSmartCollectionSemantics.csmall_nstep_SucD[where \<sigma>=\<sigma> and \<sigma>'=\<sigma>' and coll'=cset\<^sub>s
	+ and n=n1'] Suc.prems(3) by blast
	+ then have "\<sigma>1=\<sigma>1'" using \<sigma>1 JVMNaiveCollectionSemantics.csmall_def
	+ JVMSmartCollectionSemantics.csmall_def by auto
	+ then show ?thesis using Suc.hyps(1)[OF cbig \<sigma>1(3)] \<sigma>1'(3) Suc' by blast
	+ qed
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/JVM_RTS/JVMSemantics.thy b/thys/Regression_Test_Selection/JVM_RTS/JVMSemantics.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/JVM_RTS/JVMSemantics.thy
	@@ -0,0 +1,35 @@
	+(* Title: RTS/JVM_RTS/JVMSemantics.thy *)
	+(* Author: Susannah Mansky, UIUC 2020 *)
	+
	+section "Instantiating @{term Semantics} with Jinja JVM"
	+
	+theory JVMSemantics
	+imports "../Common/Semantics" JinjaDCI.JVMExec
	+begin
	+
	+fun JVMsmall :: "jvm_prog \<Rightarrow> jvm_state \<Rightarrow> jvm_state set" where
	+"JVMsmall P \<sigma> = { \<sigma>'. exec (P, \<sigma>) = Some \<sigma>' }"
	+
	+lemma JVMsmall_prealloc_pres:
	+assumes pre: "preallocated (fst(snd \<sigma>))"
	+ and "\<sigma>' \<in> JVMsmall P \<sigma>"
	+shows "preallocated (fst(snd \<sigma>'))"
	+using exec_prealloc_pres[OF pre] assms by(cases \<sigma>, cases \<sigma>', auto)
	+
	+lemma JVMsmall_det: "JVMsmall P \<sigma> = {} \<or> (\<exists>\<sigma>'. JVMsmall P \<sigma> = {\<sigma>'})"
	+by auto
	+
	+definition JVMendset :: "jvm_state set" where
	+"JVMendset \<equiv> { (xp,h,frs,sh). frs = [] \<or> (\<exists>x. xp = Some x) }"
	+
	+lemma JVMendset_final: "\<sigma> \<in> JVMendset \<Longrightarrow> \<forall>P. JVMsmall P \<sigma> = {}"
	+ by(auto simp: JVMendset_def)
	+
	+lemma start_state_nend:
	+ "start_state P \<notin> JVMendset"
	+ by(simp add: start_state_def JVMendset_def)
	+
	+interpretation JVMSemantics: Semantics JVMsmall JVMendset
	+ by unfold_locales (auto dest: JVMendset_final)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/JinjaSuppl/ClassesAbove.thy b/thys/Regression_Test_Selection/JinjaSuppl/ClassesAbove.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/JinjaSuppl/ClassesAbove.thy
	@@ -0,0 +1,286 @@
	+(* Title: RTS/JinjaSuppl/ClassesAbove.thy
	+ Author: Susannah Mansky, UIUC 2020
	+*)
	+
	+section "@{term classes_above} theory"
	+
	+text "This section contains theory around the classes above
	+ (superclasses of) a class in the class structure, in particular
	+ noting that if their contents have not changed, then much of what
	+ that class sees (methods, fields) stays the same."
	+
	+theory ClassesAbove
	+imports ClassesChanged Subcls JinjaDCI.Exceptions
	+begin
	+
	+abbreviation classes_above :: "'m prog \<Rightarrow> cname \<Rightarrow> cname set" where
	+"classes_above P c \<equiv> { cn. P \<turnstile> c \<preceq>\<^sup>* cn }"
	+
	+abbreviation classes_between :: "'m prog \<Rightarrow> cname \<Rightarrow> cname \<Rightarrow> cname set" where
	+"classes_between P c d \<equiv> { cn. (P \<turnstile> c \<preceq>\<^sup>* cn \<and> P \<turnstile> cn \<preceq>\<^sup>* d) }"
	+
	+abbreviation classes_above_xcpts :: "'m prog \<Rightarrow> cname set" where
	+"classes_above_xcpts P \<equiv> \<Union>x\<in>sys_xcpts. classes_above P x"
	+
	+(******************************************************************************)
	+
	+lemma classes_above_def2:
	+ "P \<turnstile> C \<prec>\<^sup>1 D \<Longrightarrow> classes_above P C = {C} \<union> classes_above P D"
	+using subcls1_confluent by auto
	+
	+lemma classes_above_class:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {}; P \<turnstile> C \<preceq>\<^sup>* C' \<rbrakk>
	+ \<Longrightarrow> class P C' = class P' C'"
	+ by (drule classes_changed_class_set, simp)
	+
	+lemma classes_above_subset:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "classes_above P C \<subseteq> classes_above P' C"
	+proof -
	+ have ind: "\<And>x. P \<turnstile> C \<preceq>\<^sup>* x \<Longrightarrow> P' \<turnstile> C \<preceq>\<^sup>* x"
	+ proof -
	+ fix x assume sub: "P \<turnstile> C \<preceq>\<^sup>* x"
	+ then show "P' \<turnstile> C \<preceq>\<^sup>* x"
	+ proof(induct rule: rtrancl_induct)
	+ case base then show ?case by simp
	+ next
	+ case (step y z)
	+ have "P' \<turnstile> y \<prec>\<^sup>1 z" by(rule class_subcls1[OF classes_above_class[OF assms step(1)] step(2)])
	+ then show ?case using step(3) by simp
	+ qed
	+ qed
	+ with classes_changed_class_set[OF assms] show ?thesis by clarsimp
	+qed
	+
	+lemma classes_above_subcls:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {}; P \<turnstile> C \<preceq>\<^sup>* C' \<rbrakk>
	+ \<Longrightarrow> P' \<turnstile> C \<preceq>\<^sup>* C'"
	+ by (fastforce dest: classes_above_subset)
	+
	+lemma classes_above_subset2:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "classes_above P' C \<subseteq> classes_above P C"
	+proof -
	+ have ind: "\<And>x. P' \<turnstile> C \<preceq>\<^sup>* x \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* x"
	+ proof -
	+ fix x assume sub: "P' \<turnstile> C \<preceq>\<^sup>* x"
	+ then show "P \<turnstile> C \<preceq>\<^sup>* x"
	+ proof(induct rule: rtrancl_induct)
	+ case base then show ?case by simp
	+ next
	+ case (step y z)
	+ with class_subcls1 classes_above_class[OF assms] rtrancl_into_rtrancl show ?case by metis
	+ qed
	+ qed
	+ with classes_changed_class_set[OF assms] show ?thesis by clarsimp
	+qed
	+
	+lemma classes_above_subcls2:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {}; P' \<turnstile> C \<preceq>\<^sup>* C' \<rbrakk>
	+ \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* C'"
	+ by (fastforce dest: classes_above_subset2)
	+
	+lemma classes_above_set:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {} \<rbrakk>
	+ \<Longrightarrow> classes_above P C = classes_above P' C"
	+ by(fastforce dest: classes_above_subset classes_above_subset2)
	+
	+lemma classes_above_classes_changed_sym:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "classes_above P' C \<inter> classes_changed P' P = {}"
	+proof -
	+ have "classes_above P C = classes_above P' C" by(rule classes_above_set[OF assms])
	+ with classes_changed_sym[where P=P] assms show ?thesis by simp
	+qed
	+
	+lemma classes_above_sub_classes_between_eq:
	+ "P \<turnstile> C \<preceq>\<^sup>* D \<Longrightarrow> classes_above P C = (classes_between P C D - {D}) \<union> classes_above P D"
	+using subcls_confluent by auto
	+
	+lemma classes_above_subcls_subset:
	+ "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* C' \<rbrakk> \<Longrightarrow> classes_above P C' \<subseteq> classes_above P C"
	+ by auto
	+
	+(************************************************************)
	+subsection "Methods"
	+
	+lemma classes_above_sees_methods:
	+assumes int: "classes_above P C \<inter> classes_changed P P' = {}" and ms: "P \<turnstile> C sees_methods Mm"
	+shows "P' \<turnstile> C sees_methods Mm"
	+proof -
	+ have cls: "\<forall>C'\<in>classes_above P C. class P C' = class P' C'"
	+ by(rule classes_changed_class_set[OF int])
	+
	+ have "\<And>C Mm. P \<turnstile> C sees_methods Mm \<Longrightarrow>
	+ \<forall>C'\<in>classes_above P C. class P C' = class P' C' \<Longrightarrow> P' \<turnstile> C sees_methods Mm"
	+ proof -
	+ fix C Mm assume "P \<turnstile> C sees_methods Mm" and "\<forall>C'\<in>classes_above P C. class P C' = class P' C'"
	+ then show "P' \<turnstile> C sees_methods Mm"
	+ proof(induct rule: Methods.induct)
	+ case Obj: (sees_methods_Object D fs ms Mm)
	+ with cls have "class P' Object = \<lfloor>(D, fs, ms)\<rfloor>" by simp
	+ with Obj show ?case by(auto intro!: sees_methods_Object)
	+ next
	+ case rec: (sees_methods_rec C D fs ms Mm Mm')
	+ then have "P \<turnstile> C \<preceq>\<^sup>* D" by (simp add: r_into_rtrancl[OF subcls1I])
	+ with converse_rtrancl_into_rtrancl have "\<And>x. P \<turnstile> D \<preceq>\<^sup>* x \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* x" by simp
	+ with rec.prems(1) have "\<forall>C'\<in>classes_above P D. class P C' = class P' C'" by simp
	+ with rec show ?case by(auto intro: sees_methods_rec)
	+ qed
	+ qed
	+ with ms cls show ?thesis by simp
	+qed
	+
	+lemma classes_above_sees_method:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {};
	+ P \<turnstile> C sees M,b: Ts\<rightarrow>T = m in C' \<rbrakk>
	+ \<Longrightarrow> P' \<turnstile> C sees M,b: Ts\<rightarrow>T = m in C'"
	+ by (auto dest: classes_above_sees_methods simp: Method_def)
	+
	+lemma classes_above_sees_method2:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {};
	+ P' \<turnstile> C sees M,b: Ts\<rightarrow>T = m in C' \<rbrakk>
	+ \<Longrightarrow> P \<turnstile> C sees M,b: Ts\<rightarrow>T = m in C'"
	+ by (auto dest: classes_above_classes_changed_sym intro: classes_above_sees_method)
	+
	+lemma classes_above_method:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "method P C M = method P' C M"
	+proof(cases "\<exists>Ts T m D b. P \<turnstile> C sees M,b : Ts\<rightarrow>T = m in D")
	+ case True
	+ with assms show ?thesis by (auto dest: classes_above_sees_method)
	+next
	+ case False
	+ with assms have "\<not>(\<exists>Ts T m D b. P' \<turnstile> C sees M,b : Ts\<rightarrow>T = m in D)"
	+ by (auto dest: classes_above_sees_method2)
	+ with False show ?thesis by(simp add: method_def)
	+qed
	+
	+(*********************************************)
	+subsection "Fields"
	+
	+lemma classes_above_has_fields:
	+assumes int: "classes_above P C \<inter> classes_changed P P' = {}" and fs: "P \<turnstile> C has_fields FDTs"
	+shows "P' \<turnstile> C has_fields FDTs"
	+proof -
	+ have cls: "\<forall>C'\<in>classes_above P C. class P C' = class P' C'"
	+ by(rule classes_changed_class_set[OF int])
	+
	+ have "\<And>C Mm. P \<turnstile> C has_fields FDTs \<Longrightarrow>
	+ \<forall>C'\<in>classes_above P C. class P C' = class P' C' \<Longrightarrow> P' \<turnstile> C has_fields FDTs"
	+ proof -
	+ fix C Mm assume "P \<turnstile> C has_fields FDTs" and "\<forall>C'\<in>classes_above P C. class P C' = class P' C'"
	+ then show "P' \<turnstile> C has_fields FDTs"
	+ proof(induct rule: Fields.induct)
	+ case Obj: (has_fields_Object D fs ms FDTs)
	+ with cls have "class P' Object = \<lfloor>(D, fs, ms)\<rfloor>" by simp
	+ with Obj show ?case by(auto intro!: has_fields_Object)
	+ next
	+ case rec: (has_fields_rec C D fs ms FDTs FDTs')
	+ then have "P \<turnstile> C \<preceq>\<^sup>* D" by (simp add: r_into_rtrancl[OF subcls1I])
	+ with converse_rtrancl_into_rtrancl have "\<And>x. P \<turnstile> D \<preceq>\<^sup>* x \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* x" by simp
	+ with rec.prems(1) have "\<forall>x. P \<turnstile> D \<preceq>\<^sup>* x \<longrightarrow> class P x = class P' x" by simp
	+ with rec show ?case by(auto intro: has_fields_rec)
	+ qed
	+ qed
	+ with fs cls show ?thesis by simp
	+qed
	+
	+lemma classes_above_has_fields_dne:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "(\<forall>FDTs. \<not> P \<turnstile> C has_fields FDTs) = (\<forall>FDTs. \<not> P' \<turnstile> C has_fields FDTs)"
	+proof(rule iffI)
	+ assume asm: "\<forall>FDTs. \<not> P \<turnstile> C has_fields FDTs"
	+ from assms classes_changed_sym[where P=P] classes_above_set[OF assms]
	+ have int': "classes_above P' C \<inter> classes_changed P' P = {}" by simp
	+ from asm classes_above_has_fields[OF int'] show "\<forall>FDTs. \<not> P' \<turnstile> C has_fields FDTs" by auto
	+next
	+ assume "\<forall>FDTs. \<not> P' \<turnstile> C has_fields FDTs"
	+ with assms show "\<forall>FDTs. \<not> P \<turnstile> C has_fields FDTs" by(auto dest: classes_above_has_fields)
	+qed
	+
	+lemma classes_above_has_field:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {};
	+ P \<turnstile> C has F,b:t in C' \<rbrakk>
	+ \<Longrightarrow> P' \<turnstile> C has F,b:t in C'"
	+ by(auto dest: classes_above_has_fields simp: has_field_def)
	+
	+lemma classes_above_has_field2:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {};
	+ P' \<turnstile> C has F,b:t in C' \<rbrakk>
	+ \<Longrightarrow> P \<turnstile> C has F,b:t in C'"
	+ by(auto intro: classes_above_has_field dest: classes_above_classes_changed_sym)
	+
	+lemma classes_above_sees_field:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {};
	+ P \<turnstile> C sees F,b:t in C' \<rbrakk>
	+ \<Longrightarrow> P' \<turnstile> C sees F,b:t in C'"
	+ by(auto dest: classes_above_has_fields simp: sees_field_def)
	+
	+lemma classes_above_sees_field2:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {};
	+ P' \<turnstile> C sees F,b:t in C' \<rbrakk>
	+ \<Longrightarrow> P \<turnstile> C sees F,b:t in C'"
	+ by (auto intro: classes_above_sees_field dest: classes_above_classes_changed_sym)
	+
	+lemma classes_above_field:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "field P C F = field P' C F"
	+proof(cases "\<exists>T D b. P \<turnstile> C sees F,b : T in D")
	+ case True
	+ with assms show ?thesis by (auto dest: classes_above_sees_field)
	+next
	+ case False
	+ with assms have "\<not>(\<exists>T D b. P' \<turnstile> C sees F,b : T in D)"
	+ by (auto dest: classes_above_sees_field2)
	+ with False show ?thesis by(simp add: field_def)
	+qed
	+
	+lemma classes_above_fields:
	+assumes "classes_above P C \<inter> classes_changed P P' = {}"
	+shows "fields P C = fields P' C"
	+proof(cases "\<exists>FDTs. P \<turnstile> C has_fields FDTs")
	+ case True
	+ with assms show ?thesis by(auto dest: classes_above_has_fields)
	+next
	+ case False
	+ with assms show ?thesis by (auto dest: classes_above_has_fields_dne simp: fields_def)
	+qed
	+
	+lemma classes_above_ifields:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {} \<rbrakk>
	+ \<Longrightarrow>
	+ ifields P C = ifields P' C"
	+ by (simp add: ifields_def classes_above_fields)
	+
	+
	+lemma classes_above_blank:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {} \<rbrakk>
	+ \<Longrightarrow>
	+ blank P C = blank P' C"
	+ by (simp add: blank_def classes_above_ifields)
	+
	+lemma classes_above_isfields:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {} \<rbrakk>
	+ \<Longrightarrow>
	+ isfields P C = isfields P' C"
	+ by (simp add: isfields_def classes_above_fields)
	+
	+lemma classes_above_sblank:
	+ "\<lbrakk> classes_above P C \<inter> classes_changed P P' = {} \<rbrakk>
	+ \<Longrightarrow>
	+ sblank P C = sblank P' C"
	+ by (simp add: sblank_def classes_above_isfields)
	+
	+(******************************************)
	+subsection "Other"
	+
	+lemma classes_above_start_heap:
	+assumes "classes_above_xcpts P \<inter> classes_changed P P' = {}"
	+shows "start_heap P = start_heap P'"
	+proof -
	+ from assms have "\<forall>C \<in> sys_xcpts. blank P C = blank P' C" by (auto intro: classes_above_blank)
	+ then show ?thesis by(simp add: start_heap_def)
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/JinjaSuppl/ClassesChanged.thy b/thys/Regression_Test_Selection/JinjaSuppl/ClassesChanged.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/JinjaSuppl/ClassesChanged.thy
	@@ -0,0 +1,75 @@
	+(* Title: RTS/JinjaSuppl/ClassesChanged.thy
	+ Author: Susannah Mansky, UIUC 2020
	+ Description: Theory around the classes changed from one program to another
	+*)
	+
	+section "@{term classes_changed} theory"
	+
	+theory ClassesChanged
	+imports JinjaDCI.Decl
	+begin
	+
	+text "A class is considered changed if it exists only in one program or the other,
	+ or exists in both but is different."
	+definition classes_changed :: "'m prog \<Rightarrow> 'm prog \<Rightarrow> cname set" where
	+"classes_changed P1 P2 = {cn. class P1 cn \<noteq> class P2 cn}"
	+
	+definition class_changed :: "'m prog \<Rightarrow> 'm prog \<Rightarrow> cname \<Rightarrow> bool" where
	+"class_changed P1 P2 cn = (class P1 cn \<noteq> class P2 cn)"
	+
	+lemma classes_changed_class_changed[simp]: "cn \<in> classes_changed P1 P2 = class_changed P1 P2 cn"
	+ by (simp add: classes_changed_def class_changed_def)
	+
	+lemma classes_changed_self[simp]: "classes_changed P P = {}"
	+ by (auto simp: class_changed_def)
	+
	+lemma classes_changed_sym: "classes_changed P P' = classes_changed P' P"
	+ by (auto simp: class_changed_def)
	+
	+lemma classes_changed_class: "\<lbrakk> cn \<notin> classes_changed P P'\<rbrakk> \<Longrightarrow> class P cn = class P' cn"
	+ by (clarsimp simp: class_changed_def)
	+
	+lemma classes_changed_class_set: "\<lbrakk> S \<inter> classes_changed P P' = {} \<rbrakk>
	+ \<Longrightarrow> \<forall>C \<in> S. class P C = class P' C"
	+ by (fastforce simp: disjoint_iff_not_equal dest: classes_changed_class)
	+
	+text "We now relate @{term classes_changed} over two programs to those
	+ over programs with an added class (such as a test class)."
	+
	+lemma classes_changed_cons_eq:
	+ "classes_changed (t # P) P' = (classes_changed P P' - {fst t})
	+ \<union> (if class_changed [t] P' (fst t) then {fst t} else {})"
	+ by (auto simp: classes_changed_def class_changed_def class_def)
	+
	+lemma class_changed_cons:
	+ "fst t \<notin> classes_changed (t#P) (t#P')"
	+ by (simp add: class_changed_def class_def)
	+
	+lemma classes_changed_cons:
	+ "classes_changed (t # P) (t # P') = classes_changed P P' - {fst t}"
	+proof(cases "fst t \<in> classes_changed P P'")
	+ case True
	+ then show ?thesis using class_changed_cons[where t=t and P=P and P'=P']
	+ classes_changed_cons_eq[where t=t] by (auto simp: class_changed_def class_cons)
	+next
	+ case False
	+ then show ?thesis using class_changed_cons[where t=t and P=P and P'=P']
	+ by (auto simp: class_changed_def) (metis (no_types, lifting) class_cons)+
	+qed
	+
	+lemma classes_changed_int_Cons:
	+assumes "coll \<inter> classes_changed P P' = {}"
	+shows "coll \<inter> classes_changed (t # P) (t # P') = {}"
	+proof(cases "fst t \<in> classes_changed P P'")
	+ case True
	+ then have "classes_changed P P' = classes_changed (t # P) (t # P') \<union> {fst t}"
	+ using classes_changed_cons[where t=t and P=P and P'=P'] by fastforce
	+ then show ?thesis using assms by simp
	+next
	+ case False
	+ then have "classes_changed P P' = classes_changed (t # P) (t # P')"
	+ using classes_changed_cons[where t=t and P=P and P'=P'] by fastforce
	+ then show ?thesis using assms by simp
	+qed
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/JinjaSuppl/JVMExecStepInductive.thy b/thys/Regression_Test_Selection/JinjaSuppl/JVMExecStepInductive.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/JinjaSuppl/JVMExecStepInductive.thy
	@@ -0,0 +1,919 @@
	+(* Title: RTS/JinjaSuppl/JVMExecStepInductive.thy
	+ Author: Susannah Mansky
	+ 2020, UIUC
	+
	+ Program Execution in the JVM as an inductive
	+*)
	+
	+section "Inductive JVM execution"
	+
	+theory JVMExecStepInductive
	+imports JinjaDCI.JVMExec
	+begin
	+
	+datatype step_input = StepI instr \|
	+ StepC cname "cname list" \| StepC2 cname "cname list" \|
	+ StepT "cname list" addr
	+
	+
	+inductive exec_step_ind :: "[step_input, jvm_prog, heap, val list, val list,
	+ cname, mname, pc, init_call_status, frame list, sheap,jvm_state] \<Rightarrow> bool"
	+where
	+ exec_step_ind_Load:
	+"exec_step_ind (StepI (Load n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, ((loc ! n) # stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Store:
	+"exec_step_ind (StepI (Store n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (tl stk, loc[n:=hd stk], C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Push:
	+"exec_step_ind (StepI (Push v)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (v # stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_NewOOM_Called:
	+"new_Addr h = None
	+ \<Longrightarrow> exec_step_ind (StepI (New C)) P h stk loc C\<^sub>0 M\<^sub>0 pc (Called Cs) frs sh
	+ (\<lfloor>addr_of_sys_xcpt OutOfMemory\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, No_ics)#frs, sh)"
	+
	+\| exec_step_ind_NewOOM_Done:
	+"\<lbrakk> sh C = Some(obj, Done); new_Addr h = None; \<forall>Cs. ics \<noteq> Called Cs \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (New C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt OutOfMemory\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_New_Called:
	+"new_Addr h = Some a
	+ \<Longrightarrow> exec_step_ind (StepI (New C)) P h stk loc C\<^sub>0 M\<^sub>0 pc (Called Cs) frs sh
	+ (None, h(a\<mapsto>blank P C), (Addr a#stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, No_ics)#frs, sh)"
	+
	+\| exec_step_ind_New_Done:
	+"\<lbrakk> sh C = Some(obj, Done); new_Addr h = Some a; \<forall>Cs. ics \<noteq> Called Cs \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (New C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h(a\<mapsto>blank P C), (Addr a#stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_New_Init:
	+"\<lbrakk> \<forall>obj. sh C \<noteq> Some(obj, Done); \<forall>Cs. ics \<noteq> Called Cs \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (New C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Calling C [])#frs, sh)"
	+
	+\| exec_step_ind_Getfield_Null:
	+"hd stk = Null
	+ \<Longrightarrow> exec_step_ind (StepI (Getfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Getfield_NoField:
	+"\<lbrakk> v = hd stk; (D,fs) = the(h(the_Addr v)); v \<noteq> Null; \<not>(\<exists>t b. P \<turnstile> D has F,b:t in C) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Getfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NoSuchFieldError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Getfield_Static:
	+"\<lbrakk> v = hd stk; (D,fs) = the(h(the_Addr v)); v \<noteq> Null; P \<turnstile> D has F,Static:t in C \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Getfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt IncompatibleClassChangeError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Getfield:
	+"\<lbrakk> v = hd stk; (D,fs) = the(h(the_Addr v)); (D',b,t) = field P C F; v \<noteq> Null;
	+ P \<turnstile> D has F,NonStatic:t in C \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Getfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (the(fs(F,C))#(tl stk), loc, C\<^sub>0, M\<^sub>0, pc+1, ics)#frs, sh)"
	+
	+\| exec_step_ind_Getstatic_NoField:
	+"\<not>(\<exists>t b. P \<turnstile> C has F,b:t in D)
	+ \<Longrightarrow> exec_step_ind (StepI (Getstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NoSuchFieldError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Getstatic_NonStatic:
	+"P \<turnstile> C has F,NonStatic:t in D
	+ \<Longrightarrow> exec_step_ind (StepI (Getstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt IncompatibleClassChangeError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Getstatic_Called:
	+"\<lbrakk> (D',b,t) = field P D F; P \<turnstile> C has F,Static:t in D;
	+ v = the ((fst(the(sh D'))) F) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Getstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc (Called Cs) frs sh
	+ (None, h, (v#stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, No_ics)#frs, sh)"
	+
	+\| exec_step_ind_Getstatic_Done:
	+"\<lbrakk> (D',b,t) = field P D F; P \<turnstile> C has F,Static:t in D;
	+ \<forall>Cs. ics \<noteq> Called Cs; sh D' = Some(sfs,Done);
	+ v = the (sfs F) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Getstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (v#stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Getstatic_Init:
	+"\<lbrakk> (D',b,t) = field P D F; P \<turnstile> C has F,Static:t in D;
	+ \<forall>sfs. sh D' \<noteq> Some(sfs,Done); \<forall>Cs. ics \<noteq> Called Cs \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Getstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Calling D' [])#frs, sh)"
	+
	+\| exec_step_ind_Putfield_Null:
	+"hd(tl stk) = Null
	+ \<Longrightarrow> exec_step_ind (StepI (Putfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Putfield_NoField:
	+"\<lbrakk> r = hd(tl stk); a = the_Addr r; (D,fs) = the (h a); r \<noteq> Null; \<not>(\<exists>t b. P \<turnstile> D has F,b:t in C) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Putfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NoSuchFieldError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Putfield_Static:
	+"\<lbrakk> r = hd(tl stk); a = the_Addr r; (D,fs) = the (h a); r \<noteq> Null; P \<turnstile> D has F,Static:t in C \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Putfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt IncompatibleClassChangeError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Putfield:
	+"\<lbrakk> v = hd stk; r = hd(tl stk); a = the_Addr r; (D,fs) = the (h a); (D',b,t) = field P C F;
	+ r \<noteq> Null; P \<turnstile> D has F,NonStatic:t in C \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Putfield F C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h(a \<mapsto> (D, fs((F,C) \<mapsto> v))), (tl (tl stk), loc, C\<^sub>0, M\<^sub>0, pc+1, ics)#frs, sh)"
	+
	+\| exec_step_ind_Putstatic_NoField:
	+"\<not>(\<exists>t b. P \<turnstile> C has F,b:t in D)
	+ \<Longrightarrow> exec_step_ind (StepI (Putstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NoSuchFieldError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Putstatic_NonStatic:
	+"P \<turnstile> C has F,NonStatic:t in D
	+ \<Longrightarrow> exec_step_ind (StepI (Putstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt IncompatibleClassChangeError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Putstatic_Called:
	+"\<lbrakk> (D',b,t) = field P D F; P \<turnstile> C has F,Static:t in D; the(sh D') = (sfs,i) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Putstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc (Called Cs) frs sh
	+ (None, h, (tl stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, No_ics)#frs, sh(D':=Some ((sfs(F \<mapsto> hd stk)), i)))"
	+
	+\| exec_step_ind_Putstatic_Done:
	+"\<lbrakk> (D',b,t) = field P D F; P \<turnstile> C has F,Static:t in D;
	+ \<forall>Cs. ics \<noteq> Called Cs; sh D' = Some (sfs, Done) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Putstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (tl stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh(D':=Some ((sfs(F \<mapsto> hd stk)), Done)))"
	+
	+\| exec_step_ind_Putstatic_Init:
	+"\<lbrakk> (D',b,t) = field P D F; P \<turnstile> C has F,Static:t in D;
	+ \<forall>sfs. sh D' \<noteq> Some (sfs, Done); \<forall>Cs. ics \<noteq> Called Cs \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Putstatic C F D)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Calling D' [])#frs, sh)"
	+
	+\| exec_step_ind_Checkcast:
	+"cast_ok P C h (hd stk)
	+ \<Longrightarrow> exec_step_ind (StepI (Checkcast C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Checkcast_Error:
	+"\<not>cast_ok P C h (hd stk)
	+ \<Longrightarrow> exec_step_ind (StepI (Checkcast C)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt ClassCast\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invoke_Null:
	+"stk!n = Null
	+ \<Longrightarrow> exec_step_ind (StepI (Invoke M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invoke_NoMethod:
	+"\<lbrakk> r = stk!n; C = fst(the(h(the_Addr r))); r \<noteq> Null;
	+ \<not>(\<exists>Ts T m D b. P \<turnstile> C sees M,b:Ts \<rightarrow> T = m in D) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invoke M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NoSuchMethodError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invoke_Static:
	+"\<lbrakk> r = stk!n; C = fst(the(h(the_Addr r)));
	+ (D,b,Ts,T,mxs,mxl\<^sub>0,ins,xt)= method P C M; r \<noteq> Null;
	+ P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invoke M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt IncompatibleClassChangeError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invoke:
	+"\<lbrakk> ps = take n stk; r = stk!n; C = fst(the(h(the_Addr r)));
	+ (D,b,Ts,T,mxs,mxl\<^sub>0,ins,xt)= method P C M; r \<noteq> Null;
	+ P \<turnstile> C sees M,NonStatic:Ts \<rightarrow> T = m in D;
	+ f' = ([],[r]@(rev ps)@(replicate mxl\<^sub>0 undefined),D,M,0,No_ics) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invoke M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, f'#(stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invokestatic_NoMethod:
	+"\<lbrakk> (D,b,Ts,T,mxs,mxl\<^sub>0,ins,xt)= method P C M; \<not>(\<exists>Ts T m D b. P \<turnstile> C sees M,b:Ts \<rightarrow> T = m in D) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invokestatic C M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NoSuchMethodError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invokestatic_NonStatic:
	+"\<lbrakk> (D,b,Ts,T,mxs,mxl\<^sub>0,ins,xt)= method P C M; P \<turnstile> C sees M,NonStatic:Ts \<rightarrow> T = m in D \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invokestatic C M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt IncompatibleClassChangeError\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invokestatic_Called:
	+"\<lbrakk> ps = take n stk; (D,b,Ts,T,mxs,mxl\<^sub>0,ins,xt) = method P C M;
	+ P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D;
	+ f' = ([],(rev ps)@(replicate mxl\<^sub>0 undefined),D,M,0,No_ics) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invokestatic C M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc (Called Cs) frs sh
	+ (None, h, f'#(stk, loc, C\<^sub>0, M\<^sub>0, pc, No_ics)#frs, sh)"
	+
	+\| exec_step_ind_Invokestatic_Done:
	+"\<lbrakk> ps = take n stk; (D,b,Ts,T,mxs,mxl\<^sub>0,ins,xt) = method P C M;
	+ P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D;
	+ \<forall>Cs. ics \<noteq> Called Cs; sh D = Some (sfs, Done);
	+ f' = ([],(rev ps)@(replicate mxl\<^sub>0 undefined),D,M,0,No_ics) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invokestatic C M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, f'#(stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Invokestatic_Init:
	+"\<lbrakk> (D,b,Ts,T,mxs,mxl\<^sub>0,ins,xt) = method P C M;
	+ P \<turnstile> C sees M,Static:Ts \<rightarrow> T = m in D;
	+ \<forall>sfs. sh D \<noteq> Some (sfs, Done); \<forall>Cs. ics \<noteq> Called Cs \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI (Invokestatic C M n)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Calling D [])#frs, sh)"
	+
	+\| exec_step_ind_Return_Last_Init:
	+ "exec_step_ind (StepI Return) P h stk\<^sub>0 loc\<^sub>0 C\<^sub>0 clinit pc ics [] sh
	+ (None, h, [], sh(C\<^sub>0:=Some(fst(the(sh C\<^sub>0)), Done)))"
	+
	+\| exec_step_ind_Return_Last:
	+ "M\<^sub>0 \<noteq> clinit
	+ \<Longrightarrow> exec_step_ind (StepI Return) P h stk\<^sub>0 loc\<^sub>0 C\<^sub>0 M\<^sub>0 pc ics [] sh (None, h, [], sh)"
	+
	+\| exec_step_ind_Return_Init:
	+ "\<lbrakk> (D,b,Ts,T,m) = method P C\<^sub>0 clinit \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI Return) P h stk\<^sub>0 loc\<^sub>0 C\<^sub>0 clinit pc ics ((stk',loc',C',m',pc',ics')#frs') sh
	+ (None, h, (stk',loc',C',m',pc',ics')#frs', sh(C\<^sub>0:=Some(fst(the(sh C\<^sub>0)), Done)))"
	+
	+\| exec_step_ind_Return_NonStatic:
	+ "\<lbrakk> (D,NonStatic,Ts,T,m) = method P C\<^sub>0 M\<^sub>0; M\<^sub>0 \<noteq> clinit \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI Return) P h stk\<^sub>0 loc\<^sub>0 C\<^sub>0 M\<^sub>0 pc ics ((stk',loc',C',m',pc',ics')#frs') sh
	+ (None, h, ((hd stk\<^sub>0)#(drop (length Ts + 1) stk'),loc',C',m',Suc pc',ics')#frs', sh)"
	+
	+\| exec_step_ind_Return_Static:
	+ "\<lbrakk> (D,Static,Ts,T,m) = method P C\<^sub>0 M\<^sub>0; M\<^sub>0 \<noteq> clinit \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepI Return) P h stk\<^sub>0 loc\<^sub>0 C\<^sub>0 M\<^sub>0 pc ics ((stk',loc',C',m',pc',ics')#frs') sh
	+ (None, h, ((hd stk\<^sub>0)#(drop (length Ts) stk'),loc',C',m',Suc pc',ics')#frs', sh)"
	+
	+\| exec_step_ind_Pop:
	+"exec_step_ind (StepI Pop) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (tl stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_IAdd:
	+"exec_step_ind (StepI IAdd) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (Intg (the_Intg (hd (tl stk)) + the_Intg (hd stk))#(tl (tl stk)), loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_IfFalse_False:
	+"hd stk = Bool False
	+ \<Longrightarrow> exec_step_ind (StepI (IfFalse i)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (tl stk, loc, C\<^sub>0, M\<^sub>0, nat(int pc+i), ics)#frs, sh)"
	+
	+\| exec_step_ind_IfFalse_nFalse:
	+"hd stk \<noteq> Bool False
	+ \<Longrightarrow> exec_step_ind (StepI (IfFalse i)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (tl stk, loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_CmpEq:
	+"exec_step_ind (StepI CmpEq) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (Bool (hd (tl stk) = hd stk) # tl (tl stk), loc, C\<^sub>0, M\<^sub>0, Suc pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Goto:
	+"exec_step_ind (StepI (Goto i)) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, nat(int pc+i), ics)#frs, sh)"
	+
	+\| exec_step_ind_Throw:
	+"hd stk \<noteq> Null
	+ \<Longrightarrow> exec_step_ind (StepI Throw) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>the_Addr (hd stk)\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Throw_Null:
	+"hd stk = Null
	+ \<Longrightarrow> exec_step_ind (StepI Throw) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>addr_of_sys_xcpt NullPointer\<rfloor>, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, ics)#frs, sh)"
	+
	+\| exec_step_ind_Init_None_Called:
	+"\<lbrakk> sh C = None \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepC C Cs) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Calling C Cs)#frs, sh(C := Some (sblank P C, Prepared)))"
	+
	+\| exec_step_ind_Init_Done:
	+"sh C = Some (sfs, Done)
	+ \<Longrightarrow> exec_step_ind (StepC C Cs) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Called Cs)#frs, sh)"
	+
	+\| exec_step_ind_Init_Processing:
	+"sh C = Some (sfs, Processing)
	+ \<Longrightarrow> exec_step_ind (StepC C Cs) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Called Cs)#frs, sh)"
	+
	+\| exec_step_ind_Init_Error:
	+"\<lbrakk> sh C = Some (sfs, Error) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepC C Cs) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Throwing Cs (addr_of_sys_xcpt NoClassDefFoundError))#frs, sh)"
	+
	+\| exec_step_ind_Init_Prepared_Object:
	+"\<lbrakk> sh C = Some (sfs, Prepared);
	+ sh' = sh(C:=Some(fst(the(sh C)), Processing));
	+ C = Object \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepC C Cs) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Called (C#Cs))#frs, sh')"
	+
	+\| exec_step_ind_Init_Prepared_nObject:
	+"\<lbrakk> sh C = Some (sfs, Prepared);
	+ sh' = sh(C:=Some(fst(the(sh C)), Processing));
	+ C \<noteq> Object; D = fst(the(class P C)) \<rbrakk>
	+ \<Longrightarrow> exec_step_ind (StepC C Cs) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk, loc, C\<^sub>0, M\<^sub>0, pc, Calling D (C#Cs))#frs, sh')"
	+
	+\| exec_step_ind_Init:
	+"exec_step_ind (StepC2 C Cs) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, create_init_frame P C#(stk, loc, C\<^sub>0, M\<^sub>0, pc, Called Cs)#frs, sh)"
	+
	+\| exec_step_ind_InitThrow:
	+"exec_step_ind (StepT (C#Cs) a) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (None, h, (stk,loc,C\<^sub>0,M\<^sub>0,pc,Throwing Cs a)#frs, (sh(C \<mapsto> (fst(the(sh C)), Error))))"
	+
	+\| exec_step_ind_InitThrow_End:
	+"exec_step_ind (StepT [] a) P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh
	+ (\<lfloor>a\<rfloor>, h, (stk,loc,C\<^sub>0,M\<^sub>0,pc,No_ics)#frs, sh)"
	+
	+( *** )
	+
	+inductive_cases exec_step_ind_cases [cases set]:
	+ "exec_step_ind (StepI (Load n)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Store n)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Push v)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (New C)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Getfield F C)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Getstatic C F D)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Putfield F C)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Putstatic C F D)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Checkcast C)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Invoke M n)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Invokestatic C M n)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI Return) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI Pop) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI IAdd) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (IfFalse i)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI CmpEq) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI (Goto i)) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepI Throw) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepC C' Cs) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepC2 C' Cs) P h stk loc C M pc ics frs sh \<sigma>"
	+ "exec_step_ind (StepT Cs a) P h stk loc C M pc ics frs sh \<sigma>"
	+
	+
	+\<comment> \<open> Deriving @{term step_input} for @{term exec_step_ind} from @{term exec_step} arguments \<close>
	+fun exec_step_input :: "[jvm_prog, cname, mname, pc, init_call_status] \<Rightarrow> step_input" where
	+"exec_step_input P C M pc (Calling C' Cs) = StepC C' Cs" \|
	+"exec_step_input P C M pc (Called (C'#Cs)) = StepC2 C' Cs" \|
	+"exec_step_input P C M pc (Throwing Cs a) = StepT Cs a" \|
	+"exec_step_input P C M pc ics = StepI (instrs_of P C M ! pc)"
	+
	+lemma exec_step_input_StepTD[simp]:
	+assumes "exec_step_input P C M pc ics = StepT Cs a" shows "ics = Throwing Cs a"
	+using assms proof(cases ics)
	+ case (Called Cs) with assms show ?thesis by(cases Cs; simp)
	+qed(auto)
	+
	+lemma exec_step_input_StepCD[simp]:
	+assumes "exec_step_input P C M pc ics = StepC C' Cs" shows "ics = Calling C' Cs"
	+using assms proof(cases ics)
	+ case (Called Cs) with assms show ?thesis by(cases Cs; simp)
	+qed(auto)
	+
	+lemma exec_step_input_StepC2D[simp]:
	+assumes "exec_step_input P C M pc ics = StepC2 C' Cs" shows "ics = Called (C'#Cs)"
	+using assms proof(cases ics)
	+ case (Called Cs) with assms show ?thesis by(cases Cs; simp)
	+qed(auto)
	+
	+lemma exec_step_input_StepID:
	+assumes "exec_step_input P C M pc ics = StepI i"
	+shows "(ics = Called [] \<or> ics = No_ics) \<and> instrs_of P C M ! pc = i"
	+using assms proof(cases ics)
	+ case (Called Cs) with assms show ?thesis by(cases Cs; simp)
	+qed(auto)
	+
	+subsection "Equivalence of @{term exec_step} and @{term exec_step_input}"
	+
	+lemma exec_step_imp_exec_step_ind:
	+assumes es: "exec_step P h stk loc C M pc ics frs sh = (xp', h', frs', sh')"
	+shows "exec_step_ind (exec_step_input P C M pc ics) P h stk loc C M pc ics frs sh (xp', h', frs', sh')"
	+proof(cases "exec_step_input P C M pc ics")
	+ case (StepT Cs a)
	+ then have "ics = Throwing Cs a" by simp
	+ then show ?thesis using exec_step_ind_InitThrow exec_step_ind_InitThrow_End StepT es
	+ by(cases Cs, auto)
	+next
	+ case (StepC C1 Cs)
	+ then have ics: "ics = Calling C1 Cs" by simp
	+ obtain D b Ts T m where lets: "method P C1 clinit = (D,b,Ts,T,m)" by(cases "method P C1 clinit")
	+ then obtain mxs mxl\<^sub>0 ins xt where m: "m = (mxs,mxl\<^sub>0,ins,xt)" by(cases m)
	+ show ?thesis
	+ proof(cases "sh C1")
	+ case None then show ?thesis
	+ using exec_step_ind_Init_None_Called ics assms by auto
	+ next
	+ case (Some a)
	+ then obtain sfs i where sfsi: "a = (sfs,i)" by(cases a)
	+ then show ?thesis using exec_step_ind_Init_Done exec_step_ind_Init_Processing
	+ exec_step_ind_Init_Error m lets Some ics assms
	+ proof(cases i)
	+ case Prepared
	+ show ?thesis
	+ using exec_step_ind_Init_Prepared_Object[where P=P] exec_step_ind_Init_Prepared_nObject
	+ sfsi m lets Prepared Some ics assms by(auto split: if_split_asm)
	+ qed(auto)
	+ qed
	+next
	+ case (StepC2 C1 Cs)
	+ then have ics: "ics = Called (C1#Cs)" by simp
	+ then show ?thesis using exec_step_ind_Init assms by auto
	+next
	+ case (StepI i)
	+ then have
	+ ics: "ics = Called [] \<or> ics = No_ics" and
	+ exec_instr: "exec_instr i P h stk loc C M pc ics frs sh = (xp', h', frs', sh')"
	+ using assms by(auto dest!: exec_step_input_StepID)
	+ show ?thesis
	+ proof(cases i)
	+ case (Load x1) then show ?thesis using exec_instr exec_step_ind_Load StepI by auto
	+ next
	+ case (Store x2) then show ?thesis using exec_instr exec_step_ind_Store StepI by auto
	+ next
	+ case (Push x3) then show ?thesis using exec_instr exec_step_ind_Push StepI by auto
	+ next
	+ case (New C1)
	+ then obtain sfs i where sfsi: "the(sh C1) = (sfs,i)" by(cases "the(sh C1)")
	+ then show ?thesis using exec_step_ind_New_Called exec_step_ind_NewOOM_Called
	+ exec_step_ind_New_Done exec_step_ind_NewOOM_Done
	+ exec_step_ind_New_Init sfsi New StepI exec_instr ics by(auto split: init_state.splits)
	+ next
	+ case (Getfield F1 C1)
	+ then obtain D fs D' b t where lets: "the(h(the_Addr (hd stk))) = (D,fs)"
	+ "field P C1 F1 = (D',b,t)" by(cases "the(h(the_Addr (hd stk)))", cases "field P C1 F1")
	+ then have "\<And>b' t'. P \<turnstile> D has F1,b':t' in C1 \<Longrightarrow> (D', b, t) = (C1, b', t')"
	+ using field_def2 has_field_idemp has_field_sees by fastforce
	+ then show ?thesis using exec_step_ind_Getfield_Null exec_step_ind_Getfield_NoField
	+ exec_step_ind_Getfield_Static exec_step_ind_Getfield lets Getfield StepI exec_instr
	+ by(auto split: if_split_asm staticb.splits) metis+
	+ next
	+ case (Getstatic C1 F1 D1)
	+ then obtain D' b t where lets: "field P D1 F1 = (D',b,t)" by(cases "field P D1 F1")
	+ then have field: "\<And>b' t'. P \<turnstile> C1 has F1,b':t' in D1 \<Longrightarrow> (D', b, t) = (D1, b', t')"
	+ using field_def2 has_field_idemp has_field_sees by fastforce
	+ show ?thesis
	+ proof(cases b)
	+ case NonStatic then show ?thesis
	+ using exec_step_ind_Getstatic_NoField exec_step_ind_Getstatic_NonStatic
	+ field lets Getstatic exec_instr StepI by(auto split: if_split_asm) fastforce
	+ next
	+ case Static show ?thesis
	+ proof(cases "ics = Called []")
	+ case True then show ?thesis using exec_step_ind_Getstatic_NoField
	+ exec_step_ind_Getstatic_Called exec_step_ind_Getstatic_Init
	+ Static field lets Getstatic exec_instr StepI ics
	+ by(auto simp: split_beta split: if_split_asm) metis
	+ next
	+ case False
	+ then have nCalled: "\<forall>Cs. ics \<noteq> Called Cs" using ics by simp
	+ show ?thesis
	+ proof(cases "sh D1")
	+ case None
	+ then have nDone: "\<forall>sfs. sh D1 \<noteq> Some(sfs, Done)" by simp
	+ then show ?thesis using exec_step_ind_Getstatic_NoField
	+ exec_step_ind_Getstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ field lets None False Static Getstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case (Some a)
	+ then obtain sfs i where sfsi: "a=(sfs,i)" by(cases a)
	+ show ?thesis using exec_step_ind_Getstatic_NoField
	+ exec_step_ind_Getstatic_Init sfsi False Static Some field lets Getstatic exec_instr
	+ proof(cases "i = Done")
	+ case True then show ?thesis using exec_step_ind_Getstatic_NoField
	+ exec_step_ind_Getstatic_Done[OF _ _ nCalled] exec_step_ind_Getstatic_Init
	+ sfsi False Static Some field lets Getstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case nD: False
	+ then have nDone: "\<forall>sfs. sh D1 \<noteq> Some(sfs, Done)" using sfsi Some by simp
	+ show ?thesis using nD
	+ proof(cases i)
	+ case Processing then show ?thesis using exec_step_ind_Getstatic_NoField
	+ exec_step_ind_Getstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some field lets Getstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case Prepared then show ?thesis using exec_step_ind_Getstatic_NoField
	+ exec_step_ind_Getstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some field lets Getstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case Error then show ?thesis using exec_step_ind_Getstatic_NoField
	+ exec_step_ind_Getstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some field lets Getstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ qed(simp)
	+ qed
	+ qed
	+ qed
	+ qed
	+ next
	+ case (Putfield F1 C1)
	+ then obtain D fs D' b t where lets: "the(h(the_Addr (hd(tl stk)))) = (D,fs)"
	+ "field P C1 F1 = (D',b,t)" by(cases "the(h(the_Addr (hd(tl stk))))", cases "field P C1 F1")
	+ then have "\<And>b' t'. P \<turnstile> D has F1,b':t' in C1 \<Longrightarrow> (D', b, t) = (C1, b', t')"
	+ using field_def2 has_field_idemp has_field_sees by fastforce
	+ then show ?thesis using exec_step_ind_Putfield_Null exec_step_ind_Putfield_NoField
	+ exec_step_ind_Putfield_Static exec_step_ind_Putfield lets Putfield exec_instr StepI
	+ by(auto split: if_split_asm staticb.splits) metis+
	+ next
	+ case (Putstatic C1 F1 D1)
	+ then obtain D' b t where lets: "field P D1 F1 = (D',b,t)" by(cases "field P D1 F1")
	+ then have field: "\<And>b' t'. P \<turnstile> C1 has F1,b':t' in D1 \<Longrightarrow> (D', b, t) = (D1, b', t')"
	+ using field_def2 has_field_idemp has_field_sees by fastforce
	+ show ?thesis
	+ proof(cases b)
	+ case NonStatic then show ?thesis
	+ using exec_step_ind_Putstatic_NoField exec_step_ind_Putstatic_NonStatic
	+ field lets Putstatic exec_instr StepI by(auto split: if_split_asm) fastforce
	+ next
	+ case Static show ?thesis
	+ proof(cases "ics = Called []")
	+ case True then show ?thesis using exec_step_ind_Putstatic_NoField
	+ exec_step_ind_Putstatic_Called exec_step_ind_Putstatic_Init
	+ Static field lets Putstatic exec_instr StepI ics
	+ by(cases "the(sh D1)", auto split: if_split_asm) metis
	+ next
	+ case False
	+ then have nCalled: "\<forall>Cs. ics \<noteq> Called Cs" using ics by simp
	+ show ?thesis
	+ proof(cases "sh D1")
	+ case None
	+ then have nDone: "\<forall>sfs. sh D1 \<noteq> Some(sfs, Done)" by simp
	+ then show ?thesis using exec_step_ind_Putstatic_NoField
	+ exec_step_ind_Putstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ field lets None False Static Putstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case (Some a)
	+ then obtain sfs i where sfsi: "a=(sfs,i)" by(cases a)
	+ show ?thesis using exec_step_ind_Putstatic_NoField
	+ exec_step_ind_Putstatic_Init sfsi False Static Some field lets Putstatic exec_instr
	+ proof(cases "i = Done")
	+ case True then show ?thesis using exec_step_ind_Putstatic_NoField
	+ exec_step_ind_Putstatic_Done[OF _ _ nCalled] exec_step_ind_Putstatic_Init
	+ sfsi False Static Some field lets Putstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case nD: False
	+ then have nDone: "\<forall>sfs. sh D1 \<noteq> Some(sfs, Done)" using sfsi Some by simp
	+ show ?thesis using nD
	+ proof(cases i)
	+ case Processing then show ?thesis using exec_step_ind_Putstatic_NoField
	+ exec_step_ind_Putstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some field lets Putstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case Prepared then show ?thesis using exec_step_ind_Putstatic_NoField
	+ exec_step_ind_Putstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some field lets Putstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ next
	+ case Error then show ?thesis using exec_step_ind_Putstatic_NoField
	+ exec_step_ind_Putstatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some field lets Putstatic exec_instr StepI ics
	+ by(auto split: if_split_asm) metis
	+ qed(simp)
	+ qed
	+ qed
	+ qed
	+ qed
	+ next
	+ case Checkcast then show ?thesis
	+ using exec_step_ind_Checkcast exec_step_ind_Checkcast_Error exec_instr StepI
	+ by(auto split: if_split_asm)
	+ next
	+ case (Invoke M1 n) show ?thesis
	+ proof(cases "stk!n = Null")
	+ case True then show ?thesis using exec_step_ind_Invoke_Null Invoke exec_instr StepI
	+ by clarsimp
	+ next
	+ case False
	+ let ?C = "cname_of h (the_Addr (stk ! n))"
	+ obtain D b Ts T m where method: "method P ?C M1 = (D,b,Ts,T,m)" by(cases "method P ?C M1")
	+ then obtain mxs mxl\<^sub>0 ins xt where "m = (mxs,mxl\<^sub>0,ins,xt)" by(cases m)
	+ then show ?thesis using exec_step_ind_Invoke_NoMethod
	+ exec_step_ind_Invoke_Static exec_step_ind_Invoke method False Invoke exec_instr StepI
	+ by(auto split: if_split_asm staticb.splits)
	+ qed
	+ next
	+ case (Invokestatic C1 M1 n)
	+ obtain D b Ts T m where lets: "method P C1 M1 = (D,b,Ts,T,m)" by(cases "method P C1 M1")
	+ then obtain mxs mxl\<^sub>0 ins xt where m: "m = (mxs,mxl\<^sub>0,ins,xt)" by(cases m)
	+ have method: "\<And>b' Ts' t' m' D'. P \<turnstile> C1 sees M1,b':Ts' \<rightarrow> t' = m' in D'
	+ \<Longrightarrow> (D,b,Ts,T,m) = (D',b',Ts',t',m')" using lets by auto
	+ show ?thesis
	+ proof(cases b)
	+ case NonStatic then show ?thesis
	+ using exec_step_ind_Invokestatic_NoMethod exec_step_ind_Invokestatic_NonStatic
	+ m method lets Invokestatic exec_instr StepI by(auto split: if_split_asm)
	+ next
	+ case Static show ?thesis
	+ proof(cases "ics = Called []")
	+ case True then show ?thesis using exec_step_ind_Invokestatic_NoMethod
	+ exec_step_ind_Invokestatic_Called exec_step_ind_Invokestatic_Init
	+ Static m method lets Invokestatic exec_instr StepI ics
	+ by(auto split: if_split_asm)
	+ next
	+ case False
	+ then have nCalled: "\<forall>Cs. ics \<noteq> Called Cs" using ics by simp
	+ show ?thesis
	+ proof(cases "sh D")
	+ case None
	+ then have nDone: "\<forall>sfs. sh D \<noteq> Some(sfs, Done)" by simp
	+ show ?thesis using exec_step_ind_Invokestatic_NoMethod
	+ exec_step_ind_Invokestatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ method m lets None False Static Invokestatic exec_instr StepI ics
	+ by(auto split: if_split_asm)
	+ next
	+ case (Some a)
	+ then obtain sfs i where sfsi: "a=(sfs,i)" by(cases a)
	+ show ?thesis using exec_step_ind_Invokestatic_NoMethod
	+ exec_step_ind_Invokestatic_Init sfsi False Static Some method lets Invokestatic exec_instr
	+ proof(cases "i = Done")
	+ case True then show ?thesis using exec_step_ind_Invokestatic_NoMethod
	+ exec_step_ind_Invokestatic_Done[OF _ _ _ nCalled] exec_step_ind_Invokestatic_Init
	+ sfsi False Static Some m method lets Invokestatic exec_instr StepI ics
	+ by(auto split: if_split_asm)
	+ next
	+ case nD: False
	+ then have nDone: "\<forall>sfs. sh D \<noteq> Some(sfs, Done)" using sfsi Some by simp
	+ show ?thesis using nD
	+ proof(cases i)
	+ case Processing then show ?thesis using exec_step_ind_Invokestatic_NoMethod
	+ exec_step_ind_Invokestatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some m method lets Invokestatic exec_instr StepI ics
	+ by(auto split: if_split_asm)
	+ next
	+ case Prepared then show ?thesis using exec_step_ind_Invokestatic_NoMethod
	+ exec_step_ind_Invokestatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some m method lets Invokestatic exec_instr StepI ics
	+ by(auto split: if_split_asm)
	+ next
	+ case Error then show ?thesis using exec_step_ind_Invokestatic_NoMethod
	+ exec_step_ind_Invokestatic_Init[where sh=sh, OF _ _ nDone nCalled]
	+ sfsi False Static Some m method lets Invokestatic exec_instr StepI ics
	+ by(auto split: if_split_asm)
	+ qed(simp)
	+ qed
	+ qed
	+ qed
	+ qed
	+ next
	+ case Return
	+ obtain D b Ts T m where method: "method P C M = (D,b,Ts,T,m)" by(cases "method P C M")
	+ then obtain mxs mxl\<^sub>0 ins xt where "m = (mxs,mxl\<^sub>0,ins,xt)" by(cases m)
	+ then show ?thesis using exec_step_ind_Return_Last_Init exec_step_ind_Return_Last
	+ exec_step_ind_Return_Init exec_step_ind_Return_NonStatic exec_step_ind_Return_Static
	+ method Return exec_instr StepI ics
	+ by(auto split: if_split_asm staticb.splits bool.splits list.splits)
	+ next
	+ case Pop then show ?thesis using exec_instr StepI exec_step_ind_Pop by auto
	+ next
	+ case IAdd then show ?thesis using exec_instr StepI exec_step_ind_IAdd by auto
	+ next
	+ case Goto then show ?thesis using exec_instr StepI exec_step_ind_Goto by auto
	+ next
	+ case CmpEq then show ?thesis using exec_instr StepI exec_step_ind_CmpEq by auto
	+ next
	+ case (IfFalse x17) then show ?thesis
	+ using exec_instr StepI exec_step_ind_IfFalse_nFalse exec_step_ind_IfFalse_False
	+ exec_instr StepI by(auto split: val.splits staticb.splits)
	+ next
	+ case Throw then show ?thesis
	+ using exec_instr StepI exec_step_ind_Throw exec_step_ind_Throw_Null
	+ by(auto split: val.splits)
	+ qed
	+qed
	+
	+lemma exec_step_ind_imp_exec_step:
	+assumes esi: "exec_step_ind si P h stk loc C M pc ics frs sh (xp', h', frs', sh')"
	+ and si: "exec_step_input P C M pc ics = si"
	+shows "exec_step P h stk loc C M pc ics frs sh = (xp', h', frs', sh')"
	+proof -
	+ have StepI:
	+ "\<And>P C M pc Cs i . exec_step_input P C M pc (Called Cs) = StepI i
	+ \<Longrightarrow> instrs_of P C M ! pc = i \<and> Cs = []"
	+ proof -
	+ fix P C M pc Cs i show "exec_step_input P C M pc (Called Cs) = StepI i
	+ \<Longrightarrow> instrs_of P C M ! pc = i \<and> Cs = []" by(cases Cs; simp)
	+ qed
	+ have StepC:
	+ "\<And>P C M pc ics C' Cs. exec_step_input P C M pc ics = StepC C' Cs \<Longrightarrow> ics = Calling C' Cs"
	+ by simp
	+ have StepT:
	+ "\<And>P C M pc ics Cs a. exec_step_input P C M pc ics = StepT Cs a \<Longrightarrow> ics = Throwing Cs a"
	+ by simp
	+ show ?thesis using assms
	+ proof(induct rule: exec_step_ind.induct)
	+ case (exec_step_ind_NewOOM_Done sh C obj h ics P stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case by(cases ics, auto)
	+ next
	+ case (exec_step_ind_New_Done sh C obj h a ics P stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case by(cases ics, auto)
	+ next
	+ case (exec_step_ind_New_Init sh C ics P h stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case by(cases ics, auto split: init_state.splits)
	+ next
	+ case (exec_step_ind_Getfield_NoField v stk D fs h P F C loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases "the (h (the_Addr (hd stk)))", cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Getfield_Static v stk D fs h P F t C loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case
	+ by(cases "the (h (the_Addr (hd stk)))", cases "fst(snd(field P C F))",
	+ cases ics, auto simp: split_beta dest: has_field_sees[OF has_field_idemp] dest!: StepI)
	+ next
	+ case (exec_step_ind_Getfield v stk D fs h D' b t P C F loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case
	+ by(cases "the (h (the_Addr (hd stk)))",
	+ cases ics; fastforce simp: split_beta dest: has_field_sees[OF has_field_idemp] dest!: StepI)
	+ next
	+ case (exec_step_ind_Getstatic_NonStatic P C F t D h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case
	+ by(cases ics; fastforce simp: split_beta split: staticb.splits
	+ dest: has_field_sees[OF has_field_idemp] dest!: StepI)
	+ next
	+ case exec_step_ind_Getstatic_Called
	+ then show ?case by(fastforce simp: split_beta split: staticb.splits dest!: StepI
	+ dest: has_field_sees[OF has_field_idemp])
	+ next
	+ case (exec_step_ind_Getstatic_Done D' b t P D F C ics sh sfs v h stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case by(cases ics, auto simp: split_beta split: staticb.splits
	+ dest: has_field_sees[OF has_field_idemp])
	+ next
	+ case (exec_step_ind_Getstatic_Init D' b t P D F C sh ics h stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case
	+ by(cases ics, auto simp: split_beta split: init_state.splits staticb.splits
	+ dest: has_field_sees[OF has_field_idemp])
	+ next
	+ case (exec_step_ind_Putfield_NoField r stk a D fs h P F C loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases "the (h (the_Addr (hd(tl stk))))", cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Putfield_Static r stk a D fs h P F t C loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case
	+ by(cases "the (h (the_Addr (hd(tl stk))))", cases "fst(snd(field P C F))",
	+ cases ics, auto simp: split_beta dest: has_field_sees[OF has_field_idemp] dest!: StepI)
	+ next
	+ case (exec_step_ind_Putfield v stk r a D fs h D' b t P C F loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case
	+ by(cases "the (h (the_Addr (hd(tl stk))))",
	+ cases ics; fastforce simp: split_beta dest: has_field_sees[OF has_field_idemp] dest!: StepI)
	+ next
	+ case (exec_step_ind_Putstatic_NonStatic P C F t D h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case
	+ by(cases ics; fastforce simp: split_beta split: staticb.splits
	+ dest: has_field_sees[OF has_field_idemp] dest!: StepI)
	+ next
	+ case exec_step_ind_Putstatic_Called
	+ then show ?case by(fastforce simp: split_beta split: staticb.splits dest!: StepI
	+ dest: has_field_sees[OF has_field_idemp])
	+ next
	+ case (exec_step_ind_Putstatic_Done D' b t P D F C ics sh sfs h stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case by(cases ics, auto simp: split_beta split: staticb.splits
	+ dest: has_field_sees[OF has_field_idemp])
	+ next
	+ case (exec_step_ind_Putstatic_Init D' b t P D F C sh ics h stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case
	+ by(cases ics, auto simp: split_beta split: staticb.splits init_state.splits
	+ dest: has_field_sees[OF has_field_idemp])
	+ next
	+ case (exec_step_ind_Invoke ps n stk r C h D b Ts T mxs mxl\<^sub>0 ins xt P M m f' loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics; fastforce dest!: StepI)
	+ next
	+ case (exec_step_ind_Invokestatic_Called ps n stk D b Ts T mxs mxl\<^sub>0 ins xt P C M m ics ics' sh)
	+ then show ?case by(cases ics; fastforce dest!: StepI)
	+ next
	+ case (exec_step_ind_Invokestatic_Done ps n stk D b Ts T mxs mxl\<^sub>0 ins xt P C M m ics sh sfs f')
	+ then show ?case by(cases ics; fastforce)
	+ next
	+ case (exec_step_ind_Invokestatic_Init D b Ts T mxs mxl\<^sub>0 ins xt P C M m sh ics n h stk loc C\<^sub>0 M\<^sub>0 pc frs)
	+ then show ?case by(cases ics; fastforce split: init_state.splits)
	+ next
	+ case (exec_step_ind_Return_NonStatic D Ts T m P C\<^sub>0 M\<^sub>0 h stk\<^sub>0 loc\<^sub>0 pc ics stk' loc' C' m' pc' ics' frs' sh)
	+ then show ?case by(cases "method P C\<^sub>0 M\<^sub>0", cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Return_Static D Ts T m P C\<^sub>0 M\<^sub>0 h stk\<^sub>0 loc\<^sub>0 pc ics stk' loc' C' m' pc' ics' frs' sh)
	+ then show ?case by(cases "method P C\<^sub>0 M\<^sub>0", cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_IfFalse_nFalse stk i P h loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases "hd stk"; cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Throw_Null stk P h loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases "hd stk"; cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Init C Cs P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then have "ics = Called (C#Cs)" by simp
	+ then show ?case by auto
	+ (***)
	+ next
	+ case (exec_step_ind_Load n P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Store n P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Push v P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_NewOOM_Called h C P stk loc C\<^sub>0 M\<^sub>0 pc frs sh ics')
	+ then show ?case by(auto dest!: StepI)
	+ next
	+ case (exec_step_ind_New_Called h a C P stk loc C\<^sub>0 M\<^sub>0 pc frs sh ics')
	+ then show ?case by(auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Getfield_Null stk F C P h loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Getstatic_NoField P C F D h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Putfield_Null stk F C P h loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Putstatic_NoField P C F D h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Checkcast P C h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Checkcast_Error P C h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Invoke_Null stk n M P h loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Invoke_NoMethod r stk n C h P M loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Invoke_Static r stk n C h D b Ts T mxs mxl\<^sub>0 ins xt P M m loc C\<^sub>0 M\<^sub>0 pc ics)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Invokestatic_NoMethod D b Ts T mxs mxl\<^sub>0 ins xt P C M n h stk loc C\<^sub>0 M\<^sub>0 pc ics)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Invokestatic_NonStatic D b Ts T mxs mxl\<^sub>0 ins xt P C M m n h stk loc C\<^sub>0 M\<^sub>0 pc ics)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Return_Last_Init P h stk\<^sub>0 loc\<^sub>0 C\<^sub>0 pc ics sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Return_Last M\<^sub>0 P h stk\<^sub>0 loc\<^sub>0 C\<^sub>0 pc ics sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Return_Init D b Ts T m P C\<^sub>0 h stk\<^sub>0 loc\<^sub>0 pc ics stk' loc' C' m' pc' ics')
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Pop P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_IAdd P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_IfFalse_False stk i P h loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_CmpEq P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Goto i P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Throw stk P h loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(cases ics, auto dest!: StepI)
	+ next
	+ case (exec_step_ind_Init_None_Called sh C Cs P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs)
	+ then show ?case by(auto dest!: StepC)
	+ next
	+ case (exec_step_ind_Init_Done sh C sfs Cs P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs)
	+ then show ?case by(auto dest!: StepC)
	+ next
	+ case (exec_step_ind_Init_Processing sh C sfs Cs P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs)
	+ then show ?case by(auto dest!: StepC)
	+ next
	+ case (exec_step_ind_Init_Error sh C sfs Cs P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs)
	+ then show ?case by(auto dest!: StepC)
	+ next
	+ case (exec_step_ind_Init_Prepared_Object sh C sfs sh' Cs P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs)
	+ then show ?case by(auto dest!: StepC)
	+ next
	+ case (exec_step_ind_Init_Prepared_nObject sh C sfs sh' D P Cs h stk loc C\<^sub>0 M\<^sub>0 pc ics frs)
	+ then show ?case by(auto dest!: StepC)
	+ next
	+ case (exec_step_ind_InitThrow C Cs a P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(auto dest!: StepT)
	+ next
	+ case (exec_step_ind_InitThrow_End a P h stk loc C\<^sub>0 M\<^sub>0 pc ics frs sh)
	+ then show ?case by(auto dest!: StepT)
	+ qed
	+qed
	+
	+\<comment> \<open> @{term exec_step} and @{term exec_step_ind} reach the same result given equivalent input \<close>
	+lemma exec_step_ind_equiv:
	+ "exec_step P h stk loc C M pc ics frs sh = (xp', h', frs', sh')
	+ = exec_step_ind (exec_step_input P C M pc ics) P h stk loc C M pc ics frs sh (xp', h', frs', sh')"
	+ using exec_step_imp_exec_step_ind exec_step_ind_imp_exec_step by auto
	+
	+end
	diff --git a/thys/Regression_Test_Selection/JinjaSuppl/Subcls.thy b/thys/Regression_Test_Selection/JinjaSuppl/Subcls.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/JinjaSuppl/Subcls.thy
	@@ -0,0 +1,66 @@
	+(* Title: RTS/JinjaSuppl/Subcls.thy
	+ Author: Susannah Mansky, UIUC 2020
	+ Description: Theory for the subcls relation
	+*)
	+
	+section "@{term subcls} theory"
	+
	+theory Subcls
	+imports JinjaDCI.TypeRel
	+begin
	+
	+lemma subcls_class_ex: "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* C'; C \<noteq> C' \<rbrakk>
	+ \<Longrightarrow> \<exists>D' fs ms. class P C = \<lfloor>(D', fs, ms)\<rfloor>"
	+proof(induct rule: converse_rtrancl_induct)
	+ case (step y z) then show ?case by(auto dest: subcls1D)
	+qed(simp)
	+
	+lemma class_subcls1:
	+ "\<lbrakk> class P y = class P' y; P \<turnstile> y \<prec>\<^sup>1 z \<rbrakk> \<Longrightarrow> P' \<turnstile> y \<prec>\<^sup>1 z"
	+ by(auto dest!: subcls1D intro!: subcls1I intro: sym)
	+
	+
	+lemma subcls1_single_valued: "single_valued (subcls1 P)"
	+by (clarsimp simp: single_valued_def subcls1.simps)
	+
	+lemma subcls_confluent:
	+ "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* C'; P \<turnstile> C \<preceq>\<^sup>* C'' \<rbrakk> \<Longrightarrow> P \<turnstile> C' \<preceq>\<^sup>* C'' \<or> P \<turnstile> C'' \<preceq>\<^sup>* C'"
	+ by (simp add: single_valued_confluent subcls1_single_valued)
	+
	+lemma subcls1_confluent: "\<lbrakk> P \<turnstile> a \<prec>\<^sup>1 b; P \<turnstile> a \<preceq>\<^sup>* c; a \<noteq> c \<rbrakk> \<Longrightarrow> P \<turnstile> b \<preceq>\<^sup>* c"
	+using subcls1_single_valued
	+ by (auto elim!: converse_rtranclE[where x=a] simp: single_valued_def)
	+
	+
	+lemma subcls_self_superclass: "\<lbrakk> P \<turnstile> C \<prec>\<^sup>1 C; P \<turnstile> C \<preceq>\<^sup>* D \<rbrakk> \<Longrightarrow> D = C"
	+using subcls1_single_valued
	+ by (auto elim!: rtrancl_induct[where b=D] simp: single_valued_def)
	+
	+lemma subcls_of_Obj_acyclic:
	+ "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* Object; C \<noteq> D\<rbrakk> \<Longrightarrow> \<not>(P \<turnstile> C \<preceq>\<^sup>* D \<and> P \<turnstile> D \<preceq>\<^sup>* C)"
	+proof(induct arbitrary: D rule: converse_rtrancl_induct)
	+ case base then show ?case by simp
	+next
	+ case (step y z) show ?case
	+ proof(cases "y=z")
	+ case True with step show ?thesis by simp
	+ next
	+ case False show ?thesis
	+ proof(cases "z = D")
	+ case True with False step.hyps(3)[of y] show ?thesis by clarsimp
	+ next
	+ case neq: False
	+ with step.hyps(3) have "\<not>(P \<turnstile> z \<preceq>\<^sup>* D \<and> P \<turnstile> D \<preceq>\<^sup>* z)" by simp
	+ moreover from step.hyps(1)
	+ have "P \<turnstile> D \<preceq>\<^sup>* y \<Longrightarrow> P \<turnstile> D \<preceq>\<^sup>* z" by(simp add: rtrancl_into_rtrancl)
	+ moreover from step.hyps(1) step.prems(1)
	+ have "P \<turnstile> y \<preceq>\<^sup>* D \<Longrightarrow> P \<turnstile> z \<preceq>\<^sup>* D" by(simp add: subcls1_confluent)
	+ ultimately show ?thesis by clarsimp
	+ qed
	+ qed
	+qed
	+
	+lemma subcls_of_Obj: "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* Object; P \<turnstile> C \<preceq>\<^sup>* D \<rbrakk> \<Longrightarrow> P \<turnstile> D \<preceq>\<^sup>* Object"
	+ by(auto dest: subcls_confluent)
	+
	+end
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/ROOT b/thys/Regression_Test_Selection/ROOT
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/ROOT
	@@ -0,0 +1,15 @@
	+chapter AFP
	+
	+session Regression_Test_Selection (AFP) = "HOL-Library" +
	+ options [timeout = 1200]
	+ sessions
	+ "JinjaDCI"
	+ directories
	+ "Common"
	+ "JinjaSuppl"
	+ "JVM_RTS"
	+ theories
	+ RTS
	+ document_files
	+ "root.bib"
	+ "root.tex"
	diff --git a/thys/Regression_Test_Selection/RTS.thy b/thys/Regression_Test_Selection/RTS.thy
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/RTS.thy
	@@ -0,0 +1,6 @@
	+theory RTS
	+imports
	+ "JVM_RTS/JVMCollectionBasedRTS"
	+begin
	+
	+end
	diff --git a/thys/Regression_Test_Selection/document/root.bib b/thys/Regression_Test_Selection/document/root.bib
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/document/root.bib
	@@ -0,0 +1,20 @@
	+@article{MANSKY202051,
	+title = "Safety of a Smart Classes-Used Regression Test Selection Algorithm",
	+journal = "Electronic Notes in Theoretical Computer Science",
	+volume = "351",
	+pages = "51--73",
	+year = "2020",
	+note = "Proceedings of LSFA 2020, the 15th International Workshop on Logical and Semantic Frameworks, with Applications (LSFA 2020)",
	+issn = "1571-0661",
	+doi = "https://doi.org/10.1016/j.entcs.2020.08.004",
	+url = "http://www.sciencedirect.com/science/article/pii/S1571066120300402",
	+author = "Susannah Mansky and Elsa L. Gunter",
	+keywords = "interactive theorem proving, regression test selection, small-step semantics, Java"
	+}
	+
	+@phdthesis{mansky2020verified,
	+ title={Verified collection-based regression test selection via an extended Jinja semantics},
	+ author={Mansky, Susannah Elizabeth},
	+ year={2020},
	+ school={University of Illinois at Urbana-Champaign}
	+}
	\ No newline at end of file
	diff --git a/thys/Regression_Test_Selection/document/root.tex b/thys/Regression_Test_Selection/document/root.tex
	new file mode 100755
	--- /dev/null
	+++ b/thys/Regression_Test_Selection/document/root.tex
	@@ -0,0 +1,83 @@
	+\documentclass[11pt,a4paper]{article}
	+\usepackage[english]{babel}
	+\usepackage{graphicx,latexsym,isabelle,isabellesym,amssymb}
	+
	+% further packages required for unusual symbols (see also
	+% isabellesym.sty), use only when needed
	+
	+%\usepackage{amssymb}
	+ %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
	+ %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
	+ %\<triangleq>, \<yen>, \<lozenge>
	+
	+%\usepackage{eurosym}
	+ %for \<euro>
	+
	+%\usepackage[only,bigsqcap]{stmaryrd}
	+ %for \<Sqinter>
	+
	+%\usepackage{eufrak}
	+ %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
	+
	+%\usepackage{textcomp}
	+ %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
	+ %\<currency>
	+
	+% this should be the last package used
	+\usepackage{pdfsetup}
	+
	+% urls in roman style, theory text in math-similar italics
	+\urlstyle{rm}
	+\isabellestyle{it}
	+
	+% for uniform font size
	+%\renewcommand{\isastyle}{\isastyleminor}
	+
	+
	+\begin{document}
	+
	+\title{Regression Test Selection over JVM}
	+\author{Susannah Mansky}
	+\maketitle
	+
	+\begin{abstract}
	+This development provides a general definition for safe Regression Test Selection (RTS) algorithms. RTS algorithms select which tests to rerun on revised code, reducing the time required to check for newly introduced errors. An RTS algorithm is considered safe if and only if all deselected tests would have unchanged results.
	+
	+This definition is instantiated with two class-collection-based RTS algorithms run over the JVM as modeled by JinjaDCI. This is achieved with a general definition for Collection Semantics, small-step semantics instrumented to collect information during execution. As the RTS definition mandates safety, these instantiations include proofs of safety.
	+
	+This work is described in Mansky and Gunter's LSFA 2020 paper~\cite{MANSKY202051} and Mansky's doctoral thesis~\cite{mansky2020verified}.
	+\end{abstract}
	+
	+\tableofcontents
	+
	+\clearpage
	+\section{Theory Dependencies}
	+
	+Figure \ref{theory-deps} shows the dependencies between
	+the Isabelle theories in the following sections.
	+
	+\begin{figure}[h!t]
	+\begin{center}
	+ \includegraphics[width=\textwidth]{session_graph}
	+\end{center}
	+\caption{Theory Dependency Graph\label{theory-deps}}
	+\end{figure}
	+
	+% sane default for proof documents
	+\parindent 0pt\parskip 0.5ex
	+
	+% generated text of all theories
	+\clearpage
	+\input{session}
	+
	+% optional bibliography
	+\bibliographystyle{abbrv}
	+%\bibliographystyle{plain}
	+\bibliography{root}
	+
	+\end{document}
	+
	+%%% Local Variables:
	+%%% mode: latex
	+%%% TeX-master: t
	+%%% End:
	diff --git a/web/about.html b/web/about.html
	--- a/web/about.html
	+++ b/web/about.html
	@@ -1,146 +1,146 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">A</font>rchive of
	<font class="first">F</font>ormal
	<font class="first">P</font>roofs</h1>
	</h1>
	<p> </p>

	<table width="80%" class="descr">
	<tbody>
	<tr><td>

	<h2>About</h2>
	<p>The Archive of Formal Proofs is a collection of proof libraries, examples,
	and larger scientific developments, mechanically checked in the theorem prover
	<a href="http://isabelle.in.tum.de/">Isabelle</a>. It is organized in the way
	of a scientific journal. <a href="submitting.html">Submissions</a> are
	refereed.</p>

	<p>The archive repository is hosted on <a href="https://foss.heptapod.net/isa-afp/">Heptapod</a> to
	provide easy free access to archive entries. The entries are
	tested and maintained continuously against the current stable release of
	Isabelle. Older versions of archive entries will remain available.</p>

	<h2>Editors</h2>
	<p><a name="editors">The editors of the archive are</a></p>
	<ul>
	<li><a href="http://www.in.tum.de/~eberlm/">Manuel Eberl</a>,
	<a href="http://www.tum.de/">Technische Universität München</a></li>
	<li><a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>,
	- <a href="http://www.data61.csiro.au">Data61</a></li>
	+ <a href="https://proofcraft.systems">Proofcraft</a> & <a href="https://unsw.edu.au">UNSW</a></li>
	<li><a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>,
	<a href="https://www.digitalasset.com">Digital Asset</a></li>
	<li><a href="http://www.in.tum.de/~nipkow/">Tobias Nipkow</a>,
	<a href="http://www.tum.de/">Technische Universität München</a></li>
	<li><a href="http://www.cl.cam.ac.uk/users/lcp/">Larry Paulson</a>,
	<a href="http://www.cam.ac.uk/">University of Cambridge</a></li>
	<li><a href="http://cl-informatik.uibk.ac.at/users/thiemann/">René Thiemann</a>,
	<a href="https://www.uibk.ac.at/">University of Innsbruck</a></li>
	</ul>

	<h2>Why</h2>
	<p>We aim to strengthen the community and to foster the development of formal
	proofs.</p>

	<p>We hope that the archive will provide</p>
	<ul>
	<li>a resource of knowledge, examples, and libraries for users,</li>
	<li>a large and relevant test bed of theories for Isabelle developers, and</li>
	<li>a central, citable place for authors to publish their theories</li>
	</ul>

	<p>We encourage authors of publications that contain Isabelle developments
	to make their theories available in the Archive of Formal Proofs and to refer
	to the archive entry in their publication. It makes it easier for referees to
	check the validity of theorems (all entries in the archive are
	mechanically checked), it makes it easier for readers of the publication to
	understand details of your development, and it makes it easier to use and
	build on your work.</p>

	<h2>License</h2>
	<p>All entries in the Archive of Formal Proofs are licensed under
	a <a href="LICENSE">BSD-style License</a> or
	the <a href="http://www.gnu.org/copyleft/lesser.html">GNU LGPL</a>.
	This means they are free to download, free to use, free to change, and
	free to redistribute with minimal restrictions.</p>

	<p>The authors retain their full copyright on their original work,
	including their right to make the development available under another,
	additional license in the future.</p>


	</td></tr>
	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>


	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Abstract_Completeness.html b/web/entries/Abstract_Completeness.html
	--- a/web/entries/Abstract_Completeness.html
	+++ b/web/entries/Abstract_Completeness.html
	@@ -1,232 +1,232 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Abstract Completeness - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>bstract

	<font class="first">C</font>ompleteness

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Abstract Completeness</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl),
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2014-04-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">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].</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Abstract_Completeness-AFP,
	author = {Jasmin Christian Blanchette and Andrei Popescu and Dmitriy Traytel},
	title = {Abstract Completeness},
	journal = {Archive of Formal Proofs},
	month = apr,
	year = 2014,
	note = {\url{https://isa-afp.org/entries/Abstract_Completeness.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Collections.html">Collections</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Abstract_Soundness.html">Abstract_Soundness</a>, <a href="Incredible_Proof_Machine.html">Incredible_Proof_Machine</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Completeness/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Abstract_Completeness/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Completeness/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Abstract_Completeness-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Abstract_Completeness-2020-04-18.tar.gz">
	afp-Abstract_Completeness-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Abstract_Completeness-2019-06-11.tar.gz">
	afp-Abstract_Completeness-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Abstract_Completeness-2018-08-16.tar.gz">
	afp-Abstract_Completeness-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Abstract_Completeness-2017-10-10.tar.gz">
	afp-Abstract_Completeness-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Abstract_Completeness-2016-12-17.tar.gz">
	afp-Abstract_Completeness-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Abstract_Completeness-2016-02-22.tar.gz">
	afp-Abstract_Completeness-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Abstract_Completeness-2015-05-27.tar.gz">
	afp-Abstract_Completeness-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Abstract_Completeness-2014-08-28.tar.gz">
	afp-Abstract_Completeness-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Abstract_Completeness-2014-04-16.tar.gz">
	afp-Abstract_Completeness-2014-04-16.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Abstract_Soundness.html b/web/entries/Abstract_Soundness.html
	--- a/web/entries/Abstract_Soundness.html
	+++ b/web/entries/Abstract_Soundness.html
	@@ -1,217 +1,217 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Abstract Soundness - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>bstract

	<font class="first">S</font>oundness

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Abstract Soundness</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl),
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2017-02-10</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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 <em>Journal of Automated
	Reasoning</em>. The abstract proof can be instantiated for
	various formalisms, including first-order logic with inductive
	predicates.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Abstract_Soundness-AFP,
	author = {Jasmin Christian Blanchette and Andrei Popescu and Dmitriy Traytel},
	title = {Abstract Soundness},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2017,
	note = {\url{https://isa-afp.org/entries/Abstract_Soundness.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Abstract_Completeness.html">Abstract_Completeness</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Soundness/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Abstract_Soundness/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Abstract_Soundness/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Abstract_Soundness-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Abstract_Soundness-2020-04-18.tar.gz">
	afp-Abstract_Soundness-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Abstract_Soundness-2019-06-11.tar.gz">
	afp-Abstract_Soundness-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Abstract_Soundness-2018-08-16.tar.gz">
	afp-Abstract_Soundness-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Abstract_Soundness-2017-10-10.tar.gz">
	afp-Abstract_Soundness-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Abstract_Soundness-2017-02-13.tar.gz">
	afp-Abstract_Soundness-2017-02-13.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Algebraic_Numbers.html b/web/entries/Algebraic_Numbers.html
	--- a/web/entries/Algebraic_Numbers.html
	+++ b/web/entries/Algebraic_Numbers.html
	@@ -1,241 +1,241 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Algebraic Numbers in Isabelle/HOL - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>lgebraic

	<font class="first">N</font>umbers

	in

	<font class="first">I</font>sabelle/HOL

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Algebraic Numbers in Isabelle/HOL</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at),
	<a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a> and
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>
	</td>
	</tr>

	<tr>
	<td class="datahead">
	Contributor:
	</td>
	<td class="data">
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>


	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2015-12-22</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">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.
	</p><p>
	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.
	</p></td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Change history:</td>
	<td class="abstract">[2016-01-29]: Split off Polynomial Interpolation and Polynomial Factorization<br>
	[2017-04-16]: Use certified Berlekamp-Zassenhaus factorization, use subresultant algorithm for computing resultants, improved bisection algorithm</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Algebraic_Numbers-AFP,
	author = {René Thiemann and Akihisa Yamada and Sebastiaan Joosten},
	title = {Algebraic Numbers in Isabelle/HOL},
	journal = {Archive of Formal Proofs},
	month = dec,
	year = 2015,
	note = {\url{https://isa-afp.org/entries/Algebraic_Numbers.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Berlekamp_Zassenhaus.html">Berlekamp_Zassenhaus</a>, <a href="Sturm_Sequences.html">Sturm_Sequences</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Hermite_Lindemann.html">Hermite_Lindemann</a>, <a href="LLL_Basis_Reduction.html">LLL_Basis_Reduction</a> </td></tr>
	+ <td class="data"><a href="BenOr_Kozen_Reif.html">BenOr_Kozen_Reif</a>, <a href="Hermite_Lindemann.html">Hermite_Lindemann</a>, <a href="LLL_Basis_Reduction.html">LLL_Basis_Reduction</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Algebraic_Numbers/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Algebraic_Numbers/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Algebraic_Numbers/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Algebraic_Numbers-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Algebraic_Numbers-2020-04-18.tar.gz">
	afp-Algebraic_Numbers-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Algebraic_Numbers-2019-06-11.tar.gz">
	afp-Algebraic_Numbers-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Algebraic_Numbers-2018-08-16.tar.gz">
	afp-Algebraic_Numbers-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Algebraic_Numbers-2017-10-10.tar.gz">
	afp-Algebraic_Numbers-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Algebraic_Numbers-2016-12-17.tar.gz">
	afp-Algebraic_Numbers-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Algebraic_Numbers-2016-02-22.tar.gz">
	afp-Algebraic_Numbers-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Algebraic_Numbers-2015-12-22.tar.gz">
	afp-Algebraic_Numbers-2015-12-22.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/BNF_Operations.html b/web/entries/BNF_Operations.html
	--- a/web/entries/BNF_Operations.html
	+++ b/web/entries/BNF_Operations.html
	@@ -1,213 +1,213 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Operations on Bounded Natural Functors - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">O</font>perations

	on

	<font class="first">B</font>ounded

	<font class="first">N</font>atural

	<font class="first">F</font>unctors

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Operations on Bounded Natural Functors</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl),
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2017-12-19</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{BNF_Operations-AFP,
	author = {Jasmin Christian Blanchette and Andrei Popescu and Dmitriy Traytel},
	title = {Operations on Bounded Natural Functors},
	journal = {Archive of Formal Proofs},
	month = dec,
	year = 2017,
	note = {\url{https://isa-afp.org/entries/BNF_Operations.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/BNF_Operations/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/BNF_Operations/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/BNF_Operations/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-BNF_Operations-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-BNF_Operations-2020-04-18.tar.gz">
	afp-BNF_Operations-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-BNF_Operations-2019-06-11.tar.gz">
	afp-BNF_Operations-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-BNF_Operations-2018-08-16.tar.gz">
	afp-BNF_Operations-2018-08-16.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/BTree.html b/web/entries/BTree.html
	--- a/web/entries/BTree.html
	+++ b/web/entries/BTree.html
	@@ -1,207 +1,214 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A Verified Imperative Implementation of B-Trees - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	<font class="first">V</font>erified

	<font class="first">I</font>mperative

	<font class="first">I</font>mplementation

	of

	<font class="first">B</font>-Trees

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A Verified Imperative Implementation of B-Trees</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	Niels Mündler (n /dot/ muendler /at/ tum /dot/ de)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-02-24</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	In this work, we use the interactive theorem prover Isabelle/HOL to
	verify an imperative implementation of the classical B-tree data
	structure invented by Bayer and McCreight [ACM 1970]. The
	-implementation supports set membership and insertion queries with
	+implementation supports set membership, insertion and deletion queries with
	efficient binary search for intra-node navigation. This is
	accomplished by first specifying the structure abstractly in the
	functional modeling language HOL and proving functional correctness.
	Using manual refinement, we derive an imperative implementation in
	Imperative/HOL. We show the validity of this refinement using the
	separation logic utilities from the <a
	href="https://www.isa-afp.org/entries/Refine_Imperative_HOL.html">
	Isabelle Refinement Framework </a> . The code can be exported to
	-the programming languages SML and Scala. We examine the runtime of all
	+the programming languages SML, OCaml and Scala. We examine the runtime of all
	operations indirectly by reproducing results of the logarithmic
	relationship between height and the number of nodes. The results are
	discussed in greater detail in the corresponding <a
	href="https://mediatum.ub.tum.de/1596550">Bachelor's
	Thesis</a>.</td>
	</tr>

	+ <tr>
	+ <td class="datahead" valign="top">Change history:</td>
	+ <td class="abstract">[2021-05-02]:
	+Add implementation and proof of correctness of imperative deletion operations.
	+Further add the option to export code to OCaml.
	+<br></td>
	+ </tr>

	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{BTree-AFP,
	author = {Niels Mündler},
	title = {A Verified Imperative Implementation of B-Trees},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/BTree.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Refine_Imperative_HOL.html">Refine_Imperative_HOL</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/BTree/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/BTree/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/BTree/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-BTree-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	None
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/BenOr_Kozen_Reif.html b/web/entries/BenOr_Kozen_Reif.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/BenOr_Kozen_Reif.html
	@@ -0,0 +1,206 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>The BKR Decision Procedure for Univariate Real Arithmetic - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">T</font>he
	+
	+ <font class="first">B</font>KR
	+
	+ <font class="first">D</font>ecision
	+
	+ <font class="first">P</font>rocedure
	+
	+ for
	+
	+ <font class="first">U</font>nivariate
	+
	+ <font class="first">R</font>eal
	+
	+ <font class="first">A</font>rithmetic
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">The BKR Decision Procedure for Univariate Real Arithmetic</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ <a href="https://www.cs.cmu.edu/~kcordwel/">Katherine Cordwell</a>,
	+ <a href="https://www.cs.cmu.edu/~yongkiat/">Yong Kiam Tan</a> and
	+ <a href="https://www.cs.cmu.edu/~aplatzer/">André Platzer</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-04-24</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We formalize the univariate case of Ben-Or, Kozen, and Reif's
	+decision procedure for first-order real arithmetic (the BKR
	+algorithm). We also formalize the univariate case of Renegar's
	+variation of the BKR algorithm. The two formalizations differ
	+mathematically in minor ways (that have significant impact on the
	+multivariate case), but are quite similar in proof structure. Both
	+rely on sign-determination (finding the set of consistent sign
	+assignments for a set of polynomials). The method used for
	+sign-determination is similar to Tarski's original quantifier
	+elimination algorithm (it stores key information in a matrix
	+equation), but with a reduction step to keep complexity low.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{BenOr_Kozen_Reif-AFP,
	+ author = {Katherine Cordwell and Yong Kiam Tan and André Platzer},
	+ title = {The BKR Decision Procedure for Univariate Real Arithmetic},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/BenOr_Kozen_Reif.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Algebraic_Numbers.html">Algebraic_Numbers</a>, <a href="Sturm_Tarski.html">Sturm_Tarski</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/BenOr_Kozen_Reif/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/BenOr_Kozen_Reif/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/BenOr_Kozen_Reif/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-BenOr_Kozen_Reif-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Berlekamp_Zassenhaus.html b/web/entries/Berlekamp_Zassenhaus.html
	--- a/web/entries/Berlekamp_Zassenhaus.html
	+++ b/web/entries/Berlekamp_Zassenhaus.html
	@@ -1,241 +1,241 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Factorization Algorithm of Berlekamp and Zassenhaus - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">F</font>actorization

	<font class="first">A</font>lgorithm

	of

	<font class="first">B</font>erlekamp

	and

	<font class="first">Z</font>assenhaus

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Factorization Algorithm of Berlekamp and Zassenhaus</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	<a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-10-14</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	<p>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.
	</p>
	<p>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.
	</p>
	<p>Through experiments we verify that our algorithm factors polynomials of degree
	100 within seconds.
	</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Berlekamp_Zassenhaus-AFP,
	author = {Jose Divasón and Sebastiaan Joosten and René Thiemann and Akihisa Yamada},
	title = {The Factorization Algorithm of Berlekamp and Zassenhaus},
	journal = {Archive of Formal Proofs},
	month = oct,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Berlekamp_Zassenhaus.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Algebraic_Numbers.html">Algebraic_Numbers</a>, <a href="LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>, <a href="Smith_Normal_Form.html">Smith_Normal_Form</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Berlekamp_Zassenhaus/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Berlekamp_Zassenhaus/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Berlekamp_Zassenhaus/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Berlekamp_Zassenhaus-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Berlekamp_Zassenhaus-2020-04-18.tar.gz">
	afp-Berlekamp_Zassenhaus-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Berlekamp_Zassenhaus-2019-06-11.tar.gz">
	afp-Berlekamp_Zassenhaus-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Berlekamp_Zassenhaus-2018-09-07.tar.gz">
	afp-Berlekamp_Zassenhaus-2018-09-07.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Berlekamp_Zassenhaus-2018-08-16.tar.gz">
	afp-Berlekamp_Zassenhaus-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Berlekamp_Zassenhaus-2017-10-10.tar.gz">
	afp-Berlekamp_Zassenhaus-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Berlekamp_Zassenhaus-2016-12-17.tar.gz">
	afp-Berlekamp_Zassenhaus-2016-12-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Chandy_Lamport.html b/web/entries/Chandy_Lamport.html
	--- a/web/entries/Chandy_Lamport.html
	+++ b/web/entries/Chandy_Lamport.html
	@@ -1,207 +1,207 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	<font class="first">F</font>ormal

	<font class="first">P</font>roof

	of

	<font class="first">T</font>he

	<font class="first">C</font>handy--Lamport

	<font class="first">D</font>istributed

	<font class="first">S</font>napshot

	<font class="first">A</font>lgorithm

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Ben Fiedler (ben /dot/ fiedler /at/ inf /dot/ ethz /dot/ ch) and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-07-21</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We provide a suitable distributed system model and implementation of the
	Chandy--Lamport distributed snapshot algorithm [ACM Transactions on
	Computer Systems, 3, 63-75, 1985]. Our main result is a formal
	termination and correctness proof of the Chandy--Lamport algorithm and
	its use in stable property detection.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Chandy_Lamport-AFP,
	author = {Ben Fiedler and Dmitriy Traytel},
	title = {A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm},
	journal = {Archive of Formal Proofs},
	month = jul,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Chandy_Lamport.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Ordered_Resolution_Prover.html">Ordered_Resolution_Prover</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Chandy_Lamport/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Chandy_Lamport/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Chandy_Lamport/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Chandy_Lamport-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Chandy_Lamport-2020-08-04.tar.gz">
	afp-Chandy_Lamport-2020-08-04.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Coinductive_Languages.html b/web/entries/Coinductive_Languages.html
	--- a/web/entries/Coinductive_Languages.html
	+++ b/web/entries/Coinductive_Languages.html
	@@ -1,256 +1,256 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A Codatatype of Formal Languages - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	<font class="first">C</font>odatatype

	of

	<font class="first">F</font>ormal

	<font class="first">L</font>anguages

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A Codatatype of Formal Languages</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2013-11-15</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process"><p>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.</p>
	<p>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.</p>
	<p>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.</p></td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Coinductive_Languages-AFP,
	author = {Dmitriy Traytel},
	title = {A Codatatype of Formal Languages},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2013,
	note = {\url{https://isa-afp.org/entries/Coinductive_Languages.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Regular-Sets.html">Regular-Sets</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Formula_Derivatives.html">Formula_Derivatives</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Coinductive_Languages/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Coinductive_Languages/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Coinductive_Languages/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Coinductive_Languages-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Coinductive_Languages-2020-04-18.tar.gz">
	afp-Coinductive_Languages-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Coinductive_Languages-2019-06-11.tar.gz">
	afp-Coinductive_Languages-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Coinductive_Languages-2018-08-16.tar.gz">
	afp-Coinductive_Languages-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Coinductive_Languages-2017-10-10.tar.gz">
	afp-Coinductive_Languages-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Coinductive_Languages-2016-12-17.tar.gz">
	afp-Coinductive_Languages-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Coinductive_Languages-2016-02-22.tar.gz">
	afp-Coinductive_Languages-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Coinductive_Languages-2015-05-27.tar.gz">
	afp-Coinductive_Languages-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Coinductive_Languages-2014-08-28.tar.gz">
	afp-Coinductive_Languages-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Coinductive_Languages-2013-12-11.tar.gz">
	afp-Coinductive_Languages-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-Coinductive_Languages-2013-11-17.tar.gz">
	afp-Coinductive_Languages-2013-11-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Differential_Game_Logic.html b/web/entries/Differential_Game_Logic.html
	--- a/web/entries/Differential_Game_Logic.html
	+++ b/web/entries/Differential_Game_Logic.html
	@@ -1,205 +1,205 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Differential Game Logic - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">D</font>ifferential

	<font class="first">G</font>ame

	<font class="first">L</font>ogic

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Differential Game Logic</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="http://www.cs.cmu.edu/~aplatzer/">André Platzer</a>
	+ <a href="https://www.cs.cmu.edu/~aplatzer/">André Platzer</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2019-06-03</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Differential_Game_Logic-AFP,
	author = {André Platzer},
	title = {Differential Game Logic},
	journal = {Archive of Formal Proofs},
	month = jun,
	year = 2019,
	note = {\url{https://isa-afp.org/entries/Differential_Game_Logic.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Differential_Game_Logic/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Differential_Game_Logic/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Differential_Game_Logic/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Differential_Game_Logic-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Differential_Game_Logic-2020-04-18.tar.gz">
	afp-Differential_Game_Logic-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Differential_Game_Logic-2019-06-24.tar.gz">
	afp-Differential_Game_Logic-2019-06-24.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Dijkstra_Shortest_Path.html b/web/entries/Dijkstra_Shortest_Path.html
	--- a/web/entries/Dijkstra_Shortest_Path.html
	+++ b/web/entries/Dijkstra_Shortest_Path.html
	@@ -1,268 +1,268 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Dijkstra's Shortest Path Algorithm - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">D</font>ijkstra's

	<font class="first">S</font>hortest

	<font class="first">P</font>ath

	<font class="first">A</font>lgorithm

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Dijkstra's Shortest Path Algorithm</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	- Benedikt Nordhoff (b_nord01 /at/ uni-muenster /dot/ de) and
	+ Benedikt Nordhoff (b /dot/ n /at/ wwu /dot/ de) and
	Peter Lammich
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2012-01-30</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Dijkstra_Shortest_Path-AFP,
	author = {Benedikt Nordhoff and Peter Lammich},
	title = {Dijkstra's Shortest Path Algorithm},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2012,
	note = {\url{https://isa-afp.org/entries/Dijkstra_Shortest_Path.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Collections.html">Collections</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Formal_SSA.html">Formal_SSA</a>, <a href="Koenigsberg_Friendship.html">Koenigsberg_Friendship</a>, <a href="Refine_Imperative_HOL.html">Refine_Imperative_HOL</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Dijkstra_Shortest_Path/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Dijkstra_Shortest_Path/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Dijkstra_Shortest_Path/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Dijkstra_Shortest_Path-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Dijkstra_Shortest_Path-2020-04-18.tar.gz">
	afp-Dijkstra_Shortest_Path-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Dijkstra_Shortest_Path-2019-06-11.tar.gz">
	afp-Dijkstra_Shortest_Path-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Dijkstra_Shortest_Path-2018-08-16.tar.gz">
	afp-Dijkstra_Shortest_Path-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Dijkstra_Shortest_Path-2017-10-10.tar.gz">
	afp-Dijkstra_Shortest_Path-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Dijkstra_Shortest_Path-2016-12-17.tar.gz">
	afp-Dijkstra_Shortest_Path-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Dijkstra_Shortest_Path-2016-02-22.tar.gz">
	afp-Dijkstra_Shortest_Path-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Dijkstra_Shortest_Path-2015-05-27.tar.gz">
	afp-Dijkstra_Shortest_Path-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Dijkstra_Shortest_Path-2014-08-28.tar.gz">
	afp-Dijkstra_Shortest_Path-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Dijkstra_Shortest_Path-2013-12-11.tar.gz">
	afp-Dijkstra_Shortest_Path-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-Dijkstra_Shortest_Path-2013-11-17.tar.gz">
	afp-Dijkstra_Shortest_Path-2013-11-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-Dijkstra_Shortest_Path-2013-03-08.tar.gz">
	afp-Dijkstra_Shortest_Path-2013-03-08.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-Dijkstra_Shortest_Path-2013-02-16.tar.gz">
	afp-Dijkstra_Shortest_Path-2013-02-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2012:
	<a href="../release/afp-Dijkstra_Shortest_Path-2012-05-24.tar.gz">
	afp-Dijkstra_Shortest_Path-2012-05-24.tar.gz
	</a>
	</li>
	<li>Isabelle 2011-1:
	<a href="../release/afp-Dijkstra_Shortest_Path-2012-03-15.tar.gz">
	afp-Dijkstra_Shortest_Path-2012-03-15.tar.gz
	</a>
	</li>
	<li>Isabelle 2011-1:
	<a href="../release/afp-Dijkstra_Shortest_Path-2012-02-10.tar.gz">
	afp-Dijkstra_Shortest_Path-2012-02-10.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Finger-Trees.html b/web/entries/Finger-Trees.html
	--- a/web/entries/Finger-Trees.html
	+++ b/web/entries/Finger-Trees.html
	@@ -1,274 +1,274 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Finger Trees - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>inger

	<font class="first">T</font>rees

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Finger Trees</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	- Benedikt Nordhoff (b_nord01 /at/ uni-muenster /dot/ de),
	+ Benedikt Nordhoff (b /dot/ n /at/ wwu /dot/ de),
	Stefan Körner (s_koer03 /at/ uni-muenster /dot/ de) and
	Peter Lammich
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2010-10-28</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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
	<em>monotone predicate</em> 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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Finger-Trees-AFP,
	author = {Benedikt Nordhoff and Stefan Körner and Peter Lammich},
	title = {Finger Trees},
	journal = {Archive of Formal Proofs},
	month = oct,
	year = 2010,
	note = {\url{https://isa-afp.org/entries/Finger-Trees.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Collections.html">Collections</a>, <a href="Containers.html">Containers</a>, <a href="JinjaThreads.html">JinjaThreads</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Finger-Trees/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Finger-Trees/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Finger-Trees/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Finger-Trees-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Finger-Trees-2020-04-18.tar.gz">
	afp-Finger-Trees-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Finger-Trees-2019-06-11.tar.gz">
	afp-Finger-Trees-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Finger-Trees-2018-08-16.tar.gz">
	afp-Finger-Trees-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Finger-Trees-2017-10-10.tar.gz">
	afp-Finger-Trees-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Finger-Trees-2016-12-17.tar.gz">
	afp-Finger-Trees-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Finger-Trees-2016-02-22.tar.gz">
	afp-Finger-Trees-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Finger-Trees-2015-05-27.tar.gz">
	afp-Finger-Trees-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Finger-Trees-2014-08-28.tar.gz">
	afp-Finger-Trees-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Finger-Trees-2013-12-11.tar.gz">
	afp-Finger-Trees-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-Finger-Trees-2013-11-17.tar.gz">
	afp-Finger-Trees-2013-11-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-Finger-Trees-2013-03-02.tar.gz">
	afp-Finger-Trees-2013-03-02.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-Finger-Trees-2013-02-16.tar.gz">
	afp-Finger-Trees-2013-02-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2012:
	<a href="../release/afp-Finger-Trees-2012-05-24.tar.gz">
	afp-Finger-Trees-2012-05-24.tar.gz
	</a>
	</li>
	<li>Isabelle 2011-1:
	<a href="../release/afp-Finger-Trees-2011-10-11.tar.gz">
	afp-Finger-Trees-2011-10-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2011:
	<a href="../release/afp-Finger-Trees-2011-02-11.tar.gz">
	afp-Finger-Trees-2011-02-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2009-2:
	<a href="../release/afp-Finger-Trees-2010-10-28.tar.gz">
	afp-Finger-Trees-2010-10-28.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Formula_Derivatives.html b/web/entries/Formula_Derivatives.html
	--- a/web/entries/Formula_Derivatives.html
	+++ b/web/entries/Formula_Derivatives.html
	@@ -1,236 +1,236 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Derivatives of Logical Formulas - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">D</font>erivatives

	of

	<font class="first">L</font>ogical

	<font class="first">F</font>ormulas

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Derivatives of Logical Formulas</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2015-05-28</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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 <em>not</em> 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).
	<p>
	The WS1S instance is described in the draft paper <a
	href="https://people.inf.ethz.ch/trayteld/papers/csl15-ws1s_derivatives/index.html">A
	Coalgebraic Decision Procedure for WS1S</a> by the author.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Formula_Derivatives-AFP,
	author = {Dmitriy Traytel},
	title = {Derivatives of Logical Formulas},
	journal = {Archive of Formal Proofs},
	month = may,
	year = 2015,
	note = {\url{https://isa-afp.org/entries/Formula_Derivatives.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Coinductive_Languages.html">Coinductive_Languages</a>, <a href="Deriving.html">Deriving</a>, <a href="List-Index.html">List-Index</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Formula_Derivatives/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Formula_Derivatives/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Formula_Derivatives/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Formula_Derivatives-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Formula_Derivatives-2020-04-18.tar.gz">
	afp-Formula_Derivatives-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Formula_Derivatives-2019-06-11.tar.gz">
	afp-Formula_Derivatives-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Formula_Derivatives-2018-08-16.tar.gz">
	afp-Formula_Derivatives-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Formula_Derivatives-2017-10-10.tar.gz">
	afp-Formula_Derivatives-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Formula_Derivatives-2016-12-17.tar.gz">
	afp-Formula_Derivatives-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Formula_Derivatives-2016-02-22.tar.gz">
	afp-Formula_Derivatives-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Formula_Derivatives-2015-05-28.tar.gz">
	afp-Formula_Derivatives-2015-05-28.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Functional_Ordered_Resolution_Prover.html b/web/entries/Functional_Ordered_Resolution_Prover.html
	--- a/web/entries/Functional_Ordered_Resolution_Prover.html
	+++ b/web/entries/Functional_Ordered_Resolution_Prover.html
	@@ -1,222 +1,222 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	<font class="first">V</font>erified

	<font class="first">F</font>unctional

	<font class="first">I</font>mplementation

	of

	<font class="first">B</font>achmair

	and

	<font class="first">G</font>anzinger's

	<font class="first">O</font>rdered

	<font class="first">R</font>esolution

	<font class="first">P</font>rover

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>,
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl) and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-11-23</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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
	<i>Handbook of Automated Reasoning</i>. The result is a
	functional implementation of a first-order prover.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Functional_Ordered_Resolution_Prover-AFP,
	author = {Anders Schlichtkrull and Jasmin Christian Blanchette and Dmitriy Traytel},
	title = {A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/Functional_Ordered_Resolution_Prover.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="First_Order_Terms.html">First_Order_Terms</a>, <a href="Knuth_Bendix_Order.html">Knuth_Bendix_Order</a>, <a href="Lambda_Free_RPOs.html">Lambda_Free_RPOs</a>, <a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a>, <a href="Open_Induction.html">Open_Induction</a>, <a href="Ordered_Resolution_Prover.html">Ordered_Resolution_Prover</a>, <a href="Polynomial_Factorization.html">Polynomial_Factorization</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Functional_Ordered_Resolution_Prover/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Functional_Ordered_Resolution_Prover/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Functional_Ordered_Resolution_Prover/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Functional_Ordered_Resolution_Prover-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Functional_Ordered_Resolution_Prover-2020-04-18.tar.gz">
	afp-Functional_Ordered_Resolution_Prover-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Functional_Ordered_Resolution_Prover-2019-06-11.tar.gz">
	afp-Functional_Ordered_Resolution_Prover-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Functional_Ordered_Resolution_Prover-2018-11-29.tar.gz">
	afp-Functional_Ordered_Resolution_Prover-2018-11-29.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/GaleStewart_Games.html b/web/entries/GaleStewart_Games.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/GaleStewart_Games.html
	@@ -0,0 +1,192 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Gale-Stewart Games - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">G</font>ale-Stewart
	+
	+ <font class="first">G</font>ames
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Gale-Stewart Games</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-04-23</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+This is a formalisation of the main result of Gale and Stewart from
	+1953, showing that closed finite games are determined. This property
	+is now known as the Gale Stewart Theorem. While the original paper
	+shows some additional theorems as well, we only formalize this main
	+result, but do so in a somewhat general way. We formalize games of a
	+fixed arbitrary length, including infinite length, using co-inductive
	+lists, and show that defensive strategies exist unless the other
	+player is winning. For closed games, defensive strategies are winning
	+for the closed player, proving that such games are determined. For
	+finite games, which are a special case in our formalisation, all games
	+are closed.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{GaleStewart_Games-AFP,
	+ author = {Sebastiaan Joosten},
	+ title = {Gale-Stewart Games},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/GaleStewart_Games.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Parity_Game.html">Parity_Game</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/GaleStewart_Games/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/GaleStewart_Games/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/GaleStewart_Games/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-GaleStewart_Games-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Goedel_HFSet_Semantic.html b/web/entries/Goedel_HFSet_Semantic.html
	--- a/web/entries/Goedel_HFSet_Semantic.html
	+++ b/web/entries/Goedel_HFSet_Semantic.html
	@@ -1,211 +1,211 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>From Abstract to Concrete Gödel's Incompleteness Theorems—Part I - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>rom

	<font class="first">A</font>bstract

	to

	<font class="first">C</font>oncrete

	<font class="first">G</font>ödel's

	<font class="first">I</font>ncompleteness

	<font class="first">T</font>heorems—Part

	<font class="first">I</font>

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">From Abstract to Concrete Gödel's Incompleteness Theorems—Part I</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-09-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We validate an abstract formulation of Gödel's First and
	Second Incompleteness Theorems from a <a
	href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate
	AFP entry</a> by instantiating them to the case of
	<i>finite sound extensions of the Hereditarily Finite (HF) Set
	theory</i>, i.e., FOL theories extending the HF Set theory with
	a finite set of axioms that are sound in the standard model. The
	concrete results had been previously formalised in an <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">AFP
	entry by Larry Paulson</a>; our instantiation reuses the
	infrastructure developed in that entry.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Goedel_HFSet_Semantic-AFP,
	author = {Andrei Popescu and Dmitriy Traytel},
	title = {From Abstract to Concrete Gödel's Incompleteness Theorems—Part I},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Goedel_HFSet_Semantic.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Goedel_Incompleteness.html">Goedel_Incompleteness</a>, <a href="Incompleteness.html">Incompleteness</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Goedel_HFSet_Semantic/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Goedel_HFSet_Semantic/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Goedel_HFSet_Semantic/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Goedel_HFSet_Semantic-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Goedel_HFSet_Semantic-2020-09-18.tar.gz">
	afp-Goedel_HFSet_Semantic-2020-09-18.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Goedel_HFSet_Semanticless.html b/web/entries/Goedel_HFSet_Semanticless.html
	--- a/web/entries/Goedel_HFSet_Semanticless.html
	+++ b/web/entries/Goedel_HFSet_Semanticless.html
	@@ -1,217 +1,217 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>From Abstract to Concrete Gödel's Incompleteness Theorems—Part II - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>rom

	<font class="first">A</font>bstract

	to

	<font class="first">C</font>oncrete

	<font class="first">G</font>ödel's

	<font class="first">I</font>ncompleteness

	<font class="first">T</font>heorems—Part

	<font class="first">I</font>I

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">From Abstract to Concrete Gödel's Incompleteness Theorems—Part II</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-09-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We validate an abstract formulation of Gödel's Second
	Incompleteness Theorem from a <a
	href="https://www.isa-afp.org/entries/Goedel_Incompleteness.html">separate
	AFP entry</a> by instantiating it to the case of <i>finite
	consistent extensions of the Hereditarily Finite (HF) Set
	theory</i>, i.e., consistent FOL theories extending the HF Set
	theory with a finite set of axioms. The instantiation draws heavily
	on infrastructure previously developed by Larry Paulson in his <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">direct
	formalisation of the concrete result</a>. It strengthens
	Paulson's formalization of Gödel's Second from that
	entry by <i>not</i> assuming soundness, and in fact not
	relying on any notion of model or semantic interpretation. The
	strengthening was obtained by first replacing some of Paulson’s
	semantic arguments with proofs within his HF calculus, and then
	plugging in some of Paulson's (modified) lemmas to instantiate
	our soundness-free Gödel's Second locale.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Goedel_HFSet_Semanticless-AFP,
	author = {Andrei Popescu and Dmitriy Traytel},
	title = {From Abstract to Concrete Gödel's Incompleteness Theorems—Part II},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Goedel_HFSet_Semanticless.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Goedel_Incompleteness.html">Goedel_Incompleteness</a>, <a href="HereditarilyFinite.html">HereditarilyFinite</a>, <a href="Nominal2.html">Nominal2</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Goedel_HFSet_Semanticless/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Goedel_HFSet_Semanticless/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Goedel_HFSet_Semanticless/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Goedel_HFSet_Semanticless-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Goedel_HFSet_Semanticless-2020-09-18.tar.gz">
	afp-Goedel_HFSet_Semanticless-2020-09-18.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Goedel_Incompleteness.html b/web/entries/Goedel_Incompleteness.html
	--- a/web/entries/Goedel_Incompleteness.html
	+++ b/web/entries/Goedel_Incompleteness.html
	@@ -1,222 +1,222 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>An Abstract Formalization of Gödel's Incompleteness Theorems - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>n

	<font class="first">A</font>bstract

	<font class="first">F</font>ormalization

	of

	<font class="first">G</font>ödel's

	<font class="first">I</font>ncompleteness

	<font class="first">T</font>heorems

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">An Abstract Formalization of Gödel's Incompleteness Theorems</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-09-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We present an abstract formalization of Gödel's
	incompleteness theorems. We analyze sufficient conditions for the
	theorems' applicability to a partially specified logic. Our
	abstract perspective enables a comparison between alternative
	approaches from the literature. These include Rosser's variation
	of the first theorem, Jeroslow's variation of the second theorem,
	and the Swierczkowski–Paulson semantics-based approach. This
	AFP entry is the main entry point to the results described in our
	CADE-27 paper <a
	href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A
	Formally Verified Abstract Account of Gödel's Incompleteness
	Theorems</a>. As part of our abstract formalization's
	validation, we instantiate our locales twice in the separate AFP
	entries <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	and <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Goedel_Incompleteness-AFP,
	author = {Andrei Popescu and Dmitriy Traytel},
	title = {An Abstract Formalization of Gödel's Incompleteness Theorems},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Goedel_Incompleteness.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Syntax_Independent_Logic.html">Syntax_Independent_Logic</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>, <a href="Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Goedel_Incompleteness/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Goedel_Incompleteness/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Goedel_Incompleteness/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Goedel_Incompleteness-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Goedel_Incompleteness-2020-09-19.tar.gz">
	afp-Goedel_Incompleteness-2020-09-19.tar.gz
	</a>
	</li>
	<li>Isabelle 2020:
	<a href="../release/afp-Goedel_Incompleteness-2020-09-18.tar.gz">
	afp-Goedel_Incompleteness-2020-09-18.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Grothendieck_Schemes.html b/web/entries/Grothendieck_Schemes.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Grothendieck_Schemes.html
	@@ -0,0 +1,194 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Grothendieck's Schemes in Algebraic Geometry - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">G</font>rothendieck's
	+
	+ <font class="first">S</font>chemes
	+
	+ in
	+
	+ <font class="first">A</font>lgebraic
	+
	+ <font class="first">G</font>eometry
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Grothendieck's Schemes in Algebraic Geometry</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>,
	+ <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence Paulson</a> and
	+ <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-03-29</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We formalize mainstream structures in algebraic geometry culminating
	+in Grothendieck's schemes: presheaves of rings, sheaves of rings,
	+ringed spaces, locally ringed spaces, affine schemes and schemes. We
	+prove that the spectrum of a ring is a locally ringed space, hence an
	+affine scheme. Finally, we prove that any affine scheme is a scheme.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Grothendieck_Schemes-AFP,
	+ author = {Anthony Bordg and Lawrence Paulson and Wenda Li},
	+ title = {Grothendieck's Schemes in Algebraic Geometry},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/Grothendieck_Schemes.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Jacobson_Basic_Algebra.html">Jacobson_Basic_Algebra</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Grothendieck_Schemes/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Grothendieck_Schemes/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Grothendieck_Schemes/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Grothendieck_Schemes-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/IFC_Tracking.html b/web/entries/IFC_Tracking.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/IFC_Tracking.html
	@@ -0,0 +1,201 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Information Flow Control via Dependency Tracking - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">I</font>nformation
	+
	+ <font class="first">F</font>low
	+
	+ <font class="first">C</font>ontrol
	+
	+ via
	+
	+ <font class="first">D</font>ependency
	+
	+ <font class="first">T</font>racking
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Information Flow Control via Dependency Tracking</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ Benedikt Nordhoff (b /dot/ n /at/ wwu /dot/ de)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-04-01</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We provide a characterisation of how information is propagated by
	+program executions based on the tracking data and control dependencies
	+within executions themselves. The characterisation might be used for
	+deriving approximative safety properties to be targeted by static
	+analyses or checked at runtime. We utilise a simple yet versatile
	+control flow graph model as a program representation. As our model is
	+not assumed to be finite it can be instantiated for a broad class of
	+programs. The targeted security property is indistinguishable
	+security where executions produce sequences of observations and only
	+non-terminating executions are allowed to drop a tail of those. A
	+very crude approximation of our characterisation is slicing based on
	+program dependence graphs, which we use as a minimal example and
	+derive a corresponding soundness result. For further details and
	+applications refer to the authors upcoming dissertation.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{IFC_Tracking-AFP,
	+ author = {Benedikt Nordhoff},
	+ title = {Information Flow Control via Dependency Tracking},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/IFC_Tracking.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/IFC_Tracking/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/IFC_Tracking/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/IFC_Tracking/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-IFC_Tracking-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Isabelle_Marries_Dirac.html b/web/entries/Isabelle_Marries_Dirac.html
	--- a/web/entries/Isabelle_Marries_Dirac.html
	+++ b/web/entries/Isabelle_Marries_Dirac.html
	@@ -1,218 +1,218 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">I</font>sabelle

	<font class="first">M</font>arries

	<font class="first">D</font>irac:

	a

	<font class="first">L</font>ibrary

	for

	<font class="first">Q</font>uantum

	<font class="first">C</font>omputation

	and

	<font class="first">Q</font>uantum

	<font class="first">I</font>nformation

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	- Anthony Bordg (apdb3 /at/ cam /dot/ ac /dot/ uk),
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>,
	Hanna Lachnitt (lachnitt /at/ stanford /dot/ edu) and
	Yijun He (yh403 /at/ cam /dot/ ac /dot/ uk)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-11-22</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	This work is an effort to formalise some quantum algorithms and
	results in quantum information theory. Formal methods being critical
	for the safety and security of algorithms and protocols, we foresee
	their widespread use for quantum computing in the future. We have
	developed a large library for quantum computing in Isabelle based on a
	matrix representation for quantum circuits, successfully formalising
	the no-cloning theorem, quantum teleportation, Deutsch's
	algorithm, the Deutsch-Jozsa algorithm and the quantum Prisoner's
	Dilemma.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Isabelle_Marries_Dirac-AFP,
	author = {Anthony Bordg and Hanna Lachnitt and Yijun He},
	title = {Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Isabelle_Marries_Dirac.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a>, <a href="Matrix_Tensor.html">Matrix_Tensor</a>, <a href="VectorSpace.html">VectorSpace</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Projective_Measurements.html">Projective_Measurements</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Isabelle_Marries_Dirac/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Isabelle_Marries_Dirac/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Isabelle_Marries_Dirac/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Isabelle_Marries_Dirac-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Isabelle_Marries_Dirac-2020-11-30.tar.gz">
	afp-Isabelle_Marries_Dirac-2020-11-30.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Jacobson_Basic_Algebra.html b/web/entries/Jacobson_Basic_Algebra.html
	--- a/web/entries/Jacobson_Basic_Algebra.html
	+++ b/web/entries/Jacobson_Basic_Algebra.html
	@@ -1,204 +1,206 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A Case Study in Basic Algebra - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	<font class="first">C</font>ase

	<font class="first">S</font>tudy

	in

	<font class="first">B</font>asic

	<font class="first">A</font>lgebra

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A Case Study in Basic Algebra</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="http://www21.in.tum.de/~ballarin/">Clemens Ballarin</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2019-08-30</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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 <i>Basic Algebra</i>
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Jacobson_Basic_Algebra-AFP,
	author = {Clemens Ballarin},
	title = {A Case Study in Basic Algebra},
	journal = {Archive of Formal Proofs},
	month = aug,
	year = 2019,
	note = {\url{https://isa-afp.org/entries/Jacobson_Basic_Algebra.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Grothendieck_Schemes.html">Grothendieck_Schemes</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Jacobson_Basic_Algebra/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Jacobson_Basic_Algebra/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Jacobson_Basic_Algebra/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Jacobson_Basic_Algebra-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Jacobson_Basic_Algebra-2020-04-18.tar.gz">
	afp-Jacobson_Basic_Algebra-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Jacobson_Basic_Algebra-2019-09-01.tar.gz">
	afp-Jacobson_Basic_Algebra-2019-09-01.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/JinjaDCI.html b/web/entries/JinjaDCI.html
	--- a/web/entries/JinjaDCI.html
	+++ b/web/entries/JinjaDCI.html
	@@ -1,204 +1,206 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>JinjaDCI: a Java semantics with dynamic class initialization - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">J</font>injaDCI:

	a

	<font class="first">J</font>ava

	semantics

	with

	dynamic

	class

	initialization

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">JinjaDCI: a Java semantics with dynamic class initialization</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	Susannah Mansky (sjohnsn2 /at/ illinois /dot/ edu)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2021-01-11</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We extend Jinja to include static fields, methods, and instructions,
	and dynamic class initialization, based on the Java SE 8
	specification. This includes extension of definitions and proofs. This
	work is partially described in Mansky and Gunter's paper at CPP
	2019 and Mansky's doctoral thesis (UIUC, 2020).</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{JinjaDCI-AFP,
	author = {Susannah Mansky},
	title = {JinjaDCI: a Java semantics with dynamic class initialization},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2021,
	note = {\url{https://isa-afp.org/entries/JinjaDCI.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Jinja.html">Jinja</a>, <a href="List-Index.html">List-Index</a> </td></tr>

	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="Regression_Test_Selection.html">Regression_Test_Selection</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/JinjaDCI/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/JinjaDCI/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/JinjaDCI/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-JinjaDCI-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-JinjaDCI-2021-01-13.tar.gz">
	afp-JinjaDCI-2021-01-13.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/LLL_Basis_Reduction.html b/web/entries/LLL_Basis_Reduction.html
	--- a/web/entries/LLL_Basis_Reduction.html
	+++ b/web/entries/LLL_Basis_Reduction.html
	@@ -1,236 +1,236 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A verified LLL algorithm - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	verified

	<font class="first">L</font>LL

	algorithm

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A verified LLL algorithm</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Ralph Bottesch,
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>,
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	<a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-02-02</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Change history:</td>
	<td class="abstract">[2018-04-16]: Integrated formal complexity bounds (Haslbeck, Thiemann)
	[2018-05-25]: Integrated much faster LLL implementation based on integer arithmetic (Bottesch, Haslbeck, Thiemann)</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{LLL_Basis_Reduction-AFP,
	author = {Ralph Bottesch and Jose Divasón and Maximilian Haslbeck and Sebastiaan Joosten and René Thiemann and Akihisa Yamada},
	title = {A verified LLL algorithm},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/LLL_Basis_Reduction.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Algebraic_Numbers.html">Algebraic_Numbers</a>, <a href="Berlekamp_Zassenhaus.html">Berlekamp_Zassenhaus</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Linear_Inequalities.html">Linear_Inequalities</a>, <a href="LLL_Factorization.html">LLL_Factorization</a>, <a href="Modular_arithmetic_LLL_and_HNF_algorithms.html">Modular_arithmetic_LLL_and_HNF_algorithms</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/LLL_Basis_Reduction/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/LLL_Basis_Reduction/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/LLL_Basis_Reduction/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-LLL_Basis_Reduction-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-LLL_Basis_Reduction-2020-04-20.tar.gz">
	afp-LLL_Basis_Reduction-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-LLL_Basis_Reduction-2019-06-11.tar.gz">
	afp-LLL_Basis_Reduction-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-LLL_Basis_Reduction-2018-09-07.tar.gz">
	afp-LLL_Basis_Reduction-2018-09-07.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-LLL_Basis_Reduction-2018-08-16.tar.gz">
	afp-LLL_Basis_Reduction-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-LLL_Basis_Reduction-2018-02-03.tar.gz">
	afp-LLL_Basis_Reduction-2018-02-03.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/LLL_Factorization.html b/web/entries/LLL_Factorization.html
	--- a/web/entries/LLL_Factorization.html
	+++ b/web/entries/LLL_Factorization.html
	@@ -1,234 +1,234 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A verified factorization algorithm for integer polynomials with polynomial complexity - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	verified

	factorization

	algorithm

	for

	integer

	polynomials

	with

	polynomial

	complexity

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A verified factorization algorithm for integer polynomials with polynomial complexity</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	<a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-02-06</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{LLL_Factorization-AFP,
	author = {Jose Divasón and Sebastiaan Joosten and René Thiemann and Akihisa Yamada},
	title = {A verified factorization algorithm for integer polynomials with polynomial complexity},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/LLL_Factorization.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>, <a href="Perron_Frobenius.html">Perron_Frobenius</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/LLL_Factorization/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/LLL_Factorization/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/LLL_Factorization/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-LLL_Factorization-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-LLL_Factorization-2020-04-20.tar.gz">
	afp-LLL_Factorization-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-LLL_Factorization-2019-06-11.tar.gz">
	afp-LLL_Factorization-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-LLL_Factorization-2018-08-16.tar.gz">
	afp-LLL_Factorization-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-LLL_Factorization-2018-02-07.tar.gz">
	afp-LLL_Factorization-2018-02-07.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/LambdaAuth.html b/web/entries/LambdaAuth.html
	--- a/web/entries/LambdaAuth.html
	+++ b/web/entries/LambdaAuth.html
	@@ -1,221 +1,221 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Formalization of Generic Authenticated Data Structures - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>ormalization

	of

	<font class="first">G</font>eneric

	<font class="first">A</font>uthenticated

	<font class="first">D</font>ata

	<font class="first">S</font>tructures

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Formalization of Generic Authenticated Data Structures</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Matthias Brun and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2019-05-14</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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. <a
	href="https://doi.org/10.1145/2535838.2535851">Miller et
	al.</a> introduced λ• (pronounced
	<i>lambda auth</i>)—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 an <a
	href="https://doi.org/10.4230/LIPIcs.ITP.2019.10">ITP'19 paper</a>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{LambdaAuth-AFP,
	author = {Matthias Brun and Dmitriy Traytel},
	title = {Formalization of Generic Authenticated Data Structures},
	journal = {Archive of Formal Proofs},
	month = may,
	year = 2019,
	note = {\url{https://isa-afp.org/entries/LambdaAuth.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Nominal2.html">Nominal2</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/LambdaAuth/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/LambdaAuth/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/LambdaAuth/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-LambdaAuth-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-LambdaAuth-2020-04-18.tar.gz">
	afp-LambdaAuth-2020-04-18.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-LambdaAuth-2019-06-11.tar.gz">
	afp-LambdaAuth-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-LambdaAuth-2019-05-15.tar.gz">
	afp-LambdaAuth-2019-05-15.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/List-Index.html b/web/entries/List-Index.html
	--- a/web/entries/List-Index.html
	+++ b/web/entries/List-Index.html
	@@ -1,262 +1,262 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>List Index - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">L</font>ist

	<font class="first">I</font>ndex

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">List Index</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2010-02-20</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">This theory provides functions for finding the index of an element in a list, by predicate and by value.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{List-Index-AFP,
	author = {Tobias Nipkow},
	title = {List Index},
	journal = {Archive of Formal Proofs},
	month = feb,
	year = 2010,
	note = {\url{https://isa-afp.org/entries/List-Index.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Affine_Arithmetic.html">Affine_Arithmetic</a>, <a href="Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>, <a href="Formula_Derivatives.html">Formula_Derivatives</a>, <a href="Higher_Order_Terms.html">Higher_Order_Terms</a>, <a href="Jinja.html">Jinja</a>, <a href="JinjaDCI.html">JinjaDCI</a>, <a href="List_Update.html">List_Update</a>, <a href="LTL_to_DRA.html">LTL_to_DRA</a>, <a href="MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>, <a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a>, <a href="Ordinary_Differential_Equations.html">Ordinary_Differential_Equations</a>, <a href="Planarity_Certificates.html">Planarity_Certificates</a>, <a href="Quick_Sort_Cost.html">Quick_Sort_Cost</a>, <a href="Randomised_Social_Choice.html">Randomised_Social_Choice</a>, <a href="Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>, <a href="Smith_Normal_Form.html">Smith_Normal_Form</a>, <a href="Verified_SAT_Based_AI_Planning.html">Verified_SAT_Based_AI_Planning</a> </td></tr>
	+ <td class="data"><a href="Affine_Arithmetic.html">Affine_Arithmetic</a>, <a href="Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>, <a href="Formula_Derivatives.html">Formula_Derivatives</a>, <a href="Higher_Order_Terms.html">Higher_Order_Terms</a>, <a href="Jinja.html">Jinja</a>, <a href="JinjaDCI.html">JinjaDCI</a>, <a href="List_Update.html">List_Update</a>, <a href="LTL_to_DRA.html">LTL_to_DRA</a>, <a href="Metalogic_ProofChecker.html">Metalogic_ProofChecker</a>, <a href="MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>, <a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a>, <a href="Ordinary_Differential_Equations.html">Ordinary_Differential_Equations</a>, <a href="Planarity_Certificates.html">Planarity_Certificates</a>, <a href="Quick_Sort_Cost.html">Quick_Sort_Cost</a>, <a href="Randomised_Social_Choice.html">Randomised_Social_Choice</a>, <a href="Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>, <a href="Smith_Normal_Form.html">Smith_Normal_Form</a>, <a href="Verified_SAT_Based_AI_Planning.html">Verified_SAT_Based_AI_Planning</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/List-Index/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/List-Index/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/List-Index/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-List-Index-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-List-Index-2020-04-20.tar.gz">
	afp-List-Index-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-List-Index-2019-06-11.tar.gz">
	afp-List-Index-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-List-Index-2018-08-16.tar.gz">
	afp-List-Index-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-List-Index-2017-10-10.tar.gz">
	afp-List-Index-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-List-Index-2016-12-17.tar.gz">
	afp-List-Index-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-List-Index-2016-02-22.tar.gz">
	afp-List-Index-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-List-Index-2015-05-27.tar.gz">
	afp-List-Index-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-List-Index-2014-08-28.tar.gz">
	afp-List-Index-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-List-Index-2013-12-11.tar.gz">
	afp-List-Index-2013-12-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-1:
	<a href="../release/afp-List-Index-2013-11-17.tar.gz">
	afp-List-Index-2013-11-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2013:
	<a href="../release/afp-List-Index-2013-02-16.tar.gz">
	afp-List-Index-2013-02-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2012:
	<a href="../release/afp-List-Index-2012-05-24.tar.gz">
	afp-List-Index-2012-05-24.tar.gz
	</a>
	</li>
	<li>Isabelle 2011-1:
	<a href="../release/afp-List-Index-2011-10-11.tar.gz">
	afp-List-Index-2011-10-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2011:
	<a href="../release/afp-List-Index-2011-02-11.tar.gz">
	afp-List-Index-2011-02-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2009-2:
	<a href="../release/afp-List-Index-2010-07-01.tar.gz">
	afp-List-Index-2010-07-01.tar.gz
	</a>
	</li>
	<li>Isabelle 2009-1:
	<a href="../release/afp-List-Index-2010-02-20.tar.gz">
	afp-List-Index-2010-02-20.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Localization_Ring.html b/web/entries/Localization_Ring.html
	--- a/web/entries/Localization_Ring.html
	+++ b/web/entries/Localization_Ring.html
	@@ -1,213 +1,213 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Localization of a Commutative Ring - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">L</font>ocalization

	of

	a

	<font class="first">C</font>ommutative

	<font class="first">R</font>ing

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Localization of a Commutative Ring</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- Anthony Bordg (apdb3 /at/ cam /dot/ ac /dot/ uk)
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-06-14</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Localization_Ring-AFP,
	author = {Anthony Bordg},
	title = {The Localization of a Commutative Ring},
	journal = {Archive of Formal Proofs},
	month = jun,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/Localization_Ring.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Localization_Ring/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Localization_Ring/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Localization_Ring/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Localization_Ring-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Localization_Ring-2020-04-20.tar.gz">
	afp-Localization_Ring-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Localization_Ring-2019-06-11.tar.gz">
	afp-Localization_Ring-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Localization_Ring-2018-08-16.tar.gz">
	afp-Localization_Ring-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Localization_Ring-2018-06-17.tar.gz">
	afp-Localization_Ring-2018-06-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/MFODL_Monitor_Optimized.html b/web/entries/MFODL_Monitor_Optimized.html
	--- a/web/entries/MFODL_Monitor_Optimized.html
	+++ b/web/entries/MFODL_Monitor_Optimized.html
	@@ -1,242 +1,242 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>ormalization

	of

	an

	<font class="first">O</font>ptimized

	<font class="first">M</font>onitoring

	<font class="first">A</font>lgorithm

	for

	<font class="first">M</font>etric

	<font class="first">F</font>irst-Order

	<font class="first">D</font>ynamic

	<font class="first">L</font>ogic

	with

	<font class="first">A</font>ggregations

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Thibault Dardinier,
	Lukas Heimes,
	Martin Raszyk (martin /dot/ raszyk /at/ inf /dot/ ethz /dot/ ch),
	Joshua Schneider and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-04-09</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{MFODL_Monitor_Optimized-AFP,
	author = {Thibault Dardinier and Lukas Heimes and Martin Raszyk and Joshua Schneider and Dmitriy Traytel},
	title = {Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations},
	journal = {Archive of Formal Proofs},
	month = apr,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/MFODL_Monitor_Optimized.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Generic_Join.html">Generic_Join</a>, <a href="IEEE_Floating_Point.html">IEEE_Floating_Point</a>, <a href="MFOTL_Monitor.html">MFOTL_Monitor</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/MFODL_Monitor_Optimized/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/MFODL_Monitor_Optimized/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/MFODL_Monitor_Optimized/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-MFODL_Monitor_Optimized-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-MFODL_Monitor_Optimized-2020-04-20.tar.gz">
	afp-MFODL_Monitor_Optimized-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-MFODL_Monitor_Optimized-2020-04-12.tar.gz">
	afp-MFODL_Monitor_Optimized-2020-04-12.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-MFODL_Monitor_Optimized-2020-04-11.tar.gz">
	afp-MFODL_Monitor_Optimized-2020-04-11.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/MFOTL_Monitor.html b/web/entries/MFOTL_Monitor.html
	--- a/web/entries/MFOTL_Monitor.html
	+++ b/web/entries/MFOTL_Monitor.html
	@@ -1,231 +1,231 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>ormalization

	of

	a

	<font class="first">M</font>onitoring

	<font class="first">A</font>lgorithm

	for

	<font class="first">M</font>etric

	<font class="first">F</font>irst-Order

	<font class="first">T</font>emporal

	<font class="first">L</font>ogic

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Joshua Schneider and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2019-07-04</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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 <a href="https://doi.org/10.1007/978-3-030-32079-9_18">RV
	2019 paper</a>, 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.</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Change history:</td>
	<td class="abstract">[2020-08-13]:
	added the formalization of the abstract slicing framework and joint data
	slicer (revision b1639ed541b7)<br></td>
	</tr>

	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{MFOTL_Monitor-AFP,
	author = {Joshua Schneider and Dmitriy Traytel},
	title = {Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic},
	journal = {Archive of Formal Proofs},
	month = jul,
	year = 2019,
	note = {\url{https://isa-afp.org/entries/MFOTL_Monitor.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Containers.html">Containers</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Generic_Join.html">Generic_Join</a>, <a href="MFODL_Monitor_Optimized.html">MFODL_Monitor_Optimized</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/MFOTL_Monitor/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/MFOTL_Monitor/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/MFOTL_Monitor/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-MFOTL_Monitor-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-MFOTL_Monitor-2020-04-20.tar.gz">
	afp-MFOTL_Monitor-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-MFOTL_Monitor-2019-07-05.tar.gz">
	afp-MFOTL_Monitor-2019-07-05.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/MSO_Regex_Equivalence.html b/web/entries/MSO_Regex_Equivalence.html
	--- a/web/entries/MSO_Regex_Equivalence.html
	+++ b/web/entries/MSO_Regex_Equivalence.html
	@@ -1,265 +1,265 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">D</font>ecision

	<font class="first">P</font>rocedures

	for

	<font class="first">M</font>SO

	on

	<font class="first">W</font>ords

	<font class="first">B</font>ased

	on

	<font class="first">D</font>erivatives

	of

	<font class="first">R</font>egular

	<font class="first">E</font>xpressions

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a> and
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a> and
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2014-06-12</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.
	<p>
	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.
	<p>
	The formalization is described in this <a href="http://www21.in.tum.de/~nipkow/pubs/icfp13.html">ICFP 2013 functional pearl</a>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{MSO_Regex_Equivalence-AFP,
	author = {Dmitriy Traytel and Tobias Nipkow},
	title = {Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions},
	journal = {Archive of Formal Proofs},
	month = jun,
	year = 2014,
	note = {\url{https://isa-afp.org/entries/MSO_Regex_Equivalence.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Deriving.html">Deriving</a>, <a href="List-Index.html">List-Index</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/MSO_Regex_Equivalence/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/MSO_Regex_Equivalence/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/MSO_Regex_Equivalence/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-MSO_Regex_Equivalence-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-MSO_Regex_Equivalence-2020-04-20.tar.gz">
	afp-MSO_Regex_Equivalence-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-MSO_Regex_Equivalence-2019-06-11.tar.gz">
	afp-MSO_Regex_Equivalence-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-MSO_Regex_Equivalence-2018-08-16.tar.gz">
	afp-MSO_Regex_Equivalence-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-MSO_Regex_Equivalence-2017-10-10.tar.gz">
	afp-MSO_Regex_Equivalence-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-MSO_Regex_Equivalence-2016-12-17.tar.gz">
	afp-MSO_Regex_Equivalence-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-MSO_Regex_Equivalence-2016-02-22.tar.gz">
	afp-MSO_Regex_Equivalence-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-MSO_Regex_Equivalence-2015-05-27.tar.gz">
	afp-MSO_Regex_Equivalence-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-MSO_Regex_Equivalence-2014-08-28.tar.gz">
	afp-MSO_Regex_Equivalence-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-MSO_Regex_Equivalence-2014-06-12.tar.gz">
	afp-MSO_Regex_Equivalence-2014-06-12.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Metalogic_ProofChecker.html b/web/entries/Metalogic_ProofChecker.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Metalogic_ProofChecker.html
	@@ -0,0 +1,198 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Isabelle's Metalogic: Formalization and Proof Checker - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">I</font>sabelle's
	+
	+ <font class="first">M</font>etalogic:
	+
	+ <font class="first">F</font>ormalization
	+
	+ and
	+
	+ <font class="first">P</font>roof
	+
	+ <font class="first">C</font>hecker
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Isabelle's Metalogic: Formalization and Proof Checker</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a> and
	+ <a href="http://www21.in.tum.de/~rosskops">Simon Roßkopf</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-04-27</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+In this entry we formalize Isabelle's metalogic in Isabelle/HOL.
	+Furthermore, we define a language of proof terms and an executable
	+proof checker and prove its soundness wrt. the metalogic. The
	+formalization is intentionally kept close to the Isabelle
	+implementation(for example using de Brujin indices) to enable easy
	+integration of generated code with the Isabelle system without a
	+complicated translation layer. The formalization is described in our
	+<a href="https://arxiv.org/pdf/2104.12224.pdf">CADE 28 paper</a>.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Metalogic_ProofChecker-AFP,
	+ author = {Tobias Nipkow and Simon Roßkopf},
	+ title = {Isabelle's Metalogic: Formalization and Proof Checker},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/Metalogic_ProofChecker.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="List-Index.html">List-Index</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Metalogic_ProofChecker/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Metalogic_ProofChecker/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Metalogic_ProofChecker/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Metalogic_ProofChecker-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Nested_Multisets_Ordinals.html b/web/entries/Nested_Multisets_Ordinals.html
	--- a/web/entries/Nested_Multisets_Ordinals.html
	+++ b/web/entries/Nested_Multisets_Ordinals.html
	@@ -1,225 +1,225 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>ormalization

	of

	<font class="first">N</font>ested

	<font class="first">M</font>ultisets,

	<font class="first">H</font>ereditary

	<font class="first">M</font>ultisets,

	and

	<font class="first">S</font>yntactic

	<font class="first">O</font>rdinals

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl),
	<a href="http://fmv.jku.at/fleury">Mathias Fleury</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2016-11-12</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Nested_Multisets_Ordinals-AFP,
	author = {Jasmin Christian Blanchette and Mathias Fleury and Dmitriy Traytel},
	title = {Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2016,
	note = {\url{https://isa-afp.org/entries/Nested_Multisets_Ordinals.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="List-Index.html">List-Index</a>, <a href="Ordinal.html">Ordinal</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Functional_Ordered_Resolution_Prover.html">Functional_Ordered_Resolution_Prover</a>, <a href="Lambda_Free_KBOs.html">Lambda_Free_KBOs</a>, <a href="Lambda_Free_RPOs.html">Lambda_Free_RPOs</a>, <a href="Ordered_Resolution_Prover.html">Ordered_Resolution_Prover</a>, <a href="PAC_Checker.html">PAC_Checker</a> </td></tr>
	+ <td class="data"><a href="Functional_Ordered_Resolution_Prover.html">Functional_Ordered_Resolution_Prover</a>, <a href="Lambda_Free_KBOs.html">Lambda_Free_KBOs</a>, <a href="Lambda_Free_RPOs.html">Lambda_Free_RPOs</a>, <a href="Ordered_Resolution_Prover.html">Ordered_Resolution_Prover</a>, <a href="PAC_Checker.html">PAC_Checker</a>, <a href="Progress_Tracking.html">Progress_Tracking</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Nested_Multisets_Ordinals/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Nested_Multisets_Ordinals/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Nested_Multisets_Ordinals/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Nested_Multisets_Ordinals-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Nested_Multisets_Ordinals-2020-04-20.tar.gz">
	afp-Nested_Multisets_Ordinals-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Nested_Multisets_Ordinals-2019-06-11.tar.gz">
	afp-Nested_Multisets_Ordinals-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Nested_Multisets_Ordinals-2018-08-16.tar.gz">
	afp-Nested_Multisets_Ordinals-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Nested_Multisets_Ordinals-2017-10-10.tar.gz">
	afp-Nested_Multisets_Ordinals-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Nested_Multisets_Ordinals-2016-12-17.tar.gz">
	afp-Nested_Multisets_Ordinals-2016-12-17.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Ordered_Resolution_Prover.html b/web/entries/Ordered_Resolution_Prover.html
	--- a/web/entries/Ordered_Resolution_Prover.html
	+++ b/web/entries/Ordered_Resolution_Prover.html
	@@ -1,226 +1,226 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Formalization of Bachmair and Ganzinger's Ordered Resolution Prover - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>ormalization

	of

	<font class="first">B</font>achmair

	and

	<font class="first">G</font>anzinger's

	<font class="first">O</font>rdered

	<font class="first">R</font>esolution

	<font class="first">P</font>rover

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Formalization of Bachmair and Ganzinger's Ordered Resolution Prover</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>,
	Jasmin Christian Blanchette (j /dot/ c /dot/ blanchette /at/ vu /dot/ nl),
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a> and
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a> and
	Uwe Waldmann (uwe /at/ mpi-inf /dot/ mpg /dot/ de)
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-01-18</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	This Isabelle/HOL formalization covers Sections 2 to 4 of Bachmair and
	Ganzinger's "Resolution Theorem Proving" chapter in the
	<em>Handbook of Automated Reasoning</em>. 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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Ordered_Resolution_Prover-AFP,
	author = {Anders Schlichtkrull and Jasmin Christian Blanchette and Dmitriy Traytel and Uwe Waldmann},
	title = {Formalization of Bachmair and Ganzinger's Ordered Resolution Prover},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/Ordered_Resolution_Prover.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Coinductive.html">Coinductive</a>, <a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a> </td></tr>

	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Chandy_Lamport.html">Chandy_Lamport</a>, <a href="Functional_Ordered_Resolution_Prover.html">Functional_Ordered_Resolution_Prover</a>, <a href="Saturation_Framework.html">Saturation_Framework</a>, <a href="Saturation_Framework_Extensions.html">Saturation_Framework_Extensions</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Ordered_Resolution_Prover/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Ordered_Resolution_Prover/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Ordered_Resolution_Prover/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Ordered_Resolution_Prover-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Ordered_Resolution_Prover-2020-04-20.tar.gz">
	afp-Ordered_Resolution_Prover-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Ordered_Resolution_Prover-2019-06-11.tar.gz">
	afp-Ordered_Resolution_Prover-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Ordered_Resolution_Prover-2018-08-16.tar.gz">
	afp-Ordered_Resolution_Prover-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Ordered_Resolution_Prover-2018-01-22.tar.gz">
	afp-Ordered_Resolution_Prover-2018-01-22.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Padic_Ints.html b/web/entries/Padic_Ints.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Padic_Ints.html
	@@ -0,0 +1,197 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Hensel's Lemma for the p-adic Integers - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">H</font>ensel's
	+
	+ <font class="first">L</font>emma
	+
	+ for
	+
	+ the
	+
	+ p-adic
	+
	+ <font class="first">I</font>ntegers
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Hensel's Lemma for the p-adic Integers</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ Aaron Crighton (crightoa /at/ mcmaster /dot/ ca)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-03-23</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+We formalize the ring of <em>p</em>-adic integers within the framework of the
	+HOL-Algebra library. The carrier of the ring is formalized as the
	+inverse limit of quotients of the integers by powers of a fixed prime
	+<em>p</em>. We define an integer-valued valuation, as well as an
	+extended-integer valued valuation which sends 0 to the infinite
	+element. Basic topological facts about the <em>p</em>-adic integers are
	+formalized, including completeness and sequential compactness. Taylor
	+expansions of polynomials over a commutative ring are defined,
	+culminating in the formalization of Hensel's Lemma based on a
	+proof due to Keith Conrad.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Padic_Ints-AFP,
	+ author = {Aaron Crighton},
	+ title = {Hensel's Lemma for the p-adic Integers},
	+ journal = {Archive of Formal Proofs},
	+ month = mar,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/Padic_Ints.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Padic_Ints/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Padic_Ints/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Padic_Ints/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Padic_Ints-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Parity_Game.html b/web/entries/Parity_Game.html
	--- a/web/entries/Parity_Game.html
	+++ b/web/entries/Parity_Game.html
	@@ -1,226 +1,228 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Positional Determinacy of Parity Games - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">P</font>ositional

	<font class="first">D</font>eterminacy

	of

	<font class="first">P</font>arity

	<font class="first">G</font>ames

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Positional Determinacy of Parity Games</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="http://logic.las.tu-berlin.de/Members/Dittmann/">Christoph Dittmann</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2015-11-02</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Parity_Game-AFP,
	author = {Christoph Dittmann},
	title = {Positional Determinacy of Parity Games},
	journal = {Archive of Formal Proofs},
	month = nov,
	year = 2015,
	note = {\url{https://isa-afp.org/entries/Parity_Game.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Coinductive.html">Coinductive</a>, <a href="Graph_Theory.html">Graph_Theory</a> </td></tr>

	-
	+ <tr><td class="datahead">Used by:</td>
	+ <td class="data"><a href="GaleStewart_Games.html">GaleStewart_Games</a> </td></tr>
	+


	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Parity_Game/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Parity_Game/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Parity_Game/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Parity_Game-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Parity_Game-2020-04-20.tar.gz">
	afp-Parity_Game-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Parity_Game-2019-06-11.tar.gz">
	afp-Parity_Game-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Parity_Game-2018-08-16.tar.gz">
	afp-Parity_Game-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Parity_Game-2017-10-10.tar.gz">
	afp-Parity_Game-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Parity_Game-2016-12-17.tar.gz">
	afp-Parity_Game-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Parity_Game-2016-02-22.tar.gz">
	afp-Parity_Game-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Parity_Game-2015-11-02.tar.gz">
	afp-Parity_Game-2015-11-02.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Probabilistic_System_Zoo.html b/web/entries/Probabilistic_System_Zoo.html
	--- a/web/entries/Probabilistic_System_Zoo.html
	+++ b/web/entries/Probabilistic_System_Zoo.html
	@@ -1,231 +1,231 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>A Zoo of Probabilistic Systems - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">A</font>

	<font class="first">Z</font>oo

	of

	<font class="first">P</font>robabilistic

	<font class="first">S</font>ystems

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">A Zoo of Probabilistic Systems</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>,
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2015-05-27</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.
	<p>
	This work is described in detail in the ITP 2015 publication by the authors.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Probabilistic_System_Zoo-AFP,
	author = {Johannes Hölzl and Andreas Lochbihler and Dmitriy Traytel},
	title = {A Zoo of Probabilistic Systems},
	journal = {Archive of Formal Proofs},
	month = may,
	year = 2015,
	note = {\url{https://isa-afp.org/entries/Probabilistic_System_Zoo.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Probabilistic_System_Zoo/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Probabilistic_System_Zoo/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Probabilistic_System_Zoo/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Probabilistic_System_Zoo-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Probabilistic_System_Zoo-2020-04-20.tar.gz">
	afp-Probabilistic_System_Zoo-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Probabilistic_System_Zoo-2019-06-11.tar.gz">
	afp-Probabilistic_System_Zoo-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Probabilistic_System_Zoo-2018-08-16.tar.gz">
	afp-Probabilistic_System_Zoo-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Probabilistic_System_Zoo-2017-10-10.tar.gz">
	afp-Probabilistic_System_Zoo-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Probabilistic_System_Zoo-2016-12-17.tar.gz">
	afp-Probabilistic_System_Zoo-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Probabilistic_System_Zoo-2016-02-22.tar.gz">
	afp-Probabilistic_System_Zoo-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Probabilistic_System_Zoo-2015-05-28.tar.gz">
	afp-Probabilistic_System_Zoo-2015-05-28.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Progress_Tracking.html b/web/entries/Progress_Tracking.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Progress_Tracking.html
	@@ -0,0 +1,205 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Formalization of Timely Dataflow's Progress Tracking Protocol - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">F</font>ormalization
	+
	+ of
	+
	+ <font class="first">T</font>imely
	+
	+ <font class="first">D</font>ataflow's
	+
	+ <font class="first">P</font>rogress
	+
	+ <font class="first">T</font>racking
	+
	+ <font class="first">P</font>rotocol
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Formalization of Timely Dataflow's Progress Tracking Protocol</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Authors:
	+ </td>
	+ <td class="data">
	+ Matthias Brun,
	+ Sára Decova,
	+ <a href="https://andrea.lattuada.me">Andrea Lattuada</a> and
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-04-13</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+Large-scale stream processing systems often follow the dataflow
	+paradigm, which enforces a program structure that exposes a high
	+degree of parallelism. The Timely Dataflow distributed system supports
	+expressive cyclic dataflows for which it offers low-latency data- and
	+pipeline-parallel stream processing. To achieve high expressiveness
	+and performance, Timely Dataflow uses an intricate distributed
	+protocol for tracking the computation’s progress. We formalize this
	+progress tracking protocol and verify its safety. Our formalization is
	+described in detail in our forthcoming <a
	+href="https://traytel.bitbucket.io/papers/itp21-progress_tracking/safe.pdf">ITP'21
	+paper</a>.</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Progress_Tracking-AFP,
	+ author = {Matthias Brun and Sára Decova and Andrea Lattuada and Dmitriy Traytel},
	+ title = {Formalization of Timely Dataflow's Progress Tracking Protocol},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/Progress_Tracking.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Progress_Tracking/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Progress_Tracking/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Progress_Tracking/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Progress_Tracking-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Projective_Geometry.html b/web/entries/Projective_Geometry.html
	--- a/web/entries/Projective_Geometry.html
	+++ b/web/entries/Projective_Geometry.html
	@@ -1,208 +1,208 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Projective Geometry - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">P</font>rojective

	<font class="first">G</font>eometry

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Projective Geometry</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	- Anthony Bordg (apdb3 /at/ cam /dot/ ac /dot/ uk)
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2018-06-14</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Projective_Geometry-AFP,
	author = {Anthony Bordg},
	title = {Projective Geometry},
	journal = {Archive of Formal Proofs},
	month = jun,
	year = 2018,
	note = {\url{https://isa-afp.org/entries/Projective_Geometry.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Projective_Geometry/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Projective_Geometry/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Projective_Geometry/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Projective_Geometry-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Projective_Geometry-2020-04-20.tar.gz">
	afp-Projective_Geometry-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Projective_Geometry-2019-06-11.tar.gz">
	afp-Projective_Geometry-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Projective_Geometry-2018-08-16.tar.gz">
	afp-Projective_Geometry-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Projective_Geometry-2018-06-15.tar.gz">
	afp-Projective_Geometry-2018-06-15.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Regex_Equivalence.html b/web/entries/Regex_Equivalence.html
	--- a/web/entries/Regex_Equivalence.html
	+++ b/web/entries/Regex_Equivalence.html
	@@ -1,254 +1,254 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Unified Decision Procedures for Regular Expression Equivalence - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">U</font>nified

	<font class="first">D</font>ecision

	<font class="first">P</font>rocedures

	for

	<font class="first">R</font>egular

	<font class="first">E</font>xpression

	<font class="first">E</font>quivalence

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Unified Decision Procedures for Regular Expression Equivalence</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2014-01-30</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.
	<a href="http://www21.in.tum.de/~nipkow/pubs/itp14.html">
	The formalization is described in a paper of the same name presented at
	Interactive Theorem Proving 2014</a>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Regex_Equivalence-AFP,
	author = {Tobias Nipkow and Dmitriy Traytel},
	title = {Unified Decision Procedures for Regular Expression Equivalence},
	journal = {Archive of Formal Proofs},
	month = jan,
	year = 2014,
	note = {\url{https://isa-afp.org/entries/Regex_Equivalence.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Efficient-Mergesort.html">Efficient-Mergesort</a>, <a href="Regular-Sets.html">Regular-Sets</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Regex_Equivalence/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Regex_Equivalence/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Regex_Equivalence/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Regex_Equivalence-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Regex_Equivalence-2020-04-20.tar.gz">
	afp-Regex_Equivalence-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Regex_Equivalence-2019-06-11.tar.gz">
	afp-Regex_Equivalence-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Regex_Equivalence-2018-08-16.tar.gz">
	afp-Regex_Equivalence-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Regex_Equivalence-2017-10-10.tar.gz">
	afp-Regex_Equivalence-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Regex_Equivalence-2016-12-17.tar.gz">
	afp-Regex_Equivalence-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Regex_Equivalence-2016-02-22.tar.gz">
	afp-Regex_Equivalence-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Regex_Equivalence-2015-05-27.tar.gz">
	afp-Regex_Equivalence-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Regex_Equivalence-2014-11-30.tar.gz">
	afp-Regex_Equivalence-2014-11-30.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Regex_Equivalence-2014-08-28.tar.gz">
	afp-Regex_Equivalence-2014-08-28.tar.gz
	</a>
	</li>
	<li>Isabelle 2013-2:
	<a href="../release/afp-Regex_Equivalence-2014-01-30.tar.gz">
	afp-Regex_Equivalence-2014-01-30.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Regression_Test_Selection.html b/web/entries/Regression_Test_Selection.html
	new file mode 100644
	--- /dev/null
	+++ b/web/entries/Regression_Test_Selection.html
	@@ -0,0 +1,195 @@
	+<!DOCTYPE html>
	+<html lang="en">
	+<head>
	+<meta charset="utf-8">
	+<title>Regression Test Selection - Archive of Formal Proofs
	+</title>
	+<link rel="stylesheet" type="text/css" href="../front.css">
	+<link rel="icon" href="../images/favicon.ico" type="image/icon">
	+<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	+<!-- MathJax for LaTeX support in abstracts -->
	+<script>
	+MathJax = {
	+ tex: {
	+ inlineMath: [['$', '$'], ['\$', '\$']]
	+ },
	+ processEscapes: true,
	+ svg: {
	+ fontCache: 'global'
	+ }
	+};
	+</script>
	+<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	+</head>
	+
	+<body class="mathjax_ignore">
	+
	+<table width="100%">
	+<tbody>
	+<tr>
	+
	+<!-- Navigation -->
	+<td width="20%" align="center" valign="top">
	+ <p> </p>
	+ <a href="https://www.isa-afp.org/">
	+ <img src="../images/isabelle.png" width="100" height="88" border=0>
	+ </a>
	+ <p> </p>
	+ <p> </p>
	+ <table class="nav" width="80%">
	+ <tr>
	+ <td class="nav" width="100%"><a href="../index.html">Home</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../about.html">About</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../submitting.html">Submission</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../updating.html">Updating Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../using.html">Using Entries</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../search.html">Search</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../statistics.html">Statistics</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../topics.html">Index</a></td>
	+ </tr>
	+ <tr>
	+ <td class="nav"><a href="../download.html">Download</a></td>
	+ </tr>
	+ </table>
	+ <p> </p>
	+ <p> </p>
	+</td>
	+
	+
	+<!-- Content -->
	+<td width="80%" valign="top">
	+<div align="center">
	+ <p> </p>
	+ <h1> <font class="first">R</font>egression
	+
	+ <font class="first">T</font>est
	+
	+ <font class="first">S</font>election
	+
	+</h1>
	+ <p> </p>
	+
	+<table width="80%" class="data">
	+<tbody>
	+<tr>
	+ <td class="datahead" width="20%">Title:</td>
	+ <td class="data" width="80%">Regression Test Selection</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead">
	+ Author:
	+ </td>
	+ <td class="data">
	+ Susannah Mansky (sjohnsn2 /at/ illinois /dot/ edu)
	+ </td>
	+</tr>
	+
	+
	+
	+<tr>
	+ <td class="datahead">Submission date:</td>
	+ <td class="data">2021-04-30</td>
	+</tr>
	+
	+<tr>
	+ <td class="datahead" valign="top">Abstract:</td>
	+ <td class="abstract mathjax_process">
	+This development provides a general definition for safe Regression
	+Test Selection (RTS) algorithms. RTS algorithms select which tests to
	+rerun on revised code, reducing the time required to check for newly
	+introduced errors. An RTS algorithm is considered safe if and only if
	+all deselected tests would have unchanged results. This definition is
	+instantiated with two class-collection-based RTS algorithms run over
	+the JVM as modeled by JinjaDCI. This is achieved with a general
	+definition for Collection Semantics, small-step semantics instrumented
	+to collect information during execution. As the RTS definition
	+mandates safety, these instantiations include proofs of safety. This
	+work is described in Mansky and Gunter's LSFA 2020 paper and
	+Mansky's doctoral thesis (UIUC, 2020).</td>
	+</tr>
	+
	+
	+<tr>
	+ <td class="datahead" valign="top">BibTeX:</td>
	+ <td class="formatted">
	+ <pre>@article{Regression_Test_Selection-AFP,
	+ author = {Susannah Mansky},
	+ title = {Regression Test Selection},
	+ journal = {Archive of Formal Proofs},
	+ month = apr,
	+ year = 2021,
	+ note = {\url{https://isa-afp.org/entries/Regression_Test_Selection.html},
	+ Formal proof development},
	+ ISSN = {2150-914x},
	+}</pre>
	+ </td>
	+</tr>
	+
	+ <tr><td class="datahead">License:</td>
	+ <td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>
	+
	+
	+ <tr><td class="datahead">Depends on:</td>
	+ <td class="data"><a href="JinjaDCI.html">JinjaDCI</a> </td></tr>
	+
	+
	+
	+
	+ </tbody>
	+</table>
	+
	+<p></p>
	+
	+<table class="links">
	+ <tbody>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Regression_Test_Selection/outline.pdf">Proof outline</a><br>
	+ <a href="../browser_info/current/AFP/Regression_Test_Selection/document.pdf">Proof document</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../browser_info/current/AFP/Regression_Test_Selection/index.html">Browse theories</a>
	+ </td></tr>
	+ <tr>
	+ <td class="links">
	+ <a href="../release/afp-Regression_Test_Selection-current.tar.gz">Download this entry</a>
	+ </td>
	+ </tr>
	+
	+
	+ <tr><td class="links">Older releases:
	+ None
	+ </td></tr>
	+
	+ </tbody>
	+</table>
	+
	+</div>
	+</td>
	+
	+</tr>
	+</tbody>
	+</table>
	+
	+<script src="../jquery.min.js"></script>
	+<script src="../script.js"></script>
	+
	+</body>
	+</html>
	\ No newline at end of file
	diff --git a/web/entries/Robinson_Arithmetic.html b/web/entries/Robinson_Arithmetic.html
	--- a/web/entries/Robinson_Arithmetic.html
	+++ b/web/entries/Robinson_Arithmetic.html
	@@ -1,197 +1,197 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Robinson Arithmetic - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">R</font>obinson

	<font class="first">A</font>rithmetic

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Robinson Arithmetic</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-09-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We instantiate our syntax-independent logic infrastructure developed
	in <a
	href="https://www.isa-afp.org/entries/Syntax_Independent_Logic.html">a
	separate AFP entry</a> to the FOL theory of Robinson arithmetic
	(also known as Q). The latter was formalised using Nominal Isabelle by
	adapting <a
	href="https://www.isa-afp.org/entries/Incompleteness.html">Larry
	Paulson’s formalization of the Hereditarily Finite Set
	theory</a>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Robinson_Arithmetic-AFP,
	author = {Andrei Popescu and Dmitriy Traytel},
	title = {Robinson Arithmetic},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Robinson_Arithmetic.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Nominal2.html">Nominal2</a>, <a href="Syntax_Independent_Logic.html">Syntax_Independent_Logic</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Robinson_Arithmetic/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Robinson_Arithmetic/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Robinson_Arithmetic/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Robinson_Arithmetic-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Robinson_Arithmetic-2020-09-18.tar.gz">
	afp-Robinson_Arithmetic-2020-09-18.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Sliding_Window_Algorithm.html b/web/entries/Sliding_Window_Algorithm.html
	--- a/web/entries/Sliding_Window_Algorithm.html
	+++ b/web/entries/Sliding_Window_Algorithm.html
	@@ -1,221 +1,221 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">F</font>ormalization

	of

	an

	<font class="first">A</font>lgorithm

	for

	<font class="first">G</font>reedily

	<font class="first">C</font>omputing

	<font class="first">A</font>ssociative

	<font class="first">A</font>ggregations

	on

	<font class="first">S</font>liding

	<font class="first">W</font>indows

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	Lukas Heimes,
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a> and
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a> and
	Joshua Schneider
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-04-10</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Sliding_Window_Algorithm-AFP,
	author = {Lukas Heimes and Dmitriy Traytel and Joshua Schneider},
	title = {Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows},
	journal = {Archive of Formal Proofs},
	month = apr,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Sliding_Window_Algorithm.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>






	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Sliding_Window_Algorithm/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Sliding_Window_Algorithm/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Sliding_Window_Algorithm/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Sliding_Window_Algorithm-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Sliding_Window_Algorithm-2020-04-20.tar.gz">
	afp-Sliding_Window_Algorithm-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Sliding_Window_Algorithm-2020-04-12.tar.gz">
	afp-Sliding_Window_Algorithm-2020-04-12.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Sturm_Tarski.html b/web/entries/Sturm_Tarski.html
	--- a/web/entries/Sturm_Tarski.html
	+++ b/web/entries/Sturm_Tarski.html
	@@ -1,229 +1,229 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>The Sturm-Tarski Theorem - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">T</font>he

	<font class="first">S</font>turm-Tarski

	<font class="first">T</font>heorem

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">The Sturm-Tarski Theorem</td>
	</tr>

	<tr>
	<td class="datahead">
	Author:
	</td>
	<td class="data">
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2014-09-19</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Sturm_Tarski-AFP,
	author = {Wenda Li},
	title = {The Sturm-Tarski Theorem},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2014,
	note = {\url{https://isa-afp.org/entries/Sturm_Tarski.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	- <td class="data"><a href="Budan_Fourier.html">Budan_Fourier</a>, <a href="Count_Complex_Roots.html">Count_Complex_Roots</a>, <a href="Winding_Number_Eval.html">Winding_Number_Eval</a> </td></tr>
	+ <td class="data"><a href="BenOr_Kozen_Reif.html">BenOr_Kozen_Reif</a>, <a href="Budan_Fourier.html">Budan_Fourier</a>, <a href="Count_Complex_Roots.html">Count_Complex_Roots</a>, <a href="Winding_Number_Eval.html">Winding_Number_Eval</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Sturm_Tarski/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Sturm_Tarski/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Sturm_Tarski/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Sturm_Tarski-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Sturm_Tarski-2020-04-20.tar.gz">
	afp-Sturm_Tarski-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Sturm_Tarski-2019-06-11.tar.gz">
	afp-Sturm_Tarski-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Sturm_Tarski-2018-08-16.tar.gz">
	afp-Sturm_Tarski-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Sturm_Tarski-2017-10-10.tar.gz">
	afp-Sturm_Tarski-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Sturm_Tarski-2016-12-17.tar.gz">
	afp-Sturm_Tarski-2016-12-17.tar.gz
	</a>
	</li>
	<li>Isabelle 2016:
	<a href="../release/afp-Sturm_Tarski-2016-02-22.tar.gz">
	afp-Sturm_Tarski-2016-02-22.tar.gz
	</a>
	</li>
	<li>Isabelle 2015:
	<a href="../release/afp-Sturm_Tarski-2015-05-27.tar.gz">
	afp-Sturm_Tarski-2015-05-27.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Sturm_Tarski-2014-12-05.tar.gz">
	afp-Sturm_Tarski-2014-12-05.tar.gz
	</a>
	</li>
	<li>Isabelle 2014:
	<a href="../release/afp-Sturm_Tarski-2014-09-20.tar.gz">
	afp-Sturm_Tarski-2014-09-20.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Subresultants.html b/web/entries/Subresultants.html
	--- a/web/entries/Subresultants.html
	+++ b/web/entries/Subresultants.html
	@@ -1,211 +1,211 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Subresultants - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">S</font>ubresultants

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Subresultants</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann (rene /dot/ thiemann /at/ uibk /dot/ ac /dot/ at) and
	<a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2017-04-06</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	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.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Subresultants-AFP,
	author = {Sebastiaan Joosten and René Thiemann and Akihisa Yamada},
	title = {Subresultants},
	journal = {Archive of Formal Proofs},
	month = apr,
	year = 2017,
	note = {\url{https://isa-afp.org/entries/Subresultants.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>


	<tr><td class="datahead">Depends on:</td>
	<td class="data"><a href="Jordan_Normal_Form.html">Jordan_Normal_Form</a>, <a href="Polynomial_Factorization.html">Polynomial_Factorization</a> </td></tr>




	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Subresultants/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Subresultants/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Subresultants/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Subresultants-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Subresultants-2020-04-20.tar.gz">
	afp-Subresultants-2020-04-20.tar.gz
	</a>
	</li>
	<li>Isabelle 2019:
	<a href="../release/afp-Subresultants-2019-06-11.tar.gz">
	afp-Subresultants-2019-06-11.tar.gz
	</a>
	</li>
	<li>Isabelle 2018:
	<a href="../release/afp-Subresultants-2018-08-16.tar.gz">
	afp-Subresultants-2018-08-16.tar.gz
	</a>
	</li>
	<li>Isabelle 2017:
	<a href="../release/afp-Subresultants-2017-10-10.tar.gz">
	afp-Subresultants-2017-10-10.tar.gz
	</a>
	</li>
	<li>Isabelle 2016-1:
	<a href="../release/afp-Subresultants-2017-04-07.tar.gz">
	afp-Subresultants-2017-04-07.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/entries/Syntax_Independent_Logic.html b/web/entries/Syntax_Independent_Logic.html
	--- a/web/entries/Syntax_Independent_Logic.html
	+++ b/web/entries/Syntax_Independent_Logic.html
	@@ -1,213 +1,213 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Syntax-Independent Logic Infrastructure - Archive of Formal Proofs
	</title>
	<link rel="stylesheet" type="text/css" href="../front.css">
	<link rel="icon" href="../images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="../rss.xml">
	<!-- MathJax for LaTeX support in abstracts -->
	<script>
	MathJax = {
	tex: {
	inlineMath: [['$', '$'], ['\$', '\$']]
	},
	processEscapes: true,
	svg: {
	fontCache: 'global'
	}
	};
	</script>
	<script id="MathJax-script" async src="../components/mathjax/es5/tex-mml-chtml.js"></script>
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="../images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="../index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="../download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1> <font class="first">S</font>yntax-Independent

	<font class="first">L</font>ogic

	<font class="first">I</font>nfrastructure

	</h1>
	<p> </p>

	<table width="80%" class="data">
	<tbody>
	<tr>
	<td class="datahead" width="20%">Title:</td>
	<td class="data" width="80%">Syntax-Independent Logic Infrastructure</td>
	</tr>

	<tr>
	<td class="datahead">
	Authors:
	</td>
	<td class="data">
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a> and
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>



	<tr>
	<td class="datahead">Submission date:</td>
	<td class="data">2020-09-16</td>
	</tr>

	<tr>
	<td class="datahead" valign="top">Abstract:</td>
	<td class="abstract mathjax_process">
	We formalize a notion of logic whose terms and formulas are kept
	abstract. In particular, logical connectives, substitution, free
	variables, and provability are not defined, but characterized by their
	general properties as locale assumptions. Based on this abstract
	characterization, we develop further reusable reasoning
	infrastructure. For example, we define parallel substitution (along
	with proving its characterizing theorems) from single-point
	substitution. Similarly, we develop a natural deduction style proof
	system starting from the abstract Hilbert-style one. These one-time
	efforts benefit different concrete logics satisfying our locales'
	assumptions. We instantiate the syntax-independent logic
	infrastructure to Robinson arithmetic (also known as Q) in the AFP
	entry <a
	href="https://www.isa-afp.org/entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a>
	and to hereditarily finite set theory in the AFP entries <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	and <a
	href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>,
	which are part of our formalization of Gödel's
	Incompleteness Theorems described in our CADE-27 paper <a
	href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A
	Formally Verified Abstract Account of Gödel's Incompleteness
	Theorems</a>.</td>
	</tr>


	<tr>
	<td class="datahead" valign="top">BibTeX:</td>
	<td class="formatted">
	<pre>@article{Syntax_Independent_Logic-AFP,
	author = {Andrei Popescu and Dmitriy Traytel},
	title = {Syntax-Independent Logic Infrastructure},
	journal = {Archive of Formal Proofs},
	month = sep,
	year = 2020,
	note = {\url{https://isa-afp.org/entries/Syntax_Independent_Logic.html},
	Formal proof development},
	ISSN = {2150-914x},
	}</pre>
	</td>
	</tr>

	<tr><td class="datahead">License:</td>
	<td class="data"><a href="http://isa-afp.org/LICENSE">BSD License</a></td></tr>



	<tr><td class="datahead">Used by:</td>
	<td class="data"><a href="Goedel_Incompleteness.html">Goedel_Incompleteness</a>, <a href="Robinson_Arithmetic.html">Robinson_Arithmetic</a> </td></tr>



	</tbody>
	</table>

	<p></p>

	<table class="links">
	<tbody>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Syntax_Independent_Logic/outline.pdf">Proof outline</a><br>
	<a href="../browser_info/current/AFP/Syntax_Independent_Logic/document.pdf">Proof document</a>
	</td>
	</tr>
	<tr>
	<td class="links">
	<a href="../browser_info/current/AFP/Syntax_Independent_Logic/index.html">Browse theories</a>
	</td></tr>
	<tr>
	<td class="links">
	<a href="../release/afp-Syntax_Independent_Logic-current.tar.gz">Download this entry</a>
	</td>
	</tr>


	<tr><td class="links">Older releases:
	<ul>
	<li>Isabelle 2020:
	<a href="../release/afp-Syntax_Independent_Logic-2020-09-18.tar.gz">
	afp-Syntax_Independent_Logic-2020-09-18.tar.gz
	</a>
	</li>
	</ul>
	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="../jquery.min.js"></script>
	<script src="../script.js"></script>

	</body>
	</html>
	\ 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,5408 +1,5480 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">A</font>rchive of
	<font class="first">F</font>ormal
	<font class="first">P</font>roofs</h1>
	</h1>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td>
	The Archive of Formal Proofs is a collection of proof libraries, examples, and larger scientific developments,
	mechanically checked in the theorem prover <a href="http://isabelle.in.tum.de/">Isabelle</a>. It is organized in the way
	of a scientific journal, is indexed by <a href="http://dblp.uni-trier.de/db/journals/afp/">dblp</a> and has an ISSN:
	2150-914x. Submissions are refereed. The preferred citation style is available <a href="citing.html">[here]</a>. We encourage companion AFP submissions to conference and journal publications.
	<br><br>A <a href="http://devel.isa-afp.org">development version</a> of the archive is available as well. </td>
	</tr>
	</tbody>
	</table>

	<p> </p>

	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2021</td>
	</tr>
	<tr>
	<td class="entry">
	+ 2021-04-30: <a href="entries/Regression_Test_Selection.html">Regression Test Selection</a>
	+ <br>
	+ Author:
	+ Susannah Mansky
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2021-04-27: <a href="entries/Metalogic_ProofChecker.html">Isabelle's Metalogic: Formalization and Proof Checker</a>
	+ <br>
	+ Authors:
	+ <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	+ and <a href="http://www21.in.tum.de/~rosskops">Simon Roßkopf</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2021-04-24: <a href="entries/BenOr_Kozen_Reif.html">The BKR Decision Procedure for Univariate Real Arithmetic</a>
	+ <br>
	+ Authors:
	+ <a href="https://www.cs.cmu.edu/~kcordwel/">Katherine Cordwell</a>,
	+ <a href="https://www.cs.cmu.edu/~yongkiat/">Yong Kiam Tan</a>
	+ and <a href="https://www.cs.cmu.edu/~aplatzer/">André Platzer</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2021-04-23: <a href="entries/GaleStewart_Games.html">Gale-Stewart Games</a>
	+ <br>
	+ Author:
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2021-04-13: <a href="entries/Progress_Tracking.html">Formalization of Timely Dataflow's Progress Tracking Protocol</a>
	+ <br>
	+ Authors:
	+ Matthias Brun,
	+ Sára Decova,
	+ <a href="https://andrea.lattuada.me">Andrea Lattuada</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2021-04-01: <a href="entries/IFC_Tracking.html">Information Flow Control via Dependency Tracking</a>
	+ <br>
	+ Author:
	+ Benedikt Nordhoff
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2021-03-29: <a href="entries/Grothendieck_Schemes.html">Grothendieck's Schemes in Algebraic Geometry</a>
	+ <br>
	+ Authors:
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>,
	+ <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence Paulson</a>
	+ and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	+ 2021-03-23: <a href="entries/Padic_Ints.html">Hensel's Lemma for the p-adic Integers</a>
	+ <br>
	+ Author:
	+ Aaron Crighton
	+ </td>
	+ </tr>
	+ <tr>
	+ <td class="entry">
	2021-03-17: <a href="entries/Constructive_Cryptography_CM.html">Constructive Cryptography in HOL: the Communication Modeling Aspect</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-12: <a href="entries/Modular_arithmetic_LLL_and_HNF_algorithms.html">Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation</a>
	<br>
	Authors:
	Ralph Bottesch,
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-03: <a href="entries/Projective_Measurements.html">Quantum projective measurements and the CHSH inequality</a>
	<br>
	Author:
	<a href="https://lig-membres.imag.fr/mechenim/">Mnacho Echenim</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-03: <a href="entries/Hermite_Lindemann.html">The Hermite–Lindemann–Weierstraß Transcendence Theorem</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-03-01: <a href="entries/Mereology.html">Mereology</a>
	<br>
	Author:
	<a href="https://philpeople.org/profiles/ben-blumson">Ben Blumson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-25: <a href="entries/Sunflowers.html">The Sunflower Lemma of Erdős and Rado</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-24: <a href="entries/BTree.html">A Verified Imperative Implementation of B-Trees</a>
	<br>
	Author:
	Niels Mündler
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-17: <a href="entries/Formal_Puiseux_Series.html">Formal Puiseux Series</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-02-10: <a href="entries/Laws_of_Large_Numbers.html">The Laws of Large Numbers</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-31: <a href="entries/IsaGeoCoq.html">Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid</a>
	<br>
	Author:
	Roland Coghetto
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-30: <a href="entries/Blue_Eyes.html">Solution to the xkcd Blue Eyes puzzle</a>
	<br>
	Author:
	Jakub Kądziołka
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-18: <a href="entries/Hood_Melville_Queue.html">Hood-Melville Queue</a>
	<br>
	Author:
	Alejandro Gómez-Londoño
	</td>
	</tr>
	<tr>
	<td class="entry">
	2021-01-11: <a href="entries/JinjaDCI.html">JinjaDCI: a Java semantics with dynamic class initialization</a>
	<br>
	Author:
	Susannah Mansky
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2020</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-27: <a href="entries/Delta_System_Lemma.html">Cofinality and the Delta System Lemma</a>
	<br>
	Author:
	<a href="https://cs.famaf.unc.edu.ar/~pedro/home_en.html">Pedro Sánchez Terraf</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-17: <a href="entries/Topological_Semantics.html">Topological semantics for paraconsistent and paracomplete logics</a>
	<br>
	Author:
	David Fuenmayor
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-08: <a href="entries/Relational_Minimum_Spanning_Trees.html">Relational Minimum Spanning Tree Algorithms</a>
	<br>
	Authors:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	and Nicolas Robinson-O'Brien
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-07: <a href="entries/Interpreter_Optimizations.html">Inline Caching and Unboxing Optimization for Interpreters</a>
	<br>
	Author:
	<a href="https://martin.desharnais.me">Martin Desharnais</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-12-05: <a href="entries/Relational_Method.html">The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-11-22: <a href="entries/Isabelle_Marries_Dirac.html">Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information</a>
	<br>
	Authors:
	- Anthony Bordg,
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>,
	Hanna Lachnitt
	and Yijun He
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-11-19: <a href="entries/CSP_RefTK.html">The HOL-CSP Refinement Toolkit</a>
	<br>
	Authors:
	Safouan Taha,
	<a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	and Lina Ye
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-29: <a href="entries/Verified_SAT_Based_AI_Planning.html">Verified SAT-Based AI Planning</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	and Friedrich Kurz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-29: <a href="entries/AI_Planning_Languages_Semantics.html">AI Planning Languages Semantics</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-20: <a href="entries/Physical_Quantities.html">A Sound Type System for Physical Quantities, Units, and Measurements</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-10-12: <a href="entries/Finite-Map-Extras.html">Finite Map Extras</a>
	<br>
	Author:
	Javier Díaz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/Shadow_SC_DOM.html">A Formal Model of the Safely Composable Document Object Model with Shadow Roots</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/Shadow_DOM.html">A Formal Model of the Document Object Model with Shadow Roots</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/SC_DOM_Components.html">A Formalization of Safely Composable Web Components</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/DOM_Components.html">A Formalization of Web Components</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-28: <a href="entries/Core_SC_DOM.html">The Safely Composable DOM</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Syntax_Independent_Logic.html">Syntax-Independent Logic Infrastructure</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Robinson_Arithmetic.html">Robinson Arithmetic</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Goedel_Incompleteness.html">An Abstract Formalization of Gödel's Incompleteness Theorems</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Goedel_HFSet_Semanticless.html">From Abstract to Concrete Gödel's Incompleteness Theorems—Part II</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-16: <a href="entries/Goedel_HFSet_Semantic.html">From Abstract to Concrete Gödel's Incompleteness Theorems—Part I</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-07: <a href="entries/Extended_Finite_State_Machines.html">A Formal Model of Extended Finite State Machines</a>
	<br>
	Authors:
	Michael Foster,
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Ramsay G. Taylor
	and John Derrick
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-09-07: <a href="entries/Extended_Finite_State_Machine_Inference.html">Inference of Extended Finite State Machines</a>
	<br>
	Authors:
	Michael Foster,
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Ramsay G. Taylor
	and John Derrick
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-31: <a href="entries/PAC_Checker.html">Practical Algebraic Calculus Checker</a>
	<br>
	Authors:
	<a href="http://fmv.jku.at/fleury">Mathias Fleury</a>
	and <a href="http://fmv.jku.at/kaufmann">Daniela Kaufmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-31: <a href="entries/Inductive_Inference.html">Some classical results in inductive inference of recursive functions</a>
	<br>
	Author:
	Frank J. Balbach
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-26: <a href="entries/Relational_Disjoint_Set_Forests.html">Relational Disjoint-Set Forests</a>
	<br>
	Author:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-25: <a href="entries/Saturation_Framework_Extensions.html">Extensions to the Comprehensive Framework for Saturation Theorem Proving</a>
	<br>
	Authors:
	<a href="https://www.cs.vu.nl/~jbe248/">Jasmin Blanchette</a>
	and <a href="https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret">Sophie Tourret</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-25: <a href="entries/BirdKMP.html">Putting the `K' into Bird's derivation of Knuth-Morris-Pratt string matching</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-04: <a href="entries/Amicable_Numbers.html">Amicable Numbers</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-08-03: <a href="entries/Ordinal_Partitions.html">Ordinal Partitions</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-07-21: <a href="entries/Chandy_Lamport.html">A Formal Proof of The Chandy--Lamport Distributed Snapshot Algorithm</a>
	<br>
	Authors:
	Ben Fiedler
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-07-13: <a href="entries/Relational_Paths.html">Relational Characterisations of Paths</a>
	<br>
	Authors:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	and <a href="http://www.hoefner-online.de/">Peter Höfner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-06-01: <a href="entries/Safe_Distance.html">A Formally Verified Checker of the Safe Distance Traffic Rules for Autonomous Vehicles</a>
	<br>
	Authors:
	Albert Rizaldi
	and <a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-23: <a href="entries/Smith_Normal_Form.html">A verified algorithm for computing the Smith normal form of a matrix</a>
	<br>
	Author:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-16: <a href="entries/Nash_Williams.html">The Nash-Williams Partition Theorem</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-13: <a href="entries/Knuth_Bendix_Order.html">A Formalization of Knuth–Bendix Orders</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-12: <a href="entries/Irrational_Series_Erdos_Straus.html">Irrationality Criteria for Series by Erdős and Straus</a>
	<br>
	Authors:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-11: <a href="entries/Recursion-Addition.html">Recursion Theorem in ZF</a>
	<br>
	Author:
	Georgy Dunaev
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-08: <a href="entries/LTL_Normal_Form.html">An Efficient Normalisation Procedure for Linear Temporal Logic: Isabelle/HOL Formalisation</a>
	<br>
	Author:
	Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-06: <a href="entries/Forcing.html">Formalization of Forcing in Isabelle/ZF</a>
	<br>
	Authors:
	Emmanuel Gunther,
	<a href="https://cs.famaf.unc.edu.ar/~mpagano/">Miguel Pagano</a>
	and <a href="https://cs.famaf.unc.edu.ar/~pedro/home_en.html">Pedro Sánchez Terraf</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-05-02: <a href="entries/Banach_Steinhaus.html">Banach-Steinhaus Theorem</a>
	<br>
	Authors:
	<a href="http://kodu.ut.ee/~unruh/">Dominique Unruh</a>
	and <a href="https://josephcmac.github.io/">Jose Manuel Rodriguez Caballero</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-27: <a href="entries/Attack_Trees.html">Attack Trees in Isabelle for GDPR compliance of IoT healthcare systems</a>
	<br>
	Author:
	<a href="http://www.cs.mdx.ac.uk/people/florian-kammueller/">Florian Kammueller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-24: <a href="entries/Power_Sum_Polynomials.html">Power Sum Polynomials</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-24: <a href="entries/Lambert_W.html">The Lambert W Function on the Reals</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-24: <a href="entries/Gaussian_Integers.html">Gaussian Integers</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-19: <a href="entries/Matrices_for_ODEs.html">Matrices for ODEs</a>
	<br>
	Author:
	Jonathan Julian Huerta y Munive
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-16: <a href="entries/ADS_Functor.html">Authenticated Data Structures As Functors</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Ognjen Marić
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-10: <a href="entries/Sliding_Window_Algorithm.html">Formalization of an Algorithm for Greedily Computing Associative Aggregations on Sliding Windows</a>
	<br>
	Authors:
	Lukas Heimes,
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	and Joshua Schneider
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-09: <a href="entries/Saturation_Framework.html">A Comprehensive Framework for Saturation Theorem Proving</a>
	<br>
	Author:
	<a href="https://www.mpi-inf.mpg.de/departments/automation-of-logic/people/sophie-tourret">Sophie Tourret</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-09: <a href="entries/MFODL_Monitor_Optimized.html">Formalization of an Optimized Monitoring Algorithm for Metric First-Order Dynamic Logic with Aggregations</a>
	<br>
	Authors:
	Thibault Dardinier,
	Lukas Heimes,
	Martin Raszyk,
	Joshua Schneider
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-08: <a href="entries/Stateful_Protocol_Composition_and_Typing.html">Stateful Protocol Composition and Typing</a>
	<br>
	Authors:
	Andreas V. Hess,
	<a href="https://people.compute.dtu.dk/samo/">Sebastian Mödersheim</a>
	and <a href="https://www.brucker.ch">Achim D. Brucker</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-08: <a href="entries/Automated_Stateful_Protocol_Verification.html">Automated Stateful Protocol Verification</a>
	<br>
	Authors:
	Andreas V. Hess,
	<a href="https://people.compute.dtu.dk/samo/">Sebastian Mödersheim</a>,
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-04-07: <a href="entries/Lucas_Theorem.html">Lucas's Theorem</a>
	<br>
	Author:
	Chelsea Edmonds
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-25: <a href="entries/WOOT_Strong_Eventual_Consistency.html">Strong Eventual Consistency of the Collaborative Editing Framework WOOT</a>
	<br>
	Authors:
	<a href="https://orcid.org/0000-0003-3290-5034">Emin Karayel</a>
	and Edgar Gonzàlez
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-22: <a href="entries/Furstenberg_Topology.html">Furstenberg's topology and his proof of the infinitude of primes</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-12: <a href="entries/Relational-Incorrectness-Logic.html">An Under-Approximate Relational Logic</a>
	<br>
	Author:
	<a href="https://people.eng.unimelb.edu.au/tobym/">Toby Murray</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-03-07: <a href="entries/Hello_World.html">Hello World</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-02-21: <a href="entries/Goodstein_Lambda.html">Implementing the Goodstein Function in λ-Calculus</a>
	<br>
	Author:
	Bertram Felgenhauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-02-10: <a href="entries/VeriComp.html">A Generic Framework for Verified Compilers</a>
	<br>
	Author:
	<a href="https://martin.desharnais.me">Martin Desharnais</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-02-01: <a href="entries/Arith_Prog_Rel_Primes.html">Arithmetic progressions and relative primes</a>
	<br>
	Author:
	<a href="https://josephcmac.github.io/">José Manuel Rodríguez Caballero</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-31: <a href="entries/Subset_Boolean_Algebras.html">A Hierarchy of Algebras for Boolean Subsets</a>
	<br>
	Authors:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	and <a href="https://www.informatik.uni-augsburg.de/en/chairs/dbis/pmi/staff/moeller/">Bernhard Möller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-17: <a href="entries/Mersenne_Primes.html">Mersenne primes and the Lucas–Lehmer test</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-16: <a href="entries/Approximation_Algorithms.html">Verified Approximation Algorithms</a>
	<br>
	Authors:
	Robin Eßmann,
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and <a href="https://simon-robillard.net/">Simon Robillard</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-13: <a href="entries/Closest_Pair_Points.html">Closest Pair of Points Algorithms</a>
	<br>
	Authors:
	Martin Rau
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-09: <a href="entries/Skip_Lists.html">Skip Lists</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Max W. Haslbeck</a>
	and <a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2020-01-06: <a href="entries/Bicategory.html">Bicategories</a>
	<br>
	Author:
	Eugene W. Stark
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2019</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-27: <a href="entries/Zeta_3_Irrational.html">The Irrationality of ζ(3)</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-20: <a href="entries/Hybrid_Logic.html">Formalizing a Seligman-Style Tableau System for Hybrid Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-18: <a href="entries/Poincare_Bendixson.html">The Poincaré-Bendixson Theorem</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="https://www.cs.cmu.edu/~yongkiat/">Yong Kiam Tan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-16: <a href="entries/Poincare_Disc.html">Poincaré Disc Model</a>
	<br>
	Authors:
	<a href="http://poincare.matf.bg.ac.rs/~danijela">Danijela Simić</a>,
	Filip Marić
	and Pierre Boutry
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-16: <a href="entries/Complex_Geometry.html">Complex Geometry</a>
	<br>
	Authors:
	Filip Marić
	and <a href="http://poincare.matf.bg.ac.rs/~danijela">Danijela Simić</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-10: <a href="entries/Gauss_Sums.html">Gauss Sums and the Pólya–Vinogradov Inequality</a>
	<br>
	Authors:
	<a href="https://people.epfl.ch/rodrigo.raya">Rodrigo Raya</a>
	and <a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-12-04: <a href="entries/Generalized_Counting_Sort.html">An Efficient Generalization of Counting Sort for Large, possibly Infinite Key Ranges</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-11-27: <a href="entries/Interval_Arithmetic_Word32.html">Interval Arithmetic on 32-bit Words</a>
	<br>
	Author:
	Brandon Bohrer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-24: <a href="entries/ZFC_in_HOL.html">Zermelo Fraenkel Set Theory in Higher-Order Logic</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-22: <a href="entries/Isabelle_C.html">Isabelle/C</a>
	<br>
	Authors:
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-16: <a href="entries/VerifyThis2019.html">VerifyThis 2019 -- Polished Isabelle Solutions</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-08: <a href="entries/Aristotles_Assertoric_Syllogistic.html">Aristotle's Assertoric Syllogistic</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-07: <a href="entries/Sigma_Commit_Crypto.html">Sigma Protocols and Commitment Schemes</a>
	<br>
	Authors:
	<a href="https://www.turing.ac.uk/people/doctoral-students/david-butler">David Butler</a>
	and <a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-10-04: <a href="entries/Clean.html">Clean - An Abstract Imperative Programming Language and its Theory</a>
	<br>
	Authors:
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-09-16: <a href="entries/Generic_Join.html">Formalization of Multiway-Join Algorithms</a>
	<br>
	Author:
	Thibault Dardinier
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-09-10: <a href="entries/Hybrid_Systems_VCs.html">Verification Components for Hybrid Systems</a>
	<br>
	Author:
	Jonathan Julian Huerta y Munive
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-09-06: <a href="entries/Fourier.html">Fourier Series</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-30: <a href="entries/Jacobson_Basic_Algebra.html">A Case Study in Basic Algebra</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~ballarin/">Clemens Ballarin</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-16: <a href="entries/Adaptive_State_Counting.html">Formalisation of an Adaptive State Counting Algorithm</a>
	<br>
	Author:
	Robert Sachtleben
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-14: <a href="entries/Laplace_Transform.html">Laplace Transform</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-06: <a href="entries/Linear_Programming.html">Linear Programming</a>
	<br>
	Authors:
	<a href="http://www.parsert.com/">Julian Parsert</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-06: <a href="entries/C2KA_DistributedSystems.html">Communicating Concurrent Kleene Algebra for Distributed Systems Specification</a>
	<br>
	Authors:
	Maxime Buyse
	and <a href="https://carleton.ca/jaskolka/">Jason Jaskolka</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-05: <a href="entries/IMO2019.html">Selected Problems from the International Mathematical Olympiad 2019</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-08-01: <a href="entries/Stellar_Quorums.html">Stellar Quorum Systems</a>
	<br>
	Author:
	Giuliano Losa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-30: <a href="entries/TESL_Language.html">A Formal Development of a Polychronous Polytimed Coordination Language</a>
	<br>
	Authors:
	Hai Nguyen Van,
	Frédéric Boulanger
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-27: <a href="entries/Szpilrajn.html">Order Extension and Szpilrajn's Extension Theorem</a>
	<br>
	Authors:
	Peter Zeller
	and <a href="https://www21.in.tum.de/team/stevensl">Lukas Stevens</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-18: <a href="entries/FOL_Seq_Calc1.html">A Sequent Calculus for First-Order Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-08: <a href="entries/CakeML_Codegen.html">A Verified Code Generator from Isabelle/HOL to CakeML</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-07-04: <a href="entries/MFOTL_Monitor.html">Formalization of a Monitoring Algorithm for Metric First-Order Temporal Logic</a>
	<br>
	Authors:
	Joshua Schneider
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-27: <a href="entries/Complete_Non_Orders.html">Complete Non-Orders and Fixed Points</a>
	<br>
	Authors:
	<a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	and <a href="http://group-mmm.org/~dubut/">Jérémy Dubut</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-25: <a href="entries/Priority_Search_Trees.html">Priority Search Trees</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-25: <a href="entries/Prim_Dijkstra_Simple.html">Purely Functional, Simple, and Efficient Implementation of Prim and Dijkstra</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-21: <a href="entries/Linear_Inequalities.html">Linear Inequalities</a>
	<br>
	Authors:
	Ralph Bottesch,
	Alban Reynaud
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-16: <a href="entries/Nullstellensatz.html">Hilbert's Nullstellensatz</a>
	<br>
	Author:
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-15: <a href="entries/Groebner_Macaulay.html">Gröbner Bases, Macaulay Matrices and Dubé's Degree Bounds</a>
	<br>
	Author:
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-13: <a href="entries/IMP2_Binary_Heap.html">Binary Heaps for IMP2</a>
	<br>
	Author:
	Simon Griebel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-06-03: <a href="entries/Differential_Game_Logic.html">Differential Game Logic</a>
	<br>
	Author:
	- <a href="http://www.cs.cmu.edu/~aplatzer/">André Platzer</a>
	+ <a href="https://www.cs.cmu.edu/~aplatzer/">André Platzer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-05-30: <a href="entries/KD_Tree.html">Multidimensional Binary Search Trees</a>
	<br>
	Author:
	Martin Rau
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-05-14: <a href="entries/LambdaAuth.html">Formalization of Generic Authenticated Data Structures</a>
	<br>
	Authors:
	Matthias Brun
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-05-09: <a href="entries/Multi_Party_Computation.html">Multi-Party Computation</a>
	<br>
	Authors:
	<a href="http://homepages.inf.ed.ac.uk/da/">David Aspinall</a>
	and <a href="https://www.turing.ac.uk/people/doctoral-students/david-butler">David Butler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-04-26: <a href="entries/HOL-CSP.html">HOL-CSP Version 2.0</a>
	<br>
	Authors:
	Safouan Taha,
	Lina Ye
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-04-16: <a href="entries/LTL_Master_Theorem.html">A Compositional and Unified Translation of LTL into ω-Automata</a>
	<br>
	Authors:
	Benedikt Seidl
	and Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-04-06: <a href="entries/Binding_Syntax_Theory.html">A General Theory of Syntax with Bindings</a>
	<br>
	Authors:
	Lorenzo Gheri
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-03-27: <a href="entries/Transcendence_Series_Hancl_Rucki.html">The Transcendence of Certain Infinite Series</a>
	<br>
	Authors:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-03-24: <a href="entries/QHLProver.html">Quantum Hoare Logic</a>
	<br>
	Authors:
	Junyi Liu,
	<a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>,
	Shuling Wang,
	Shenggang Ying,
	Tao Liu,
	Yangjia Li,
	Mingsheng Ying
	and Naijun Zhan
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-03-09: <a href="entries/Safe_OCL.html">Safe OCL</a>
	<br>
	Author:
	Denis Nikiforov
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-21: <a href="entries/Prime_Distribution_Elementary.html">Elementary Facts About the Distribution of Primes</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-14: <a href="entries/Kruskal.html">Kruskal's Algorithm for Minimum Spanning Forest</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~haslbema/">Maximilian P.L. Haslbeck</a>,
	Peter Lammich
	and Julian Biendarra
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-11: <a href="entries/Probabilistic_Prime_Tests.html">Probabilistic Primality Testing</a>
	<br>
	Authors:
	Daniel Stüwe
	and <a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-08: <a href="entries/Universal_Turing_Machine.html">Universal Turing Machine</a>
	<br>
	Authors:
	Jian Xu,
	Xingyuan Zhang,
	<a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>
	and Sebastiaan J. C. Joosten
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-01: <a href="entries/UTP.html">Isabelle/UTP: Mechanised Theory Engineering for Unifying Theories of Programming</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>,
	Frank Zeyda,
	Yakoub Nemouchi,
	Pedro Ribeiro
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-02-01: <a href="entries/List_Inversions.html">The Inversions of a List</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-17: <a href="entries/Farkas.html">Farkas' Lemma and Motzkin's Transposition Theorem</a>
	<br>
	Authors:
	Ralph Bottesch,
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Max W. Haslbeck</a>
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-15: <a href="entries/IMP2.html">IMP2 – Simple Program Verification in Isabelle/HOL</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-15: <a href="entries/Higher_Order_Terms.html">An Algebra for Higher-Order Terms</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2019-01-07: <a href="entries/Store_Buffer_Reduction.html">A Reduction Theorem for Store Buffers</a>
	<br>
	Authors:
	Ernie Cohen
	and Norbert Schirmer
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2018</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-26: <a href="entries/Core_DOM.html">A Formal Model of the Document Object Model</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>
	and <a href="http://www.dcs.shef.ac.uk/cgi-bin/makeperson?M.Herzberg">Michael Herzberg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-25: <a href="entries/Concurrent_Revisions.html">Formalization of Concurrent Revisions</a>
	<br>
	Author:
	Roy Overbeek
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-21: <a href="entries/Auto2_Imperative_HOL.html">Verifying Imperative Programs using Auto2</a>
	<br>
	Author:
	<a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-17: <a href="entries/Constructive_Cryptography.html">Constructive Cryptography in HOL</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-11: <a href="entries/Transformer_Semantics.html">Transformer Semantics</a>
	<br>
	Author:
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-11: <a href="entries/Quantales.html">Quantales</a>
	<br>
	Author:
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-12-11: <a href="entries/Order_Lattice_Props.html">Properties of Orderings and Lattices</a>
	<br>
	Author:
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-23: <a href="entries/Graph_Saturation.html">Graph Saturation</a>
	<br>
	Author:
	Sebastiaan J. C. Joosten
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-23: <a href="entries/Functional_Ordered_Resolution_Prover.html">A Verified Functional Implementation of Bachmair and Ganzinger's Ordered Resolution Prover</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>,
	Jasmin Christian Blanchette
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-20: <a href="entries/Auto2_HOL.html">Auto2 Prover</a>
	<br>
	Author:
	<a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-16: <a href="entries/Matroids.html">Matroids</a>
	<br>
	Author:
	Jonas Keinholz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-11-06: <a href="entries/Generic_Deriving.html">Deriving generic class instances for datatypes</a>
	<br>
	Authors:
	Jonas Rädle
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-30: <a href="entries/GewirthPGCProof.html">Formalisation and Evaluation of Alan Gewirth's Proof for the Principle of Generic Consistency in Isabelle/HOL</a>
	<br>
	Authors:
	David Fuenmayor
	and <a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-29: <a href="entries/Epistemic_Logic.html">Epistemic Logic: Completeness of Modal Logics</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/ahfrom/">Asta Halkjær From</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-22: <a href="entries/Smooth_Manifolds.html">Smooth Manifolds</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="http://lcs.ios.ac.cn/~bzhan/">Bohua Zhan</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-19: <a href="entries/Randomised_BSTs.html">Randomised Binary Search Trees</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-19: <a href="entries/Lambda_Free_EPO.html">Formalization of the Embedding Path Order for Lambda-Free Higher-Order Terms</a>
	<br>
	Author:
	Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-10-12: <a href="entries/Factored_Transition_System_Bounding.html">Upper Bounding Diameters of State Spaces of Factored Transition Systems</a>
	<br>
	Authors:
	Friedrich Kurz
	and <a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-28: <a href="entries/Pi_Transcendental.html">The Transcendence of π</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-25: <a href="entries/Symmetric_Polynomials.html">Symmetric Polynomials</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-20: <a href="entries/Signature_Groebner.html">Signature-Based Gröbner Basis Algorithms</a>
	<br>
	Author:
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-19: <a href="entries/Prime_Number_Theorem.html">The Prime Number Theorem</a>
	<br>
	Authors:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-15: <a href="entries/Aggregation_Algebras.html">Aggregation Algebras</a>
	<br>
	Author:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-14: <a href="entries/Octonions.html">Octonions</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-05: <a href="entries/Quaternions.html">Quaternions</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-09-02: <a href="entries/Budan_Fourier.html">The Budan-Fourier Theorem and Counting Real Roots with Multiplicity</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-08-24: <a href="entries/Simplex.html">An Incremental Simplex Algorithm with Unsatisfiable Core Generation</a>
	<br>
	Authors:
	Filip Marić,
	Mirko Spasić
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-08-14: <a href="entries/Minsky_Machines.html">Minsky Machines</a>
	<br>
	Author:
	Bertram Felgenhauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-07-16: <a href="entries/DiscretePricing.html">Pricing in discrete financial models</a>
	<br>
	Author:
	<a href="https://lig-membres.imag.fr/mechenim/">Mnacho Echenim</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-07-04: <a href="entries/Neumann_Morgenstern_Utility.html">Von-Neumann-Morgenstern Utility Theorem</a>
	<br>
	Authors:
	<a href="http://www.parsert.com/">Julian Parsert</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-23: <a href="entries/Pell.html">Pell's Equation</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-14: <a href="entries/Projective_Geometry.html">Projective Geometry</a>
	<br>
	Author:
	- Anthony Bordg
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-14: <a href="entries/Localization_Ring.html">The Localization of a Commutative Ring</a>
	<br>
	Author:
	- Anthony Bordg
	+ <a href="https://sites.google.com/site/anthonybordg/">Anthony Bordg</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-06-05: <a href="entries/Partial_Order_Reduction.html">Partial Order Reduction</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~brunnerj/">Julian Brunner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-27: <a href="entries/Optimal_BST.html">Optimal Binary Search Trees</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and Dániel Somogyi
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-25: <a href="entries/Hidden_Markov_Models.html">Hidden Markov Models</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-24: <a href="entries/Probabilistic_Timed_Automata.html">Probabilistic Timed Automata</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-23: <a href="entries/Irrationality_J_Hancl.html">Irrational Rapidly Convergent Series</a>
	<br>
	Authors:
	<a href="https://www.cl.cam.ac.uk/~ak2110/">Angeliki Koutsoukou-Argyraki</a>
	and <a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-23: <a href="entries/AxiomaticCategoryTheory.html">Axiom Systems for Category Theory in Free Logic</a>
	<br>
	Authors:
	<a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	and <a href="http://www.cs.cmu.edu/~scott/">Dana Scott</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-22: <a href="entries/Monad_Memo_DP.html">Monadification, Memoization and Dynamic Programming</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>,
	Shuwei Hu
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-10: <a href="entries/OpSets.html">OpSets: Sequential Specifications for Replicated Datatypes</a>
	<br>
	Authors:
	Martin Kleppmann,
	Victor B. F. Gomes,
	Dominic P. Mulligan
	and Alastair R. Beresford
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-05-07: <a href="entries/Modular_Assembly_Kit_Security.html">An Isabelle/HOL Formalization of the Modular Assembly Kit for Security Properties</a>
	<br>
	Authors:
	Oliver Bračevac,
	Richard Gay,
	Sylvia Grewe,
	Heiko Mantel,
	Henning Sudbrock
	and Markus Tasch
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-04-29: <a href="entries/WebAssembly.html">WebAssembly</a>
	<br>
	Author:
	<a href="http://www.cl.cam.ac.uk/~caw77/">Conrad Watt</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-04-27: <a href="entries/VerifyThis2018.html">VerifyThis 2018 - Polished Isabelle Solutions</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-04-24: <a href="entries/BNF_CC.html">Bounded Natural Functors with Covariance and Contravariance</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Joshua Schneider
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-22: <a href="entries/Fishburn_Impossibility.html">The Incompatibility of Fishburn-Strategyproofness and Pareto-Efficiency</a>
	<br>
	Authors:
	<a href="http://dss.in.tum.de/staff/brandt.html">Felix Brandt</a>,
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>,
	<a href="http://dss.in.tum.de/staff/christian-saile.html">Christian Saile</a>
	and <a href="http://dss.in.tum.de/staff/christian-stricker.html">Christian Stricker</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-13: <a href="entries/Weight_Balanced_Trees.html">Weight-Balanced Trees</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and Stefan Dirix
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-12: <a href="entries/CakeML.html">CakeML</a>
	<br>
	Authors:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	and Yu Zhang
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-03-01: <a href="entries/Architectural_Design_Patterns.html">A Theory of Architectural Design Patterns</a>
	<br>
	Author:
	<a href="http://marmsoler.com">Diego Marmsoler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-26: <a href="entries/Hoare_Time.html">Hoare Logics for Time Bounds</a>
	<br>
	Authors:
	<a href="http://www.in.tum.de/~haslbema">Maximilian P. L. Haslbeck</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/Treaps.html">Treaps</a>
	<br>
	Authors:
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>,
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/LLL_Factorization.html">A verified factorization algorithm for integer polynomials with polynomial complexity</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/First_Order_Terms.html">First-Order Terms</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-06: <a href="entries/Error_Function.html">The Error Function</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-02-02: <a href="entries/LLL_Basis_Reduction.html">A verified LLL algorithm</a>
	<br>
	Authors:
	Ralph Bottesch,
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>,
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-18: <a href="entries/Ordered_Resolution_Prover.html">Formalization of Bachmair and Ganzinger's Ordered Resolution Prover</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>,
	Jasmin Christian Blanchette,
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	and Uwe Waldmann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-16: <a href="entries/Gromov_Hyperbolicity.html">Gromov Hyperbolicity</a>
	<br>
	Author:
	Sebastien Gouezel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-11: <a href="entries/Green.html">An Isabelle/HOL formalisation of Green's Theorem</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~mansour/">Mohammad Abdulaziz</a>
	and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2018-01-08: <a href="entries/Taylor_Models.html">Taylor Models</a>
	<br>
	Authors:
	Christoph Traut
	and <a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2017</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-22: <a href="entries/Falling_Factorial_Sum.html">The Falling Factorial of a Sum</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-21: <a href="entries/Median_Of_Medians_Selection.html">The Median-of-Medians Selection Algorithm</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-21: <a href="entries/Mason_Stothers.html">The Mason–Stothers Theorem</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-21: <a href="entries/Dirichlet_L.html">Dirichlet L-Functions and Dirichlet's Theorem</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-19: <a href="entries/BNF_Operations.html">Operations on Bounded Natural Functors</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-12-18: <a href="entries/Knuth_Morris_Pratt.html">The string search algorithm by Knuth, Morris and Pratt</a>
	<br>
	Authors:
	Fabian Hellauer
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-11-22: <a href="entries/Stochastic_Matrices.html">Stochastic Matrices and the Perron-Frobenius Theorem</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-11-09: <a href="entries/IMAP-CRDT.html">The IMAP CmRDT</a>
	<br>
	Authors:
	Tim Jungnickel,
	Lennart Oldenburg
	and Matthias Loibl
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-11-06: <a href="entries/Hybrid_Multi_Lane_Spatial_Logic.html">Hybrid Multi-Lane Spatial Logic</a>
	<br>
	Author:
	Sven Linker
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-26: <a href="entries/Kuratowski_Closure_Complement.html">The Kuratowski Closure-Complement Theorem</a>
	<br>
	Authors:
	<a href="http://peteg.org">Peter Gammie</a>
	and Gianpaolo Gioiosa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-19: <a href="entries/Transition_Systems_and_Automata.html">Transition Systems and Automata</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~brunnerj/">Julian Brunner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-19: <a href="entries/Buchi_Complementation.html">Büchi Complementation</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~brunnerj/">Julian Brunner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-17: <a href="entries/Winding_Number_Eval.html">Evaluate Winding Numbers through Cauchy Indices</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-17: <a href="entries/Count_Complex_Roots.html">Count the Number of Complex Roots</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-14: <a href="entries/Diophantine_Eqns_Lin_Hom.html">Homogeneous Linear Diophantine Equations</a>
	<br>
	Authors:
	Florian Messner,
	<a href="http://www.parsert.com/">Julian Parsert</a>,
	Jonas Schöpf
	and Christian Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-12: <a href="entries/Zeta_Function.html">The Hurwitz and Riemann ζ Functions</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-12: <a href="entries/Linear_Recurrences.html">Linear Recurrences</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-10-12: <a href="entries/Dirichlet_Series.html">Dirichlet Series</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-21: <a href="entries/Lowe_Ontological_Argument.html">Computer-assisted Reconstruction and Assessment of E. J. Lowe's Modal Ontological Argument</a>
	<br>
	Authors:
	David Fuenmayor
	and <a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-17: <a href="entries/PLM.html">Representation and Partial Automation of the Principia Logico-Metaphysica in Isabelle/HOL</a>
	<br>
	Author:
	Daniel Kirchner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-06: <a href="entries/AnselmGod.html">Anselm's God in Isabelle/HOL</a>
	<br>
	Author:
	<a href="https://philpeople.org/profiles/ben-blumson">Ben Blumson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-09-01: <a href="entries/First_Welfare_Theorem.html">Microeconomics and the First Welfare Theorem</a>
	<br>
	Authors:
	<a href="http://www.parsert.com/">Julian Parsert</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-08-20: <a href="entries/Root_Balanced_Tree.html">Root-Balanced Tree</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-08-20: <a href="entries/Orbit_Stabiliser.html">Orbit-Stabiliser Theorem with Application to Rotational Symmetries</a>
	<br>
	Author:
	Jonas Rädle
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-08-16: <a href="entries/LambdaMu.html">The LambdaMu-calculus</a>
	<br>
	Authors:
	Cristina Matache,
	Victor B. F. Gomes
	and Dominic P. Mulligan
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-31: <a href="entries/Stewart_Apollonius.html">Stewart's Theorem and Apollonius' Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-28: <a href="entries/DynamicArchitectures.html">Dynamic Architectures</a>
	<br>
	Author:
	<a href="http://marmsoler.com">Diego Marmsoler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-21: <a href="entries/Decl_Sem_Fun_PL.html">Declarative Semantics for Functional Languages</a>
	<br>
	Author:
	<a href="http://homes.soic.indiana.edu/jsiek/">Jeremy Siek</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-15: <a href="entries/HOLCF-Prelude.html">HOLCF-Prelude</a>
	<br>
	Authors:
	Joachim Breitner,
	Brian Huffman,
	Neil Mitchell
	and Christian Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-13: <a href="entries/Minkowskis_Theorem.html">Minkowski's Theorem</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-09: <a href="entries/Name_Carrying_Type_Inference.html">Verified Metatheory and Type Inference for a Name-Carrying Simply-Typed Lambda Calculus</a>
	<br>
	Author:
	Michael Rawson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-07: <a href="entries/CRDT.html">A framework for establishing Strong Eventual Consistency for Conflict-free Replicated Datatypes</a>
	<br>
	Authors:
	Victor B. F. Gomes,
	Martin Kleppmann,
	Dominic P. Mulligan
	and Alastair R. Beresford
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-07-06: <a href="entries/Stone_Kleene_Relation_Algebras.html">Stone-Kleene Relation Algebras</a>
	<br>
	Author:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-21: <a href="entries/Propositional_Proof_Systems.html">Propositional Proof Systems</a>
	<br>
	Authors:
	<a href="http://liftm.de">Julius Michaelis</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-13: <a href="entries/PSemigroupsConvolution.html">Partial Semigroups and Convolution Algebras</a>
	<br>
	Authors:
	Brijesh Dongol,
	Victor B. F. Gomes,
	Ian J. Hayes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-06: <a href="entries/Buffons_Needle.html">Buffon's Needle Problem</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-01: <a href="entries/Prpu_Maxflow.html">Formalizing Push-Relabel Algorithms</a>
	<br>
	Authors:
	Peter Lammich
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-06-01: <a href="entries/Flow_Networks.html">Flow Networks and the Min-Cut-Max-Flow Theorem</a>
	<br>
	Authors:
	Peter Lammich
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-25: <a href="entries/Optics.html">Optics</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>
	and Frank Zeyda
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-24: <a href="entries/Security_Protocol_Refinement.html">Developing Security Protocols by Refinement</a>
	<br>
	Authors:
	Christoph Sprenger
	and Ivano Somaini
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-24: <a href="entries/Dict_Construction.html">Dictionary Construction</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-08: <a href="entries/Floyd_Warshall.html">The Floyd-Warshall Algorithm for Shortest Paths</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Probabilistic_While.html">Probabilistic while loop</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Monomorphic_Monad.html">Effect polymorphism in higher-order logic</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Monad_Normalisation.html">Monad normalisation</a>
	<br>
	Authors:
	Joshua Schneider,
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	and <a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/Game_Based_Crypto.html">Game-based cryptography in HOL</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>,
	S. Reza Sefidgar
	and Bhargav Bhatt
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-05: <a href="entries/CryptHOL.html">CryptHOL</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-04: <a href="entries/MonoidalCategory.html">Monoidal Categories</a>
	<br>
	Author:
	Eugene W. Stark
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-05-01: <a href="entries/Types_Tableaus_and_Goedels_God.html">Types, Tableaus and Gödel’s God in Isabelle/HOL</a>
	<br>
	Authors:
	David Fuenmayor
	and <a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-28: <a href="entries/LocalLexing.html">Local Lexing</a>
	<br>
	Author:
	Steven Obua
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-19: <a href="entries/Constructor_Funs.html">Constructor Functions</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-18: <a href="entries/Lazy_Case.html">Lazifying case constants</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-06: <a href="entries/Subresultants.html">Subresultants</a>
	<br>
	Authors:
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-04-04: <a href="entries/Random_BSTs.html">Expected Shape of Random Binary Search Trees</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-03-15: <a href="entries/Quick_Sort_Cost.html">The number of comparisons in QuickSort</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-03-15: <a href="entries/Comparison_Sort_Lower_Bound.html">Lower bound on comparison-based sorting algorithms</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-03-10: <a href="entries/Euler_MacLaurin.html">The Euler–MacLaurin Formula</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-28: <a href="entries/Elliptic_Curves_Group_Law.html">The Group Law for Elliptic Curves</a>
	<br>
	Author:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-26: <a href="entries/Menger.html">Menger's Theorem</a>
	<br>
	Author:
	<a href="http://logic.las.tu-berlin.de/Members/Dittmann/">Christoph Dittmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-13: <a href="entries/Differential_Dynamic_Logic.html">Differential Dynamic Logic</a>
	<br>
	Author:
	Brandon Bohrer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-10: <a href="entries/Abstract_Soundness.html">Abstract Soundness</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-02-07: <a href="entries/Stone_Relation_Algebras.html">Stone Relation Algebras</a>
	<br>
	Author:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-31: <a href="entries/Key_Agreement_Strong_Adversaries.html">Refining Authenticated Key Agreement with Strong Adversaries</a>
	<br>
	Authors:
	Joseph Lallemand
	and Christoph Sprenger
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-24: <a href="entries/Bernoulli.html">Bernoulli Numbers</a>
	<br>
	Authors:
	Lukas Bulwahn
	and <a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-17: <a href="entries/Minimal_SSA.html">Minimal Static Single Assignment Form</a>
	<br>
	Authors:
	Max Wagner
	and <a href="http://pp.ipd.kit.edu/person.php?id=88">Denis Lohner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-17: <a href="entries/Bertrands_Postulate.html">Bertrand's postulate</a>
	<br>
	Authors:
	Julian Biendarra
	and <a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-12: <a href="entries/E_Transcendental.html">The Transcendence of e</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-08: <a href="entries/UPF_Firewall.html">Formal Network Models and Their Application to Firewall Policies</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Lukas Brügger
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-03: <a href="entries/Password_Authentication_Protocol.html">Verification of a Diffie-Hellman Password-based Authentication Protocol by Extending the Inductive Method</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2017-01-01: <a href="entries/FOL_Harrison.html">First-Order Logic According to Harrison</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/aleje/">Alexander Birch Jensen</a>,
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	and <a href="https://people.compute.dtu.dk/jovi/">Jørgen Villadsen</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2016</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-30: <a href="entries/Concurrent_Ref_Alg.html">Concurrent Refinement Algebra and Rely Quotients</a>
	<br>
	Authors:
	Julian Fell,
	Ian J. Hayes
	and <a href="http://andrius.velykis.lt">Andrius Velykis</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-29: <a href="entries/Twelvefold_Way.html">The Twelvefold Way</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-20: <a href="entries/Proof_Strategy_Language.html">Proof Strategy Language</a>
	<br>
	Author:
	Yutaka Nagashima
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-12-07: <a href="entries/Paraconsistency.html">Paraconsistency</a>
	<br>
	Authors:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	and <a href="https://people.compute.dtu.dk/jovi/">Jørgen Villadsen</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-29: <a href="entries/Complx.html">COMPLX: A Verification Framework for Concurrent Imperative Programs</a>
	<br>
	Authors:
	Sidney Amani,
	June Andronick,
	Maksym Bortin,
	Corey Lewis,
	Christine Rizkallah
	and Joseph Tuong
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-23: <a href="entries/Abs_Int_ITP2012.html">Abstract Interpretation of Annotated Commands</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-16: <a href="entries/Separata.html">Separata: Isabelle tactics for Separation Algebra</a>
	<br>
	Authors:
	Zhe Hou,
	David Sanan,
	Alwen Tiu,
	Rajeev Gore
	and Ranald Clouston
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-12: <a href="entries/Nested_Multisets_Ordinals.html">Formalization of Nested Multisets, Hereditary Multisets, and Syntactic Ordinals</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="http://fmv.jku.at/fleury">Mathias Fleury</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-12: <a href="entries/Lambda_Free_KBOs.html">Formalization of Knuth–Bendix Orders for Lambda-Free Higher-Order Terms</a>
	<br>
	Authors:
	Heiko Becker,
	Jasmin Christian Blanchette,
	Uwe Waldmann
	and Daniel Wand
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-11-10: <a href="entries/Deep_Learning.html">Expressiveness of Deep Learning</a>
	<br>
	Author:
	Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-25: <a href="entries/Modal_Logics_for_NTS.html">Modal Logics for Nominal Transition Systems</a>
	<br>
	Authors:
	Tjark Weber,
	Lars-Henrik Eriksson,
	Joachim Parrow,
	Johannes Borgström
	and Ramunas Gutkovas
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-24: <a href="entries/Stable_Matching.html">Stable Matching</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-21: <a href="entries/LOFT.html">LOFT — Verified Migration of Linux Firewalls to SDN</a>
	<br>
	Authors:
	<a href="http://liftm.de">Julius Michaelis</a>
	and <a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-19: <a href="entries/Source_Coding_Theorem.html">Source Coding Theorem</a>
	<br>
	Authors:
	Quentin Hibon
	and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-19: <a href="entries/SPARCv8.html">A formal model for the SPARCv8 ISA and a proof of non-interference for the LEON3 processor</a>
	<br>
	Authors:
	Zhe Hou,
	David Sanan,
	Alwen Tiu
	and Yang Liu
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-14: <a href="entries/Berlekamp_Zassenhaus.html">The Factorization Algorithm of Berlekamp and Zassenhaus</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	- <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>,
	+ <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>,
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-11: <a href="entries/Chord_Segments.html">Intersecting Chords Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-10-05: <a href="entries/Lp.html">Lp spaces</a>
	<br>
	Author:
	Sebastien Gouezel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-30: <a href="entries/Fisher_Yates.html">Fisher–Yates shuffle</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-29: <a href="entries/Allen_Calculus.html">Allen's Interval Calculus</a>
	<br>
	Author:
	Fadoua Ghourabi
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-23: <a href="entries/Lambda_Free_RPOs.html">Formalization of Recursive Path Orders for Lambda-Free Higher-Order Terms</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	Uwe Waldmann
	and Daniel Wand
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-09: <a href="entries/Iptables_Semantics.html">Iptables Semantics</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-06: <a href="entries/SuperCalc.html">A Variant of the Superposition Calculus</a>
	<br>
	Author:
	<a href="http://membres-lig.imag.fr/peltier/">Nicolas Peltier</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-06: <a href="entries/Stone_Algebras.html">Stone Algebras</a>
	<br>
	Author:
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-09-01: <a href="entries/Stirling_Formula.html">Stirling's formula</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-31: <a href="entries/Routing.html">Routing</a>
	<br>
	Authors:
	<a href="http://liftm.de">Julius Michaelis</a>
	and <a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-24: <a href="entries/Simple_Firewall.html">Simple Firewall</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>,
	<a href="http://liftm.de">Julius Michaelis</a>
	and <a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-18: <a href="entries/InfPathElimination.html">Infeasible Paths Elimination by Symbolic Execution Techniques: Proof of Correctness and Preservation of Paths</a>
	<br>
	Authors:
	Romain Aissat,
	Frederic Voisin
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-12: <a href="entries/EdmondsKarp_Maxflow.html">Formalizing the Edmonds-Karp Algorithm</a>
	<br>
	Authors:
	Peter Lammich
	and S. Reza Sefidgar
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-08: <a href="entries/Refine_Imperative_HOL.html">The Imperative Refinement Framework</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-08-07: <a href="entries/Ptolemys_Theorem.html">Ptolemy's Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-17: <a href="entries/Surprise_Paradox.html">Surprise Paradox</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-14: <a href="entries/Pairing_Heap.html">Pairing Heap</a>
	<br>
	Authors:
	Hauke Brinkop
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-05: <a href="entries/DFS_Framework.html">A Framework for Verifying Depth-First Search Algorithms</a>
	<br>
	Authors:
	Peter Lammich
	and René Neumann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-07-01: <a href="entries/Buildings.html">Chamber Complexes, Coxeter Systems, and Buildings</a>
	<br>
	Author:
	<a href="http://ualberta.ca/~jsylvest/">Jeremy Sylvestre</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-30: <a href="entries/Rewriting_Z.html">The Z Property</a>
	<br>
	Authors:
	Bertram Felgenhauer,
	Julian Nagele,
	Vincent van Oostrom
	and Christian Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-30: <a href="entries/Resolution_FOL.html">The Resolution Calculus for First-Order Logic</a>
	<br>
	Author:
	<a href="https://people.compute.dtu.dk/andschl/">Anders Schlichtkrull</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-28: <a href="entries/IP_Addresses.html">IP Addresses</a>
	<br>
	Authors:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>,
	<a href="http://liftm.de">Julius Michaelis</a>
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-28: <a href="entries/Dependent_SIFUM_Refinement.html">Compositional Security-Preserving Refinement for Concurrent Imperative Programs</a>
	<br>
	Authors:
	<a href="https://people.eng.unimelb.edu.au/tobym/">Toby Murray</a>,
	Robert Sison,
	Edward Pierzchalski
	and Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-26: <a href="entries/Category3.html">Category Theory with Adjunctions and Limits</a>
	<br>
	Author:
	Eugene W. Stark
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-26: <a href="entries/Card_Multisets.html">Cardinality of Multisets</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-25: <a href="entries/Dependent_SIFUM_Type_Systems.html">A Dependent Security Type System for Concurrent Imperative Programs</a>
	<br>
	Authors:
	<a href="https://people.eng.unimelb.edu.au/tobym/">Toby Murray</a>,
	Robert Sison,
	Edward Pierzchalski
	and Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-21: <a href="entries/Catalan_Numbers.html">Catalan Numbers</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-18: <a href="entries/Algebraic_VCs.html">Program Construction and Verification Components Based on Kleene Algebra</a>
	<br>
	Authors:
	Victor B. F. Gomes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-13: <a href="entries/Noninterference_Concurrent_Composition.html">Conservation of CSP Noninterference Security under Concurrent Composition</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-06-09: <a href="entries/Word_Lib.html">Finite Machine Word Library</a>
	<br>
	Authors:
	Joel Beeren,
	Matthew Fernandez,
	Xin Gao,
	<a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>,
	Rafal Kolanski,
	Japheth Lim,
	Corey Lewis,
	Daniel Matichuk
	and Thomas Sewell
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-31: <a href="entries/Tree_Decomposition.html">Tree Decomposition</a>
	<br>
	Author:
	<a href="http://logic.las.tu-berlin.de/Members/Dittmann/">Christoph Dittmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-24: <a href="entries/Posix-Lexing.html">POSIX Lexing with Derivatives of Regular Expressions</a>
	<br>
	Authors:
	<a href="http://kcl.academia.edu/FahadAusaf">Fahad Ausaf</a>,
	<a href="https://rd.host.cs.st-andrews.ac.uk">Roy Dyckhoff</a>
	and <a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-24: <a href="entries/Card_Equiv_Relations.html">Cardinality of Equivalence Relations</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-20: <a href="entries/Perron_Frobenius.html">Perron-Frobenius Theorem for Spectral Radius Analysis</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>,
	<a href="http://www21.in.tum.de/~kuncar/">Ondřej Kunčar</a>,
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-20: <a href="entries/Incredible_Proof_Machine.html">The meta theory of the Incredible Proof Machine</a>
	<br>
	Authors:
	Joachim Breitner
	and <a href="http://pp.ipd.kit.edu/person.php?id=88">Denis Lohner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-18: <a href="entries/FLP.html">A Constructive Proof for FLP</a>
	<br>
	Authors:
	Benjamin Bisping,
	Paul-David Brodmann,
	Tim Jungnickel,
	Christina Rickmann,
	Henning Seidler,
	Anke Stüber,
	Arno Wilhelm-Weidner,
	Kirstin Peters
	and <a href="https://www.mtv.tu-berlin.de/nestmann/">Uwe Nestmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-09: <a href="entries/MFMC_Countable.html">A Formal Proof of the Max-Flow Min-Cut Theorem for Countable Networks</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-05: <a href="entries/Randomised_Social_Choice.html">Randomised Social Choice Theory</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-04: <a href="entries/SDS_Impossibility.html">The Incompatibility of SD-Efficiency and SD-Strategy-Proofness</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-04: <a href="entries/Bell_Numbers_Spivey.html">Spivey's Generalized Recurrence for Bell Numbers</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-05-02: <a href="entries/Groebner_Bases.html">Gröbner Bases Theory</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-28: <a href="entries/No_FTL_observers.html">No Faster-Than-Light Observers</a>
	<br>
	Authors:
	Mike Stannett
	and <a href="http://www.renyi.hu/~nemeti/">István Németi</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-27: <a href="entries/ROBDD.html">Algorithms for Reduced Ordered Binary Decision Diagrams</a>
	<br>
	Authors:
	<a href="http://liftm.de">Julius Michaelis</a>,
	<a href="http://cl-informatik.uibk.ac.at/users/mhaslbeck/">Maximilian Haslbeck</a>,
	Peter Lammich
	and <a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-27: <a href="entries/CYK.html">A formalisation of the Cocke-Younger-Kasami algorithm</a>
	<br>
	Author:
	Maksym Bortin
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-26: <a href="entries/Noninterference_Sequential_Composition.html">Conservation of CSP Noninterference Security under Sequential Composition</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-04-12: <a href="entries/KAD.html">Kleene Algebras with Domain</a>
	<br>
	Authors:
	Victor B. F. Gomes,
	<a href="http://www.cosc.canterbury.ac.nz/walter.guttmann/">Walter Guttmann</a>,
	<a href="http://www.hoefner-online.de/">Peter Höfner</a>,
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	and Tjark Weber
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-11: <a href="entries/PropResPI.html">Propositional Resolution and Prime Implicates Generation</a>
	<br>
	Author:
	<a href="http://membres-lig.imag.fr/peltier/">Nicolas Peltier</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-08: <a href="entries/Timed_Automata.html">Timed Automata</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-08: <a href="entries/Cartan_FP.html">The Cartan Fixed Point Theorems</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-03-01: <a href="entries/LTL.html">Linear Temporal Logic</a>
	<br>
	Author:
	Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-02-17: <a href="entries/List_Update.html">Analysis of List Update Algorithms</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~haslbema/">Maximilian P.L. Haslbeck</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-02-05: <a href="entries/Formal_SSA.html">Verified Construction of Static Single Assignment Form</a>
	<br>
	Authors:
	Sebastian Ullrich
	and <a href="http://pp.ipd.kit.edu/person.php?id=88">Denis Lohner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-29: <a href="entries/Polynomial_Interpolation.html">Polynomial Interpolation</a>
	<br>
	Authors:
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-29: <a href="entries/Polynomial_Factorization.html">Polynomial Factorization</a>
	<br>
	Authors:
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-20: <a href="entries/Knot_Theory.html">Knot Theory</a>
	<br>
	Author:
	T.V.H. Prathamesh
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-18: <a href="entries/Matrix_Tensor.html">Tensor Product of Matrices</a>
	<br>
	Author:
	T.V.H. Prathamesh
	</td>
	</tr>
	<tr>
	<td class="entry">
	2016-01-14: <a href="entries/Card_Number_Partitions.html">Cardinality of Number Partitions</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2015</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Triangle.html">Basic Geometric Properties of Triangles</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Prime_Harmonic_Series.html">The Divergence of the Prime Harmonic Series</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Liouville_Numbers.html">Liouville numbers</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-28: <a href="entries/Descartes_Sign_Rule.html">Descartes' Rule of Signs</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-22: <a href="entries/Stern_Brocot.html">The Stern-Brocot Tree</a>
	<br>
	Authors:
	<a href="http://peteg.org">Peter Gammie</a>
	and <a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-22: <a href="entries/Applicative_Lifting.html">Applicative Lifting</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Joshua Schneider
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-22: <a href="entries/Algebraic_Numbers.html">Algebraic Numbers in Isabelle/HOL</a>
	<br>
	Authors:
	René Thiemann,
	<a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	- and <a href="http://sjcjoosten.nl/">Sebastiaan Joosten</a>
	+ and <a href="https://sjcjoosten.nl">Sebastiaan Joosten</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-12: <a href="entries/Card_Partitions.html">Cardinality of Set Partitions</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-02: <a href="entries/Latin_Square.html">Latin Square</a>
	<br>
	Author:
	Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-12-01: <a href="entries/Ergodic_Theory.html">Ergodic Theory</a>
	<br>
	Author:
	Sebastien Gouezel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-19: <a href="entries/Euler_Partition.html">Euler's Partition Theorem</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-18: <a href="entries/TortoiseHare.html">The Tortoise and Hare Algorithm</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-11: <a href="entries/Planarity_Certificates.html">Planarity Certificates</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-11-02: <a href="entries/Parity_Game.html">Positional Determinacy of Parity Games</a>
	<br>
	Author:
	<a href="http://logic.las.tu-berlin.de/Members/Dittmann/">Christoph Dittmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-09-16: <a href="entries/Isabelle_Meta_Model.html">A Meta-Model for the Isabelle API</a>
	<br>
	Authors:
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-09-04: <a href="entries/LTL_to_DRA.html">Converting Linear Temporal Logic to Deterministic (Generalized) Rabin Automata</a>
	<br>
	Author:
	Salomon Sickert
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-21: <a href="entries/Jordan_Normal_Form.html">Matrices, Jordan Normal Forms, and Spectral Radius Theory</a>
	<br>
	Authors:
	René Thiemann
	and <a href="http://group-mmm.org/~ayamada/">Akihisa Yamada</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-20: <a href="entries/Decreasing-Diagrams-II.html">Decreasing Diagrams II</a>
	<br>
	Author:
	Bertram Felgenhauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-18: <a href="entries/Noninterference_Inductive_Unwinding.html">The Inductive Unwinding Theorem for CSP Noninterference Security</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-12: <a href="entries/Rep_Fin_Groups.html">Representations of Finite Groups</a>
	<br>
	Author:
	<a href="http://ualberta.ca/~jsylvest/">Jeremy Sylvestre</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-08-10: <a href="entries/Encodability_Process_Calculi.html">Analysing and Comparing Encodability Criteria for Process Calculi</a>
	<br>
	Authors:
	Kirstin Peters
	and <a href="http://theory.stanford.edu/~rvg/">Rob van Glabbeek</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-21: <a href="entries/Case_Labeling.html">Generating Cases from Labeled Subgoals</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-14: <a href="entries/Landau_Symbols.html">Landau Symbols</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-14: <a href="entries/Akra_Bazzi.html">The Akra-Bazzi theorem and the Master theorem</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-07-07: <a href="entries/Hermite.html">Hermite Normal Form</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="http://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-27: <a href="entries/Derangements.html">Derangements Formula</a>
	<br>
	Author:
	Lukas Bulwahn
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/Noninterference_Ipurge_Unwinding.html">The Ipurge Unwinding Theorem for CSP Noninterference Security</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/Noninterference_Generic_Unwinding.html">The Generic Unwinding Theorem for CSP Noninterference Security</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/Multirelations.html">Binary Multirelations</a>
	<br>
	Authors:
	<a href="http://www.sci.kagoshima-u.ac.jp/~furusawa/">Hitoshi Furusawa</a>
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-11: <a href="entries/List_Interleaving.html">Reasoning about Lists via List Interleaving</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-06-07: <a href="entries/Dynamic_Tables.html">Parameterized Dynamic Tables</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-05-28: <a href="entries/Formula_Derivatives.html">Derivatives of Logical Formulas</a>
	<br>
	Author:
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-05-27: <a href="entries/Probabilistic_System_Zoo.html">A Zoo of Probabilistic Systems</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>,
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-30: <a href="entries/Vickrey_Clarke_Groves.html">VCG - Combinatorial Vickrey-Clarke-Groves Auctions</a>
	<br>
	Authors:
	Marco B. Caminati,
	<a href="http://www.cs.bham.ac.uk/~mmk">Manfred Kerber</a>,
	Christoph Lange
	and Colin Rowat
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-15: <a href="entries/Residuated_Lattices.html">Residuated Lattices</a>
	<br>
	Authors:
	Victor B. F. Gomes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-13: <a href="entries/ConcurrentIMP.html">Concurrent IMP</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-04-13: <a href="entries/ConcurrentGC.html">Relaxing Safely: Verified On-the-Fly Garbage Collection for x86-TSO</a>
	<br>
	Authors:
	<a href="http://peteg.org">Peter Gammie</a>,
	<a href="https://www.cs.purdue.edu/homes/hosking/">Tony Hosking</a>
	and Kai Engelhardt
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-03-30: <a href="entries/Trie.html">Trie</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-03-18: <a href="entries/Consensus_Refined.html">Consensus Refined</a>
	<br>
	Authors:
	Ognjen Maric
	and Christoph Sprenger
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-03-11: <a href="entries/Deriving.html">Deriving class instances for datatypes</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-20: <a href="entries/Call_Arity.html">The Safety of Call Arity</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-12: <a href="entries/QR_Decomposition.html">QR Decomposition</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="http://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-12: <a href="entries/Echelon_Form.html">Echelon Form</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="http://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-02-05: <a href="entries/Finite_Automata_HF.html">Finite Automata in Hereditarily Finite Set Theory</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2015-01-28: <a href="entries/UpDown_Scheme.html">Verification of the UpDown Scheme</a>
	<br>
	Author:
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2014</td>
	</tr>
	<tr>
	<td class="entry">
	2014-11-28: <a href="entries/UPF.html">The Unified Policy Framework (UPF)</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	Lukas Brügger
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-23: <a href="entries/AODV.html">Loop freedom of the (untimed) AODV routing protocol</a>
	<br>
	Authors:
	<a href="http://www.tbrk.org">Timothy Bourke</a>
	and <a href="http://www.hoefner-online.de/">Peter Höfner</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-13: <a href="entries/Lifting_Definition_Option.html">Lifting Definition Option</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-10: <a href="entries/Stream_Fusion_Code.html">Stream Fusion in HOL with Code Generation</a>
	<br>
	Authors:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Alexandra Maximova
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-09: <a href="entries/Density_Compiler.html">A Verified Compiler for Probability Density Functions</a>
	<br>
	Authors:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>,
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-08: <a href="entries/RefinementReactive.html">Formalization of Refinement Calculus for Reactive Systems</a>
	<br>
	Author:
	Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-03: <a href="entries/XML.html">XML</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-10-03: <a href="entries/Certification_Monads.html">Certification Monads</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-25: <a href="entries/Imperative_Insertion_Sort.html">Imperative Insertion Sort</a>
	<br>
	Author:
	Christian Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-19: <a href="entries/Sturm_Tarski.html">The Sturm-Tarski Theorem</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-15: <a href="entries/Cayley_Hamilton.html">The Cayley-Hamilton Theorem</a>
	<br>
	Authors:
	<a href="http://nm.wu.ac.at/nm/sadelsbe">Stephan Adelsberger</a>,
	<a href="http://www.logic.at/people/hetzl/">Stefan Hetzl</a>
	and Florian Pollak
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-09: <a href="entries/Jordan_Hoelder.html">The Jordan-Hölder Theorem</a>
	<br>
	Author:
	Jakob von Raumer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-04: <a href="entries/Priority_Queue_Braun.html">Priority Queues Based on Braun Trees</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-09-03: <a href="entries/Gauss_Jordan.html">Gauss-Jordan Algorithm and Its Applications</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="http://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-29: <a href="entries/VectorSpace.html">Vector Spaces</a>
	<br>
	Author:
	Holden Lee
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-29: <a href="entries/Special_Function_Bounds.html">Real-Valued Special Functions: Upper and Lower Bounds</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-13: <a href="entries/Skew_Heap.html">Skew Heap</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-08-12: <a href="entries/Splay_Tree.html">Splay Tree</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-29: <a href="entries/Show.html">Haskell's Show Class in Isabelle/HOL</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-18: <a href="entries/CISC-Kernel.html">Formal Specification of a Generic Separation Kernel</a>
	<br>
	Authors:
	Freek Verbeek,
	Sergey Tverdyshev,
	Oto Havle,
	Holger Blasum,
	Bruno Langenstein,
	Werner Stephan,
	Yakoub Nemouchi,
	Abderrahmane Feliachi,
	<a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	and Julien Schmaltz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-13: <a href="entries/pGCL.html">pGCL for Isabelle</a>
	<br>
	Author:
	David Cock
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-07: <a href="entries/Amortized_Complexity.html">Amortized Complexity Verified</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-04: <a href="entries/Network_Security_Policy_Verification.html">Network Security Policy Verification</a>
	<br>
	Author:
	<a href="http://net.in.tum.de/~diekmann">Cornelius Diekmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-07-03: <a href="entries/Pop_Refinement.html">Pop-Refinement</a>
	<br>
	Author:
	<a href="http://www.kestrel.edu/~coglio">Alessandro Coglio</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-06-12: <a href="entries/MSO_Regex_Equivalence.html">Decision Procedures for MSO on Words Based on Derivatives of Regular Expressions</a>
	<br>
	Authors:
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-06-08: <a href="entries/Boolean_Expression_Checkers.html">Boolean Expression Checkers</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/Promela.html">Promela Formalization</a>
	<br>
	Author:
	René Neumann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/LTL_to_GBA.html">Converting Linear-Time Temporal Logic to Generalized Büchi Automata</a>
	<br>
	Authors:
	Alexander Schimpf
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/Gabow_SCC.html">Verified Efficient Implementation of Gabow's Strongly Connected Components Algorithm</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/CAVA_LTL_Modelchecker.html">A Fully Verified Executable LTL Model Checker</a>
	<br>
	Authors:
	<a href="https://www7.in.tum.de/~esparza/">Javier Esparza</a>,
	Peter Lammich,
	René Neumann,
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>,
	Alexander Schimpf
	and <a href="http://www.irit.fr/~Jan-Georg.Smaus">Jan-Georg Smaus</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-28: <a href="entries/CAVA_Automata.html">The CAVA Automata Library</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-23: <a href="entries/Roy_Floyd_Warshall.html">Transitive closure according to Roy-Floyd-Warshall</a>
	<br>
	Author:
	Makarius Wenzel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-23: <a href="entries/Noninterference_CSP.html">Noninterference Security in Communicating Sequential Processes</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-05-21: <a href="entries/Regular_Algebras.html">Regular Algebras</a>
	<br>
	Authors:
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-28: <a href="entries/ComponentDependencies.html">Formalisation and Analysis of Component Dependencies</a>
	<br>
	Author:
	Maria Spichkova
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-23: <a href="entries/WHATandWHERE_Security.html">A Formalization of Declassification with WHAT-and-WHERE-Security</a>
	<br>
	Authors:
	Sylvia Grewe,
	Alexander Lux,
	Heiko Mantel
	and Jens Sauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-23: <a href="entries/Strong_Security.html">A Formalization of Strong Security</a>
	<br>
	Authors:
	Sylvia Grewe,
	Alexander Lux,
	Heiko Mantel
	and Jens Sauer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-23: <a href="entries/SIFUM_Type_Systems.html">A Formalization of Assumptions and Guarantees for Compositional Noninterference</a>
	<br>
	Authors:
	Sylvia Grewe,
	Heiko Mantel
	and Daniel Schoepe
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-22: <a href="entries/Bounded_Deducibility_Security.html">Bounded-Deducibility Security</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-16: <a href="entries/HyperCTL.html">A shallow embedding of HyperCTL*</a>
	<br>
	Authors:
	<a href="http://www.react.uni-saarland.de/people/rabe.html">Markus N. Rabe</a>,
	Peter Lammich
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-16: <a href="entries/Abstract_Completeness.html">Abstract Completeness</a>
	<br>
	Authors:
	Jasmin Christian Blanchette,
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-13: <a href="entries/Discrete_Summation.html">Discrete Summation</a>
	<br>
	Author:
	<a href="http://isabelle.in.tum.de/~haftmann">Florian Haftmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-04-03: <a href="entries/GPU_Kernel_PL.html">Syntax and semantics of a GPU kernel programming language</a>
	<br>
	Author:
	John Wickerson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-03-11: <a href="entries/Probabilistic_Noninterference.html">Probabilistic Noninterference</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-03-08: <a href="entries/AWN.html">Mechanization of the Algebra for Wireless Networks (AWN)</a>
	<br>
	Author:
	<a href="http://www.tbrk.org">Timothy Bourke</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-18: <a href="entries/Partial_Function_MR.html">Mutually Recursive Partial Functions</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-13: <a href="entries/Random_Graph_Subgraph_Threshold.html">Properties of Random Graphs -- Subgraph Containment</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~hupel/">Lars Hupel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-11: <a href="entries/Selection_Heap_Sort.html">Verification of Selection and Heap Sort Using Locales</a>
	<br>
	Author:
	<a href="http://www.matf.bg.ac.rs/~danijela">Danijela Petrovic</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-07: <a href="entries/Affine_Arithmetic.html">Affine Arithmetic</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-02-06: <a href="entries/Real_Impl.html">Implementing field extensions of the form Q[sqrt(b)]</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-30: <a href="entries/Regex_Equivalence.html">Unified Decision Procedures for Regular Expression Equivalence</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	- and <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ and <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-28: <a href="entries/Secondary_Sylow.html">Secondary Sylow Theorems</a>
	<br>
	Author:
	Jakob von Raumer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-25: <a href="entries/Relation_Algebra.html">Relation Algebra</a>
	<br>
	Authors:
	Alasdair Armstrong,
	<a href="https://www-users.cs.york.ac.uk/~simonf/">Simon Foster</a>,
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	and Tjark Weber
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-23: <a href="entries/KAT_and_DRA.html">Kleene Algebra with Tests and Demonic Refinement Algebras</a>
	<br>
	Authors:
	Alasdair Armstrong,
	Victor B. F. Gomes
	and <a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-16: <a href="entries/Featherweight_OCL.html">Featherweight OCL: A Proposal for a Machine-Checked Formal Semantics for OCL 2.5</a>
	<br>
	Authors:
	<a href="https://www.brucker.ch">Achim D. Brucker</a>,
	<a href="https://www.lri.fr/~ftuong/">Frédéric Tuong</a>
	and <a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-11: <a href="entries/Sturm_Sequences.html">Sturm's Theorem</a>
	<br>
	Author:
	<a href="https://www21.in.tum.de/~eberlm">Manuel Eberl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2014-01-11: <a href="entries/CryptoBasedCompositionalProperties.html">Compositional Properties of Crypto-Based Components</a>
	<br>
	Author:
	Maria Spichkova
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2013</td>
	</tr>
	<tr>
	<td class="entry">
	2013-12-01: <a href="entries/Tail_Recursive_Functions.html">A General Method for the Proof of Theorems on Tail-recursive Functions</a>
	<br>
	Author:
	Pasquale Noce
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-17: <a href="entries/Incompleteness.html">Gödel's Incompleteness Theorems</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-17: <a href="entries/HereditarilyFinite.html">The Hereditarily Finite Sets</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-15: <a href="entries/Coinductive_Languages.html">A Codatatype of Formal Languages</a>
	<br>
	Author:
	- <a href="https://traytel.bitbucket.io">Dmitriy Traytel</a>
	+ <a href="https://traytel.bitbucket.io/">Dmitriy Traytel</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-14: <a href="entries/FocusStreamsCaseStudies.html">Stream Processing Components: Isabelle/HOL Formalisation and Case Studies</a>
	<br>
	Author:
	Maria Spichkova
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-12: <a href="entries/GoedelGod.html">Gödel's God in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://christoph-benzmueller.de">Christoph Benzmüller</a>
	and <a href="http://www.logic.at/staff/bruno/">Bruno Woltzenlogel Paleo</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-11-01: <a href="entries/Decreasing-Diagrams.html">Decreasing Diagrams</a>
	<br>
	Author:
	<a href="http://cl-informatik.uibk.ac.at/users/hzankl">Harald Zankl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-10-02: <a href="entries/Automatic_Refinement.html">Automatic Data Refinement</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-09-17: <a href="entries/Native_Word.html">Native Word</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-27: <a href="entries/IEEE_Floating_Point.html">A Formal Model of IEEE Floating Point Arithmetic</a>
	<br>
	Author:
	Lei Yu
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-22: <a href="entries/Pratt_Certificate.html">Pratt's Primality Certificates</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and <a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-22: <a href="entries/Lehmer.html">Lehmer's Theorem</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~wimmers/">Simon Wimmer</a>
	and <a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-07-19: <a href="entries/Koenigsberg_Friendship.html">The Königsberg Bridge Problem and the Friendship Theorem</a>
	<br>
	Author:
	<a href="https://www.cl.cam.ac.uk/~wl302/">Wenda Li</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-06-27: <a href="entries/Sort_Encodings.html">Sound and Complete Sort Encodings for First-Order Logic</a>
	<br>
	Authors:
	Jasmin Christian Blanchette
	and <a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-05-22: <a href="entries/ShortestPath.html">An Axiomatic Characterization of the Single-Source Shortest Path Problem</a>
	<br>
	Author:
	Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-04-28: <a href="entries/Graph_Theory.html">Graph Theory</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-04-15: <a href="entries/Containers.html">Light-weight Containers</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-02-21: <a href="entries/Nominal2.html">Nominal 2</a>
	<br>
	Authors:
	<a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>,
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	and <a href="http://cl-informatik.uibk.ac.at/cek/">Cezary Kaliszyk</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-31: <a href="entries/Launchbury.html">The Correctness of Launchbury's Natural Semantics for Lazy Evaluation</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-19: <a href="entries/Ribbon_Proofs.html">Ribbon Proofs</a>
	<br>
	Author:
	John Wickerson
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-16: <a href="entries/Rank_Nullity_Theorem.html">Rank-Nullity Theorem in Linear Algebra</a>
	<br>
	Authors:
	<a href="https://www.unirioja.es/cu/jodivaso/">Jose Divasón</a>
	and <a href="http://www.unirioja.es/cu/jearansa">Jesús Aransay</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-15: <a href="entries/Kleene_Algebra.html">Kleene Algebra</a>
	<br>
	Authors:
	Alasdair Armstrong,
	<a href="http://staffwww.dcs.shef.ac.uk/people/G.Struth/">Georg Struth</a>
	and Tjark Weber
	</td>
	</tr>
	<tr>
	<td class="entry">
	2013-01-03: <a href="entries/Sqrt_Babylonian.html">Computing N-th Roots using the Babylonian Method</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2012</td>
	</tr>
	<tr>
	<td class="entry">
	2012-11-14: <a href="entries/Separation_Logic_Imperative_HOL.html">A Separation Logic Framework for Imperative HOL</a>
	<br>
	Authors:
	Peter Lammich
	and Rene Meis
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-11-02: <a href="entries/Open_Induction.html">Open Induction</a>
	<br>
	Authors:
	Mizuhito Ogawa
	and Christian Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-10-30: <a href="entries/Tarskis_Geometry.html">The independence of Tarski's Euclidean axiom</a>
	<br>
	Author:
	T. J. M. Makarios
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-10-27: <a href="entries/Bondy.html">Bondy's Theorem</a>
	<br>
	Authors:
	<a href="http://www.andrew.cmu.edu/user/avigad/">Jeremy Avigad</a>
	and <a href="http://www.logic.at/people/hetzl/">Stefan Hetzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-09-10: <a href="entries/Possibilistic_Noninterference.html">Possibilistic Noninterference</a>
	<br>
	Authors:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-08-07: <a href="entries/Datatype_Order_Generator.html">Generating linear orders for datatypes</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-08-05: <a href="entries/Impossible_Geometry.html">Proving the Impossibility of Trisecting an Angle and Doubling the Cube</a>
	<br>
	Authors:
	Ralph Romanos
	and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-07-27: <a href="entries/Heard_Of.html">Verifying Fault-Tolerant Distributed Algorithms in the Heard-Of Model</a>
	<br>
	Authors:
	Henri Debrat
	and <a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-07-01: <a href="entries/PCF.html">Logical Relations for PCF</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-06-26: <a href="entries/Tycon.html">Type Constructor Classes and Monad Transformers</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-29: <a href="entries/Psi_Calculi.html">Psi-calculi in Isabelle</a>
	<br>
	Author:
	<a href="http://www.itu.dk/people/jebe">Jesper Bengtson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-29: <a href="entries/Pi_Calculus.html">The pi-calculus in nominal logic</a>
	<br>
	Author:
	<a href="http://www.itu.dk/people/jebe">Jesper Bengtson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-29: <a href="entries/CCS.html">CCS in nominal logic</a>
	<br>
	Author:
	<a href="http://www.itu.dk/people/jebe">Jesper Bengtson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-27: <a href="entries/Circus.html">Isabelle/Circus</a>
	<br>
	Authors:
	Abderrahmane Feliachi,
	<a href="https://www.lri.fr/~wolff/">Burkhart Wolff</a>
	and Marie-Claude Gaudel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-11: <a href="entries/Separation_Algebra.html">Separation Algebra</a>
	<br>
	Authors:
	<a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>,
	Rafal Kolanski
	and Andrew Boyton
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-07: <a href="entries/Stuttering_Equivalence.html">Stuttering Equivalence</a>
	<br>
	Author:
	<a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-05-02: <a href="entries/Inductive_Confidentiality.html">Inductive Study of Confidentiality</a>
	<br>
	Author:
	<a href="http://www.dmi.unict.it/~giamp/">Giampaolo Bella</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-04-26: <a href="entries/Ordinary_Differential_Equations.html">Ordinary Differential Equations</a>
	<br>
	Authors:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	and <a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-04-13: <a href="entries/Well_Quasi_Orders.html">Well-Quasi-Orders</a>
	<br>
	Author:
	Christian Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-03-01: <a href="entries/Abortable_Linearizable_Modules.html">Abortable Linearizable Modules</a>
	<br>
	Authors:
	Rachid Guerraoui,
	<a href="http://lara.epfl.ch/~kuncak/">Viktor Kuncak</a>
	and Giuliano Losa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-02-29: <a href="entries/Transitive-Closure-II.html">Executable Transitive Closures</a>
	<br>
	Author:
	René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-02-06: <a href="entries/Girth_Chromatic.html">A Probabilistic Proof of the Girth-Chromatic Number Theorem</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~noschinl/">Lars Noschinski</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-01-30: <a href="entries/Refine_Monadic.html">Refinement for Monadic Programs</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-01-30: <a href="entries/Dijkstra_Shortest_Path.html">Dijkstra's Shortest Path Algorithm</a>
	<br>
	Authors:
	Benedikt Nordhoff
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2012-01-03: <a href="entries/Markov_Models.html">Markov Models</a>
	<br>
	Authors:
	<a href="http://in.tum.de/~hoelzl">Johannes Hölzl</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2011</td>
	</tr>
	<tr>
	<td class="entry">
	2011-11-19: <a href="entries/TLA.html">A Definitional Encoding of TLA* in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://homepages.inf.ed.ac.uk/ggrov">Gudmund Grov</a>
	and <a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-11-09: <a href="entries/Efficient-Mergesort.html">Efficient Mergesort</a>
	<br>
	Author:
	Christian Sternagel
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-09-22: <a href="entries/PseudoHoops.html">Pseudo Hoops</a>
	<br>
	Authors:
	George Georgescu,
	Laurentiu Leustean
	and Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-09-22: <a href="entries/MonoBoolTranAlgebra.html">Algebra of Monotonic Boolean Transformers</a>
	<br>
	Author:
	Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-09-22: <a href="entries/LatticeProperties.html">Lattice Properties</a>
	<br>
	Author:
	Viorel Preoteasa
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-08-26: <a href="entries/Myhill-Nerode.html">The Myhill-Nerode Theorem Based on Regular Expressions</a>
	<br>
	Authors:
	Chunhan Wu,
	Xingyuan Zhang
	and <a href="http://www.inf.kcl.ac.uk/staff/urbanc/">Christian Urban</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-08-19: <a href="entries/Gauss-Jordan-Elim-Fun.html">Gauss-Jordan Elimination for Matrices Represented as Functions</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-07-21: <a href="entries/Max-Card-Matching.html">Maximum Cardinality Matching</a>
	<br>
	Author:
	Christine Rizkallah
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-05-17: <a href="entries/KBPs.html">Knowledge-based programs</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-04-01: <a href="entries/General-Triangle.html">The General Triangle Is Unique</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-03-14: <a href="entries/Transitive-Closure.html">Executable Transitive Closures of Finite Relations</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-23: <a href="entries/Nat-Interval-Logic.html">Interval Temporal Logic on Natural Numbers</a>
	<br>
	Author:
	David Trachtenherz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-23: <a href="entries/List-Infinite.html">Infinite Lists</a>
	<br>
	Author:
	David Trachtenherz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-23: <a href="entries/AutoFocus-Stream.html">AutoFocus Stream Processing for Single-Clocking and Multi-Clocking Semantics</a>
	<br>
	Author:
	David Trachtenherz
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-02-07: <a href="entries/LightweightJava.html">Lightweight Java</a>
	<br>
	Authors:
	<a href="http://rok.strnisa.com/lj/">Rok Strniša</a>
	and <a href="http://research.microsoft.com/people/mattpark/">Matthew Parkinson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-01-10: <a href="entries/RIPEMD-160-SPARK.html">RIPEMD-160</a>
	<br>
	Author:
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2011-01-08: <a href="entries/Lower_Semicontinuous.html">Lower Semicontinuous Functions</a>
	<br>
	Author:
	Bogdan Grechuk
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2010</td>
	</tr>
	<tr>
	<td class="entry">
	2010-12-17: <a href="entries/Marriage.html">Hall's Marriage Theorem</a>
	<br>
	Authors:
	Dongchen Jiang
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-11-16: <a href="entries/Shivers-CFA.html">Shivers' Control Flow Analysis</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-10-28: <a href="entries/Finger-Trees.html">Finger Trees</a>
	<br>
	Authors:
	Benedikt Nordhoff,
	Stefan Körner
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-10-28: <a href="entries/Binomial-Queues.html">Functional Binomial Queues</a>
	<br>
	Author:
	René Neumann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-10-28: <a href="entries/Binomial-Heaps.html">Binomial Heaps and Skew Binomial Heaps</a>
	<br>
	Authors:
	Rene Meis,
	Finn Nielsen
	and Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-08-29: <a href="entries/Lam-ml-Normalization.html">Strong Normalization of Moggis's Computational Metalanguage</a>
	<br>
	Author:
	Christian Doczkal
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-08-10: <a href="entries/Polynomials.html">Executable Multivariate Polynomials</a>
	<br>
	Authors:
	Christian Sternagel,
	René Thiemann,
	<a href="https://risc.jku.at/m/alexander-maletzky/">Alexander Maletzky</a>,
	<a href="http://home.in.tum.de/~immler/">Fabian Immler</a>,
	<a href="http://isabelle.in.tum.de/~haftmann">Florian Haftmann</a>,
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	and Alexander Bentkamp
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-08-08: <a href="entries/Statecharts.html">Formalizing Statecharts using Hierarchical Automata</a>
	<br>
	Authors:
	Steffen Helke
	and Florian Kammüller
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-24: <a href="entries/Free-Groups.html">Free Groups</a>
	<br>
	Author:
	Joachim Breitner
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-20: <a href="entries/Category2.html">Category Theory</a>
	<br>
	Author:
	Alexander Katovsky
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-17: <a href="entries/Matrix.html">Executable Matrix Operations on Matrices of Arbitrary Dimensions</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-06-14: <a href="entries/Abstract-Rewriting.html">Abstract Rewriting</a>
	<br>
	Authors:
	Christian Sternagel
	and René Thiemann
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-28: <a href="entries/GraphMarkingIBP.html">Verification of the Deutsch-Schorr-Waite Graph Marking Algorithm using Data Refinement</a>
	<br>
	Authors:
	Viorel Preoteasa
	and <a href="http://users.abo.fi/Ralph-Johan.Back/">Ralph-Johan Back</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-28: <a href="entries/DataRefinementIBP.html">Semantics and Data Refinement of Invariant Based Programs</a>
	<br>
	Authors:
	Viorel Preoteasa
	and <a href="http://users.abo.fi/Ralph-Johan.Back/">Ralph-Johan Back</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-22: <a href="entries/Robbins-Conjecture.html">A Complete Proof of the Robbins Conjecture</a>
	<br>
	Author:
	Matthew Wampler-Doty
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-05-12: <a href="entries/Regular-Sets.html">Regular Sets and Expressions</a>
	<br>
	Authors:
	<a href="http://www.in.tum.de/~krauss">Alexander Krauss</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-04-30: <a href="entries/Locally-Nameless-Sigma.html">Locally Nameless Sigma Calculus</a>
	<br>
	Authors:
	Ludovic Henrio,
	Florian Kammüller,
	Bianca Lutz
	and Henry Sudhof
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-03-29: <a href="entries/Free-Boolean-Algebra.html">Free Boolean Algebra</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-03-23: <a href="entries/InformationFlowSlicing_Inter.html">Inter-Procedural Information Flow Noninterference via Slicing</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-03-23: <a href="entries/InformationFlowSlicing.html">Information Flow Noninterference via Slicing</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-02-20: <a href="entries/List-Index.html">List Index</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2010-02-12: <a href="entries/Coinductive.html">Coinductive</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2009</td>
	</tr>
	<tr>
	<td class="entry">
	2009-12-09: <a href="entries/DPT-SAT-Solver.html">A Fast SAT Solver for Isabelle in Standard ML</a>
	<br>
	Author:
	Armin Heller
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-12-03: <a href="entries/Presburger-Automata.html">Formalizing the Logic-Automaton Connection</a>
	<br>
	Authors:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	and Markus Reiter
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-25: <a href="entries/Tree-Automata.html">Tree Automata</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-25: <a href="entries/Collections.html">Collections Framework</a>
	<br>
	Author:
	Peter Lammich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-22: <a href="entries/Perfect-Number-Thm.html">Perfect Number Theorem</a>
	<br>
	Author:
	Mark Ijbema
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-11-13: <a href="entries/HRB-Slicing.html">Backing up Slicing: Verifying the Interprocedural Two-Phase Horwitz-Reps-Binkley Slicer</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-10-30: <a href="entries/WorkerWrapper.html">The Worker/Wrapper Transformation</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-09-01: <a href="entries/Ordinals_and_Cardinals.html">Ordinals and Cardinals</a>
	<br>
	Author:
	<a href="https://www.andreipopescu.uk">Andrei Popescu</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-08-28: <a href="entries/SequentInvertibility.html">Invertibility in Sequent Calculi</a>
	<br>
	Author:
	Peter Chapman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-08-04: <a href="entries/CofGroups.html">An Example of a Cofinitary Group in Isabelle/HOL</a>
	<br>
	Author:
	<a href="http://kasterma.net">Bart Kastermans</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-05-06: <a href="entries/FinFun.html">Code Generation for Functions as Data</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2009-04-29: <a href="entries/Stream-Fusion.html">Stream Fusion</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2008</td>
	</tr>
	<tr>
	<td class="entry">
	2008-12-12: <a href="entries/BytecodeLogicJmlTypes.html">A Bytecode Logic for JML and Types</a>
	<br>
	Authors:
	Lennart Beringer
	and <a href="http://www.tcs.informatik.uni-muenchen.de/~mhofmann">Martin Hofmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-11-10: <a href="entries/SIFPL.html">Secure information flow and program logics</a>
	<br>
	Authors:
	Lennart Beringer
	and <a href="http://www.tcs.informatik.uni-muenchen.de/~mhofmann">Martin Hofmann</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-11-09: <a href="entries/SenSocialChoice.html">Some classical results in Social Choice Theory</a>
	<br>
	Author:
	<a href="http://peteg.org">Peter Gammie</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-11-07: <a href="entries/FunWithTilings.html">Fun With Tilings</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and <a href="https://www.cl.cam.ac.uk/~lp15/">Lawrence C. Paulson</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-10-15: <a href="entries/Huffman.html">The Textbook Proof of Huffman's Algorithm</a>
	<br>
	Author:
	Jasmin Christian Blanchette
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-09-16: <a href="entries/Slicing.html">Towards Certified Slicing</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-09-02: <a href="entries/VolpanoSmith.html">A Correctness Proof for the Volpano/Smith Security Typing System</a>
	<br>
	Authors:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/gregor_snelting.php">Gregor Snelting</a>
	and <a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-09-01: <a href="entries/ArrowImpossibilityGS.html">Arrow and Gibbard-Satterthwaite</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-08-26: <a href="entries/FunWithFunctions.html">Fun With Functions</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-07-23: <a href="entries/SATSolverVerification.html">Formal Verification of Modern SAT Solvers</a>
	<br>
	Author:
	Filip Marić
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-04-05: <a href="entries/Recursion-Theory-I.html">Recursion Theory I</a>
	<br>
	Author:
	Michael Nedzelsky
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-02-29: <a href="entries/Simpl.html">A Sequential Imperative Programming Language Syntax, Semantics, Hoare Logics and Verification Environment</a>
	<br>
	Author:
	Norbert Schirmer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-02-29: <a href="entries/BDD.html">BDD Normalisation</a>
	<br>
	Authors:
	Veronika Ortner
	and Norbert Schirmer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-02-18: <a href="entries/NormByEval.html">Normalization by Evaluation</a>
	<br>
	Authors:
	<a href="http://www.linta.de/~aehlig/">Klaus Aehlig</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2008-01-11: <a href="entries/LinearQuantifierElim.html">Quantifier Elimination for Linear Arithmetic</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2007</td>
	</tr>
	<tr>
	<td class="entry">
	2007-12-14: <a href="entries/Program-Conflict-Analysis.html">Formalization of Conflict Analysis of Programs with Procedures, Thread Creation, and Monitors</a>
	<br>
	Authors:
	Peter Lammich
	and <a href="http://cs.uni-muenster.de/u/mmo/">Markus Müller-Olm</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-12-03: <a href="entries/JinjaThreads.html">Jinja with Threads</a>
	<br>
	Author:
	<a href="http://www.andreas-lochbihler.de">Andreas Lochbihler</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-11-06: <a href="entries/MuchAdoAboutTwo.html">Much Ado About Two</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~boehmes/">Sascha Böhme</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-12: <a href="entries/SumSquares.html">Sums of Two and Four Squares</a>
	<br>
	Author:
	Roelof Oosterhuis
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-12: <a href="entries/Fermat3_4.html">Fermat's Last Theorem for Exponents 3 and 4 and the Parametrisation of Pythagorean Triples</a>
	<br>
	Author:
	Roelof Oosterhuis
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-08: <a href="entries/Valuation.html">Fundamental Properties of Valuation Theory and Hensel's Lemma</a>
	<br>
	Author:
	Hidetsune Kobayashi
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-02: <a href="entries/POPLmark-deBruijn.html">POPLmark Challenge Via de Bruijn Indices</a>
	<br>
	Author:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2007-08-02: <a href="entries/FOL-Fitting.html">First-Order Logic According to Fitting</a>
	<br>
	Author:
	<a href="http://www.in.tum.de/~berghofe">Stefan Berghofer</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2006</td>
	</tr>
	<tr>
	<td class="entry">
	2006-09-09: <a href="entries/HotelKeyCards.html">Hotel Key Card System</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-08-08: <a href="entries/Abstract-Hoare-Logics.html">Abstract Hoare Logics</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-05-22: <a href="entries/Flyspeck-Tame.html">Flyspeck I: Tame Graphs</a>
	<br>
	Authors:
	Gertrud Bauer
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-05-15: <a href="entries/CoreC++.html">CoreC++</a>
	<br>
	Author:
	<a href="http://pp.info.uni-karlsruhe.de/personhp/daniel_wasserrab.php">Daniel Wasserrab</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-03-31: <a href="entries/FeatherweightJava.html">A Theory of Featherweight Java in Isabelle/HOL</a>
	<br>
	Authors:
	<a href="http://www.cs.cornell.edu/~jnfoster/">J. Nathan Foster</a>
	and <a href="http://research.microsoft.com/en-us/people/dimitris/">Dimitrios Vytiniotis</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-03-15: <a href="entries/ClockSynchInst.html">Instances of Schneider's generalized protocol of clock synchronization</a>
	<br>
	Author:
	<a href="http://www.cs.famaf.unc.edu.ar/~damian/">Damián Barsotti</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2006-03-14: <a href="entries/Cauchy.html">Cauchy's Mean Theorem and the Cauchy-Schwarz Inequality</a>
	<br>
	Author:
	Benjamin Porter
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2005</td>
	</tr>
	<tr>
	<td class="entry">
	2005-11-11: <a href="entries/Ordinal.html">Countable Ordinals</a>
	<br>
	Author:
	Brian Huffman
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-10-12: <a href="entries/FFT.html">Fast Fourier Transform</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~ballarin/">Clemens Ballarin</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-24: <a href="entries/GenClock.html">Formalization of a Generalized Protocol for Clock Synchronization</a>
	<br>
	Author:
	Alwen Tiu
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-22: <a href="entries/DiskPaxos.html">Proving the Correctness of Disk Paxos</a>
	<br>
	Authors:
	<a href="http://www.fceia.unr.edu.ar/~mauro/">Mauro Jaskelioff</a>
	and <a href="http://www.loria.fr/~merz">Stephan Merz</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-20: <a href="entries/JiveDataStoreModel.html">Jive Data and Store Model</a>
	<br>
	Authors:
	Nicole Rauch
	and Norbert Schirmer
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-06-01: <a href="entries/Jinja.html">Jinja is not Java</a>
	<br>
	Authors:
	<a href="http://www.cse.unsw.edu.au/~kleing/">Gerwin Klein</a>
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-05-02: <a href="entries/RSAPSS.html">SHA1, RSA, PSS and more</a>
	<br>
	Authors:
	Christina Lindenberg
	and Kai Wirt
	</td>
	</tr>
	<tr>
	<td class="entry">
	2005-04-21: <a href="entries/Category.html">Category Theory to Yoneda's Lemma</a>
	<br>
	Author:
	<a href="http://users.rsise.anu.edu.au/~okeefe/">Greg O'Keefe</a>
	</td>
	</tr>
	</tbody>
	</table>
	<p> </p>

	<table width="80%" class="entries">
	<tbody>
	<tr>
	<td class="head">2004</td>
	</tr>
	<tr>
	<td class="entry">
	2004-12-09: <a href="entries/FileRefinement.html">File Refinement</a>
	<br>
	Authors:
	<a href="http://www.mit.edu/~kkz/">Karen Zee</a>
	and <a href="http://lara.epfl.ch/~kuncak/">Viktor Kuncak</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-11-19: <a href="entries/Integration.html">Integration theory and random variables</a>
	<br>
	Author:
	<a href="http://www-lti.informatik.rwth-aachen.de/~richter/">Stefan Richter</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-09-28: <a href="entries/Verified-Prover.html">A Mechanically Verified, Efficient, Sound and Complete Theorem Prover For First Order Logic</a>
	<br>
	Author:
	Tom Ridge
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-09-20: <a href="entries/Ramsey-Infinite.html">Ramsey's theorem, infinitary version</a>
	<br>
	Author:
	Tom Ridge
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-09-20: <a href="entries/Completeness.html">Completeness theorem</a>
	<br>
	Authors:
	James Margetson
	and Tom Ridge
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-07-09: <a href="entries/Compiling-Exceptions-Correctly.html">Compiling Exceptions Correctly</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-06-24: <a href="entries/Depth-First-Search.html">Depth First Search</a>
	<br>
	Authors:
	Toshiaki Nishihara
	and Yasuhiko Minamide
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-05-18: <a href="entries/Group-Ring-Module.html">Groups, Rings and Modules</a>
	<br>
	Authors:
	Hidetsune Kobayashi,
	L. Chen
	and H. Murao
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-04-26: <a href="entries/Topology.html">Topology</a>
	<br>
	Author:
	Stefan Friedrich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-04-26: <a href="entries/Lazy-Lists-II.html">Lazy Lists II</a>
	<br>
	Author:
	Stefan Friedrich
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-04-05: <a href="entries/BinarySearchTree.html">Binary Search Trees</a>
	<br>
	Author:
	<a href="http://lara.epfl.ch/~kuncak/">Viktor Kuncak</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-03-30: <a href="entries/Functional-Automata.html">Functional Automata</a>
	<br>
	Author:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-03-19: <a href="entries/MiniML.html">Mini ML</a>
	<br>
	Authors:
	Wolfgang Naraschewski
	and <a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	</td>
	</tr>
	<tr>
	<td class="entry">
	2004-03-19: <a href="entries/AVL-Trees.html">AVL Trees</a>
	<br>
	Authors:
	<a href="http://www21.in.tum.de/~nipkow">Tobias Nipkow</a>
	and Cornelia Pusch
	</td>
	</tr>
	</tbody>
	</table>


	</div>
	</td>

	</tr>
	</tbody>
	</table>


	</body>
	</html>
	\ 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,614 +1,583 @@
	<?xml version="1.0" encoding="UTF-8" ?>
	<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom" xmlns:dc="http://purl.org/dc/elements/1.1/">
	<channel>
	<atom:link href="https://www.isa-afp.org/rss.xml" rel="self" type="application/rss+xml" />
	<title>Archive of Formal Proofs</title>
	<link>https://www.isa-afp.org</link>
	<description>
	The Archive of Formal Proofs is a collection of proof libraries, examples,
	and larger scientific developments, mechanically checked
	in the theorem prover Isabelle.
	</description>
	- <pubDate>17 Mar 2021 00:00:00 +0000</pubDate>
	+ <pubDate>30 Apr 2021 00:00:00 +0000</pubDate>
	+ <item>
	+ <title>Regression Test Selection</title>
	+ <link>https://www.isa-afp.org/entries/Regression_Test_Selection.html</link>
	+ <guid>https://www.isa-afp.org/entries/Regression_Test_Selection.html</guid>
	+ <dc:creator> Susannah Mansky </dc:creator>
	+ <pubDate>30 Apr 2021 00:00:00 +0000</pubDate>
	+ <description>
	+This development provides a general definition for safe Regression
	+Test Selection (RTS) algorithms. RTS algorithms select which tests to
	+rerun on revised code, reducing the time required to check for newly
	+introduced errors. An RTS algorithm is considered safe if and only if
	+all deselected tests would have unchanged results. This definition is
	+instantiated with two class-collection-based RTS algorithms run over
	+the JVM as modeled by JinjaDCI. This is achieved with a general
	+definition for Collection Semantics, small-step semantics instrumented
	+to collect information during execution. As the RTS definition
	+mandates safety, these instantiations include proofs of safety. This
	+work is described in Mansky and Gunter's LSFA 2020 paper and
	+Mansky's doctoral thesis (UIUC, 2020).</description>
	+ </item>
	+ <item>
	+ <title>Isabelle's Metalogic: Formalization and Proof Checker</title>
	+ <link>https://www.isa-afp.org/entries/Metalogic_ProofChecker.html</link>
	+ <guid>https://www.isa-afp.org/entries/Metalogic_ProofChecker.html</guid>
	+ <dc:creator> Tobias Nipkow, Simon Roßkopf </dc:creator>
	+ <pubDate>27 Apr 2021 00:00:00 +0000</pubDate>
	+ <description>
	+In this entry we formalize Isabelle's metalogic in Isabelle/HOL.
	+Furthermore, we define a language of proof terms and an executable
	+proof checker and prove its soundness wrt. the metalogic. The
	+formalization is intentionally kept close to the Isabelle
	+implementation(for example using de Brujin indices) to enable easy
	+integration of generated code with the Isabelle system without a
	+complicated translation layer. The formalization is described in our
	+<a href="https://arxiv.org/pdf/2104.12224.pdf">CADE 28 paper</a>.</description>
	+ </item>
	+ <item>
	+ <title>The BKR Decision Procedure for Univariate Real Arithmetic</title>
	+ <link>https://www.isa-afp.org/entries/BenOr_Kozen_Reif.html</link>
	+ <guid>https://www.isa-afp.org/entries/BenOr_Kozen_Reif.html</guid>
	+ <dc:creator> Katherine Cordwell, Yong Kiam Tan, André Platzer </dc:creator>
	+ <pubDate>24 Apr 2021 00:00:00 +0000</pubDate>
	+ <description>
	+We formalize the univariate case of Ben-Or, Kozen, and Reif's
	+decision procedure for first-order real arithmetic (the BKR
	+algorithm). We also formalize the univariate case of Renegar's
	+variation of the BKR algorithm. The two formalizations differ
	+mathematically in minor ways (that have significant impact on the
	+multivariate case), but are quite similar in proof structure. Both
	+rely on sign-determination (finding the set of consistent sign
	+assignments for a set of polynomials). The method used for
	+sign-determination is similar to Tarski's original quantifier
	+elimination algorithm (it stores key information in a matrix
	+equation), but with a reduction step to keep complexity low.</description>
	+ </item>
	+ <item>
	+ <title>Gale-Stewart Games</title>
	+ <link>https://www.isa-afp.org/entries/GaleStewart_Games.html</link>
	+ <guid>https://www.isa-afp.org/entries/GaleStewart_Games.html</guid>
	+ <dc:creator> Sebastiaan Joosten </dc:creator>
	+ <pubDate>23 Apr 2021 00:00:00 +0000</pubDate>
	+ <description>
	+This is a formalisation of the main result of Gale and Stewart from
	+1953, showing that closed finite games are determined. This property
	+is now known as the Gale Stewart Theorem. While the original paper
	+shows some additional theorems as well, we only formalize this main
	+result, but do so in a somewhat general way. We formalize games of a
	+fixed arbitrary length, including infinite length, using co-inductive
	+lists, and show that defensive strategies exist unless the other
	+player is winning. For closed games, defensive strategies are winning
	+for the closed player, proving that such games are determined. For
	+finite games, which are a special case in our formalisation, all games
	+are closed.</description>
	+ </item>
	+ <item>
	+ <title>Formalization of Timely Dataflow's Progress Tracking Protocol</title>
	+ <link>https://www.isa-afp.org/entries/Progress_Tracking.html</link>
	+ <guid>https://www.isa-afp.org/entries/Progress_Tracking.html</guid>
	+ <dc:creator> Matthias Brun, Sára Decova, Andrea Lattuada, Dmitriy Traytel </dc:creator>
	+ <pubDate>13 Apr 2021 00:00:00 +0000</pubDate>
	+ <description>
	+Large-scale stream processing systems often follow the dataflow
	+paradigm, which enforces a program structure that exposes a high
	+degree of parallelism. The Timely Dataflow distributed system supports
	+expressive cyclic dataflows for which it offers low-latency data- and
	+pipeline-parallel stream processing. To achieve high expressiveness
	+and performance, Timely Dataflow uses an intricate distributed
	+protocol for tracking the computation’s progress. We formalize this
	+progress tracking protocol and verify its safety. Our formalization is
	+described in detail in our forthcoming <a
	+href="https://traytel.bitbucket.io/papers/itp21-progress_tracking/safe.pdf">ITP'21
	+paper</a>.</description>
	+ </item>
	+ <item>
	+ <title>Information Flow Control via Dependency Tracking</title>
	+ <link>https://www.isa-afp.org/entries/IFC_Tracking.html</link>
	+ <guid>https://www.isa-afp.org/entries/IFC_Tracking.html</guid>
	+ <dc:creator> Benedikt Nordhoff </dc:creator>
	+ <pubDate>01 Apr 2021 00:00:00 +0000</pubDate>
	+ <description>
	+We provide a characterisation of how information is propagated by
	+program executions based on the tracking data and control dependencies
	+within executions themselves. The characterisation might be used for
	+deriving approximative safety properties to be targeted by static
	+analyses or checked at runtime. We utilise a simple yet versatile
	+control flow graph model as a program representation. As our model is
	+not assumed to be finite it can be instantiated for a broad class of
	+programs. The targeted security property is indistinguishable
	+security where executions produce sequences of observations and only
	+non-terminating executions are allowed to drop a tail of those. A
	+very crude approximation of our characterisation is slicing based on
	+program dependence graphs, which we use as a minimal example and
	+derive a corresponding soundness result. For further details and
	+applications refer to the authors upcoming dissertation.</description>
	+ </item>
	+ <item>
	+ <title>Grothendieck's Schemes in Algebraic Geometry</title>
	+ <link>https://www.isa-afp.org/entries/Grothendieck_Schemes.html</link>
	+ <guid>https://www.isa-afp.org/entries/Grothendieck_Schemes.html</guid>
	+ <dc:creator> Anthony Bordg, Lawrence Paulson, Wenda Li </dc:creator>
	+ <pubDate>29 Mar 2021 00:00:00 +0000</pubDate>
	+ <description>
	+We formalize mainstream structures in algebraic geometry culminating
	+in Grothendieck's schemes: presheaves of rings, sheaves of rings,
	+ringed spaces, locally ringed spaces, affine schemes and schemes. We
	+prove that the spectrum of a ring is a locally ringed space, hence an
	+affine scheme. Finally, we prove that any affine scheme is a scheme.</description>
	+ </item>
	+ <item>
	+ <title>Hensel's Lemma for the p-adic Integers</title>
	+ <link>https://www.isa-afp.org/entries/Padic_Ints.html</link>
	+ <guid>https://www.isa-afp.org/entries/Padic_Ints.html</guid>
	+ <dc:creator> Aaron Crighton </dc:creator>
	+ <pubDate>23 Mar 2021 00:00:00 +0000</pubDate>
	+ <description>
	+We formalize the ring of <em>p</em>-adic integers within the framework of the
	+HOL-Algebra library. The carrier of the ring is formalized as the
	+inverse limit of quotients of the integers by powers of a fixed prime
	+<em>p</em>. We define an integer-valued valuation, as well as an
	+extended-integer valued valuation which sends 0 to the infinite
	+element. Basic topological facts about the <em>p</em>-adic integers are
	+formalized, including completeness and sequential compactness. Taylor
	+expansions of polynomials over a commutative ring are defined,
	+culminating in the formalization of Hensel's Lemma based on a
	+proof due to Keith Conrad.</description>
	+ </item>
	<item>
	<title>Constructive Cryptography in HOL: the Communication Modeling Aspect</title>
	<link>https://www.isa-afp.org/entries/Constructive_Cryptography_CM.html</link>
	<guid>https://www.isa-afp.org/entries/Constructive_Cryptography_CM.html</guid>
	<dc:creator> Andreas Lochbihler, S. Reza Sefidgar </dc:creator>
	<pubDate>17 Mar 2021 00:00:00 +0000</pubDate>
	<description>
	Constructive Cryptography (CC) [<a
	href="https://conference.iiis.tsinghua.edu.cn/ICS2011/content/papers/14.html">ICS
	2011</a>, <a
	href="https://doi.org/10.1007/978-3-642-27375-9_3">TOSCA
	2011</a>, <a
	href="https://doi.org/10.1007/978-3-662-53641-4_1">TCC
	2016</a>] introduces an abstract approach to composable security
	statements that allows one to focus on a particular aspect of security
	proofs at a time. Instead of proving the properties of concrete
	systems, CC studies system classes, i.e., the shared behavior of
	similar systems, and their transformations. Modeling of systems
	communication plays a crucial role in composability and reusability of
	security statements; yet, this aspect has not been studied in any of
	the existing CC results. We extend our previous CC formalization
	[<a href="https://isa-afp.org/entries/Constructive_Cryptography.html">Constructive_Cryptography</a>,
	<a href="https://doi.org/10.1109/CSF.2019.00018">CSF
	2019</a>] with a new semantic domain called Fused Resource
	Templates (FRT) that abstracts over the systems communication patterns
	in CC proofs. This widens the scope of cryptography proof
	formalizations in the CryptHOL library [<a
	href="https://isa-afp.org/entries/CryptHOL.html">CryptHOL</a>,
	<a
	href="https://doi.org/10.1007/978-3-662-49498-1_20">ESOP
	2016</a>, <a
	href="https://doi.org/10.1007/s00145-019-09341-z">J
	Cryptol 2020</a>]. This formalization is described in <a
	href="http://www.andreas-lochbihler.de/pub/basin2021.pdf">Abstract
	Modeling of Systems Communication in Constructive Cryptography using
	CryptHOL</a>.</description>
	</item>
	<item>
	<title>Two algorithms based on modular arithmetic: lattice basis reduction and Hermite normal form computation</title>
	<link>https://www.isa-afp.org/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html</link>
	<guid>https://www.isa-afp.org/entries/Modular_arithmetic_LLL_and_HNF_algorithms.html</guid>
	<dc:creator> Ralph Bottesch, Jose Divasón, René Thiemann </dc:creator>
	<pubDate>12 Mar 2021 00:00:00 +0000</pubDate>
	<description>
	We verify two algorithms for which modular arithmetic plays an
	essential role: Storjohann's variant of the LLL lattice basis
	reduction algorithm and Kopparty's algorithm for computing the
	Hermite normal form of a matrix. To do this, we also formalize some
	facts about the modulo operation with symmetric range. Our
	implementations are based on the original papers, but are otherwise
	efficient. For basis reduction we formalize two versions: one that
	includes all of the optimizations/heuristics from Storjohann's
	paper, and one excluding a heuristic that we observed to often
	decrease efficiency. We also provide a fast, self-contained certifier
	for basis reduction, based on the efficient Hermite normal form
	algorithm.</description>
	</item>
	<item>
	<title>Quantum projective measurements and the CHSH inequality</title>
	<link>https://www.isa-afp.org/entries/Projective_Measurements.html</link>
	<guid>https://www.isa-afp.org/entries/Projective_Measurements.html</guid>
	<dc:creator> Mnacho Echenim </dc:creator>
	<pubDate>03 Mar 2021 00:00:00 +0000</pubDate>
	<description>
	This work contains a formalization of quantum projective measurements,
	also known as von Neumann measurements, which are based on elements of
	spectral theory. We also formalized the CHSH inequality, an inequality
	involving expectations in a probability space that is violated by
	quantum measurements, thus proving that quantum mechanics cannot be modeled with an underlying local hidden-variable theory.</description>
	</item>
	<item>
	<title>The Hermite–Lindemann–Weierstraß Transcendence Theorem</title>
	<link>https://www.isa-afp.org/entries/Hermite_Lindemann.html</link>
	<guid>https://www.isa-afp.org/entries/Hermite_Lindemann.html</guid>
	<dc:creator> Manuel Eberl </dc:creator>
	<pubDate>03 Mar 2021 00:00:00 +0000</pubDate>
	<description>
	<p>This article provides a formalisation of the
	Hermite-Lindemann-Weierstraß Theorem (also known as simply
	Hermite-Lindemann or Lindemann-Weierstraß). This theorem is one of the
	crowning achievements of 19th century number theory.</p>
	<p>The theorem states that if $\alpha_1, \ldots,
	\alpha_n\in\mathbb{C}$ are algebraic numbers that are linearly
	independent over $\mathbb{Z}$, then $e^{\alpha_1},\ldots,e^{\alpha_n}$
	are algebraically independent over $\mathbb{Q}$.</p>
	<p>Like the <a
	href="https://doi.org/10.1007/978-3-319-66107-0_5">previous
	formalisation in Coq by Bernard</a>, I proceeded by formalising
	<a
	href="https://doi.org/10.1017/CBO9780511565977">Baker's
	version of the theorem and proof</a> and then deriving the
	original one from that. Baker's version states that for any
	algebraic numbers $\beta_1, \ldots, \beta_n\in\mathbb{C}$ and distinct
	algebraic numbers $\alpha_i, \ldots, \alpha_n\in\mathbb{C}$, we have
	$\beta_1 e^{\alpha_1} + \ldots + \beta_n e^{\alpha_n} = 0$ if and only
	if all the $\beta_i$ are zero.</p> <p>This has a number of
	direct corollaries, e.g.:</p> <ul> <li>$e$ and $\pi$
	are transcendental</li> <li>$e^z$, $\sin z$, $\tan z$,
	etc. are transcendental for algebraic
	$z\in\mathbb{C}\setminus\{0\}$</li> <li>$\ln z$ is
	transcendental for algebraic $z\in\mathbb{C}\setminus\{0,
	1\}$</li> </ul></description>
	</item>
	<item>
	<title>Mereology</title>
	<link>https://www.isa-afp.org/entries/Mereology.html</link>
	<guid>https://www.isa-afp.org/entries/Mereology.html</guid>
	<dc:creator> Ben Blumson </dc:creator>
	<pubDate>01 Mar 2021 00:00:00 +0000</pubDate>
	<description>
	We use Isabelle/HOL to verify elementary theorems and alternative
	axiomatizations of classical extensional mereology.</description>
	</item>
	<item>
	<title>The Sunflower Lemma of Erdős and Rado</title>
	<link>https://www.isa-afp.org/entries/Sunflowers.html</link>
	<guid>https://www.isa-afp.org/entries/Sunflowers.html</guid>
	<dc:creator> René Thiemann </dc:creator>
	<pubDate>25 Feb 2021 00:00:00 +0000</pubDate>
	<description>
	We formally define sunflowers and provide a formalization of the
	sunflower lemma of Erd&odblac;s and Rado: whenever a set of
	size-<i>k</i>-sets has a larger cardinality than
	<i>(r - 1)<sup>k</sup> &middot; k!</i>,
	then it contains a sunflower of cardinality <i>r</i>.</description>
	</item>
	<item>
	<title>A Verified Imperative Implementation of B-Trees</title>
	<link>https://www.isa-afp.org/entries/BTree.html</link>
	<guid>https://www.isa-afp.org/entries/BTree.html</guid>
	<dc:creator> Niels Mündler </dc:creator>
	<pubDate>24 Feb 2021 00:00:00 +0000</pubDate>
	<description>
	In this work, we use the interactive theorem prover Isabelle/HOL to
	verify an imperative implementation of the classical B-tree data
	structure invented by Bayer and McCreight [ACM 1970]. The
	-implementation supports set membership and insertion queries with
	+implementation supports set membership, insertion and deletion queries with
	efficient binary search for intra-node navigation. This is
	accomplished by first specifying the structure abstractly in the
	functional modeling language HOL and proving functional correctness.
	Using manual refinement, we derive an imperative implementation in
	Imperative/HOL. We show the validity of this refinement using the
	separation logic utilities from the <a
	href="https://www.isa-afp.org/entries/Refine_Imperative_HOL.html">
	Isabelle Refinement Framework </a> . The code can be exported to
	-the programming languages SML and Scala. We examine the runtime of all
	+the programming languages SML, OCaml and Scala. We examine the runtime of all
	operations indirectly by reproducing results of the logarithmic
	relationship between height and the number of nodes. The results are
	discussed in greater detail in the corresponding <a
	href="https://mediatum.ub.tum.de/1596550">Bachelor's
	Thesis</a>.</description>
	</item>
	<item>
	<title>Formal Puiseux Series</title>
	<link>https://www.isa-afp.org/entries/Formal_Puiseux_Series.html</link>
	<guid>https://www.isa-afp.org/entries/Formal_Puiseux_Series.html</guid>
	<dc:creator> Manuel Eberl </dc:creator>
	<pubDate>17 Feb 2021 00:00:00 +0000</pubDate>
	<description>
	<p>Formal Puiseux series are generalisations of formal power
	series and formal Laurent series that also allow for fractional
	exponents. They have the following general form: \[\sum_{i=N}^\infty
	a_{i/d} X^{i/d}\] where <em>N</em> is an integer and
	<em>d</em> is a positive integer.</p> <p>This
	entry defines these series including their basic algebraic properties.
	Furthermore, it proves the Newton–Puiseux Theorem, namely that the
	Puiseux series over an algebraically closed field of characteristic 0
	are also algebraically closed.</p></description>
	</item>
	<item>
	<title>The Laws of Large Numbers</title>
	<link>https://www.isa-afp.org/entries/Laws_of_Large_Numbers.html</link>
	<guid>https://www.isa-afp.org/entries/Laws_of_Large_Numbers.html</guid>
	<dc:creator> Manuel Eberl </dc:creator>
	<pubDate>10 Feb 2021 00:00:00 +0000</pubDate>
	<description>
	<p>The Law of Large Numbers states that, informally, if one
	performs a random experiment $X$ many times and takes the average of
	the results, that average will be very close to the expected value
	$E[X]$.</p> <p> More formally, let
	$(X_i)_{i\in\mathbb{N}}$ be a sequence of independently identically
	distributed random variables whose expected value $E[X_1]$ exists.
	Denote the running average of $X_1, \ldots, X_n$ as $\overline{X}_n$.
	Then:</p> <ul> <li>The Weak Law of Large Numbers
	states that $\overline{X}_{n} \longrightarrow E[X_1]$ in probability
	for $n\to\infty$, i.e. $\mathcal{P}(\|\overline{X}_{n} - E[X_1]\| >
	\varepsilon) \longrightarrow 0$ as $n\to\infty$ for any $\varepsilon
	> 0$.</li> <li>The Strong Law of Large Numbers states
	that $\overline{X}_{n} \longrightarrow E[X_1]$ almost surely for
	$n\to\infty$, i.e. $\mathcal{P}(\overline{X}_{n} \longrightarrow
	E[X_1]) = 1$.</li> </ul> <p>In this entry, I
	formally prove the strong law and from it the weak law. The approach
	used for the proof of the strong law is a particularly quick and slick
	one based on ergodic theory, which was formalised by Gouëzel in
	another AFP entry.</p></description>
	</item>
	<item>
	<title>Tarski's Parallel Postulate implies the 5th Postulate of Euclid, the Postulate of Playfair and the original Parallel Postulate of Euclid</title>
	<link>https://www.isa-afp.org/entries/IsaGeoCoq.html</link>
	<guid>https://www.isa-afp.org/entries/IsaGeoCoq.html</guid>
	<dc:creator> Roland Coghetto </dc:creator>
	<pubDate>31 Jan 2021 00:00:00 +0000</pubDate>
	<description>
	<p>The <a href="https://geocoq.github.io/GeoCoq/">GeoCoq library</a> contains a formalization
	of geometry using the Coq proof assistant. It contains both proofs
	about the foundations of geometry and high-level proofs in the same
	style as in high school. We port a part of the GeoCoq
	2.4.0 library to Isabelle/HOL: more precisely,
	the files Chap02.v to Chap13_3.v, suma.v as well as the associated
	definitions and some useful files for the demonstration of certain
	parallel postulates. The synthetic approach of the demonstrations is directly
	inspired by those contained in GeoCoq. The names of the lemmas and
	theorems used are kept as far as possible as well as the definitions.
	</p>
	<p>It should be noted that T.J.M. Makarios has done
	<a href="https://www.isa-afp.org/entries/Tarskis_Geometry.html">some proofs in Tarski's Geometry</a>. It uses a definition that does not quite
	coincide with the definition used in Geocoq and here.
	Furthermore, corresponding definitions in the <a href="https://www.isa-afp.org/entries/Poincare_Disc.html">Poincaré Disc Model
	development</a> are not identical to those defined in GeoCoq.
	</p>
	<p>In the last part, it is
	formalized that, in the neutral/absolute space, the axiom of the
	parallels of Tarski's system implies the Playfair axiom, the 5th
	postulate of Euclid and Euclid's original parallel postulate. These
	proofs, which are not constructive, are directly inspired by Pierre
	Boutry, Charly Gries, Julien Narboux and Pascal Schreck.
	</p></description>
	</item>
	<item>
	<title>Solution to the xkcd Blue Eyes puzzle</title>
	<link>https://www.isa-afp.org/entries/Blue_Eyes.html</link>
	<guid>https://www.isa-afp.org/entries/Blue_Eyes.html</guid>
	<dc:creator> Jakub Kądziołka </dc:creator>
	<pubDate>30 Jan 2021 00:00:00 +0000</pubDate>
	<description>
	In a <a href="https://xkcd.com/blue_eyes.html">puzzle published by
	Randall Munroe</a>, perfect logicians forbidden
	from communicating are stranded on an island, and may only leave once
	they have figured out their own eye color. We present a method of
	modeling the behavior of perfect logicians and formalize a solution of
	the puzzle.</description>
	</item>
	<item>
	<title>Hood-Melville Queue</title>
	<link>https://www.isa-afp.org/entries/Hood_Melville_Queue.html</link>
	<guid>https://www.isa-afp.org/entries/Hood_Melville_Queue.html</guid>
	<dc:creator> Alejandro Gómez-Londoño </dc:creator>
	<pubDate>18 Jan 2021 00:00:00 +0000</pubDate>
	<description>
	This is a verified implementation of a constant time queue. The
	original design is due to <a
	href="https://doi.org/10.1016/0020-0190(81)90030-2">Hood
	and Melville</a>. This formalization follows the presentation in
	<em>Purely Functional Data Structures</em>by Okasaki.</description>
	</item>
	<item>
	<title>JinjaDCI: a Java semantics with dynamic class initialization</title>
	<link>https://www.isa-afp.org/entries/JinjaDCI.html</link>
	<guid>https://www.isa-afp.org/entries/JinjaDCI.html</guid>
	<dc:creator> Susannah Mansky </dc:creator>
	<pubDate>11 Jan 2021 00:00:00 +0000</pubDate>
	<description>
	We extend Jinja to include static fields, methods, and instructions,
	and dynamic class initialization, based on the Java SE 8
	specification. This includes extension of definitions and proofs. This
	work is partially described in Mansky and Gunter's paper at CPP
	2019 and Mansky's doctoral thesis (UIUC, 2020).</description>
	</item>
	<item>
	<title>Cofinality and the Delta System Lemma</title>
	<link>https://www.isa-afp.org/entries/Delta_System_Lemma.html</link>
	<guid>https://www.isa-afp.org/entries/Delta_System_Lemma.html</guid>
	<dc:creator> Pedro Sánchez Terraf </dc:creator>
	<pubDate>27 Dec 2020 00:00:00 +0000</pubDate>
	<description>
	We formalize the basic results on cofinality of linearly ordered sets
	and ordinals and Šanin’s Lemma for uncountable families of finite
	sets. This last result is used to prove the countable chain condition
	for Cohen posets. We work in the set theory framework of Isabelle/ZF,
	using the Axiom of Choice as needed.</description>
	</item>
	<item>
	<title>Topological semantics for paraconsistent and paracomplete logics</title>
	<link>https://www.isa-afp.org/entries/Topological_Semantics.html</link>
	<guid>https://www.isa-afp.org/entries/Topological_Semantics.html</guid>
	<dc:creator> David Fuenmayor </dc:creator>
	<pubDate>17 Dec 2020 00:00:00 +0000</pubDate>
	<description>
	We introduce a generalized topological semantics for paraconsistent
	and paracomplete logics by drawing upon early works on topological
	Boolean algebras (cf. works by Kuratowski, Zarycki, McKinsey &
	Tarski, etc.). In particular, this work exemplarily illustrates the
	shallow semantical embeddings approach (<a
	href="http://dx.doi.org/10.1007/s11787-012-0052-y">SSE</a>)
	employing the proof assistant Isabelle/HOL. By means of the SSE
	technique we can effectively harness theorem provers, model finders
	and 'hammers' for reasoning with quantified non-classical
	logics.</description>
	</item>
	<item>
	<title>Relational Minimum Spanning Tree Algorithms</title>
	<link>https://www.isa-afp.org/entries/Relational_Minimum_Spanning_Trees.html</link>
	<guid>https://www.isa-afp.org/entries/Relational_Minimum_Spanning_Trees.html</guid>
	<dc:creator> Walter Guttmann, Nicolas Robinson-O'Brien </dc:creator>
	<pubDate>08 Dec 2020 00:00:00 +0000</pubDate>
	<description>
	We verify the correctness of Prim's, Kruskal's and
	Borůvka's minimum spanning tree algorithms based on algebras for
	aggregation and minimisation.</description>
	</item>
	<item>
	<title>Inline Caching and Unboxing Optimization for Interpreters</title>
	<link>https://www.isa-afp.org/entries/Interpreter_Optimizations.html</link>
	<guid>https://www.isa-afp.org/entries/Interpreter_Optimizations.html</guid>
	<dc:creator> Martin Desharnais </dc:creator>
	<pubDate>07 Dec 2020 00:00:00 +0000</pubDate>
	<description>
	This Isabelle/HOL formalization builds on the
	<em>VeriComp</em> entry of the <em>Archive of Formal
	Proofs</em> to provide the following contributions: <ul>
	<li>an operational semantics for a realistic virtual machine
	(Std) for dynamically typed programming languages;</li>
	<li>the formalization of an inline caching optimization (Inca),
	a proof of bisimulation with (Std), and a compilation
	function;</li> <li>the formalization of an unboxing
	optimization (Ubx), a proof of bisimulation with (Inca), and a simple
	compilation function.</li> </ul> This formalization was
	described in the CPP 2021 paper <em>Towards Efficient and
	Verified Virtual Machines for Dynamic Languages</em></description>
	</item>
	<item>
	<title>The Relational Method with Message Anonymity for the Verification of Cryptographic Protocols</title>
	<link>https://www.isa-afp.org/entries/Relational_Method.html</link>
	<guid>https://www.isa-afp.org/entries/Relational_Method.html</guid>
	<dc:creator> Pasquale Noce </dc:creator>
	<pubDate>05 Dec 2020 00:00:00 +0000</pubDate>
	<description>
	This paper introduces a new method for the formal verification of
	cryptographic protocols, the relational method, derived from
	Paulson's inductive method by means of some enhancements aimed at
	streamlining formal definitions and proofs, specially for protocols
	using public key cryptography. Moreover, this paper proposes a method
	to formalize a further security property, message anonymity, in
	addition to message confidentiality and authenticity. The relational
	method, including message anonymity, is then applied to the
	verification of a sample authentication protocol, comprising Password
	Authenticated Connection Establishment (PACE) with Chip Authentication
	Mapping followed by the explicit verification of an additional
	password over the PACE secure channel.</description>
	</item>
	<item>
	<title>Isabelle Marries Dirac: a Library for Quantum Computation and Quantum Information</title>
	<link>https://www.isa-afp.org/entries/Isabelle_Marries_Dirac.html</link>
	<guid>https://www.isa-afp.org/entries/Isabelle_Marries_Dirac.html</guid>
	<dc:creator> Anthony Bordg, Hanna Lachnitt, Yijun He </dc:creator>
	<pubDate>22 Nov 2020 00:00:00 +0000</pubDate>
	<description>
	This work is an effort to formalise some quantum algorithms and
	results in quantum information theory. Formal methods being critical
	for the safety and security of algorithms and protocols, we foresee
	their widespread use for quantum computing in the future. We have
	developed a large library for quantum computing in Isabelle based on a
	matrix representation for quantum circuits, successfully formalising
	the no-cloning theorem, quantum teleportation, Deutsch's
	algorithm, the Deutsch-Jozsa algorithm and the quantum Prisoner's
	Dilemma.</description>
	</item>
	<item>
	<title>The HOL-CSP Refinement Toolkit</title>
	<link>https://www.isa-afp.org/entries/CSP_RefTK.html</link>
	<guid>https://www.isa-afp.org/entries/CSP_RefTK.html</guid>
	<dc:creator> Safouan Taha, Burkhart Wolff, Lina Ye </dc:creator>
	<pubDate>19 Nov 2020 00:00:00 +0000</pubDate>
	<description>
	We use a formal development for CSP, called HOL-CSP2.0, to analyse a
	family of refinement notions, comprising classic and new ones. This
	analysis enables to derive a number of properties that allow to deepen
	the understanding of these notions, in particular with respect to
	specification decomposition principles for the case of infinite sets
	of events. The established relations between the refinement relations
	help to clarify some obscure points in the CSP literature, but also
	provide a weapon for shorter refinement proofs. Furthermore, we
	provide a framework for state-normalisation allowing to formally
	reason on parameterised process architectures. As a result, we have a
	modern environment for formal proofs of concurrent systems that allow
	for the combination of general infinite processes with locally finite
	ones in a logically safe way. We demonstrate these
	verification-techniques for classical, generalised examples: The
	CopyBuffer for arbitrary data and the Dijkstra's Dining
	Philosopher Problem of arbitrary size.</description>
	</item>
	<item>
	<title>Verified SAT-Based AI Planning</title>
	<link>https://www.isa-afp.org/entries/Verified_SAT_Based_AI_Planning.html</link>
	<guid>https://www.isa-afp.org/entries/Verified_SAT_Based_AI_Planning.html</guid>
	<dc:creator> Mohammad Abdulaziz, Friedrich Kurz </dc:creator>
	<pubDate>29 Oct 2020 00:00:00 +0000</pubDate>
	<description>
	We present an executable formally verified SAT encoding of classical
	AI planning that is based on the encodings by Kautz and Selman and the
	one by Rintanen et al. The encoding was experimentally tested and
	shown to be usable for reasonably sized standard AI planning
	benchmarks. We also use it as a reference to test a state-of-the-art
	SAT-based planner, showing that it sometimes falsely claims that
	problems have no solutions of certain lengths. The formalisation in
	this submission was described in an independent publication.</description>
	</item>
	<item>
	<title>AI Planning Languages Semantics</title>
	<link>https://www.isa-afp.org/entries/AI_Planning_Languages_Semantics.html</link>
	<guid>https://www.isa-afp.org/entries/AI_Planning_Languages_Semantics.html</guid>
	<dc:creator> Mohammad Abdulaziz, Peter Lammich </dc:creator>
	<pubDate>29 Oct 2020 00:00:00 +0000</pubDate>
	<description>
	This is an Isabelle/HOL formalisation of the semantics of the
	multi-valued planning tasks language that is used by the planning
	system Fast-Downward, the STRIPS fragment of the Planning Domain
	Definition Language (PDDL), and the STRIPS soundness meta-theory
	developed by Vladimir Lifschitz. It also contains formally verified
	checkers for checking the well-formedness of problems specified in
	either language as well the correctness of potential solutions. The
	formalisation in this entry was described in an earlier publication.</description>
	</item>
	- <item>
	- <title>A Sound Type System for Physical Quantities, Units, and Measurements</title>
	- <link>https://www.isa-afp.org/entries/Physical_Quantities.html</link>
	- <guid>https://www.isa-afp.org/entries/Physical_Quantities.html</guid>
	- <dc:creator> Simon Foster, Burkhart Wolff </dc:creator>
	- <pubDate>20 Oct 2020 00:00:00 +0000</pubDate>
	- <description>
	-The present Isabelle theory builds a formal model for both the
	-International System of Quantities (ISQ) and the International System
	-of Units (SI), which are both fundamental for physics and engineering.
	-Both the ISQ and the SI are deeply integrated into Isabelle's
	-type system. Quantities are parameterised by dimension types, which
	-correspond to base vectors, and thus only quantities of the same
	-dimension can be equated. Since the underlying "algebra of
	-quantities" induces congruences on quantity and SI types,
	-specific tactic support is developed to capture these. Our
	-construction is validated by a test-set of known equivalences between
	-both quantities and SI units. Moreover, the presented theory can be
	-used for type-safe conversions between the SI system and others, like
	-the British Imperial System (BIS).</description>
	- </item>
	- <item>
	- <title>Finite Map Extras</title>
	- <link>https://www.isa-afp.org/entries/Finite-Map-Extras.html</link>
	- <guid>https://www.isa-afp.org/entries/Finite-Map-Extras.html</guid>
	- <dc:creator> Javier Díaz </dc:creator>
	- <pubDate>12 Oct 2020 00:00:00 +0000</pubDate>
	- <description>
	-This entry includes useful syntactic sugar, new operators and functions, and
	-their associated lemmas for finite maps which currently are not
	-present in the standard Finite_Map theory.</description>
	- </item>
	- <item>
	- <title>A Formal Model of the Safely Composable Document Object Model with Shadow Roots</title>
	- <link>https://www.isa-afp.org/entries/Shadow_SC_DOM.html</link>
	- <guid>https://www.isa-afp.org/entries/Shadow_SC_DOM.html</guid>
	- <dc:creator> Achim D. Brucker, Michael Herzberg </dc:creator>
	- <pubDate>28 Sep 2020 00:00:00 +0000</pubDate>
	- <description>
	-In this AFP entry, we extend our formalization of the safely
	-composable DOM with Shadow Roots. This is a proposal for Shadow Roots
	-with stricter safety guarantess than the standard compliant
	-formalization (see "Shadow DOM"). Shadow Roots are a recent
	-proposal of the web community to support a component-based development
	-approach for client-side web applications. Shadow roots are a
	-significant extension to the DOM standard and, as web standards are
	-condemned to be backward compatible, such extensions often result in
	-complex specification that may contain unwanted subtleties that can be
	-detected by a formalization. Our Isabelle/HOL formalization is, in
	-the sense of object-orientation, an extension of our formalization of
	-the core DOM and enjoys the same basic properties, i.e., it is
	-extensible, i.e., can be extended without the need of re-proving
	-already proven properties and executable, i.e., we can generate
	-executable code from our specification. We exploit the executability
	-to show that our formalization complies to the official standard of
	-the W3C, respectively, the WHATWG.</description>
	- </item>
	- <item>
	- <title>A Formal Model of the Document Object Model with Shadow Roots</title>
	- <link>https://www.isa-afp.org/entries/Shadow_DOM.html</link>
	- <guid>https://www.isa-afp.org/entries/Shadow_DOM.html</guid>
	- <dc:creator> Achim D. Brucker, Michael Herzberg </dc:creator>
	- <pubDate>28 Sep 2020 00:00:00 +0000</pubDate>
	- <description>
	-In this AFP entry, we extend our formalization of the core DOM with
	-Shadow Roots. Shadow roots are a recent proposal of the web community
	-to support a component-based development approach for client-side web
	-applications. Shadow roots are a significant extension to the DOM
	-standard and, as web standards are condemned to be backward
	-compatible, such extensions often result in complex specification that
	-may contain unwanted subtleties that can be detected by a
	-formalization. Our Isabelle/HOL formalization is, in the sense of
	-object-orientation, an extension of our formalization of the core DOM
	-and enjoys the same basic properties, i.e., it is extensible, i.e.,
	-can be extended without the need of re-proving already proven
	-properties and executable, i.e., we can generate executable code from
	-our specification. We exploit the executability to show that our
	-formalization complies to the official standard of the W3C,
	-respectively, the WHATWG.</description>
	- </item>
	- <item>
	- <title>A Formalization of Safely Composable Web Components</title>
	- <link>https://www.isa-afp.org/entries/SC_DOM_Components.html</link>
	- <guid>https://www.isa-afp.org/entries/SC_DOM_Components.html</guid>
	- <dc:creator> Achim D. Brucker, Michael Herzberg </dc:creator>
	- <pubDate>28 Sep 2020 00:00:00 +0000</pubDate>
	- <description>
	-While the (safely composable) DOM with shadow trees provide the
	-technical basis for defining web components, it does neither defines
	-the concept of web components nor specifies the safety properties that
	-web components should guarantee. Consequently, the standard also does
	-not discuss how or even if the methods for modifying the DOM respect
	-component boundaries. In AFP entry, we present a formally verified
	-model of safely composable web components and define safety properties
	-which ensure that different web components can only interact with each
	-other using well-defined interfaces. Moreover, our verification of the
	-application programming interface (API) of the DOM revealed numerous
	-invariants that implementations of the DOM API need to preserve to
	-ensure the integrity of components. In comparison to the strict
	-standard compliance formalization of Web Components in the AFP entry
	-"DOM_Components", the notion of components in this entry
	-(based on "SC_DOM" and "Shadow_SC_DOM") provides
	-much stronger safety guarantees.</description>
	- </item>
	- <item>
	- <title>A Formalization of Web Components</title>
	- <link>https://www.isa-afp.org/entries/DOM_Components.html</link>
	- <guid>https://www.isa-afp.org/entries/DOM_Components.html</guid>
	- <dc:creator> Achim D. Brucker, Michael Herzberg </dc:creator>
	- <pubDate>28 Sep 2020 00:00:00 +0000</pubDate>
	- <description>
	-While the DOM with shadow trees provide the technical basis for
	-defining web components, the DOM standard neither defines the concept
	-of web components nor specifies the safety properties that web
	-components should guarantee. Consequently, the standard also does not
	-discuss how or even if the methods for modifying the DOM respect
	-component boundaries. In AFP entry, we present a formally verified
	-model of web components and define safety properties which ensure that
	-different web components can only interact with each other using
	-well-defined interfaces. Moreover, our verification of the application
	-programming interface (API) of the DOM revealed numerous invariants
	-that implementations of the DOM API need to preserve to ensure the
	-integrity of components.</description>
	- </item>
	- <item>
	- <title>The Safely Composable DOM</title>
	- <link>https://www.isa-afp.org/entries/Core_SC_DOM.html</link>
	- <guid>https://www.isa-afp.org/entries/Core_SC_DOM.html</guid>
	- <dc:creator> Achim D. Brucker, Michael Herzberg </dc:creator>
	- <pubDate>28 Sep 2020 00:00:00 +0000</pubDate>
	- <description>
	-In this AFP entry, we formalize the core of the Safely Composable
	-Document Object Model (SC DOM). The SC DOM improve the standard DOM
	-(as formalized in the AFP entry "Core DOM") by strengthening
	-the tree boundaries set by shadow roots: in the SC DOM, the shadow
	-root is a sub-class of the document class (instead of a base class).
	-This modifications also results in changes to some API methods (e.g.,
	-getOwnerDocument) to return the nearest shadow root rather than the
	-document root. As a result, many API methods that, when called on a
	-node inside a shadow tree, would previously ``break out''
	-and return or modify nodes that are possibly outside the shadow tree,
	-now stay within its boundaries. This change in behavior makes programs
	-that operate on shadow trees more predictable for the developer and
	-allows them to make more assumptions about other code accessing the
	-DOM.</description>
	- </item>
	- <item>
	- <title>Syntax-Independent Logic Infrastructure</title>
	- <link>https://www.isa-afp.org/entries/Syntax_Independent_Logic.html</link>
	- <guid>https://www.isa-afp.org/entries/Syntax_Independent_Logic.html</guid>
	- <dc:creator> Andrei Popescu, Dmitriy Traytel </dc:creator>
	- <pubDate>16 Sep 2020 00:00:00 +0000</pubDate>
	- <description>
	-We formalize a notion of logic whose terms and formulas are kept
	-abstract. In particular, logical connectives, substitution, free
	-variables, and provability are not defined, but characterized by their
	-general properties as locale assumptions. Based on this abstract
	-characterization, we develop further reusable reasoning
	-infrastructure. For example, we define parallel substitution (along
	-with proving its characterizing theorems) from single-point
	-substitution. Similarly, we develop a natural deduction style proof
	-system starting from the abstract Hilbert-style one. These one-time
	-efforts benefit different concrete logics satisfying our locales'
	-assumptions. We instantiate the syntax-independent logic
	-infrastructure to Robinson arithmetic (also known as Q) in the AFP
	-entry <a
	-href="https://www.isa-afp.org/entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a>
	-and to hereditarily finite set theory in the AFP entries <a
	-href="https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	-and <a
	-href="https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>,
	-which are part of our formalization of G&ouml;del's
	-Incompleteness Theorems described in our CADE-27 paper <a
	-href="https://dx.doi.org/10.1007/978-3-030-29436-6_26">A
	-Formally Verified Abstract Account of Gödel's Incompleteness
	-Theorems</a>.</description>
	- </item>
	</channel>
	</rss>
	diff --git a/web/statistics.html b/web/statistics.html
	--- a/web/statistics.html
	+++ b/web/statistics.html
	@@ -1,302 +1,302 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">S</font>tatistics
	</h1>
	<p> </p>

	<table width="80%" class="descr">
	<tbody>
	<tr><td>
	<h2>Statistics</h2>

	<table>
	-<tr><td>Number of Articles:</td><td class="statsnumber">590</td></tr>
	-<tr><td>Number of Authors:</td><td class="statsnumber">376</td></tr>
	-<tr><td>Number of lemmas:</td><td class="statsnumber">~165,500</td></tr>
	-<tr><td>Lines of Code:</td><td class="statsnumber">~2,899,800</td></tr>
	+<tr><td>Number of Articles:</td><td class="statsnumber">598</td></tr>
	+<tr><td>Number of Authors:</td><td class="statsnumber">382</td></tr>
	+<tr><td>Number of lemmas:</td><td class="statsnumber">~169,100</td></tr>
	+<tr><td>Lines of Code:</td><td class="statsnumber">~2,959,200</td></tr>
	</table>
	<h4>Most used AFP articles:</h4>
	<table id="most_used">
	<tr>
	<th></th><th>Name</th><th>Used by ? articles</th>
	</tr>

	<tr><td>1.</td>

	<td><a href="entries/List-Index.html">List-Index</a></td>
	- <td>17</td>
	+ <td>18</td>
	</tr>
	<tr><td>2.</td>

	<td><a href="entries/Coinductive.html">Coinductive</a></td>
	<td>12</td>
	</tr>
	<td></td>
	<td><a href="entries/Collections.html">Collections</a></td>
	<td>12</td>
	</tr>
	<td></td>
	<td><a href="entries/Regular-Sets.html">Regular-Sets</a></td>
	<td>12</td>
	</tr>
	<td></td>
	<td><a href="entries/Show.html">Show</a></td>
	<td>12</td>
	</tr>
	<tr><td>3.</td>

	<td><a href="entries/Landau_Symbols.html">Landau_Symbols</a></td>
	<td>11</td>
	</tr>
	<tr><td>4.</td>

	<td><a href="entries/Jordan_Normal_Form.html">Jordan_Normal_Form</a></td>
	<td>10</td>
	</tr>
	<td></td>
	<td><a href="entries/Polynomial_Factorization.html">Polynomial_Factorization</a></td>
	<td>10</td>
	</tr>
	<tr><td>5.</td>

	<td><a href="entries/Abstract-Rewriting.html">Abstract-Rewriting</a></td>
	<td>9</td>
	</tr>
	<td></td>
	<td><a href="entries/Automatic_Refinement.html">Automatic_Refinement</a></td>
	<td>9</td>
	</tr>
	<td></td>
	<td><a href="entries/Deriving.html">Deriving</a></td>
	<td>9</td>
	</tr>

	</table>
	<script>
	// DATA
	var years = [2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021];
	-var no_articles = [14, 22, 29, 37, 52, 64, 86, 103, 128, 151, 208, 253, 326, 396, 455, 511, 577, 590];
	-var no_loc = [60900.0, 96700.0, 131300.0, 238700.0, 353600.0, 435800.0, 517000.0, 568000.0, 740400.0, 827700.0, 1038000.0, 1218800.0, 1597200.0, 1849700.0, 2121500.0, 2421400.0, 2801000.0, 2899800.0 ];
	-var no_authors = [14, 11, 6, 6, 10, 6, 24, 11, 17, 16, 36, 20, 63, 31, 28, 39, 33, 5];
	-var no_authors_series = [14, 25, 31, 37, 47, 53, 77, 88, 105, 121, 157, 177, 240, 271, 299, 338, 371, 376];
	-var all_articles = [ "MiniML","AVL-Trees","Functional-Automata","BinarySearchTree","Lazy-Lists-II","Topology","Group-Ring-Module","Depth-First-Search","Compiling-Exceptions-Correctly","Completeness","Ramsey-Infinite","Verified-Prover","Integration","FileRefinement","Category","RSAPSS","Jinja","JiveDataStoreModel","DiskPaxos","GenClock","FFT","Ordinal","Cauchy","ClockSynchInst","FeatherweightJava","CoreC++","Flyspeck-Tame","Abstract-Hoare-Logics","HotelKeyCards","FOL-Fitting","POPLmark-deBruijn","Valuation","SumSquares","Fermat3_4","MuchAdoAboutTwo","JinjaThreads","Program-Conflict-Analysis","LinearQuantifierElim","NormByEval","Simpl","BDD","Recursion-Theory-I","SATSolverVerification","FunWithFunctions","ArrowImpossibilityGS","VolpanoSmith","Slicing","Huffman","FunWithTilings","SenSocialChoice","SIFPL","BytecodeLogicJmlTypes","Stream-Fusion","FinFun","CofGroups","SequentInvertibility","Ordinals_and_Cardinals","WorkerWrapper","HRB-Slicing","Perfect-Number-Thm","Collections","Tree-Automata","Presburger-Automata","DPT-SAT-Solver","Coinductive","List-Index","InformationFlowSlicing","InformationFlowSlicing_Inter","Free-Boolean-Algebra","Locally-Nameless-Sigma","Regular-Sets","Robbins-Conjecture","DataRefinementIBP","GraphMarkingIBP","Abstract-Rewriting","Matrix","Category2","Free-Groups","Statecharts","Polynomials","Lam-ml-Normalization","Binomial-Queues","Binomial-Heaps","Finger-Trees","Shivers-CFA","Marriage","Lower_Semicontinuous","RIPEMD-160-SPARK","LightweightJava","List-Infinite","AutoFocus-Stream","Nat-Interval-Logic","Transitive-Closure","General-Triangle","KBPs","Max-Card-Matching","Gauss-Jordan-Elim-Fun","Myhill-Nerode","LatticeProperties","MonoBoolTranAlgebra","PseudoHoops","Efficient-Mergesort","TLA","Markov_Models","Dijkstra_Shortest_Path","Refine_Monadic","Girth_Chromatic","Transitive-Closure-II","Abortable_Linearizable_Modules","Well_Quasi_Orders","Ordinary_Differential_Equations","Inductive_Confidentiality","Stuttering_Equivalence","Separation_Algebra","Circus","Psi_Calculi","CCS","Pi_Calculus","Tycon","PCF","Heard_Of","Impossible_Geometry","Datatype_Order_Generator","Possibilistic_Noninterference","Bondy","Tarskis_Geometry","Open_Induction","Separation_Logic_Imperative_HOL","Sqrt_Babylonian","Kleene_Algebra","Rank_Nullity_Theorem","Ribbon_Proofs","Launchbury","Nominal2","Containers","Graph_Theory","ShortestPath","Sort_Encodings","Koenigsberg_Friendship","Lehmer","Pratt_Certificate","IEEE_Floating_Point","Native_Word","Automatic_Refinement","Decreasing-Diagrams","GoedelGod","FocusStreamsCaseStudies","Coinductive_Languages","Incompleteness","HereditarilyFinite","Tail_Recursive_Functions","CryptoBasedCompositionalProperties","Sturm_Sequences","Featherweight_OCL","KAT_and_DRA","Relation_Algebra","Secondary_Sylow","Regex_Equivalence","Real_Impl","Affine_Arithmetic","Selection_Heap_Sort","Random_Graph_Subgraph_Threshold","Partial_Function_MR","AWN","Probabilistic_Noninterference","GPU_Kernel_PL","Discrete_Summation","HyperCTL","Abstract_Completeness","Bounded_Deducibility_Security","SIFUM_Type_Systems","WHATandWHERE_Security","Strong_Security","ComponentDependencies","Regular_Algebras","Noninterference_CSP","Roy_Floyd_Warshall","Gabow_SCC","CAVA_Automata","CAVA_LTL_Modelchecker","LTL_to_GBA","Promela","Boolean_Expression_Checkers","MSO_Regex_Equivalence","Pop_Refinement","Network_Security_Policy_Verification","Amortized_Complexity","pGCL","CISC-Kernel","Show","Splay_Tree","Skew_Heap","VectorSpace","Special_Function_Bounds","Gauss_Jordan","Priority_Queue_Braun","Jordan_Hoelder","Cayley_Hamilton","Sturm_Tarski","Imperative_Insertion_Sort","Certification_Monads","XML","RefinementReactive","Density_Compiler","Stream_Fusion_Code","Lifting_Definition_Option","AODV","UPF","UpDown_Scheme","Finite_Automata_HF","QR_Decomposition","Echelon_Form","Call_Arity","Deriving","Consensus_Refined","Trie","ConcurrentIMP","ConcurrentGC","Residuated_Lattices","Vickrey_Clarke_Groves","Probabilistic_System_Zoo","Formula_Derivatives","Dynamic_Tables","Noninterference_Ipurge_Unwinding","Noninterference_Generic_Unwinding","List_Interleaving","Multirelations","Derangements","Hermite","Akra_Bazzi","Landau_Symbols","Case_Labeling","Encodability_Process_Calculi","Rep_Fin_Groups","Noninterference_Inductive_Unwinding","Decreasing-Diagrams-II","Jordan_Normal_Form","LTL_to_DRA","Isabelle_Meta_Model","Parity_Game","Planarity_Certificates","TortoiseHare","Euler_Partition","Ergodic_Theory","Latin_Square","Card_Partitions","Applicative_Lifting","Algebraic_Numbers","Stern_Brocot","Liouville_Numbers","Triangle","Prime_Harmonic_Series","Descartes_Sign_Rule","Card_Number_Partitions","Matrix_Tensor","Knot_Theory","Polynomial_Factorization","Polynomial_Interpolation","Formal_SSA","List_Update","LTL","Cartan_FP","Timed_Automata","PropResPI","KAD","Noninterference_Sequential_Composition","ROBDD","CYK","No_FTL_observers","Groebner_Bases","Bell_Numbers_Spivey","SDS_Impossibility","Randomised_Social_Choice","MFMC_Countable","FLP","Perron_Frobenius","Incredible_Proof_Machine","Posix-Lexing","Card_Equiv_Relations","Tree_Decomposition","Word_Lib","Noninterference_Concurrent_Composition","Algebraic_VCs","Catalan_Numbers","Dependent_SIFUM_Type_Systems","Card_Multisets","Category3","Dependent_SIFUM_Refinement","IP_Addresses","Rewriting_Z","Resolution_FOL","Buildings","DFS_Framework","Pairing_Heap","Surprise_Paradox","Ptolemys_Theorem","Refine_Imperative_HOL","EdmondsKarp_Maxflow","InfPathElimination","Simple_Firewall","Routing","Stirling_Formula","Stone_Algebras","SuperCalc","Iptables_Semantics","Lambda_Free_RPOs","Allen_Calculus","Fisher_Yates","Lp","Chord_Segments","Berlekamp_Zassenhaus","Source_Coding_Theorem","SPARCv8","LOFT","Stable_Matching","Modal_Logics_for_NTS","Deep_Learning","Lambda_Free_KBOs","Nested_Multisets_Ordinals","Separata","Abs_Int_ITP2012","Complx","Paraconsistency","Proof_Strategy_Language","Twelvefold_Way","Concurrent_Ref_Alg","FOL_Harrison","Password_Authentication_Protocol","UPF_Firewall","E_Transcendental","Bertrands_Postulate","Minimal_SSA","Bernoulli","Key_Agreement_Strong_Adversaries","Stone_Relation_Algebras","Abstract_Soundness","Differential_Dynamic_Logic","Menger","Elliptic_Curves_Group_Law","Euler_MacLaurin","Quick_Sort_Cost","Comparison_Sort_Lower_Bound","Random_BSTs","Subresultants","Lazy_Case","Constructor_Funs","LocalLexing","Types_Tableaus_and_Goedels_God","MonoidalCategory","Game_Based_Crypto","Monomorphic_Monad","Probabilistic_While","Monad_Normalisation","CryptHOL","Floyd_Warshall","Security_Protocol_Refinement","Dict_Construction","Optics","Flow_Networks","Prpu_Maxflow","Buffons_Needle","PSemigroupsConvolution","Propositional_Proof_Systems","Stone_Kleene_Relation_Algebras","CRDT","Name_Carrying_Type_Inference","Minkowskis_Theorem","HOLCF-Prelude","Decl_Sem_Fun_PL","DynamicArchitectures","Stewart_Apollonius","LambdaMu","Orbit_Stabiliser","Root_Balanced_Tree","First_Welfare_Theorem","AnselmGod","PLM","Lowe_Ontological_Argument","Dirichlet_Series","Zeta_Function","Linear_Recurrences","Diophantine_Eqns_Lin_Hom","Winding_Number_Eval","Count_Complex_Roots","Buchi_Complementation","Transition_Systems_and_Automata","Kuratowski_Closure_Complement","Hybrid_Multi_Lane_Spatial_Logic","IMAP-CRDT","Stochastic_Matrices","Knuth_Morris_Pratt","BNF_Operations","Dirichlet_L","Mason_Stothers","Median_Of_Medians_Selection","Falling_Factorial_Sum","Taylor_Models","Green","Gromov_Hyperbolicity","Ordered_Resolution_Prover","LLL_Basis_Reduction","Treaps","First_Order_Terms","Error_Function","LLL_Factorization","Hoare_Time","Architectural_Design_Patterns","CakeML","Weight_Balanced_Trees","Fishburn_Impossibility","BNF_CC","VerifyThis2018","WebAssembly","Modular_Assembly_Kit_Security","OpSets","Monad_Memo_DP","AxiomaticCategoryTheory","Irrationality_J_Hancl","Probabilistic_Timed_Automata","Hidden_Markov_Models","Optimal_BST","Partial_Order_Reduction","Projective_Geometry","Localization_Ring","Pell","Neumann_Morgenstern_Utility","DiscretePricing","Minsky_Machines","Simplex","Budan_Fourier","Quaternions","Octonions","Aggregation_Algebras","Prime_Number_Theorem","Signature_Groebner","Symmetric_Polynomials","Pi_Transcendental","Factored_Transition_System_Bounding","Randomised_BSTs","Lambda_Free_EPO","Smooth_Manifolds","Epistemic_Logic","GewirthPGCProof","Generic_Deriving","Matroids","Auto2_HOL","Functional_Ordered_Resolution_Prover","Graph_Saturation","Transformer_Semantics","Order_Lattice_Props","Quantales","Constructive_Cryptography","Auto2_Imperative_HOL","Concurrent_Revisions","Core_DOM","Store_Buffer_Reduction","Higher_Order_Terms","IMP2","Farkas","List_Inversions","UTP","Universal_Turing_Machine","Probabilistic_Prime_Tests","Kruskal","Prime_Distribution_Elementary","Safe_OCL","QHLProver","Transcendence_Series_Hancl_Rucki","Binding_Syntax_Theory","LTL_Master_Theorem","HOL-CSP","Multi_Party_Computation","LambdaAuth","KD_Tree","Differential_Game_Logic","IMP2_Binary_Heap","Groebner_Macaulay","Nullstellensatz","Linear_Inequalities","Priority_Search_Trees","Prim_Dijkstra_Simple","Complete_Non_Orders","MFOTL_Monitor","CakeML_Codegen","FOL_Seq_Calc1","Szpilrajn","TESL_Language","Stellar_Quorums","IMO2019","C2KA_DistributedSystems","Linear_Programming","Laplace_Transform","Adaptive_State_Counting","Jacobson_Basic_Algebra","Fourier","Hybrid_Systems_VCs","Generic_Join","Clean","Sigma_Commit_Crypto","Aristotles_Assertoric_Syllogistic","VerifyThis2019","Isabelle_C","ZFC_in_HOL","Interval_Arithmetic_Word32","Generalized_Counting_Sort","Gauss_Sums","Poincare_Disc","Complex_Geometry","Poincare_Bendixson","Hybrid_Logic","Zeta_3_Irrational","Bicategory","Skip_Lists","Closest_Pair_Points","Approximation_Algorithms","Mersenne_Primes","Subset_Boolean_Algebras","Arith_Prog_Rel_Primes","VeriComp","Goodstein_Lambda","Hello_World","Relational-Incorrectness-Logic","Furstenberg_Topology","WOOT_Strong_Eventual_Consistency","Lucas_Theorem","Automated_Stateful_Protocol_Verification","Stateful_Protocol_Composition_and_Typing","MFODL_Monitor_Optimized","Saturation_Framework","Sliding_Window_Algorithm","ADS_Functor","Matrices_for_ODEs","Power_Sum_Polynomials","Lambert_W","Gaussian_Integers","Attack_Trees","Banach_Steinhaus","Forcing","LTL_Normal_Form","Recursion-Addition","Irrational_Series_Erdos_Straus","Knuth_Bendix_Order","Nash_Williams","Smith_Normal_Form","Safe_Distance","Relational_Paths","Chandy_Lamport","Ordinal_Partitions","Amicable_Numbers","BirdKMP","Saturation_Framework_Extensions","Relational_Disjoint_Set_Forests","PAC_Checker","Inductive_Inference","Extended_Finite_State_Machine_Inference","Extended_Finite_State_Machines","Goedel_HFSet_Semanticless","Syntax_Independent_Logic","Goedel_HFSet_Semantic","Goedel_Incompleteness","Robinson_Arithmetic","Shadow_SC_DOM","Shadow_DOM","DOM_Components","Core_SC_DOM","SC_DOM_Components","Finite-Map-Extras","Physical_Quantities","Verified_SAT_Based_AI_Planning","AI_Planning_Languages_Semantics","CSP_RefTK","Isabelle_Marries_Dirac","Relational_Method","Interpreter_Optimizations","Relational_Minimum_Spanning_Trees","Topological_Semantics","Delta_System_Lemma","JinjaDCI","Hood_Melville_Queue","Blue_Eyes","IsaGeoCoq","Laws_of_Large_Numbers","Formal_Puiseux_Series","BTree","Sunflowers","Mereology","Projective_Measurements","Hermite_Lindemann","Modular_arithmetic_LLL_and_HNF_algorithms","Constructive_Cryptography_CM"];
	-var years_loc_articles = [ 2004 , , , , , , , , , , , , , ,2005 , , , , , , , ,2006 , , , , , , ,2007 , , , , , , , ,2008 , , , , , , , , , , , , , , ,2009 , , , , , , , , , , , ,2010 , , , , , , , , , , , , , , , , , , , , , ,2011 , , , , , , , , , , , , , , , , ,2012 , , , , , , , , , , , , , , , , , , , , , , , , ,2013 , , , , , , , , , , , , , , , , , , , , , , ,2014 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2015 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2016 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2017 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2018 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2019 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2020 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2021 , , , , , , , , , , , ,];
	-var loc_articles = [ "1798","839","1544","1096","1058","2419","44195","205","142","1984","209","1110","3792","506","1141","3769","17206","3119","6430","1145","447","2537","1275","1583","1838","12832","13120","2685","1228","3556","4238","9647","970","2847","1740","79749","4738","3396","2185","31122","10664","6723","30332","180","793","1047","14413","2080","254","2221","5959","3463","799","1540","684","6654","8","2627","27490","264","32553","5025","4380","208","9533","447","2380","3399","611","6311","2042","840","713","1024","5632","1427","4078","2230","6002","22620","1602","1587","3370","2451","2591","260","1617","16","2937","7805","6557","6381","992","125","10134","332","235","1828","999","1784","4420","434","4461","11857","2835","8583","1043","408","2940","2613","38078","3243","1480","2612","3141","27588","2580","25274","2266","4107","7701","1245","260","5309","73","9729","719","6673","1512","4355","1249","1908","6214","4979","10110","7257","538","3830","4591","202","848","1777","5509","10319","1524","150","5292","706","10776","2248","1463","1958","3067","11485","1860","1190","1219","2175","1144","14848","2212","1964","166","10685","6420","572","590","1698","465","883","4133","2138","1403","2280","1959","2467","220","5430","4433","9390","3999","4463","406","5935","1829","12828","3214","9486","4560","931","659","63","2338","1653","9143","753","2113","875","1727","627","931","1201","1296","7880","1922","90","28055","2879","2796","1116","4863","5259","8842","1356","6178","527","2606","6658","1782","5327","1085","4103","952","2446","1089","1064","2362","471","2074","3761","2148","710","16080","8267","908","1063","21109","9679","8659","3142","9162","695","435","13984","478","898","2724","10647","1162","401","498","495","741","838","3622","4616","6284","4102","8166","12108","3178","518","17583","2876","2418","5496","2453","885","1162","17388","509","702","5036","10363","4287","5332","3811","656","329","1057","14151","3257","2593","553","8478","206","25451","8773","3275","398","2960","12822","9483","370","173","384","18974","2545","6119","3777","1017","2608","4341","9356","20042","4052","3419","319","3208","169","19413","541","14634","2651","7058","7590","3898","3244","4704","855","2289","5020","1349","276","4339","1475","3482","7119","9662","601","1722","852","2194","12222","4173","590","13558","1695","4484","1640","835","694","737","3346","105","68","10492","1127","8513","4135","4711","1200","378","11280","2078","14059","639","2283","3930","4869","468","1531","5554","5665","1993","4205","478","4121","3146","3471","88","480","1261","1877","2193","250","10669","854","7463","5301","3083","2784","8844","5261","2324","6164","945","6514","992","489","810","8891","3133","338","854","493","4585","9457","15962","6327","10343","1819","2288","785","3260","8438","3278","12959","592","841","3383","3638","11570","13548","3734","6597","530","965","7674","1042","1221","5297","2754","1390","1622","2173","13358","805","10027","2667","541","1271","2668","5318","9772","2765","934","11918","1743","2355","7917","1385","449","685","1811","1132","3540","3578","1644","2983","2218","5182","4968","2767","17369","34365","3204","6022","1900","374","10305","16866","3018","3298","5304","4576","10485","986","15843","4437","9487","5543","3301","1264","2973","805","10235","2606","5262","472","3365","3603","3199","13339","951","778","4455","527","713","782","2335","2134","9936","2090","3736","5752","2350","3195","3809","176","1726","8509","6894","5069","5730","4561","10292","14118","6402","4470","1907","67700","2355","3936","3086","1699","3154","944","1033","596","370","691","764","2564","332","14517","21776","10948","3059","744","2353","1559","1239","1609","2537","1939","1337","11999","1034","1444","1902","2670","815","12972","3028","5074","9795","6625","1261","2908","1929","2074","9008","12872","4265","4741","11477","8100","426","3546","1295","15453","12763","3523","16385","7798","648","1761","16434","1967","2359","7700","3752","4280","4556","2826","3295","25018","745","363","26525","290","2582","4265","615","4039","4959","3891","17064","8475"];
	+var no_articles = [14, 22, 29, 37, 52, 64, 86, 103, 128, 151, 208, 253, 326, 396, 455, 511, 577, 598];
	+var no_loc = [60900.0, 96700.0, 131300.0, 238700.0, 353600.0, 435800.0, 517000.0, 568000.0, 740400.0, 827800.0, 1038100.0, 1218900.0, 1597200.0, 1849700.0, 2121500.0, 2421400.0, 2800800.0, 2959200.0 ];
	+var no_authors = [14, 11, 6, 6, 10, 6, 24, 11, 17, 16, 36, 20, 63, 31, 28, 39, 33, 11];
	+var no_authors_series = [14, 25, 31, 37, 47, 53, 77, 88, 105, 121, 157, 177, 240, 271, 299, 338, 371, 382];
	+var all_articles = [ "MiniML","AVL-Trees","Functional-Automata","BinarySearchTree","Lazy-Lists-II","Topology","Group-Ring-Module","Depth-First-Search","Compiling-Exceptions-Correctly","Completeness","Ramsey-Infinite","Verified-Prover","Integration","FileRefinement","Category","RSAPSS","Jinja","JiveDataStoreModel","DiskPaxos","GenClock","FFT","Ordinal","Cauchy","ClockSynchInst","FeatherweightJava","CoreC++","Flyspeck-Tame","Abstract-Hoare-Logics","HotelKeyCards","FOL-Fitting","POPLmark-deBruijn","Valuation","SumSquares","Fermat3_4","MuchAdoAboutTwo","JinjaThreads","Program-Conflict-Analysis","LinearQuantifierElim","NormByEval","Simpl","BDD","Recursion-Theory-I","SATSolverVerification","FunWithFunctions","ArrowImpossibilityGS","VolpanoSmith","Slicing","Huffman","FunWithTilings","SenSocialChoice","SIFPL","BytecodeLogicJmlTypes","Stream-Fusion","FinFun","CofGroups","SequentInvertibility","Ordinals_and_Cardinals","WorkerWrapper","HRB-Slicing","Perfect-Number-Thm","Collections","Tree-Automata","Presburger-Automata","DPT-SAT-Solver","Coinductive","List-Index","InformationFlowSlicing","InformationFlowSlicing_Inter","Free-Boolean-Algebra","Locally-Nameless-Sigma","Regular-Sets","Robbins-Conjecture","DataRefinementIBP","GraphMarkingIBP","Abstract-Rewriting","Matrix","Category2","Free-Groups","Statecharts","Polynomials","Lam-ml-Normalization","Binomial-Queues","Binomial-Heaps","Finger-Trees","Shivers-CFA","Marriage","Lower_Semicontinuous","RIPEMD-160-SPARK","LightweightJava","List-Infinite","AutoFocus-Stream","Nat-Interval-Logic","Transitive-Closure","General-Triangle","KBPs","Max-Card-Matching","Gauss-Jordan-Elim-Fun","Myhill-Nerode","LatticeProperties","MonoBoolTranAlgebra","PseudoHoops","Efficient-Mergesort","TLA","Markov_Models","Dijkstra_Shortest_Path","Refine_Monadic","Girth_Chromatic","Transitive-Closure-II","Abortable_Linearizable_Modules","Well_Quasi_Orders","Ordinary_Differential_Equations","Inductive_Confidentiality","Stuttering_Equivalence","Separation_Algebra","Circus","Psi_Calculi","CCS","Pi_Calculus","Tycon","PCF","Heard_Of","Impossible_Geometry","Datatype_Order_Generator","Possibilistic_Noninterference","Bondy","Tarskis_Geometry","Open_Induction","Separation_Logic_Imperative_HOL","Sqrt_Babylonian","Kleene_Algebra","Rank_Nullity_Theorem","Ribbon_Proofs","Launchbury","Nominal2","Containers","Graph_Theory","ShortestPath","Sort_Encodings","Koenigsberg_Friendship","Lehmer","Pratt_Certificate","IEEE_Floating_Point","Native_Word","Automatic_Refinement","Decreasing-Diagrams","GoedelGod","FocusStreamsCaseStudies","Coinductive_Languages","Incompleteness","HereditarilyFinite","Tail_Recursive_Functions","CryptoBasedCompositionalProperties","Sturm_Sequences","Featherweight_OCL","KAT_and_DRA","Relation_Algebra","Secondary_Sylow","Regex_Equivalence","Real_Impl","Affine_Arithmetic","Selection_Heap_Sort","Random_Graph_Subgraph_Threshold","Partial_Function_MR","AWN","Probabilistic_Noninterference","GPU_Kernel_PL","Discrete_Summation","HyperCTL","Abstract_Completeness","Bounded_Deducibility_Security","SIFUM_Type_Systems","WHATandWHERE_Security","Strong_Security","ComponentDependencies","Regular_Algebras","Noninterference_CSP","Roy_Floyd_Warshall","Gabow_SCC","CAVA_Automata","CAVA_LTL_Modelchecker","LTL_to_GBA","Promela","Boolean_Expression_Checkers","MSO_Regex_Equivalence","Pop_Refinement","Network_Security_Policy_Verification","Amortized_Complexity","pGCL","CISC-Kernel","Show","Splay_Tree","Skew_Heap","VectorSpace","Special_Function_Bounds","Gauss_Jordan","Priority_Queue_Braun","Jordan_Hoelder","Cayley_Hamilton","Sturm_Tarski","Imperative_Insertion_Sort","Certification_Monads","XML","RefinementReactive","Density_Compiler","Stream_Fusion_Code","Lifting_Definition_Option","AODV","UPF","UpDown_Scheme","Finite_Automata_HF","QR_Decomposition","Echelon_Form","Call_Arity","Deriving","Consensus_Refined","Trie","ConcurrentIMP","ConcurrentGC","Residuated_Lattices","Vickrey_Clarke_Groves","Probabilistic_System_Zoo","Formula_Derivatives","Dynamic_Tables","Noninterference_Ipurge_Unwinding","Noninterference_Generic_Unwinding","List_Interleaving","Multirelations","Derangements","Hermite","Akra_Bazzi","Landau_Symbols","Case_Labeling","Encodability_Process_Calculi","Rep_Fin_Groups","Noninterference_Inductive_Unwinding","Decreasing-Diagrams-II","Jordan_Normal_Form","LTL_to_DRA","Isabelle_Meta_Model","Parity_Game","Planarity_Certificates","TortoiseHare","Euler_Partition","Ergodic_Theory","Latin_Square","Card_Partitions","Applicative_Lifting","Algebraic_Numbers","Stern_Brocot","Liouville_Numbers","Triangle","Prime_Harmonic_Series","Descartes_Sign_Rule","Card_Number_Partitions","Matrix_Tensor","Knot_Theory","Polynomial_Factorization","Polynomial_Interpolation","Formal_SSA","List_Update","LTL","Cartan_FP","Timed_Automata","PropResPI","KAD","Noninterference_Sequential_Composition","ROBDD","CYK","No_FTL_observers","Groebner_Bases","Bell_Numbers_Spivey","SDS_Impossibility","Randomised_Social_Choice","MFMC_Countable","FLP","Perron_Frobenius","Incredible_Proof_Machine","Posix-Lexing","Card_Equiv_Relations","Tree_Decomposition","Word_Lib","Noninterference_Concurrent_Composition","Algebraic_VCs","Catalan_Numbers","Dependent_SIFUM_Type_Systems","Card_Multisets","Category3","Dependent_SIFUM_Refinement","IP_Addresses","Rewriting_Z","Resolution_FOL","Buildings","DFS_Framework","Pairing_Heap","Surprise_Paradox","Ptolemys_Theorem","Refine_Imperative_HOL","EdmondsKarp_Maxflow","InfPathElimination","Simple_Firewall","Routing","Stirling_Formula","Stone_Algebras","SuperCalc","Iptables_Semantics","Lambda_Free_RPOs","Allen_Calculus","Fisher_Yates","Lp","Chord_Segments","Berlekamp_Zassenhaus","Source_Coding_Theorem","SPARCv8","LOFT","Stable_Matching","Modal_Logics_for_NTS","Deep_Learning","Lambda_Free_KBOs","Nested_Multisets_Ordinals","Separata","Abs_Int_ITP2012","Complx","Paraconsistency","Proof_Strategy_Language","Twelvefold_Way","Concurrent_Ref_Alg","FOL_Harrison","Password_Authentication_Protocol","UPF_Firewall","E_Transcendental","Bertrands_Postulate","Minimal_SSA","Bernoulli","Key_Agreement_Strong_Adversaries","Stone_Relation_Algebras","Abstract_Soundness","Differential_Dynamic_Logic","Menger","Elliptic_Curves_Group_Law","Euler_MacLaurin","Quick_Sort_Cost","Comparison_Sort_Lower_Bound","Random_BSTs","Subresultants","Lazy_Case","Constructor_Funs","LocalLexing","Types_Tableaus_and_Goedels_God","MonoidalCategory","Game_Based_Crypto","Monomorphic_Monad","Probabilistic_While","Monad_Normalisation","CryptHOL","Floyd_Warshall","Security_Protocol_Refinement","Dict_Construction","Optics","Flow_Networks","Prpu_Maxflow","Buffons_Needle","PSemigroupsConvolution","Propositional_Proof_Systems","Stone_Kleene_Relation_Algebras","CRDT","Name_Carrying_Type_Inference","Minkowskis_Theorem","HOLCF-Prelude","Decl_Sem_Fun_PL","DynamicArchitectures","Stewart_Apollonius","LambdaMu","Orbit_Stabiliser","Root_Balanced_Tree","First_Welfare_Theorem","AnselmGod","PLM","Lowe_Ontological_Argument","Dirichlet_Series","Zeta_Function","Linear_Recurrences","Diophantine_Eqns_Lin_Hom","Winding_Number_Eval","Count_Complex_Roots","Buchi_Complementation","Transition_Systems_and_Automata","Kuratowski_Closure_Complement","Hybrid_Multi_Lane_Spatial_Logic","IMAP-CRDT","Stochastic_Matrices","Knuth_Morris_Pratt","BNF_Operations","Dirichlet_L","Mason_Stothers","Median_Of_Medians_Selection","Falling_Factorial_Sum","Taylor_Models","Green","Gromov_Hyperbolicity","Ordered_Resolution_Prover","LLL_Basis_Reduction","Treaps","First_Order_Terms","Error_Function","LLL_Factorization","Hoare_Time","Architectural_Design_Patterns","CakeML","Weight_Balanced_Trees","Fishburn_Impossibility","BNF_CC","VerifyThis2018","WebAssembly","Modular_Assembly_Kit_Security","OpSets","Monad_Memo_DP","AxiomaticCategoryTheory","Irrationality_J_Hancl","Probabilistic_Timed_Automata","Hidden_Markov_Models","Optimal_BST","Partial_Order_Reduction","Projective_Geometry","Localization_Ring","Pell","Neumann_Morgenstern_Utility","DiscretePricing","Minsky_Machines","Simplex","Budan_Fourier","Quaternions","Octonions","Aggregation_Algebras","Prime_Number_Theorem","Signature_Groebner","Symmetric_Polynomials","Pi_Transcendental","Factored_Transition_System_Bounding","Randomised_BSTs","Lambda_Free_EPO","Smooth_Manifolds","Epistemic_Logic","GewirthPGCProof","Generic_Deriving","Matroids","Auto2_HOL","Functional_Ordered_Resolution_Prover","Graph_Saturation","Transformer_Semantics","Order_Lattice_Props","Quantales","Constructive_Cryptography","Auto2_Imperative_HOL","Concurrent_Revisions","Core_DOM","Store_Buffer_Reduction","Higher_Order_Terms","IMP2","Farkas","List_Inversions","UTP","Universal_Turing_Machine","Probabilistic_Prime_Tests","Kruskal","Prime_Distribution_Elementary","Safe_OCL","QHLProver","Transcendence_Series_Hancl_Rucki","Binding_Syntax_Theory","LTL_Master_Theorem","HOL-CSP","Multi_Party_Computation","LambdaAuth","KD_Tree","Differential_Game_Logic","IMP2_Binary_Heap","Groebner_Macaulay","Nullstellensatz","Linear_Inequalities","Priority_Search_Trees","Prim_Dijkstra_Simple","Complete_Non_Orders","MFOTL_Monitor","CakeML_Codegen","FOL_Seq_Calc1","Szpilrajn","TESL_Language","Stellar_Quorums","IMO2019","C2KA_DistributedSystems","Linear_Programming","Laplace_Transform","Adaptive_State_Counting","Jacobson_Basic_Algebra","Fourier","Hybrid_Systems_VCs","Generic_Join","Clean","Sigma_Commit_Crypto","Aristotles_Assertoric_Syllogistic","VerifyThis2019","Isabelle_C","ZFC_in_HOL","Interval_Arithmetic_Word32","Generalized_Counting_Sort","Gauss_Sums","Poincare_Disc","Complex_Geometry","Poincare_Bendixson","Hybrid_Logic","Zeta_3_Irrational","Bicategory","Skip_Lists","Closest_Pair_Points","Approximation_Algorithms","Mersenne_Primes","Subset_Boolean_Algebras","Arith_Prog_Rel_Primes","VeriComp","Goodstein_Lambda","Hello_World","Relational-Incorrectness-Logic","Furstenberg_Topology","WOOT_Strong_Eventual_Consistency","Lucas_Theorem","Automated_Stateful_Protocol_Verification","Stateful_Protocol_Composition_and_Typing","MFODL_Monitor_Optimized","Saturation_Framework","Sliding_Window_Algorithm","ADS_Functor","Matrices_for_ODEs","Power_Sum_Polynomials","Lambert_W","Gaussian_Integers","Attack_Trees","Banach_Steinhaus","Forcing","LTL_Normal_Form","Recursion-Addition","Irrational_Series_Erdos_Straus","Knuth_Bendix_Order","Nash_Williams","Smith_Normal_Form","Safe_Distance","Relational_Paths","Chandy_Lamport","Ordinal_Partitions","Amicable_Numbers","BirdKMP","Saturation_Framework_Extensions","Relational_Disjoint_Set_Forests","PAC_Checker","Inductive_Inference","Extended_Finite_State_Machine_Inference","Extended_Finite_State_Machines","Goedel_HFSet_Semanticless","Syntax_Independent_Logic","Goedel_HFSet_Semantic","Goedel_Incompleteness","Robinson_Arithmetic","Shadow_SC_DOM","Shadow_DOM","DOM_Components","Core_SC_DOM","SC_DOM_Components","Finite-Map-Extras","Physical_Quantities","Verified_SAT_Based_AI_Planning","AI_Planning_Languages_Semantics","CSP_RefTK","Isabelle_Marries_Dirac","Relational_Method","Interpreter_Optimizations","Relational_Minimum_Spanning_Trees","Topological_Semantics","Delta_System_Lemma","JinjaDCI","Hood_Melville_Queue","Blue_Eyes","IsaGeoCoq","Laws_of_Large_Numbers","Formal_Puiseux_Series","BTree","Sunflowers","Mereology","Projective_Measurements","Hermite_Lindemann","Modular_arithmetic_LLL_and_HNF_algorithms","Constructive_Cryptography_CM","Padic_Ints","Grothendieck_Schemes","IFC_Tracking","Progress_Tracking","GaleStewart_Games","BenOr_Kozen_Reif","Metalogic_ProofChecker","Regression_Test_Selection"];
	+var years_loc_articles = [ 2004 , , , , , , , , , , , , , ,2005 , , , , , , , ,2006 , , , , , , ,2007 , , , , , , , ,2008 , , , , , , , , , , , , , , ,2009 , , , , , , , , , , , ,2010 , , , , , , , , , , , , , , , , , , , , , ,2011 , , , , , , , , , , , , , , , , ,2012 , , , , , , , , , , , , , , , , , , , , , , , , ,2013 , , , , , , , , , , , , , , , , , , , , , , ,2014 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2015 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2016 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2017 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2018 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2019 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2020 , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ,2021 , , , , , , , , , , , , , , , , , , , ,];
	+var loc_articles = [ "1798","839","1544","1096","1058","2419","44195","205","142","1984","209","1110","3792","506","1141","3769","17206","3119","6430","1145","447","2537","1275","1583","1838","12832","13120","2685","1228","3556","4238","9647","970","2847","1740","79749","4738","3396","2185","31122","10664","6723","30332","180","793","1047","14413","2080","254","2221","5959","3463","799","1540","684","6654","8","2627","27490","264","32552","5025","4380","208","9533","447","2380","3399","611","6311","2042","840","713","1024","5632","1427","4078","2230","6002","22620","1602","1587","3370","2451","2591","260","1617","16","2937","7805","6557","6381","992","125","10130","332","239","1828","999","1784","4420","434","4461","11857","2835","8583","1043","408","2940","2613","38078","3243","1480","2612","3141","27588","2580","25274","2266","4107","7701","1245","260","5309","73","9729","719","6673","1512","4355","1249","1908","6214","4979","10110","7261","538","3830","4591","202","848","1777","5579","10317","1524","150","5292","706","10776","2248","1463","1958","3067","11485","1860","1190","1219","2175","1144","14861","2212","1964","166","10685","6420","572","590","1698","465","883","4133","2138","1403","2280","1959","2467","220","5430","4433","9390","3999","4463","406","5935","1829","12828","3214","9486","4560","931","659","63","2338","1653","9145","753","2113","875","1727","627","931","1201","1296","7880","1922","90","28055","2879","2796","1116","4863","5259","8842","1356","6178","527","2606","6658","1782","5327","1085","4103","952","2446","1089","1064","2362","477","2074","3761","2148","710","16080","8267","908","1063","21042","9679","8659","3142","9156","695","435","13984","478","898","2724","10647","1162","401","498","495","741","838","3622","4616","6284","4102","8166","12108","3178","518","17583","2876","2418","5496","2453","885","1162","17387","509","702","5036","10363","4287","5340","3811","656","329","1057","14150","3257","2593","553","8478","206","25451","8773","3275","398","2960","12822","9483","370","173","384","18974","2545","6119","3777","1017","2608","4341","9356","20042","4052","3419","319","3208","169","19413","541","14634","2651","7058","7590","3898","3244","4704","855","2289","5020","1349","276","4339","1475","3482","7119","9662","601","1722","852","2194","12222","4173","590","13558","1695","4484","1640","835","694","737","3346","105","68","10492","1127","8513","4135","4711","1200","378","11280","2078","14059","639","2283","3930","4869","468","1531","5554","5665","1993","4205","478","4121","3146","3471","88","480","1261","1877","2193","250","10669","854","7463","5301","3083","2784","8844","5261","2324","6164","945","6514","992","489","810","8891","3133","338","854","493","4585","9457","15962","6327","10343","1819","2288","785","3260","8438","3278","12945","592","841","3383","3638","11570","13548","3734","6597","530","965","7674","1042","1221","5297","2754","1390","1622","2173","13358","805","10027","2667","541","1271","2668","5318","9772","2765","934","11918","1743","2355","7917","1391","449","685","1811","1141","3540","3578","1644","2983","2218","5182","4968","2767","17369","34365","3204","6022","1900","373","10303","16866","3018","3298","5304","4576","10485","986","15843","4437","9487","5543","3301","1264","2973","805","10235","2606","5262","472","3365","3603","3199","13339","951","778","4455","527","713","782","2335","2134","9936","2090","3736","5752","2350","3195","3809","176","1726","8507","6912","5069","5730","4561","10292","14118","6402","4470","1907","67700","2355","3936","3086","1699","3154","944","1033","596","370","691","764","2564","332","14517","21776","10948","3059","744","2353","1559","1239","1609","2537","1939","1337","11999","1034","1444","1902","2670","751","12972","3028","5074","9795","6299","1261","2908","1929","2074","9020","12872","4265","4741","11477","8100","426","3546","1295","15453","12763","3523","16385","7798","648","1761","16434","1967","2359","7700","3752","4280","4731","2826","3295","25018","745","365","26525","290","2582","5083","615","4039","4959","3891","17064","8475","15847","6575","4133","7214","1309","10332","9264","4094"];

	</script>
	<h4>Growth in number of articles:</h4>
	<script src="Chart.js"></script>
	<div class="chart">
	<canvas id="NumberOfArticles" width="400" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("NumberOfArticles");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years,
	datasets: [{
	label: 'size of the AFP in # of articles',
	data: no_articles,
	backgroundColor: "rgba(46, 45, 78, 1)"
	}],
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	}
	});
	</script>

	<h4>Growth in lines of code:</h4>
	<div class="chart">
	<canvas id="NumberOfLoc" width="400" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("NumberOfLoc");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years,
	datasets: [{
	label: 'size of the AFP in lines of code',
	data: no_loc,
	backgroundColor: "rgba(101, 99, 136, 1)"
	}],
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	}
	});
	</script>

	<h4>Growth in number of authors:</h4>
	<div class="chart">
	<canvas id="NumberOfAuthors" width="400" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("NumberOfAuthors");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years,
	datasets: [{
	label: 'new authors per year',
	data: no_authors,
	backgroundColor: "rgba(101, 99, 136, 1)"
	},
	{
	label: 'number of authors contributing (cumulative)',
	data: no_authors_series,
	backgroundColor: "rgba(0, 15, 48, 1)"
	}],
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	}
	});
	</script>

	<h4>Size of articles:</h4>
	<div style="width: 800px" class="chart">
	<canvas id="LocArticles" width="800" height="400"></canvas>
	</div>
	<script>
	var ctx = document.getElementById("LocArticles");
	var myChart = new Chart(ctx, {
	type: 'bar',
	data: {
	labels: years_loc_articles,
	datasets: [{
	label: 'loc per article',
	data: loc_articles,
	backgroundColor: "rgba(101, 99, 136, 1)"
	}]
	},
	options: {
	responsive: true,
	maintainAspectRatio: true,
	scales: {
	xAxes: [{
	categoryPercentage: 1,
	barPercentage: 0.9,
	ticks: {
	autoSkip: false
	}
	}],
	yAxes: [{
	ticks: {
	beginAtZero:true
	}
	}]
	},
	tooltips: {
	callbacks: {
	title: function(tooltipItem, data) {
	return all_articles[tooltipItem[0].index];
	}
	}
	}
	}
	});
	</script>

	</td></tr>

	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>

	<script src="Chart.js"></script>

	</body>
	</html>
	\ 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,950 +1,959 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">I</font>ndex by <font class="first">T</font>opic
	</h1>
	<p> </p>

	<table width="80%" class="descr">
	<tbody>
	<tr>
	<td>
	<h2>Computer science</h2>
	<div class="list">
	</div>
	<h3>Artificial intelligence</h3>
	<div class="list">
	<a href="entries/AI_Planning_Languages_Semantics.html">AI_Planning_Languages_Semantics</a>
	<a href="entries/Verified_SAT_Based_AI_Planning.html">Verified_SAT_Based_AI_Planning</a>
	</div>
	<h3>Automata and formal languages</h3>
	<div class="list">
	<a href="entries/Partial_Order_Reduction.html">Partial_Order_Reduction</a>
	<a href="entries/C2KA_DistributedSystems.html">C2KA_DistributedSystems</a>
	<a href="entries/Posix-Lexing.html">Posix-Lexing</a>
	<a href="entries/LocalLexing.html">LocalLexing</a>
	<a href="entries/KBPs.html">KBPs</a>
	<a href="entries/Regular-Sets.html">Regular-Sets</a>
	<a href="entries/Regex_Equivalence.html">Regex_Equivalence</a>
	<a href="entries/MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>
	<a href="entries/Formula_Derivatives.html">Formula_Derivatives</a>
	<a href="entries/Myhill-Nerode.html">Myhill-Nerode</a>
	<a href="entries/Universal_Turing_Machine.html">Universal_Turing_Machine</a>
	<a href="entries/CYK.html">CYK</a>
	<a href="entries/Presburger-Automata.html">Presburger-Automata</a>
	<a href="entries/Functional-Automata.html">Functional-Automata</a>
	<a href="entries/Statecharts.html">Statecharts</a>
	<a href="entries/Stuttering_Equivalence.html">Stuttering_Equivalence</a>
	<a href="entries/Coinductive_Languages.html">Coinductive_Languages</a>
	<a href="entries/Tree-Automata.html">Tree-Automata</a>
	<a href="entries/Kleene_Algebra.html">Kleene_Algebra</a>
	<a href="entries/KAT_and_DRA.html">KAT_and_DRA</a>
	<a href="entries/KAD.html">KAD</a>
	<a href="entries/Regular_Algebras.html">Regular_Algebras</a>
	<a href="entries/Markov_Models.html">Markov_Models</a>
	<a href="entries/Probabilistic_System_Zoo.html">Probabilistic_System_Zoo</a>
	<a href="entries/CAVA_Automata.html">CAVA_Automata</a>
	<a href="entries/LTL.html">LTL</a>
	<a href="entries/LTL_to_GBA.html">LTL_to_GBA</a>
	<a href="entries/CAVA_LTL_Modelchecker.html">CAVA_LTL_Modelchecker</a>
	<a href="entries/Probabilistic_Timed_Automata.html">Probabilistic_Timed_Automata</a>
	<a href="entries/Finite_Automata_HF.html">Finite_Automata_HF</a>
	<a href="entries/LTL_to_DRA.html">LTL_to_DRA</a>
	<a href="entries/Timed_Automata.html">Timed_Automata</a>
	<a href="entries/Stochastic_Matrices.html">Stochastic_Matrices</a>
	<a href="entries/Buchi_Complementation.html">Buchi_Complementation</a>
	<a href="entries/Transition_Systems_and_Automata.html">Transition_Systems_and_Automata</a>
	<a href="entries/Factored_Transition_System_Bounding.html">Factored_Transition_System_Bounding</a>
	<a href="entries/LTL_Master_Theorem.html">LTL_Master_Theorem</a>
	<a href="entries/MFOTL_Monitor.html">MFOTL_Monitor</a>
	<a href="entries/Adaptive_State_Counting.html">Adaptive_State_Counting</a>
	<a href="entries/MFODL_Monitor_Optimized.html">MFODL_Monitor_Optimized</a>
	<a href="entries/LTL_Normal_Form.html">LTL_Normal_Form</a>
	<a href="entries/Extended_Finite_State_Machines.html">Extended_Finite_State_Machines</a>
	<a href="entries/Extended_Finite_State_Machine_Inference.html">Extended_Finite_State_Machine_Inference</a>
	</div>
	<h3>Algorithms</h3>
	<div class="list">
	<a href="entries/Knuth_Morris_Pratt.html">Knuth_Morris_Pratt</a>
	<a href="entries/Probabilistic_While.html">Probabilistic_While</a>
	<a href="entries/Comparison_Sort_Lower_Bound.html">Comparison_Sort_Lower_Bound</a>
	<a href="entries/Quick_Sort_Cost.html">Quick_Sort_Cost</a>
	<a href="entries/TortoiseHare.html">TortoiseHare</a>
	<a href="entries/Selection_Heap_Sort.html">Selection_Heap_Sort</a>
	<a href="entries/VerifyThis2018.html">VerifyThis2018</a>
	<a href="entries/CYK.html">CYK</a>
	<a href="entries/Boolean_Expression_Checkers.html">Boolean_Expression_Checkers</a>
	<a href="entries/Efficient-Mergesort.html">Efficient-Mergesort</a>
	<a href="entries/SATSolverVerification.html">SATSolverVerification</a>
	<a href="entries/MuchAdoAboutTwo.html">MuchAdoAboutTwo</a>
	<a href="entries/First_Order_Terms.html">First_Order_Terms</a>
	<a href="entries/Monad_Memo_DP.html">Monad_Memo_DP</a>
	<a href="entries/Hidden_Markov_Models.html">Hidden_Markov_Models</a>
	<a href="entries/Imperative_Insertion_Sort.html">Imperative_Insertion_Sort</a>
	<a href="entries/Formal_SSA.html">Formal_SSA</a>
	<a href="entries/ROBDD.html">ROBDD</a>
	<a href="entries/Median_Of_Medians_Selection.html">Median_Of_Medians_Selection</a>
	<a href="entries/Fisher_Yates.html">Fisher_Yates</a>
	<a href="entries/Optimal_BST.html">Optimal_BST</a>
	<a href="entries/IMP2.html">IMP2</a>
	<a href="entries/Auto2_Imperative_HOL.html">Auto2_Imperative_HOL</a>
	<a href="entries/List_Inversions.html">List_Inversions</a>
	<a href="entries/IMP2_Binary_Heap.html">IMP2_Binary_Heap</a>
	<a href="entries/MFOTL_Monitor.html">MFOTL_Monitor</a>
	<a href="entries/Adaptive_State_Counting.html">Adaptive_State_Counting</a>
	<a href="entries/Generic_Join.html">Generic_Join</a>
	<a href="entries/VerifyThis2019.html">VerifyThis2019</a>
	<a href="entries/Generalized_Counting_Sort.html">Generalized_Counting_Sort</a>
	<a href="entries/MFODL_Monitor_Optimized.html">MFODL_Monitor_Optimized</a>
	<a href="entries/Sliding_Window_Algorithm.html">Sliding_Window_Algorithm</a>
	<a href="entries/PAC_Checker.html">PAC_Checker</a>
	+ <a href="entries/Regression_Test_Selection.html">Regression_Test_Selection</a>
	<strong>Graph:</strong>
	<a href="entries/DFS_Framework.html">DFS_Framework</a>
	<a href="entries/Prpu_Maxflow.html">Prpu_Maxflow</a>
	<a href="entries/Floyd_Warshall.html">Floyd_Warshall</a>
	<a href="entries/Roy_Floyd_Warshall.html">Roy_Floyd_Warshall</a>
	<a href="entries/Dijkstra_Shortest_Path.html">Dijkstra_Shortest_Path</a>
	<a href="entries/EdmondsKarp_Maxflow.html">EdmondsKarp_Maxflow</a>
	<a href="entries/Depth-First-Search.html">Depth-First-Search</a>
	<a href="entries/GraphMarkingIBP.html">GraphMarkingIBP</a>
	<a href="entries/Transitive-Closure.html">Transitive-Closure</a>
	<a href="entries/Transitive-Closure-II.html">Transitive-Closure-II</a>
	<a href="entries/Gabow_SCC.html">Gabow_SCC</a>
	<a href="entries/Kruskal.html">Kruskal</a>
	<a href="entries/Prim_Dijkstra_Simple.html">Prim_Dijkstra_Simple</a>
	<a href="entries/Relational_Minimum_Spanning_Trees.html">Relational_Minimum_Spanning_Trees</a>
	<strong>Distributed:</strong>
	<a href="entries/DiskPaxos.html">DiskPaxos</a>
	<a href="entries/GenClock.html">GenClock</a>
	<a href="entries/ClockSynchInst.html">ClockSynchInst</a>
	<a href="entries/Heard_Of.html">Heard_Of</a>
	<a href="entries/Consensus_Refined.html">Consensus_Refined</a>
	<a href="entries/Abortable_Linearizable_Modules.html">Abortable_Linearizable_Modules</a>
	<a href="entries/IMAP-CRDT.html">IMAP-CRDT</a>
	<a href="entries/CRDT.html">CRDT</a>
	<a href="entries/Chandy_Lamport.html">Chandy_Lamport</a>
	<a href="entries/OpSets.html">OpSets</a>
	<a href="entries/Stellar_Quorums.html">Stellar_Quorums</a>
	<a href="entries/WOOT_Strong_Eventual_Consistency.html">WOOT_Strong_Eventual_Consistency</a>
	+ <a href="entries/Progress_Tracking.html">Progress_Tracking</a>
	<strong>Concurrent:</strong>
	<a href="entries/ConcurrentGC.html">ConcurrentGC</a>
	<strong>Online:</strong>
	<a href="entries/List_Update.html">List_Update</a>
	<strong>Geometry:</strong>
	<a href="entries/Closest_Pair_Points.html">Closest_Pair_Points</a>
	<strong>Approximation:</strong>
	<a href="entries/Approximation_Algorithms.html">Approximation_Algorithms</a>
	<strong>Mathematical:</strong>
	<a href="entries/FFT.html">FFT</a>
	<a href="entries/Gauss-Jordan-Elim-Fun.html">Gauss-Jordan-Elim-Fun</a>
	<a href="entries/UpDown_Scheme.html">UpDown_Scheme</a>
	<a href="entries/Polynomials.html">Polynomials</a>
	<a href="entries/Gauss_Jordan.html">Gauss_Jordan</a>
	<a href="entries/Echelon_Form.html">Echelon_Form</a>
	<a href="entries/QR_Decomposition.html">QR_Decomposition</a>
	<a href="entries/Hermite.html">Hermite</a>
	<a href="entries/Groebner_Bases.html">Groebner_Bases</a>
	<a href="entries/Diophantine_Eqns_Lin_Hom.html">Diophantine_Eqns_Lin_Hom</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>
	<a href="entries/Signature_Groebner.html">Signature_Groebner</a>
	+ <a href="entries/BenOr_Kozen_Reif.html">BenOr_Kozen_Reif</a>
	<a href="entries/Smith_Normal_Form.html">Smith_Normal_Form</a>
	<a href="entries/Safe_Distance.html">Safe_Distance</a>
	<a href="entries/Modular_arithmetic_LLL_and_HNF_algorithms.html">Modular_arithmetic_LLL_and_HNF_algorithms</a>
	<strong>Optimization:</strong>
	<a href="entries/Simplex.html">Simplex</a>
	<strong>Quantum computing:</strong>
	<a href="entries/Isabelle_Marries_Dirac.html">Isabelle_Marries_Dirac</a>
	<a href="entries/Projective_Measurements.html">Projective_Measurements</a>
	</div>
	<h3>Concurrency</h3>
	<div class="list">
	<a href="entries/FLP.html">FLP</a>
	<a href="entries/Concurrent_Ref_Alg.html">Concurrent_Ref_Alg</a>
	<a href="entries/Concurrent_Revisions.html">Concurrent_Revisions</a>
	<a href="entries/Store_Buffer_Reduction.html">Store_Buffer_Reduction</a>
	<a href="entries/TESL_Language.html">TESL_Language</a>
	<strong>Process calculi:</strong>
	<a href="entries/Noninterference_Generic_Unwinding.html">Noninterference_Generic_Unwinding</a>
	<a href="entries/AODV.html">AODV</a>
	<a href="entries/AWN.html">AWN</a>
	<a href="entries/CCS.html">CCS</a>
	<a href="entries/Pi_Calculus.html">Pi_Calculus</a>
	<a href="entries/Psi_Calculi.html">Psi_Calculi</a>
	<a href="entries/Encodability_Process_Calculi.html">Encodability_Process_Calculi</a>
	<a href="entries/Circus.html">Circus</a>
	<a href="entries/Noninterference_Sequential_Composition.html">Noninterference_Sequential_Composition</a>
	<a href="entries/Noninterference_Concurrent_Composition.html">Noninterference_Concurrent_Composition</a>
	<a href="entries/Modal_Logics_for_NTS.html">Modal_Logics_for_NTS</a>
	<a href="entries/HOL-CSP.html">HOL-CSP</a>
	<a href="entries/CSP_RefTK.html">CSP_RefTK</a>
	</div>
	<h3>Data structures</h3>
	<div class="list">
	<a href="entries/Generic_Deriving.html">Generic_Deriving</a>
	<a href="entries/Random_BSTs.html">Random_BSTs</a>
	<a href="entries/Randomised_BSTs.html">Randomised_BSTs</a>
	<a href="entries/List_Interleaving.html">List_Interleaving</a>
	<a href="entries/Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>
	<a href="entries/Amortized_Complexity.html">Amortized_Complexity</a>
	<a href="entries/Dynamic_Tables.html">Dynamic_Tables</a>
	<a href="entries/AVL-Trees.html">AVL-Trees</a>
	<a href="entries/BDD.html">BDD</a>
	<a href="entries/BinarySearchTree.html">BinarySearchTree</a>
	<a href="entries/Splay_Tree.html">Splay_Tree</a>
	<a href="entries/Root_Balanced_Tree.html">Root_Balanced_Tree</a>
	<a href="entries/Skew_Heap.html">Skew_Heap</a>
	<a href="entries/Pairing_Heap.html">Pairing_Heap</a>
	<a href="entries/Priority_Queue_Braun.html">Priority_Queue_Braun</a>
	<a href="entries/Binomial-Queues.html">Binomial-Queues</a>
	<a href="entries/Binomial-Heaps.html">Binomial-Heaps</a>
	<a href="entries/Finger-Trees.html">Finger-Trees</a>
	<a href="entries/Trie.html">Trie</a>
	<a href="entries/FinFun.html">FinFun</a>
	<a href="entries/Collections.html">Collections</a>
	<a href="entries/Containers.html">Containers</a>
	<a href="entries/FileRefinement.html">FileRefinement</a>
	<a href="entries/Datatype_Order_Generator.html">Datatype_Order_Generator</a>
	<a href="entries/Deriving.html">Deriving</a>
	<a href="entries/List-Index.html">List-Index</a>
	<a href="entries/List-Infinite.html">List-Infinite</a>
	<a href="entries/Matrix.html">Matrix</a>
	<a href="entries/Matrix_Tensor.html">Matrix_Tensor</a>
	<a href="entries/Huffman.html">Huffman</a>
	<a href="entries/Lazy-Lists-II.html">Lazy-Lists-II</a>
	<a href="entries/IEEE_Floating_Point.html">IEEE_Floating_Point</a>
	<a href="entries/Native_Word.html">Native_Word</a>
	<a href="entries/XML.html">XML</a>
	<a href="entries/ROBDD.html">ROBDD</a>
	<a href="entries/IMAP-CRDT.html">IMAP-CRDT</a>
	<a href="entries/Word_Lib.html">Word_Lib</a>
	<a href="entries/CRDT.html">CRDT</a>
	<a href="entries/KD_Tree.html">KD_Tree</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/Treaps.html">Treaps</a>
	<a href="entries/Skip_Lists.html">Skip_Lists</a>
	<a href="entries/Weight_Balanced_Trees.html">Weight_Balanced_Trees</a>
	<a href="entries/OpSets.html">OpSets</a>
	<a href="entries/Optimal_BST.html">Optimal_BST</a>
	<a href="entries/Core_DOM.html">Core_DOM</a>
	<a href="entries/Core_SC_DOM.html">Core_SC_DOM</a>
	<a href="entries/Shadow_SC_DOM.html">Shadow_SC_DOM</a>
	<a href="entries/SC_DOM_Components.html">SC_DOM_Components</a>
	<a href="entries/Auto2_Imperative_HOL.html">Auto2_Imperative_HOL</a>
	<a href="entries/IMP2_Binary_Heap.html">IMP2_Binary_Heap</a>
	<a href="entries/Priority_Search_Trees.html">Priority_Search_Trees</a>
	<a href="entries/Interval_Arithmetic_Word32.html">Interval_Arithmetic_Word32</a>
	<a href="entries/ADS_Functor.html">ADS_Functor</a>
	<a href="entries/Relational_Disjoint_Set_Forests.html">Relational_Disjoint_Set_Forests</a>
	<a href="entries/Shadow_DOM.html">Shadow_DOM</a>
	<a href="entries/DOM_Components.html">DOM_Components</a>
	<a href="entries/Finite-Map-Extras.html">Finite-Map-Extras</a>
	<a href="entries/Hood_Melville_Queue.html">Hood_Melville_Queue</a>
	<a href="entries/BTree.html">BTree</a>
	</div>
	<h3>Functional programming</h3>
	<div class="list">
	<a href="entries/Optics.html">Optics</a>
	<a href="entries/CryptHOL.html">CryptHOL</a>
	<a href="entries/Probabilistic_While.html">Probabilistic_While</a>
	<a href="entries/Monad_Normalisation.html">Monad_Normalisation</a>
	<a href="entries/Monomorphic_Monad.html">Monomorphic_Monad</a>
	<a href="entries/Show.html">Show</a>
	<a href="entries/Certification_Monads.html">Certification_Monads</a>
	<a href="entries/Partial_Function_MR.html">Partial_Function_MR</a>
	<a href="entries/Lifting_Definition_Option.html">Lifting_Definition_Option</a>
	<a href="entries/Coinductive.html">Coinductive</a>
	<a href="entries/Stream-Fusion.html">Stream-Fusion</a>
	<a href="entries/Tycon.html">Tycon</a>
	<a href="entries/Monad_Memo_DP.html">Monad_Memo_DP</a>
	<a href="entries/XML.html">XML</a>
	<a href="entries/Tail_Recursive_Functions.html">Tail_Recursive_Functions</a>
	<a href="entries/Stream_Fusion_Code.html">Stream_Fusion_Code</a>
	<a href="entries/Applicative_Lifting.html">Applicative_Lifting</a>
	<a href="entries/HOLCF-Prelude.html">HOLCF-Prelude</a>
	<a href="entries/BNF_CC.html">BNF_CC</a>
	<a href="entries/Binding_Syntax_Theory.html">Binding_Syntax_Theory</a>
	<a href="entries/Generalized_Counting_Sort.html">Generalized_Counting_Sort</a>
	<a href="entries/Hello_World.html">Hello_World</a>
	<a href="entries/BirdKMP.html">BirdKMP</a>
	</div>
	<h3>Hardware</h3>
	<div class="list">
	<a href="entries/SPARCv8.html">SPARCv8</a>
	</div>
	<h3>Machine learning</h3>
	<div class="list">
	<a href="entries/Deep_Learning.html">Deep_Learning</a>
	<a href="entries/Inductive_Inference.html">Inductive_Inference</a>
	</div>
	<h3>Networks</h3>
	<div class="list">
	<a href="entries/UPF_Firewall.html">UPF_Firewall</a>
	<a href="entries/IP_Addresses.html">IP_Addresses</a>
	<a href="entries/Simple_Firewall.html">Simple_Firewall</a>
	<a href="entries/Iptables_Semantics.html">Iptables_Semantics</a>
	<a href="entries/Routing.html">Routing</a>
	<a href="entries/LOFT.html">LOFT</a>
	</div>
	<h3>Programming languages</h3>
	<div class="list">
	<a href="entries/Clean.html">Clean</a>
	<a href="entries/Decl_Sem_Fun_PL.html">Decl_Sem_Fun_PL</a>
	<strong>Language definitions:</strong>
	<a href="entries/CakeML.html">CakeML</a>
	<a href="entries/WebAssembly.html">WebAssembly</a>
	<a href="entries/pGCL.html">pGCL</a>
	<a href="entries/GPU_Kernel_PL.html">GPU_Kernel_PL</a>
	<a href="entries/LightweightJava.html">LightweightJava</a>
	<a href="entries/CoreC++.html">CoreC++</a>
	<a href="entries/FeatherweightJava.html">FeatherweightJava</a>
	<a href="entries/Jinja.html">Jinja</a>
	<a href="entries/JinjaThreads.html">JinjaThreads</a>
	<a href="entries/Locally-Nameless-Sigma.html">Locally-Nameless-Sigma</a>
	<a href="entries/AutoFocus-Stream.html">AutoFocus-Stream</a>
	<a href="entries/FocusStreamsCaseStudies.html">FocusStreamsCaseStudies</a>
	<a href="entries/Isabelle_Meta_Model.html">Isabelle_Meta_Model</a>
	<a href="entries/Simpl.html">Simpl</a>
	<a href="entries/Complx.html">Complx</a>
	<a href="entries/Safe_OCL.html">Safe_OCL</a>
	<a href="entries/Isabelle_C.html">Isabelle_C</a>
	<a href="entries/JinjaDCI.html">JinjaDCI</a>
	<strong>Lambda calculi:</strong>
	<a href="entries/Higher_Order_Terms.html">Higher_Order_Terms</a>
	<a href="entries/Launchbury.html">Launchbury</a>
	<a href="entries/PCF.html">PCF</a>
	<a href="entries/POPLmark-deBruijn.html">POPLmark-deBruijn</a>
	<a href="entries/Lam-ml-Normalization.html">Lam-ml-Normalization</a>
	<a href="entries/LambdaMu.html">LambdaMu</a>
	<a href="entries/Binding_Syntax_Theory.html">Binding_Syntax_Theory</a>
	<a href="entries/LambdaAuth.html">LambdaAuth</a>
	<strong>Type systems:</strong>
	<a href="entries/Name_Carrying_Type_Inference.html">Name_Carrying_Type_Inference</a>
	<a href="entries/MiniML.html">MiniML</a>
	<a href="entries/Possibilistic_Noninterference.html">Possibilistic_Noninterference</a>
	<a href="entries/SIFUM_Type_Systems.html">SIFUM_Type_Systems</a>
	<a href="entries/Dependent_SIFUM_Type_Systems.html">Dependent_SIFUM_Type_Systems</a>
	<a href="entries/Strong_Security.html">Strong_Security</a>
	<a href="entries/WHATandWHERE_Security.html">WHATandWHERE_Security</a>
	<a href="entries/VolpanoSmith.html">VolpanoSmith</a>
	<a href="entries/Physical_Quantities.html">Physical_Quantities</a>
	<strong>Logics:</strong>
	<a href="entries/ConcurrentIMP.html">ConcurrentIMP</a>
	<a href="entries/Refine_Monadic.html">Refine_Monadic</a>
	<a href="entries/Automatic_Refinement.html">Automatic_Refinement</a>
	<a href="entries/MonoBoolTranAlgebra.html">MonoBoolTranAlgebra</a>
	<a href="entries/Simpl.html">Simpl</a>
	<a href="entries/Separation_Algebra.html">Separation_Algebra</a>
	<a href="entries/Separation_Logic_Imperative_HOL.html">Separation_Logic_Imperative_HOL</a>
	<a href="entries/Relational-Incorrectness-Logic.html">Relational-Incorrectness-Logic</a>
	<a href="entries/Abstract-Hoare-Logics.html">Abstract-Hoare-Logics</a>
	<a href="entries/Kleene_Algebra.html">Kleene_Algebra</a>
	<a href="entries/KAT_and_DRA.html">KAT_and_DRA</a>
	<a href="entries/KAD.html">KAD</a>
	<a href="entries/BytecodeLogicJmlTypes.html">BytecodeLogicJmlTypes</a>
	<a href="entries/DataRefinementIBP.html">DataRefinementIBP</a>
	<a href="entries/RefinementReactive.html">RefinementReactive</a>
	<a href="entries/SIFPL.html">SIFPL</a>
	<a href="entries/TLA.html">TLA</a>
	<a href="entries/Ribbon_Proofs.html">Ribbon_Proofs</a>
	<a href="entries/Separata.html">Separata</a>
	<a href="entries/Complx.html">Complx</a>
	<a href="entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a>
	<a href="entries/Hoare_Time.html">Hoare_Time</a>
	<a href="entries/IMP2.html">IMP2</a>
	<a href="entries/UTP.html">UTP</a>
	<a href="entries/QHLProver.html">QHLProver</a>
	<a href="entries/Differential_Game_Logic.html">Differential_Game_Logic</a>
	<strong>Compiling:</strong>
	<a href="entries/CakeML_Codegen.html">CakeML_Codegen</a>
	<a href="entries/Compiling-Exceptions-Correctly.html">Compiling-Exceptions-Correctly</a>
	<a href="entries/NormByEval.html">NormByEval</a>
	<a href="entries/Density_Compiler.html">Density_Compiler</a>
	<a href="entries/VeriComp.html">VeriComp</a>
	<strong>Static analysis:</strong>
	<a href="entries/RIPEMD-160-SPARK.html">RIPEMD-160-SPARK</a>
	<a href="entries/Program-Conflict-Analysis.html">Program-Conflict-Analysis</a>
	<a href="entries/Shivers-CFA.html">Shivers-CFA</a>
	<a href="entries/Slicing.html">Slicing</a>
	<a href="entries/HRB-Slicing.html">HRB-Slicing</a>
	<a href="entries/InfPathElimination.html">InfPathElimination</a>
	<a href="entries/Abs_Int_ITP2012.html">Abs_Int_ITP2012</a>
	<strong>Transformations:</strong>
	<a href="entries/Call_Arity.html">Call_Arity</a>
	<a href="entries/Refine_Imperative_HOL.html">Refine_Imperative_HOL</a>
	<a href="entries/WorkerWrapper.html">WorkerWrapper</a>
	<a href="entries/Monad_Memo_DP.html">Monad_Memo_DP</a>
	<a href="entries/Formal_SSA.html">Formal_SSA</a>
	<a href="entries/Minimal_SSA.html">Minimal_SSA</a>
	<strong>Misc:</strong>
	<a href="entries/JiveDataStoreModel.html">JiveDataStoreModel</a>
	<a href="entries/Pop_Refinement.html">Pop_Refinement</a>
	<a href="entries/Case_Labeling.html">Case_Labeling</a>
	<a href="entries/Interpreter_Optimizations.html">Interpreter_Optimizations</a>
	</div>
	<h3>Security</h3>
	<div class="list">
	<a href="entries/Multi_Party_Computation.html">Multi_Party_Computation</a>
	<a href="entries/Noninterference_Generic_Unwinding.html">Noninterference_Generic_Unwinding</a>
	<a href="entries/Noninterference_Ipurge_Unwinding.html">Noninterference_Ipurge_Unwinding</a>
	<a href="entries/Relational_Method.html">Relational_Method</a>
	<a href="entries/UPF.html">UPF</a>
	<a href="entries/UPF_Firewall.html">UPF_Firewall</a>
	<a href="entries/CISC-Kernel.html">CISC-Kernel</a>
	<a href="entries/Noninterference_CSP.html">Noninterference_CSP</a>
	<a href="entries/Key_Agreement_Strong_Adversaries.html">Key_Agreement_Strong_Adversaries</a>
	<a href="entries/Security_Protocol_Refinement.html">Security_Protocol_Refinement</a>
	<a href="entries/Attack_Trees.html">Attack_Trees</a>
	<a href="entries/Inductive_Confidentiality.html">Inductive_Confidentiality</a>
	<a href="entries/Possibilistic_Noninterference.html">Possibilistic_Noninterference</a>
	<a href="entries/SIFUM_Type_Systems.html">SIFUM_Type_Systems</a>
	<a href="entries/Dependent_SIFUM_Type_Systems.html">Dependent_SIFUM_Type_Systems</a>
	<a href="entries/Dependent_SIFUM_Refinement.html">Dependent_SIFUM_Refinement</a>
	<a href="entries/Relational-Incorrectness-Logic.html">Relational-Incorrectness-Logic</a>
	<a href="entries/Strong_Security.html">Strong_Security</a>
	<a href="entries/WHATandWHERE_Security.html">WHATandWHERE_Security</a>
	<a href="entries/VolpanoSmith.html">VolpanoSmith</a>
	<a href="entries/SIFPL.html">SIFPL</a>
	<a href="entries/HotelKeyCards.html">HotelKeyCards</a>
	<a href="entries/InformationFlowSlicing.html">InformationFlowSlicing</a>
	<a href="entries/InformationFlowSlicing_Inter.html">InformationFlowSlicing_Inter</a>
	<a href="entries/CryptoBasedCompositionalProperties.html">CryptoBasedCompositionalProperties</a>
	<a href="entries/Probabilistic_Noninterference.html">Probabilistic_Noninterference</a>
	<a href="entries/HyperCTL.html">HyperCTL</a>
	<a href="entries/Bounded_Deducibility_Security.html">Bounded_Deducibility_Security</a>
	<a href="entries/Network_Security_Policy_Verification.html">Network_Security_Policy_Verification</a>
	<a href="entries/Noninterference_Inductive_Unwinding.html">Noninterference_Inductive_Unwinding</a>
	<a href="entries/Password_Authentication_Protocol.html">Password_Authentication_Protocol</a>
	<a href="entries/Noninterference_Sequential_Composition.html">Noninterference_Sequential_Composition</a>
	<a href="entries/Noninterference_Concurrent_Composition.html">Noninterference_Concurrent_Composition</a>
	<a href="entries/SPARCv8.html">SPARCv8</a>
	<a href="entries/Modular_Assembly_Kit_Security.html">Modular_Assembly_Kit_Security</a>
	<a href="entries/LambdaAuth.html">LambdaAuth</a>
	<a href="entries/Stateful_Protocol_Composition_and_Typing.html">Stateful_Protocol_Composition_and_Typing</a>
	<a href="entries/Automated_Stateful_Protocol_Verification.html">Automated_Stateful_Protocol_Verification</a>
	+ <a href="entries/IFC_Tracking.html">IFC_Tracking</a>
	<strong>Cryptography:</strong>
	<a href="entries/Game_Based_Crypto.html">Game_Based_Crypto</a>
	<a href="entries/Sigma_Commit_Crypto.html">Sigma_Commit_Crypto</a>
	<a href="entries/CryptHOL.html">CryptHOL</a>
	<a href="entries/Constructive_Cryptography.html">Constructive_Cryptography</a>
	<a href="entries/RSAPSS.html">RSAPSS</a>
	<a href="entries/Elliptic_Curves_Group_Law.html">Elliptic_Curves_Group_Law</a>
	<a href="entries/Constructive_Cryptography_CM.html">Constructive_Cryptography_CM</a>
	</div>
	<h3>Semantics</h3>
	<div class="list">
	<a href="entries/Launchbury.html">Launchbury</a>
	<a href="entries/Clean.html">Clean</a>
	<a href="entries/Transformer_Semantics.html">Transformer_Semantics</a>
	<a href="entries/HOL-CSP.html">HOL-CSP</a>
	<a href="entries/QHLProver.html">QHLProver</a>
	<a href="entries/TESL_Language.html">TESL_Language</a>
	<a href="entries/Isabelle_C.html">Isabelle_C</a>
	<a href="entries/CSP_RefTK.html">CSP_RefTK</a>
	</div>
	<h3>System description languages</h3>
	<div class="list">
	<a href="entries/Circus.html">Circus</a>
	<a href="entries/ComponentDependencies.html">ComponentDependencies</a>
	<a href="entries/Promela.html">Promela</a>
	<a href="entries/Featherweight_OCL.html">Featherweight_OCL</a>
	<a href="entries/DynamicArchitectures.html">DynamicArchitectures</a>
	<a href="entries/Architectural_Design_Patterns.html">Architectural_Design_Patterns</a>
	<a href="entries/TESL_Language.html">TESL_Language</a>
	</div>
	<h2>Logic</h2>
	<div class="list">
	</div>
	<h3>Philosophical aspects</h3>
	<div class="list">
	<a href="entries/GoedelGod.html">GoedelGod</a>
	<a href="entries/Types_Tableaus_and_Goedels_God.html">Types_Tableaus_and_Goedels_God</a>
	<a href="entries/GewirthPGCProof.html">GewirthPGCProof</a>
	<a href="entries/Lowe_Ontological_Argument.html">Lowe_Ontological_Argument</a>
	<a href="entries/AnselmGod.html">AnselmGod</a>
	<a href="entries/PLM.html">PLM</a>
	<a href="entries/Aristotles_Assertoric_Syllogistic.html">Aristotles_Assertoric_Syllogistic</a>
	<a href="entries/Mereology.html">Mereology</a>
	</div>
	<h3>General logic</h3>
	<div class="list">
	<a href="entries/Topological_Semantics.html">Topological_Semantics</a>
	+ <a href="entries/Metalogic_ProofChecker.html">Metalogic_ProofChecker</a>
	<strong>Classical propositional logic:</strong>
	<a href="entries/Free-Boolean-Algebra.html">Free-Boolean-Algebra</a>
	<strong>Classical first-order logic:</strong>
	<a href="entries/FOL-Fitting.html">FOL-Fitting</a>
	<strong>Decidability of theories:</strong>
	<a href="entries/MSO_Regex_Equivalence.html">MSO_Regex_Equivalence</a>
	<a href="entries/Formula_Derivatives.html">Formula_Derivatives</a>
	<a href="entries/Presburger-Automata.html">Presburger-Automata</a>
	<a href="entries/LinearQuantifierElim.html">LinearQuantifierElim</a>
	<strong>Mechanization of proofs:</strong>
	<a href="entries/Boolean_Expression_Checkers.html">Boolean_Expression_Checkers</a>
	<a href="entries/Verified-Prover.html">Verified-Prover</a>
	<a href="entries/Sort_Encodings.html">Sort_Encodings</a>
	<a href="entries/PropResPI.html">PropResPI</a>
	<a href="entries/Resolution_FOL.html">Resolution_FOL</a>
	<a href="entries/FOL_Harrison.html">FOL_Harrison</a>
	<a href="entries/Ordered_Resolution_Prover.html">Ordered_Resolution_Prover</a>
	<a href="entries/Functional_Ordered_Resolution_Prover.html">Functional_Ordered_Resolution_Prover</a>
	<a href="entries/Binding_Syntax_Theory.html">Binding_Syntax_Theory</a>
	<a href="entries/Saturation_Framework.html">Saturation_Framework</a>
	<a href="entries/Saturation_Framework_Extensions.html">Saturation_Framework_Extensions</a>
	<strong>Lambda calculus:</strong>
	<a href="entries/LambdaMu.html">LambdaMu</a>
	<strong>Logics of knowledge and belief:</strong>
	<a href="entries/Epistemic_Logic.html">Epistemic_Logic</a>
	<a href="entries/Blue_Eyes.html">Blue_Eyes</a>
	<strong>Temporal logic:</strong>
	<a href="entries/Nat-Interval-Logic.html">Nat-Interval-Logic</a>
	<a href="entries/LTL.html">LTL</a>
	<a href="entries/HyperCTL.html">HyperCTL</a>
	<a href="entries/Allen_Calculus.html">Allen_Calculus</a>
	<a href="entries/MFOTL_Monitor.html">MFOTL_Monitor</a>
	<a href="entries/LTL_Normal_Form.html">LTL_Normal_Form</a>
	<strong>Modal logic:</strong>
	<a href="entries/Modal_Logics_for_NTS.html">Modal_Logics_for_NTS</a>
	<a href="entries/Differential_Dynamic_Logic.html">Differential_Dynamic_Logic</a>
	<a href="entries/Hybrid_Multi_Lane_Spatial_Logic.html">Hybrid_Multi_Lane_Spatial_Logic</a>
	<a href="entries/Hybrid_Logic.html">Hybrid_Logic</a>
	<a href="entries/MFODL_Monitor_Optimized.html">MFODL_Monitor_Optimized</a>
	<strong>Paraconsistent logics:</strong>
	<a href="entries/Paraconsistency.html">Paraconsistency</a>
	</div>
	<h3>Computability</h3>
	<div class="list">
	<a href="entries/Universal_Turing_Machine.html">Universal_Turing_Machine</a>
	<a href="entries/Recursion-Theory-I.html">Recursion-Theory-I</a>
	<a href="entries/Inductive_Inference.html">Inductive_Inference</a>
	<a href="entries/Minsky_Machines.html">Minsky_Machines</a>
	</div>
	<h3>Set theory</h3>
	<div class="list">
	<a href="entries/Ordinal.html">Ordinal</a>
	<a href="entries/Ordinals_and_Cardinals.html">Ordinals_and_Cardinals</a>
	<a href="entries/HereditarilyFinite.html">HereditarilyFinite</a>
	<a href="entries/ZFC_in_HOL.html">ZFC_in_HOL</a>
	<a href="entries/Forcing.html">Forcing</a>
	<a href="entries/Delta_System_Lemma.html">Delta_System_Lemma</a>
	<a href="entries/Recursion-Addition.html">Recursion-Addition</a>
	<a href="entries/Ordinal_Partitions.html">Ordinal_Partitions</a>
	</div>
	<h3>Proof theory</h3>
	<div class="list">
	<a href="entries/Propositional_Proof_Systems.html">Propositional_Proof_Systems</a>
	<a href="entries/Completeness.html">Completeness</a>
	<a href="entries/SequentInvertibility.html">SequentInvertibility</a>
	<a href="entries/Incompleteness.html">Incompleteness</a>
	<a href="entries/Abstract_Completeness.html">Abstract_Completeness</a>
	<a href="entries/SuperCalc.html">SuperCalc</a>
	<a href="entries/Incredible_Proof_Machine.html">Incredible_Proof_Machine</a>
	<a href="entries/Surprise_Paradox.html">Surprise_Paradox</a>
	<a href="entries/Abstract_Soundness.html">Abstract_Soundness</a>
	<a href="entries/Syntax_Independent_Logic.html">Syntax_Independent_Logic</a>
	<a href="entries/Goedel_Incompleteness.html">Goedel_Incompleteness</a>
	<a href="entries/Goedel_HFSet_Semantic.html">Goedel_HFSet_Semantic</a>
	<a href="entries/Goedel_HFSet_Semanticless.html">Goedel_HFSet_Semanticless</a>
	<a href="entries/Robinson_Arithmetic.html">Robinson_Arithmetic</a>
	<a href="entries/FOL_Seq_Calc1.html">FOL_Seq_Calc1</a>
	</div>
	<h3>Rewriting</h3>
	<div class="list">
	<a href="entries/CakeML_Codegen.html">CakeML_Codegen</a>
	<a href="entries/Monad_Normalisation.html">Monad_Normalisation</a>
	<a href="entries/Lambda_Free_RPOs.html">Lambda_Free_RPOs</a>
	<a href="entries/Lambda_Free_KBOs.html">Lambda_Free_KBOs</a>
	<a href="entries/Lambda_Free_EPO.html">Lambda_Free_EPO</a>
	<a href="entries/Nested_Multisets_Ordinals.html">Nested_Multisets_Ordinals</a>
	<a href="entries/Abstract-Rewriting.html">Abstract-Rewriting</a>
	<a href="entries/First_Order_Terms.html">First_Order_Terms</a>
	<a href="entries/Decreasing-Diagrams.html">Decreasing-Diagrams</a>
	<a href="entries/Decreasing-Diagrams-II.html">Decreasing-Diagrams-II</a>
	<a href="entries/Rewriting_Z.html">Rewriting_Z</a>
	<a href="entries/Graph_Saturation.html">Graph_Saturation</a>
	<a href="entries/Goodstein_Lambda.html">Goodstein_Lambda</a>
	<a href="entries/Knuth_Bendix_Order.html">Knuth_Bendix_Order</a>
	</div>
	<h2>Mathematics</h2>
	<div class="list">
	</div>
	<h3>Order</h3>
	<div class="list">
	<a href="entries/LatticeProperties.html">LatticeProperties</a>
	<a href="entries/Stone_Algebras.html">Stone_Algebras</a>
	<a href="entries/Allen_Calculus.html">Allen_Calculus</a>
	<a href="entries/Order_Lattice_Props.html">Order_Lattice_Props</a>
	<a href="entries/Complete_Non_Orders.html">Complete_Non_Orders</a>
	<a href="entries/Szpilrajn.html">Szpilrajn</a>
	</div>
	<h3>Algebra</h3>
	<div class="list">
	<a href="entries/Optics.html">Optics</a>
	<a href="entries/Subresultants.html">Subresultants</a>
	<a href="entries/Buildings.html">Buildings</a>
	<a href="entries/Algebraic_VCs.html">Algebraic_VCs</a>
	<a href="entries/C2KA_DistributedSystems.html">C2KA_DistributedSystems</a>
	<a href="entries/Multirelations.html">Multirelations</a>
	<a href="entries/Residuated_Lattices.html">Residuated_Lattices</a>
	<a href="entries/PseudoHoops.html">PseudoHoops</a>
	<a href="entries/Impossible_Geometry.html">Impossible_Geometry</a>
	<a href="entries/Gauss-Jordan-Elim-Fun.html">Gauss-Jordan-Elim-Fun</a>
	<a href="entries/Matrix_Tensor.html">Matrix_Tensor</a>
	<a href="entries/Kleene_Algebra.html">Kleene_Algebra</a>
	<a href="entries/KAT_and_DRA.html">KAT_and_DRA</a>
	<a href="entries/KAD.html">KAD</a>
	<a href="entries/Regular_Algebras.html">Regular_Algebras</a>
	<a href="entries/Free-Groups.html">Free-Groups</a>
	<a href="entries/CofGroups.html">CofGroups</a>
	<a href="entries/Group-Ring-Module.html">Group-Ring-Module</a>
	<a href="entries/Robbins-Conjecture.html">Robbins-Conjecture</a>
	<a href="entries/Valuation.html">Valuation</a>
	<a href="entries/Rank_Nullity_Theorem.html">Rank_Nullity_Theorem</a>
	<a href="entries/Polynomials.html">Polynomials</a>
	<a href="entries/Relation_Algebra.html">Relation_Algebra</a>
	<a href="entries/PSemigroupsConvolution.html">PSemigroupsConvolution</a>
	<a href="entries/Secondary_Sylow.html">Secondary_Sylow</a>
	<a href="entries/Jordan_Hoelder.html">Jordan_Hoelder</a>
	<a href="entries/Cayley_Hamilton.html">Cayley_Hamilton</a>
	<a href="entries/VectorSpace.html">VectorSpace</a>
	<a href="entries/Echelon_Form.html">Echelon_Form</a>
	<a href="entries/QR_Decomposition.html">QR_Decomposition</a>
	<a href="entries/Hermite.html">Hermite</a>
	<a href="entries/Rep_Fin_Groups.html">Rep_Fin_Groups</a>
	<a href="entries/Jordan_Normal_Form.html">Jordan_Normal_Form</a>
	<a href="entries/Algebraic_Numbers.html">Algebraic_Numbers</a>
	<a href="entries/Polynomial_Interpolation.html">Polynomial_Interpolation</a>
	<a href="entries/Polynomial_Factorization.html">Polynomial_Factorization</a>
	<a href="entries/Perron_Frobenius.html">Perron_Frobenius</a>
	<a href="entries/Stochastic_Matrices.html">Stochastic_Matrices</a>
	<a href="entries/Groebner_Bases.html">Groebner_Bases</a>
	<a href="entries/Nullstellensatz.html">Nullstellensatz</a>
	<a href="entries/Mason_Stothers.html">Mason_Stothers</a>
	<a href="entries/Berlekamp_Zassenhaus.html">Berlekamp_Zassenhaus</a>
	<a href="entries/Stone_Relation_Algebras.html">Stone_Relation_Algebras</a>
	<a href="entries/Stone_Kleene_Relation_Algebras.html">Stone_Kleene_Relation_Algebras</a>
	<a href="entries/Orbit_Stabiliser.html">Orbit_Stabiliser</a>
	<a href="entries/Dirichlet_L.html">Dirichlet_L</a>
	<a href="entries/Symmetric_Polynomials.html">Symmetric_Polynomials</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/LLL_Basis_Reduction.html">LLL_Basis_Reduction</a>
	<a href="entries/LLL_Factorization.html">LLL_Factorization</a>
	<a href="entries/Localization_Ring.html">Localization_Ring</a>
	<a href="entries/Quaternions.html">Quaternions</a>
	<a href="entries/Octonions.html">Octonions</a>
	<a href="entries/Aggregation_Algebras.html">Aggregation_Algebras</a>
	<a href="entries/Signature_Groebner.html">Signature_Groebner</a>
	<a href="entries/Quantales.html">Quantales</a>
	<a href="entries/Transformer_Semantics.html">Transformer_Semantics</a>
	<a href="entries/Farkas.html">Farkas</a>
	<a href="entries/Groebner_Macaulay.html">Groebner_Macaulay</a>
	<a href="entries/Linear_Inequalities.html">Linear_Inequalities</a>
	<a href="entries/Linear_Programming.html">Linear_Programming</a>
	<a href="entries/Jacobson_Basic_Algebra.html">Jacobson_Basic_Algebra</a>
	<a href="entries/Hybrid_Systems_VCs.html">Hybrid_Systems_VCs</a>
	<a href="entries/Subset_Boolean_Algebras.html">Subset_Boolean_Algebras</a>
	<a href="entries/Power_Sum_Polynomials.html">Power_Sum_Polynomials</a>
	<a href="entries/Formal_Puiseux_Series.html">Formal_Puiseux_Series</a>
	<a href="entries/Matrices_for_ODEs.html">Matrices_for_ODEs</a>
	<a href="entries/Smith_Normal_Form.html">Smith_Normal_Form</a>
	+ <a href="entries/Grothendieck_Schemes.html">Grothendieck_Schemes</a>
	</div>
	<h3>Analysis</h3>
	<div class="list">
	<a href="entries/Banach_Steinhaus.html">Banach_Steinhaus</a>
	<a href="entries/Fourier.html">Fourier</a>
	<a href="entries/E_Transcendental.html">E_Transcendental</a>
	<a href="entries/Liouville_Numbers.html">Liouville_Numbers</a>
	<a href="entries/Descartes_Sign_Rule.html">Descartes_Sign_Rule</a>
	<a href="entries/Euler_MacLaurin.html">Euler_MacLaurin</a>
	<a href="entries/Real_Impl.html">Real_Impl</a>
	<a href="entries/Lower_Semicontinuous.html">Lower_Semicontinuous</a>
	<a href="entries/Affine_Arithmetic.html">Affine_Arithmetic</a>
	<a href="entries/Laplace_Transform.html">Laplace_Transform</a>
	<a href="entries/Cauchy.html">Cauchy</a>
	<a href="entries/Integration.html">Integration</a>
	<a href="entries/Ordinary_Differential_Equations.html">Ordinary_Differential_Equations</a>
	<a href="entries/Polynomials.html">Polynomials</a>
	<a href="entries/Sqrt_Babylonian.html">Sqrt_Babylonian</a>
	<a href="entries/Sturm_Sequences.html">Sturm_Sequences</a>
	<a href="entries/Sturm_Tarski.html">Sturm_Tarski</a>
	<a href="entries/Special_Function_Bounds.html">Special_Function_Bounds</a>
	<a href="entries/Landau_Symbols.html">Landau_Symbols</a>
	<a href="entries/Error_Function.html">Error_Function</a>
	<a href="entries/Akra_Bazzi.html">Akra_Bazzi</a>
	<a href="entries/Zeta_Function.html">Zeta_Function</a>
	<a href="entries/Linear_Recurrences.html">Linear_Recurrences</a>
	<a href="entries/Lambert_W.html">Lambert_W</a>
	<a href="entries/Cartan_FP.html">Cartan_FP</a>
	<a href="entries/Deep_Learning.html">Deep_Learning</a>
	<a href="entries/Stirling_Formula.html">Stirling_Formula</a>
	<a href="entries/Lp.html">Lp</a>
	<a href="entries/Bernoulli.html">Bernoulli</a>
	<a href="entries/Winding_Number_Eval.html">Winding_Number_Eval</a>
	<a href="entries/Count_Complex_Roots.html">Count_Complex_Roots</a>
	<a href="entries/Taylor_Models.html">Taylor_Models</a>
	<a href="entries/Green.html">Green</a>
	<a href="entries/Irrationality_J_Hancl.html">Irrationality_J_Hancl</a>
	<a href="entries/Budan_Fourier.html">Budan_Fourier</a>
	<a href="entries/Smooth_Manifolds.html">Smooth_Manifolds</a>
	<a href="entries/Transcendence_Series_Hancl_Rucki.html">Transcendence_Series_Hancl_Rucki</a>
	<a href="entries/Hybrid_Systems_VCs.html">Hybrid_Systems_VCs</a>
	<a href="entries/Poincare_Bendixson.html">Poincare_Bendixson</a>
	<a href="entries/Matrices_for_ODEs.html">Matrices_for_ODEs</a>
	<a href="entries/Irrational_Series_Erdos_Straus.html">Irrational_Series_Erdos_Straus</a>
	</div>
	<h3>Probability theory</h3>
	<div class="list">
	<a href="entries/DiscretePricing.html">DiscretePricing</a>
	<a href="entries/CryptHOL.html">CryptHOL</a>
	<a href="entries/Constructive_Cryptography.html">Constructive_Cryptography</a>
	<a href="entries/Probabilistic_While.html">Probabilistic_While</a>
	<a href="entries/Markov_Models.html">Markov_Models</a>
	<a href="entries/Density_Compiler.html">Density_Compiler</a>
	<a href="entries/Probabilistic_Timed_Automata.html">Probabilistic_Timed_Automata</a>
	<a href="entries/Hidden_Markov_Models.html">Hidden_Markov_Models</a>
	<a href="entries/Random_Graph_Subgraph_Threshold.html">Random_Graph_Subgraph_Threshold</a>
	<a href="entries/Ergodic_Theory.html">Ergodic_Theory</a>
	<a href="entries/Source_Coding_Theorem.html">Source_Coding_Theorem</a>
	<a href="entries/Buffons_Needle.html">Buffons_Needle</a>
	<a href="entries/Laws_of_Large_Numbers.html">Laws_of_Large_Numbers</a>
	<a href="entries/Constructive_Cryptography_CM.html">Constructive_Cryptography_CM</a>
	</div>
	<h3>Number theory</h3>
	<div class="list">
	<a href="entries/Arith_Prog_Rel_Primes.html">Arith_Prog_Rel_Primes</a>
	<a href="entries/Pell.html">Pell</a>
	<a href="entries/Minkowskis_Theorem.html">Minkowskis_Theorem</a>
	<a href="entries/E_Transcendental.html">E_Transcendental</a>
	<a href="entries/Pi_Transcendental.html">Pi_Transcendental</a>
	<a href="entries/Hermite_Lindemann.html">Hermite_Lindemann</a>
	<a href="entries/Liouville_Numbers.html">Liouville_Numbers</a>
	<a href="entries/Prime_Harmonic_Series.html">Prime_Harmonic_Series</a>
	<a href="entries/Fermat3_4.html">Fermat3_4</a>
	<a href="entries/Perfect-Number-Thm.html">Perfect-Number-Thm</a>
	<a href="entries/SumSquares.html">SumSquares</a>
	<a href="entries/Lehmer.html">Lehmer</a>
	<a href="entries/Pratt_Certificate.html">Pratt_Certificate</a>
	<a href="entries/Dirichlet_Series.html">Dirichlet_Series</a>
	<a href="entries/Gauss_Sums.html">Gauss_Sums</a>
	<a href="entries/Zeta_Function.html">Zeta_Function</a>
	<a href="entries/Stern_Brocot.html">Stern_Brocot</a>
	<a href="entries/Bertrands_Postulate.html">Bertrands_Postulate</a>
	<a href="entries/Bernoulli.html">Bernoulli</a>
	<a href="entries/Diophantine_Eqns_Lin_Hom.html">Diophantine_Eqns_Lin_Hom</a>
	<a href="entries/Dirichlet_L.html">Dirichlet_L</a>
	<a href="entries/Mersenne_Primes.html">Mersenne_Primes</a>
	<a href="entries/Irrationality_J_Hancl.html">Irrationality_J_Hancl</a>
	<a href="entries/Prime_Number_Theorem.html">Prime_Number_Theorem</a>
	<a href="entries/Probabilistic_Prime_Tests.html">Probabilistic_Prime_Tests</a>
	<a href="entries/Prime_Distribution_Elementary.html">Prime_Distribution_Elementary</a>
	<a href="entries/Transcendence_Series_Hancl_Rucki.html">Transcendence_Series_Hancl_Rucki</a>
	<a href="entries/Zeta_3_Irrational.html">Zeta_3_Irrational</a>
	<a href="entries/Furstenberg_Topology.html">Furstenberg_Topology</a>
	<a href="entries/Lucas_Theorem.html">Lucas_Theorem</a>
	<a href="entries/Gaussian_Integers.html">Gaussian_Integers</a>
	<a href="entries/Irrational_Series_Erdos_Straus.html">Irrational_Series_Erdos_Straus</a>
	<a href="entries/Amicable_Numbers.html">Amicable_Numbers</a>
	+ <a href="entries/Padic_Ints.html">Padic_Ints</a>
	</div>
	<h3>Games and economics</h3>
	<div class="list">
	<a href="entries/DiscretePricing.html">DiscretePricing</a>
	<a href="entries/ArrowImpossibilityGS.html">ArrowImpossibilityGS</a>
	<a href="entries/SenSocialChoice.html">SenSocialChoice</a>
	<a href="entries/Vickrey_Clarke_Groves.html">Vickrey_Clarke_Groves</a>
	<a href="entries/Parity_Game.html">Parity_Game</a>
	<a href="entries/First_Welfare_Theorem.html">First_Welfare_Theorem</a>
	<a href="entries/Randomised_Social_Choice.html">Randomised_Social_Choice</a>
	<a href="entries/SDS_Impossibility.html">SDS_Impossibility</a>
	<a href="entries/Stable_Matching.html">Stable_Matching</a>
	<a href="entries/Fishburn_Impossibility.html">Fishburn_Impossibility</a>
	<a href="entries/Neumann_Morgenstern_Utility.html">Neumann_Morgenstern_Utility</a>
	+ <a href="entries/GaleStewart_Games.html">GaleStewart_Games</a>
	</div>
	<h3>Geometry</h3>
	<div class="list">
	<a href="entries/Complex_Geometry.html">Complex_Geometry</a>
	<a href="entries/Poincare_Disc.html">Poincare_Disc</a>
	<a href="entries/Minkowskis_Theorem.html">Minkowskis_Theorem</a>
	<a href="entries/Buildings.html">Buildings</a>
	<a href="entries/Chord_Segments.html">Chord_Segments</a>
	<a href="entries/Triangle.html">Triangle</a>
	<a href="entries/Impossible_Geometry.html">Impossible_Geometry</a>
	<a href="entries/Tarskis_Geometry.html">Tarskis_Geometry</a>
	<a href="entries/IsaGeoCoq.html">IsaGeoCoq</a>
	<a href="entries/General-Triangle.html">General-Triangle</a>
	<a href="entries/Nullstellensatz.html">Nullstellensatz</a>
	<a href="entries/Ptolemys_Theorem.html">Ptolemys_Theorem</a>
	<a href="entries/Buffons_Needle.html">Buffons_Needle</a>
	<a href="entries/Stewart_Apollonius.html">Stewart_Apollonius</a>
	<a href="entries/Gromov_Hyperbolicity.html">Gromov_Hyperbolicity</a>
	<a href="entries/Projective_Geometry.html">Projective_Geometry</a>
	<a href="entries/Quaternions.html">Quaternions</a>
	<a href="entries/Octonions.html">Octonions</a>
	+ <a href="entries/Grothendieck_Schemes.html">Grothendieck_Schemes</a>
	</div>
	<h3>Topology</h3>
	<div class="list">
	<a href="entries/Topology.html">Topology</a>
	<a href="entries/Knot_Theory.html">Knot_Theory</a>
	<a href="entries/Kuratowski_Closure_Complement.html">Kuratowski_Closure_Complement</a>
	<a href="entries/Smooth_Manifolds.html">Smooth_Manifolds</a>
	</div>
	<h3>Graph theory</h3>
	<div class="list">
	<a href="entries/Flow_Networks.html">Flow_Networks</a>
	<a href="entries/Prpu_Maxflow.html">Prpu_Maxflow</a>
	<a href="entries/MFMC_Countable.html">MFMC_Countable</a>
	<a href="entries/ShortestPath.html">ShortestPath</a>
	<a href="entries/Gabow_SCC.html">Gabow_SCC</a>
	<a href="entries/Graph_Theory.html">Graph_Theory</a>
	<a href="entries/Planarity_Certificates.html">Planarity_Certificates</a>
	<a href="entries/Max-Card-Matching.html">Max-Card-Matching</a>
	<a href="entries/Girth_Chromatic.html">Girth_Chromatic</a>
	<a href="entries/Random_Graph_Subgraph_Threshold.html">Random_Graph_Subgraph_Threshold</a>
	<a href="entries/Flyspeck-Tame.html">Flyspeck-Tame</a>
	<a href="entries/Koenigsberg_Friendship.html">Koenigsberg_Friendship</a>
	<a href="entries/Tree_Decomposition.html">Tree_Decomposition</a>
	<a href="entries/Menger.html">Menger</a>
	<a href="entries/Parity_Game.html">Parity_Game</a>
	<a href="entries/Factored_Transition_System_Bounding.html">Factored_Transition_System_Bounding</a>
	<a href="entries/Graph_Saturation.html">Graph_Saturation</a>
	<a href="entries/Relational_Paths.html">Relational_Paths</a>
	</div>
	<h3>Combinatorics</h3>
	<div class="list">
	<a href="entries/Card_Equiv_Relations.html">Card_Equiv_Relations</a>
	<a href="entries/Twelvefold_Way.html">Twelvefold_Way</a>
	<a href="entries/Card_Multisets.html">Card_Multisets</a>
	<a href="entries/Card_Partitions.html">Card_Partitions</a>
	<a href="entries/Card_Number_Partitions.html">Card_Number_Partitions</a>
	<a href="entries/Well_Quasi_Orders.html">Well_Quasi_Orders</a>
	<a href="entries/Marriage.html">Marriage</a>
	<a href="entries/Bondy.html">Bondy</a>
	<a href="entries/Ramsey-Infinite.html">Ramsey-Infinite</a>
	<a href="entries/Derangements.html">Derangements</a>
	<a href="entries/Euler_Partition.html">Euler_Partition</a>
	<a href="entries/Discrete_Summation.html">Discrete_Summation</a>
	<a href="entries/Open_Induction.html">Open_Induction</a>
	<a href="entries/Latin_Square.html">Latin_Square</a>
	<a href="entries/Bell_Numbers_Spivey.html">Bell_Numbers_Spivey</a>
	<a href="entries/Catalan_Numbers.html">Catalan_Numbers</a>
	<a href="entries/Falling_Factorial_Sum.html">Falling_Factorial_Sum</a>
	<a href="entries/Matroids.html">Matroids</a>
	<a href="entries/Delta_System_Lemma.html">Delta_System_Lemma</a>
	<a href="entries/Nash_Williams.html">Nash_Williams</a>
	<a href="entries/Ordinal_Partitions.html">Ordinal_Partitions</a>
	<a href="entries/Sunflowers.html">Sunflowers</a>
	</div>
	<h3>Category theory</h3>
	<div class="list">
	<a href="entries/Category3.html">Category3</a>
	<a href="entries/MonoidalCategory.html">MonoidalCategory</a>
	<a href="entries/Category.html">Category</a>
	<a href="entries/Category2.html">Category2</a>
	<a href="entries/AxiomaticCategoryTheory.html">AxiomaticCategoryTheory</a>
	<a href="entries/Bicategory.html">Bicategory</a>
	</div>
	<h3>Physics</h3>
	<div class="list">
	<a href="entries/No_FTL_observers.html">No_FTL_observers</a>
	<a href="entries/Safe_Distance.html">Safe_Distance</a>
	<a href="entries/Physical_Quantities.html">Physical_Quantities</a>
	<strong>Quantum information:</strong>
	<a href="entries/Isabelle_Marries_Dirac.html">Isabelle_Marries_Dirac</a>
	<a href="entries/Projective_Measurements.html">Projective_Measurements</a>
	</div>
	<h3>Misc</h3>
	<div class="list">
	<a href="entries/FunWithFunctions.html">FunWithFunctions</a>
	<a href="entries/FunWithTilings.html">FunWithTilings</a>
	<a href="entries/IMO2019.html">IMO2019</a>
	</div>
	<h2>Tools</h2>
	<div class="list">
	<a href="entries/Monad_Normalisation.html">Monad_Normalisation</a>
	<a href="entries/Constructor_Funs.html">Constructor_Funs</a>
	<a href="entries/Lazy_Case.html">Lazy_Case</a>
	<a href="entries/Dict_Construction.html">Dict_Construction</a>
	<a href="entries/Case_Labeling.html">Case_Labeling</a>
	<a href="entries/DPT-SAT-Solver.html">DPT-SAT-Solver</a>
	<a href="entries/Nominal2.html">Nominal2</a>
	<a href="entries/Separata.html">Separata</a>
	<a href="entries/Proof_Strategy_Language.html">Proof_Strategy_Language</a>
	<a href="entries/Diophantine_Eqns_Lin_Hom.html">Diophantine_Eqns_Lin_Hom</a>
	<a href="entries/BNF_Operations.html">BNF_Operations</a>
	<a href="entries/BNF_CC.html">BNF_CC</a>
	<a href="entries/Auto2_HOL.html">Auto2_HOL</a>
	<a href="entries/Isabelle_C.html">Isabelle_C</a>
	<a href="entries/Automated_Stateful_Protocol_Verification.html">Automated_Stateful_Protocol_Verification</a>
	</div>
	</td>
	</tr>
	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>


	</body>
	</html>
	\ No newline at end of file
	diff --git a/web/using.html b/web/using.html
	--- a/web/using.html
	+++ b/web/using.html
	@@ -1,126 +1,126 @@
	<!DOCTYPE html>
	<html lang="en">
	<head>
	<meta charset="utf-8">
	<title>Archive of Formal Proofs</title>
	<link rel="stylesheet" type="text/css" href="front.css">
	<link rel="icon" href="images/favicon.ico" type="image/icon">
	<link rel="alternate" type="application/rss+xml" title="RSS" href="rss.xml">
	</head>

	<body class="mathjax_ignore">

	<table width="100%">
	<tbody>
	<tr>

	<!-- Navigation -->
	<td width="20%" align="center" valign="top">
	<p> </p>
	<a href="https://www.isa-afp.org/">
	<img src="images/isabelle.png" width="100" height="88" border=0>
	</a>
	<p> </p>
	<p> </p>
	<table class="nav" width="80%">
	<tr>
	<td class="nav" width="100%"><a href="index.html">Home</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="about.html">About</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="submitting.html">Submission</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="updating.html">Updating Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="using.html">Using Entries</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="search.html">Search</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="statistics.html">Statistics</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="topics.html">Index</a></td>
	</tr>
	<tr>
	<td class="nav"><a href="download.html">Download</a></td>
	</tr>
	</table>
	<p> </p>
	<p> </p>
	</td>


	<!-- Content -->
	<td width="80%" valign="top">
	<div align="center">
	<p> </p>
	<h1><font class="first">R</font>eferring to
	<font class="first">A</font>FP
	<font class="first">E</font>ntries
	</h1>
	<p> </p>

	<table width="80%" class="descr">
	<tbody>
	<tr><td>

	<p>
	Once you have downloaded the AFP, you can include its articles and theories in
	your own developments. If you would like to make your work available to others
	<i>without</i> having to include the AFP articles you depend on, here is how to do it.
	</p>
	<p>
	-If you are using Isabelle2021, and have downloaded your AFP directory to
	-<code>/home/myself/afp</code>, for Linux/Mac you can run the following command to make the AFP session ROOTS available to Isabelle:</p>
	+From Isabelle2021 on, the recommended method for making the whole AFP available to Isabelle
	+is the <code>isabelle components -u</code> command.
	+</p>
	+
	+<h2>Linux/Mac</h2>
	<p>
	+Assuming you have downloaded and unzipped the afp to <code>/home/myself/afp</code>, run
	+</p>
	<pre class="code">
	- echo "/home/myself/afp/thys" >> ~/.isabelle/Isabelle2021/ROOTS
	+ isabelle components -u /home/myself/afp
	</pre>
	-This adds the path <code>/home/myself/afp/thys/</code> to the ROOTS file, which
	-Isabelle will scan by default. You can also manually edit and/or create that
	-ROOTS file. There are many other ways to achieve the same outcome, this is just
	-one option.
	-</p>
	+
	+<h2>Windows</h2>
	<p>
	-For Windows, the idea is the same just the path is slightly different. If the
	-AFP is in <code>C:\afp</code>, you should be able to run the following in a
	-Cygwin terminal.
	+If the AFP is in <code>C:\afp</code>, run the following command in a Cygwin terminal:
	<pre class="code">
	- echo "/cygdrive/c/afp/thys" >> ~/.isabelle/Isabelle2021/ROOTS
	+ isabelle components -u /cygdrive/c/afp
	</pre>
	</p>

	+<h2>Use</h2>
	<p>
	-You can now refer to article <code>ABC</code> from the AFP in some theory of
	-yours via</p>
	+You can now refer to article <code>ABC</code> from the AFP in another theory via</p>

	<pre class="code">
	imports "ABC.Some_ABC_Theory"
	</pre>

	<p>This allows you to distribute your material separately from any AFP
	theories. Users of your distribution also need to install the AFP in the above
	manner.</p>

	<p> </p>

	</td></tr>
	</tbody>
	</table>

	</div>
	</td>

	</tr>
	</tbody>
	</table>


	</body>
	</html>
	\ No newline at end of file

File Metadata

Mime Type: application/octet-stream
Expires: Sun, Apr 28, 3:17 AM (2 d)
Storage Engine: chunks
Storage Format: Chunks
Storage Handle: 3dugNszpEmKE
Default Alt Text: (4 MB)

Offset	End	Complete
0	4194304	Yes
4194304	4739608	Yes

No OneTemporaryActions

View Options

File Metadata

Event Timeline

No OneTemporary
Actions