diff --git a/metadata/entries/HyperHoareLogic.toml b/metadata/entries/HyperHoareLogic.toml
--- a/metadata/entries/HyperHoareLogic.toml
+++ b/metadata/entries/HyperHoareLogic.toml
@@ -1,31 +1,33 @@
 title = "Formalization of Hyper Hoare Logic: A Logic to (Dis-)Prove Program Hyperproperties"
 date = 2023-04-03
 topics = [
   "Computer science/Programming languages/Logics",
 ]
 abstract = """
-Hoare logics are proof systems that allow one to formally establish properties of computer programs. Traditional Hoare logics prove properties of individual program executions (so-called trace properties, such as functional correctness). On the one hand, Hoare logic has been generalized to prove properties of multiple executions of a program (so-called hyperproperties, such as determinism or non-interference). These program logics prove the absence of (bad combinations of) executions. On the other hand, program logics similar to Hoare logic have been proposed to disprove program properties (e.g., Incorrectness Logic [8]), by proving the existence of (bad combinations of) executions. All of these logics have in common that they specify program properties using assertions over a fixed number of states, for instance, a single pre- and post-state for functional properties or pairs of pre- and post-states for non-interference.
+Hoare logics are proof systems that allow one to formally establish properties of computer programs. Traditional Hoare logics prove properties of individual program executions (such as functional correctness). On the one hand, Hoare logic has been generalized to prove properties of multiple executions of a program (so-called hyperproperties, such as determinism or non-interference). These program logics prove the absence of (bad combinations of) executions. On the other hand, program logics similar to Hoare logic have been proposed to disprove program properties (e.g., Incorrectness Logic), by proving the existence of (bad combinations of) executions. All of these logics have in common that they specify program properties using assertions over a fixed number of states, for instance, a single pre- and post-state for functional properties or pairs of pre- and post-states for non-interference.
 
-In this entry, we formalize Hyper Hoare Logic, a generalization of Hoare logic that lifts assertions to properties of arbitrary sets of states. The resulting logic is simple yet expressive: its judgments can express arbitrary trace- and hyperproperties over the terminating executions of a program. By allowing assertions to reason about sets of states, Hyper Hoare Logic can reason about both the absence and the existence of (combinations of) executions, and, thereby, supports both proving and disproving program (hyper-)properties within the same logic. In fact, we prove that Hyper Hoare Logic subsumes the properties handled by numerous existing correctness and incorrectness logics, and can express hyperproperties that no existing Hoare logic can. We also prove that Hyper Hoare Logic is sound and complete."""
+In this entry, we formalize Hyper Hoare Logic, a generalization of Hoare logic that lifts assertions to properties of arbitrary sets of states. The resulting logic is simple yet expressive: its judgments can express arbitrary program hyperproperties, a particular class of hyperproperties over the set of terminating executions of a program (including properties of individual program executions). By allowing assertions to reason about sets of states, Hyper Hoare Logic can reason about both the absence and the existence of (combinations of) executions, and, thereby, supports both proving and disproving program (hyper-)properties within the same logic, including hyperproperties that no existing Hoare logic can express. We prove that Hyper Hoare Logic is sound and complete, and demonstrate that it captures important proof principles naturally."""
 license = "bsd"
 note = ""
 
 [authors]
 
 [authors.dardinier]
 email = "dardinier_email"
 
 [contributors]
 
 [notify]
 dardinier = "dardinier_email"
 
 [history]
+<2024>-<04>-<12> = "additional rules for compositionality, syntactic hyper-assertions, and loops"
 
 [extra]
 
 [related]
 dois = [
   "10.48550/arXiv.2301.10037",
+  "10.1145/3656437"
 ]
 pubs = []
diff --git a/thys/HyperHoareLogic/Compositionality.thy b/thys/HyperHoareLogic/Compositionality.thy
new file mode 100644
--- /dev/null
+++ b/thys/HyperHoareLogic/Compositionality.thy
@@ -0,0 +1,908 @@
+section \<open>Compositionality Rules\<close>
+
+theory Compositionality
+  imports Logic Expressivity Loops
+begin
+
+text \<open>In this file, we prove the soundness of all compositionality rules presented in Appendix D (figure 11).\<close>
+
+definition in_set where
+  "in_set \<phi> S \<longleftrightarrow> \<phi> \<in> S"
+
+subsection \<open>Linking rule\<close>
+
+proposition rule_linking:
+  assumes "\<And>\<phi>1 (\<phi>2 :: ('a, 'b, 'c, 'd) state). fst \<phi>1 = fst \<phi>2 \<and> ( \<Turnstile> { (in_set \<phi>1 :: (('a, 'b, 'c, 'd) state) hyperassertion) } C { in_set \<phi>2 } )
+  \<Longrightarrow> ( \<Turnstile> { (P \<phi>1 :: (('a, 'b, 'c, 'd) state) hyperassertion) } C { Q \<phi>2 } )"
+  shows "\<Turnstile> { ((\<lambda>S. \<forall>\<phi>1 \<in> S. P \<phi>1 S) :: (('a, 'b, 'c, 'd) state) hyperassertion) } C { (\<lambda>S. \<forall>\<phi>2 \<in> S. Q \<phi>2 S) }"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "\<forall>\<phi>1\<in>S. P \<phi>1 S"
+  show "\<forall>\<phi>2\<in>sem C S. Q \<phi>2 (sem C S)"
+  proof (clarify)
+    fix l \<sigma>' assume "(l, \<sigma>') \<in> sem C S"
+    then obtain \<sigma> where "(l, \<sigma>) \<in> S" "single_sem C \<sigma> \<sigma>'"
+      by (metis fst_conv in_sem snd_conv)
+    then show "Q (l, \<sigma>') (sem C S)"
+      by (metis (mono_tags, opaque_lifting) asm0 assms fst_eqD hyper_hoare_triple_def in_set_def single_step_then_in_sem)
+  qed
+qed
+
+
+lemma rule_linking_alt:
+  assumes "\<And>l \<sigma> \<sigma>'. single_sem C \<sigma> \<sigma>' \<Longrightarrow> ( \<Turnstile> { P (l, \<sigma>) } C { Q (l, \<sigma>') } )"
+  shows "\<Turnstile> { (\<lambda>S. \<forall>\<omega> \<in> S. P \<omega> S) } C { (\<lambda>S. \<forall>\<omega>' \<in> S. Q \<omega>' S) }"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "\<forall>\<omega>\<in>S. P \<omega> S"
+  show "\<forall>\<omega>'\<in>sem C S. Q \<omega>' (sem C S)"
+  proof (clarify)
+    fix l \<sigma>' assume "(l, \<sigma>') \<in> sem C S"
+    then obtain \<sigma> where "(l, \<sigma>) \<in> S" "single_sem C \<sigma> \<sigma>'"
+      by (metis fst_conv in_sem snd_conv)
+    then have "\<Turnstile> { P (l, \<sigma>) } C { Q (l, \<sigma>') }"
+      by (simp add: assms)
+    then show "Q (l, \<sigma>') (sem C S)"
+      by (simp add: \<open>(l, \<sigma>) \<in> S\<close> asm0 hyper_hoare_tripleE)
+  qed
+qed
+
+subsection \<open>Frame rules\<close>
+
+lemma rule_lframe:
+
+  fixes b :: "('a \<Rightarrow> ('lvar \<Rightarrow> 'lval)) \<Rightarrow> bool"
+\<comment>\<open>b takes a mapping from keys to logical states (representing the tuple), and returns a boolean\<close>
+
+  shows "\<Turnstile> { (\<lambda>S. \<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> b (fst \<circ> \<phi>)) } C { \<lambda>S. \<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> b (fst \<circ> \<phi>) }"
+
+proof (rule hyper_hoare_tripleI)
+  fix S :: "('lvar, 'lval, 'b, 'c) state set"
+  assume asm0: "\<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> b (fst \<circ> \<phi>)"
+  show "\<forall>\<phi>. (\<forall>k. \<phi> k \<in> sem C S) \<longrightarrow> b (fst \<circ> \<phi>)"
+  proof (clarify)
+    fix \<phi>' :: "'a \<Rightarrow> ('lvar, 'lval, 'b, 'c) state"
+    assume asm1: "\<forall>k. \<phi>' k \<in> sem C S"
+    let ?\<phi> = "\<lambda>k. SOME \<phi>k. fst \<phi>k = fst (\<phi>' k) \<and> \<phi>k \<in> S \<and> single_sem C (snd \<phi>k) (snd (\<phi>' k))"
+    have r: "\<And>k. fst (?\<phi> k) = fst (\<phi>' k) \<and> (?\<phi> k) \<in> S \<and> single_sem C (snd (?\<phi> k)) (snd (\<phi>' k))"
+    proof -
+      fix k show "fst (?\<phi> k) = fst (\<phi>' k) \<and> (?\<phi> k) \<in> S \<and> single_sem C (snd (?\<phi> k)) (snd (\<phi>' k))"
+      proof (rule someI_ex)
+        show "\<exists>x. fst x = fst (\<phi>' k) \<and> x \<in> S \<and> \<langle>C, snd x\<rangle> \<rightarrow> snd (\<phi>' k)"
+          by (metis asm1 fst_conv in_sem snd_conv)
+      qed
+    qed
+    then have "b (fst \<circ> ?\<phi>)"
+      using asm0 by presburger
+    moreover have "fst \<circ> ?\<phi> = fst \<circ> \<phi>'"
+      using ext r by fastforce
+    then show "b (fst \<circ> \<phi>')"
+      using calculation by presburger
+  qed
+qed
+
+lemma rule_lframe_single:
+  "\<Turnstile> { (\<lambda>S. \<forall>\<omega> \<in> S. P (fst \<omega>)) } C { \<lambda>S. \<forall>\<omega> \<in> S. P (fst \<omega>) }"
+proof -
+  let ?P = "\<lambda>\<phi>. P (\<phi> ())"
+  have "\<Turnstile> { (\<lambda>S. \<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> ?P (fst \<circ> \<phi>)) } C { \<lambda>S. \<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> ?P (fst \<circ> \<phi>) }"
+    using rule_lframe by fast
+  moreover have "(\<lambda>S. \<forall>\<omega> \<in> S. P (fst \<omega>)) = (\<lambda>S. \<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> ?P (fst \<circ> \<phi>))"
+    using ext by fastforce
+  ultimately show ?thesis
+    using forw_subst ssubst order_trans_rules(13) prop_subst basic_trans_rules(13)
+    by fast
+qed
+
+definition differ_only_by_pset where
+  "differ_only_by_pset vars a b \<longleftrightarrow> (\<forall>i. fst (a i) = fst (b i) \<and> differ_only_by_set vars (snd (a i)) (snd (b i)))"
+
+lemma differ_only_by_psetI:
+  assumes "\<And>i. fst (a i) = fst (b i) \<and> differ_only_by_set vars (snd (a i)) (snd (b i))"
+  shows "differ_only_by_pset vars a b"
+  by (simp add: assms differ_only_by_pset_def)
+
+definition not_in_free_pvars_prop where
+  "not_in_free_pvars_prop vars b \<longleftrightarrow> (\<forall>\<phi>1 \<phi>2. differ_only_by_pset vars \<phi>1 \<phi>2 \<longrightarrow> (b \<phi>1 \<longleftrightarrow> b \<phi>2))"
+
+proposition rule_frame:
+
+  fixes b :: "('a \<Rightarrow> ('lvar, 'lval, 'pvar, 'pval) state) \<Rightarrow> bool"
+\<comment>\<open>b takes a mapping from keys to extended states (representing the tuple), and returns a boolean\<close>
+
+  assumes "not_in_free_pvars_prop (written_vars C) b"
+
+  shows "\<Turnstile> { (\<lambda>S. \<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> b \<phi>) } C { \<lambda>S. \<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> b \<phi> }"
+
+proof (rule hyper_hoare_tripleI)
+  fix S :: "('lvar, 'lval, 'pvar, 'pval) state set"
+  assume asm0: "\<forall>\<phi>. (\<forall>k. \<phi> k \<in> S) \<longrightarrow> b \<phi>"
+  show "\<forall>\<phi>. (\<forall>k. \<phi> k \<in> sem C S) \<longrightarrow> b \<phi>"
+  proof (clarify)
+    fix \<phi>' :: "'a \<Rightarrow> ('lvar, 'lval, 'pvar, 'pval) state"
+    assume asm1: "\<forall>k. \<phi>' k \<in> sem C S"
+    let ?\<phi> = "\<lambda>k. SOME \<phi>k. fst \<phi>k = fst (\<phi>' k) \<and> \<phi>k \<in> S \<and> single_sem C (snd \<phi>k) (snd (\<phi>' k))"
+    have r: "\<And>k. fst (?\<phi> k) = fst (\<phi>' k) \<and> (?\<phi> k) \<in> S \<and> single_sem C (snd (?\<phi> k)) (snd (\<phi>' k))"
+    proof -
+      fix k show "fst (?\<phi> k) = fst (\<phi>' k) \<and> (?\<phi> k) \<in> S \<and> single_sem C (snd (?\<phi> k)) (snd (\<phi>' k))"
+      proof (rule someI_ex)
+        show "\<exists>x. fst x = fst (\<phi>' k) \<and> x \<in> S \<and> \<langle>C, snd x\<rangle> \<rightarrow> snd (\<phi>' k)"
+          by (metis asm1 fst_conv in_sem snd_conv)
+      qed
+    qed
+    then have "b ?\<phi>"
+      using asm0 by presburger
+    moreover have "differ_only_by_pset (written_vars C) ?\<phi> \<phi>'"
+    proof (rule differ_only_by_psetI)
+      fix i show "fst (SOME \<phi>k. fst \<phi>k = fst (\<phi>' i) \<and> \<phi>k \<in> S \<and> \<langle>C, snd \<phi>k\<rangle> \<rightarrow> snd (\<phi>' i)) = fst (\<phi>' i) \<and>
+       differ_only_by_set (written_vars C) (snd (SOME \<phi>k. fst \<phi>k = fst (\<phi>' i) \<and> \<phi>k \<in> S \<and> \<langle>C, snd \<phi>k\<rangle> \<rightarrow> snd (\<phi>' i))) (snd (\<phi>' i))"
+        by (metis (mono_tags, lifting) differ_only_by_set_def r written_vars_not_modified)
+    qed
+    ultimately show "b \<phi>'"
+      using assms not_in_free_pvars_prop_def by blast
+  qed
+qed
+
+
+subsection \<open>Logical Updates\<close>
+
+definition equal_outside_set where
+  "equal_outside_set vars l1 l2 \<longleftrightarrow> (\<forall>x. x \<notin> vars \<longrightarrow> l1 x = l2 x)"
+
+lemma equal_outside_setI:
+  assumes "\<And>x. x \<notin> vars \<Longrightarrow> l1 x = l2 x"
+  shows "equal_outside_set vars l1 l2"
+  using assms equal_outside_set_def by auto
+
+lemma equal_outside_setE:
+  assumes "equal_outside_set vars l1 l2"
+      and "x \<notin> vars"
+    shows "l1 x = l2 x"
+  using assms equal_outside_set_def by meson
+
+lemma equal_outside_sym:
+  "equal_outside_set vars l l' \<longleftrightarrow> equal_outside_set vars l' l"
+  by (metis equal_outside_set_def)
+
+definition subset_mod_updates where
+  "subset_mod_updates vars S S' \<longleftrightarrow> (\<forall>\<omega> \<in> S. \<exists>\<omega>' \<in> S'. snd \<omega> = snd \<omega>' \<and> equal_outside_set vars (fst \<omega>) (fst \<omega>'))"
+
+lemma subset_mod_updatesI:
+  assumes "\<And>\<omega>. \<omega> \<in> S \<Longrightarrow> (\<exists>\<omega>' \<in> S'. snd \<omega> = snd \<omega>' \<and> equal_outside_set vars (fst \<omega>) (fst \<omega>'))"
+  shows "subset_mod_updates vars S S'"
+  by (simp add: assms subset_mod_updates_def)
+
+lemma subset_mod_updatesE:
+  assumes "subset_mod_updates vars S S'"
+      and "\<omega> \<in> S"
+    shows "\<exists>\<omega>' \<in> S'. snd \<omega> = snd \<omega>' \<and> equal_outside_set vars (fst \<omega>) (fst \<omega>')"
+  using assms(1) assms(2) subset_mod_updates_def by blast
+
+
+definition same_mod_updates where
+  "same_mod_updates vars S S' \<longleftrightarrow> subset_mod_updates vars S S' \<and> subset_mod_updates vars S' S"
+
+lemma same_mod_updatesI:
+  assumes "\<And>\<omega>. \<omega> \<in> S \<Longrightarrow> (\<exists>\<omega>' \<in> S'. snd \<omega> = snd \<omega>' \<and> equal_outside_set vars (fst \<omega>) (fst \<omega>'))"
+      and "\<And>\<omega>'. \<omega>' \<in> S' \<Longrightarrow> (\<exists>\<omega> \<in> S. snd \<omega> = snd \<omega>' \<and> equal_outside_set vars (fst \<omega>') (fst \<omega>))"
+    shows "same_mod_updates vars S S'"
+  by (metis assms(1) assms(2) same_mod_updates_def subset_mod_updates_def)
+
+lemma same_mod_updates_sym:
+  "same_mod_updates vars S S' \<longleftrightarrow> same_mod_updates vars S' S"
+  using same_mod_updates_def by blast
+
+lemma same_mod_updates_refl:
+  "same_mod_updates vars S S"
+  by (metis equal_outside_set_def same_mod_updates_def subset_mod_updates_def)
+
+lemma equal_outside_set_trans:
+  assumes "equal_outside_set vars a b"
+      and "equal_outside_set vars b c"
+    shows "equal_outside_set vars a c"
+  using equal_outside_set_def[of vars a b] equal_outside_set_def[of vars b c] equal_outside_set_def[of vars a c] assms
+  by presburger
+
+lemma subset_mod_updates_trans:
+  assumes "subset_mod_updates vars S1 S2"
+      and "subset_mod_updates vars S2 S3"
+    shows "subset_mod_updates vars S1 S3"
+proof (rule subset_mod_updatesI)
+  fix \<omega>1 assume "\<omega>1 \<in> S1"
+  then obtain \<omega>2 where "\<omega>2 \<in> S2" "snd \<omega>1 = snd \<omega>2 \<and> equal_outside_set vars (fst \<omega>1) (fst \<omega>2)"
+    using assms(1) same_mod_updates_def subset_mod_updatesE by blast
+  then show "\<exists>\<omega>'\<in>S3. snd \<omega>1 = snd \<omega>' \<and> equal_outside_set vars (fst \<omega>1) (fst \<omega>')"
+    by (metis (no_types, lifting) assms(2) equal_outside_set_trans subset_mod_updatesE)
+qed
+
+lemma same_mod_updates_trans:
+  assumes "same_mod_updates vars S1 S2"
+      and "same_mod_updates vars S2 S3"
+    shows "same_mod_updates vars S1 S3"
+  by (meson assms(1) assms(2) same_mod_updates_def subset_mod_updates_trans)
+
+
+lemma sem_update_commute_aux:
+  assumes "subset_mod_updates vars S1 S2"
+  shows "subset_mod_updates vars (sem C S1) (sem C S2)"
+proof (rule subset_mod_updatesI)
+  fix \<omega>1 assume asm0: "\<omega>1 \<in> sem C S1"
+  then obtain l1 \<sigma> where "(l1, \<sigma>) \<in> S1" "single_sem C \<sigma> (snd \<omega>1)" "fst \<omega>1 = l1"
+    by (metis in_sem)
+  then obtain l2 where "(l2, \<sigma>) \<in> S2" "equal_outside_set vars l1 l2"
+    using assms subset_mod_updatesE by fastforce
+  then show "\<exists>\<omega>'\<in>sem C S2. snd \<omega>1 = snd \<omega>' \<and> equal_outside_set vars (fst \<omega>1) (fst \<omega>')"
+    by (metis \<open>\<langle>C, \<sigma>\<rangle> \<rightarrow> snd \<omega>1\<close> \<open>fst \<omega>1 = l1\<close> fst_conv in_sem snd_conv)
+qed
+
+
+lemma sem_update_commute:
+  assumes "same_mod_updates (vars :: 'a set) S1 S2"
+  shows "same_mod_updates vars (sem C S1) (sem C S2)"
+  using assms same_mod_updates_def sem_update_commute_aux by blast
+
+
+
+type_synonym ('a, 'b, 'c, 'd) chyperassertion = "(('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool"
+
+definition invariant_on_updates :: "'a set \<Rightarrow> ('a, 'b, 'c, 'd) chyperassertion \<Rightarrow> bool" where
+  "invariant_on_updates vars P \<longleftrightarrow> (\<forall>S S'. same_mod_updates vars S S' \<longrightarrow> (P S \<longleftrightarrow> P S'))"
+
+lemma invariant_on_updatesI:
+  assumes "\<And>S S'. same_mod_updates vars S S' \<Longrightarrow> P S \<Longrightarrow> P S'"
+  shows "invariant_on_updates vars P"
+  using assms invariant_on_updates_def same_mod_updates_sym by blast
+
+definition entails_with_updates :: "'a set \<Rightarrow> ('a, 'b, 'c, 'd) chyperassertion \<Rightarrow> ('a, 'b, 'c, 'd) chyperassertion \<Rightarrow> bool"
+  where
+  "entails_with_updates vars P Q \<longleftrightarrow> (\<forall>S. P S \<longrightarrow> (\<exists>S'. same_mod_updates vars S S' \<and> Q S'))"
+
+lemma entails_with_updatesI:
+  assumes "\<And>S. P S \<Longrightarrow> (\<exists>S'. same_mod_updates vars S S' \<and> Q S')"
+  shows "entails_with_updates vars P Q"
+  by (simp add: assms entails_with_updates_def)
+
+
+lemma entails_with_updatesE:
+  assumes "entails_with_updates vars P Q"
+      and "P S"
+    shows "\<exists>S'. same_mod_updates vars S S' \<and> Q S'"
+  by (meson assms(1) assms(2) entails_with_updates_def)
+
+
+proposition rule_LUpdate:
+  assumes "\<Turnstile> {P'} C {Q}"
+      and "entails_with_updates vars P P'"
+      and "invariant_on_updates vars Q"
+    shows "\<Turnstile> {P} C {Q}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "P S"
+  then obtain S' where "same_mod_updates vars S S' \<and> P' S'"
+    using assms(2) entails_with_updatesE by blast
+  then have "same_mod_updates vars (sem C S) (sem C S')"
+    using sem_update_commute by blast
+  moreover have "Q (sem C S')"
+    using \<open>same_mod_updates vars S S' \<and> P' S'\<close> assms(1) hyper_hoare_tripleE by auto
+  ultimately show "Q (sem C S)"
+    using assms(3) invariant_on_updates_def by blast
+qed
+
+
+
+
+subsection \<open>Filters\<close>
+
+lemma filter_prop_commute_aux:
+  assumes "\<And>\<omega> \<omega>'. fst \<omega> = fst \<omega>' \<Longrightarrow> (f \<omega> \<longleftrightarrow> f \<omega>')"
+  shows "Set.filter f (sem C S) = sem C (Set.filter f S)" (is "?A = ?B")
+proof
+  show "?A \<subseteq> ?B"
+  proof
+    fix \<omega>' assume "\<omega>' \<in> ?A"
+    then obtain \<omega> where "\<omega> \<in> S" "single_sem C (snd \<omega>) (snd \<omega>')" "fst \<omega> = fst \<omega>'" "f \<omega>'"
+      by (metis fst_conv in_sem member_filter snd_conv)
+    then show "\<omega>' \<in> ?B"
+      by (metis assms in_sem member_filter prod.collapse)
+  qed
+  show "?B \<subseteq> ?A"
+  proof
+    fix x assume "x \<in> sem C (Set.filter f S)"
+    then show "x \<in> Set.filter f (sem C S)"
+      by (metis assms fst_conv in_sem member_filter)
+  qed
+qed
+
+definition commute_with_sem where
+  "commute_with_sem f \<longleftrightarrow> (\<forall>S C. f (sem C S) = sem C (f S))"
+
+lemma commute_with_semI:
+  assumes "\<And>(S :: (('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set) C. f (sem C S) = sem C (f S)"
+  shows "commute_with_sem f"
+  by (simp add: assms commute_with_sem_def)
+
+lemma filter_prop_commute:
+  assumes "\<And>\<omega> \<omega>'. fst \<omega> = fst \<omega>' \<Longrightarrow> (f \<omega> \<longleftrightarrow> f \<omega>')"
+  shows "commute_with_sem (Set.filter f)"
+  using assms commute_with_sem_def filter_prop_commute_aux by blast
+
+lemma rule_apply:
+  assumes "\<Turnstile> {P} C {Q}"
+      and "commute_with_sem f"
+    shows "\<Turnstile> {P \<circ> f} C {Q \<circ> f}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume "(P \<circ> f) S"
+  then show "(Q \<circ> f) (sem C S)"
+    by (metis assms(1) assms(2) commute_with_sem_def comp_apply hyper_hoare_tripleE)
+qed
+
+definition apply_filter where
+  "apply_filter b P S \<longleftrightarrow> P (Set.filter b S)"
+
+proposition rule_LFilter:
+  assumes "\<Turnstile> {P} C {Q}"
+  shows "\<Turnstile> { P \<circ> (Set.filter (b \<circ> fst)) } C { Q \<circ> (Set.filter (b \<circ> fst)) }"
+  by (simp add: assms filter_prop_commute rule_apply)
+
+
+definition differ_only_by_pset_single where
+  "differ_only_by_pset_single vars a b \<longleftrightarrow> (fst a = fst b \<and> differ_only_by_set vars (snd a) (snd b))"
+
+definition not_in_free_pvars_pexp where
+  "not_in_free_pvars_pexp vars b \<longleftrightarrow> (\<forall>\<phi>1 \<phi>2. differ_only_by_set vars \<phi>1 \<phi>2 \<longrightarrow> (b \<phi>1 \<longleftrightarrow> b \<phi>2))"
+
+lemma single_sem_differ_by_written_vars:
+  assumes "single_sem C \<phi> \<phi>'"
+  shows "differ_only_by_set (written_vars C) \<phi> \<phi>'"
+  by (meson assms differ_only_by_set_def written_vars_not_modified)
+
+lemma single_sem_not_free_vars:
+  assumes "not_in_free_pvars_pexp (written_vars C) b"
+      and "single_sem C \<phi> \<phi>'"
+    shows "b \<phi> \<longleftrightarrow> b \<phi>'"
+  using assms(1) assms(2) not_in_free_pvars_pexp_def single_sem_differ_by_written_vars by blast
+
+
+proposition rule_PFilter:
+  assumes "\<Turnstile> {P} C {Q}"
+      and "not_in_free_pvars_pexp (written_vars C) b"
+  shows "\<Turnstile> { P \<circ> (Set.filter (b \<circ> snd)) } C { Q \<circ> (Set.filter (b \<circ> snd)) }"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "(P \<circ> Set.filter (b \<circ> snd)) S"
+  let ?S = "Set.filter (b \<circ> snd) S"
+  have "Q (sem C ?S)"
+    using asm0 assms(1) hyper_hoare_tripleE by auto
+  moreover have "sem C ?S = Set.filter (b \<circ> snd) (sem C S)" (is "?A = ?B")
+  proof
+    show "?B \<subseteq> ?A"
+    proof
+      fix \<phi>' assume "\<phi>' \<in> Set.filter (b \<circ> snd) (sem C S)"
+      then obtain \<phi> where "\<phi> \<in> S" "fst \<phi> = fst \<phi>'" "single_sem C (snd \<phi>) (snd \<phi>')" "b (snd \<phi>')"
+        by (metis comp_apply fst_conv in_sem member_filter snd_conv)
+      then have "b (snd \<phi>)"
+        using single_sem_not_free_vars[of C b "snd \<phi>" "snd \<phi>'"] assms(2)
+        by simp
+      then show "\<phi>' \<in> ?A"
+        by (metis \<open>\<langle>C, snd \<phi>\<rangle> \<rightarrow> snd \<phi>'\<close> \<open>\<phi> \<in> S\<close> \<open>fst \<phi> = fst \<phi>'\<close> comp_apply in_sem member_filter prod.collapse)
+    qed
+    show "?A \<subseteq> ?B"
+    proof
+      fix \<phi>' assume "\<phi>' \<in> sem C (Set.filter (b \<circ> snd) S)"
+      then obtain \<phi> where "\<phi> \<in> S" "fst \<phi> = fst \<phi>'" "single_sem C (snd \<phi>) (snd \<phi>')" "b (snd \<phi>)"
+        by (metis (mono_tags, lifting) comp_apply fst_conv in_sem member_filter snd_conv)
+      then have "b (snd \<phi>')"
+        using assms(2) single_sem_not_free_vars by blast
+      then show "\<phi>' \<in> ?B"
+        by (metis \<open>\<langle>C, snd \<phi>\<rangle> \<rightarrow> snd \<phi>'\<close> \<open>\<phi> \<in> S\<close> \<open>fst \<phi> = fst \<phi>'\<close> comp_apply member_filter prod.collapse single_step_then_in_sem)
+    qed
+  qed
+  ultimately show "(Q \<circ> Set.filter (b \<circ> snd)) (sem C S)"
+    by auto
+qed
+
+
+
+
+subsection \<open>Other Compositionality Rules\<close>
+
+proposition rule_False:
+  "hyper_hoare_triple (\<lambda>_. False) C Q"
+  by (simp add: hyper_hoare_triple_def)
+
+proposition rule_True:
+  "hyper_hoare_triple P C (\<lambda>_. True)"
+  by (simp add: hyper_hoare_triple_def)
+
+
+(* Other direction does not hold! *)
+lemma sem_inter:
+  "sem C (S1 \<inter> S2) \<subseteq> sem C S1 \<inter> sem C S2"
+  by (simp add: sem_monotonic)
+
+
+proposition rule_Union:
+  assumes "\<Turnstile> {P} C {Q}"
+      and "hyper_hoare_triple P' C Q'"
+    shows "hyper_hoare_triple (join P P') C (join Q Q')"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "join P P' S"
+  then obtain S1 S2 where "S = S1 \<union> S2" "P S1" "P' S2"
+    by (metis join_def)
+  then have "sem C S = sem C S1 \<union> sem C S2"
+    using sem_union by auto
+  then show "join Q Q' (sem C S)"
+    by (metis \<open>P S1\<close> \<open>P' S2\<close> assms(1) assms(2) hyper_hoare_tripleE join_def)
+qed
+
+proposition rule_IndexedUnion:
+  assumes "\<And>x. \<Turnstile> {P x} C {Q x}"
+  shows "hyper_hoare_triple (general_join P) C (general_join Q)"
+proof (rule hyper_hoare_tripleI)
+  fix S assume "general_join P S"
+  then obtain F where asm0: "S = (\<Union>x. F x)" "\<And>x. P x (F x)"
+    by (meson general_join_def)
+  have "sem C S = (\<Union>x. sem C (F x))"
+    by (simp add: asm0(1) sem_split_general)
+  moreover have "\<And>x. Q x (sem C (F x))"
+    using asm0(2) assms hyper_hoare_tripleE by blast
+  ultimately show "general_join Q (sem C S)"
+    by (metis general_join_def)
+qed
+
+proposition rule_And:
+  assumes "\<Turnstile> {P} C {Q}"
+      and "hyper_hoare_triple P' C Q'"
+    shows "hyper_hoare_triple (conj P P') C (conj Q Q')"
+proof (rule hyper_hoare_tripleI)
+  fix S assume "Logic.conj P P' S"
+  then show "Logic.conj Q Q' (sem C S)"
+    by (metis assms(1) assms(2) conj_def hyper_hoare_tripleE)
+qed
+
+lemma rule_Forall:
+  assumes "\<And>x. \<Turnstile> {P x} C {Q x}"
+  shows "hyper_hoare_triple (forall P) C (forall Q)"
+  by (metis assms forall_def hyper_hoare_triple_def)
+
+lemma rule_Or:
+  assumes "\<Turnstile> {P} C {Q}"
+      and "\<Turnstile> {P'} C {Q'}"
+    shows "hyper_hoare_triple (disj P P') C (disj Q Q')"
+  by (metis assms(1) assms(2) disj_def hyper_hoare_triple_def)
+
+corollary variant_if_rule:
+  assumes "hyper_hoare_triple P C1 Q"
+      and "hyper_hoare_triple P C2 Q"
+      and "closed_by_union Q"
+    shows "hyper_hoare_triple P (If C1 C2) Q"
+  by (metis assms(1) assms(2) assms(3) if_rule join_closed_by_union)
+
+
+text \<open>Simplifying the rule\<close>
+
+definition stable_by_infinite_union :: "'a hyperassertion \<Rightarrow> bool" where
+  "stable_by_infinite_union I \<longleftrightarrow> (\<forall>F. (\<forall>S \<in> F. I S) \<longrightarrow> I (\<Union>S \<in> F. S))"
+
+lemma stable_by_infinite_unionE:
+  assumes "stable_by_infinite_union I"
+      and "\<And>S. S \<in> F \<Longrightarrow> I S"
+    shows "I (\<Union>S \<in> F. S)"
+  using assms(1) assms(2) stable_by_infinite_union_def by blast
+
+lemma stable_by_union_and_constant_then_I:
+  assumes "\<And>n. I n = I'"
+      and "stable_by_infinite_union I'"
+    shows "natural_partition I = I'"
+proof (rule ext)
+  fix S show "natural_partition I S = I' S"
+  proof
+    show "I' S \<Longrightarrow> natural_partition I S"
+    proof -
+      assume "I' S"
+      show "natural_partition I S"
+      proof (rule natural_partitionI)
+        show "S = \<Union> (range (\<lambda>n. S))"
+          by simp
+        fix n show "I n S"
+          by (simp add: \<open>I' S\<close> assms(1))
+      qed
+    qed
+    assume asm0: "natural_partition I S"
+    then obtain F where "S = (\<Union>n. F n)" "\<And>n. I n (F n)"
+      using natural_partitionE by blast
+    let ?F = "{F n |n. True}"
+    have "I' (\<Union>S\<in>?F. S)"
+      using assms(2)
+    proof (rule stable_by_infinite_unionE[of I'])
+      fix S assume "S \<in> {F n |n. True}"
+      then show "I' S"
+        using \<open>\<And>n. I n (F n)\<close> assms(1) by force
+    qed
+    moreover have "(\<Union>S\<in>?F. S) = S"
+      using \<open>S = (\<Union>n. F n)\<close> by auto
+    ultimately show "I' S" by blast
+  qed
+qed
+
+corollary simpler_rule_while:
+  assumes "hyper_hoare_triple I C I"
+    and "stable_by_infinite_union I"
+  shows "hyper_hoare_triple I (While C) I"
+proof -
+  let ?I = "\<lambda>n. I"
+  have "hyper_hoare_triple (?I 0) (While C) (natural_partition ?I)"
+    using while_rule[of ?I C]
+    by (simp add: assms(1) assms(2) stable_by_union_and_constant_then_I)
+  then show ?thesis
+    by (simp add: assms(2) stable_by_union_and_constant_then_I)
+qed
+
+
+lemma rule_and3:
+  assumes "\<Turnstile> {P1} C {Q1}"
+      and "\<Turnstile> {P2} C {Q2}"
+      and "\<Turnstile> {P3} C {Q3}"
+    shows "\<Turnstile> { conj P1 (conj P2 P3) } C { conj Q1 (conj Q2 Q3) }"
+  by (simp add: assms(1) assms(2) assms(3) rule_And)
+
+definition not_empty where
+  "not_empty S \<longleftrightarrow> S \<noteq> {}"
+
+definition finite_not_empty where
+  "finite_not_empty S \<longleftrightarrow> S \<noteq> {} \<and> finite S"
+
+definition update_logical where
+  "update_logical \<omega> i v = ((fst \<omega>)(i := v), snd \<omega>)"
+
+
+lemma single_sem_prop:
+  assumes "single_sem C (snd \<omega>) (snd \<omega>')"
+      and "fst \<omega> = fst \<omega>'"
+  shows "\<Turnstile> { (\<lambda>S. \<omega> \<in> S) } C { (\<lambda>S. \<omega>' \<in> S) }"
+  by (metis assms(1) assms(2) hyper_hoare_tripleI in_sem prod.collapse)
+
+lemma weaker_linking_rule:
+  assumes "\<And>l \<sigma> \<sigma>'. \<Turnstile> { (\<lambda>S. (l, \<sigma>) \<in> S) } C { (\<lambda>S. (l, \<sigma>') \<in> S) } \<Longrightarrow> ( \<Turnstile> { P (l, \<sigma>) } C { Q (l, \<sigma>') } )"
+  shows "\<Turnstile> { (\<lambda>S. \<forall>\<omega> \<in> S. P \<omega> S) } C { (\<lambda>S. \<forall>\<omega>' \<in> S. Q \<omega>' S) }"
+  by (simp add: assms rule_linking_alt single_sem_prop)
+
+
+definition general_union :: "'a hyperassertion \<Rightarrow> 'a hyperassertion" where
+  "general_union P S \<longleftrightarrow> (\<exists>F. S = Union F \<and> (\<forall>S' \<in> F. P S'))"
+
+lemma general_unionI:
+  assumes "S = Union F"
+      and "\<And>S'. S' \<in> F \<Longrightarrow> P S'"
+    shows "general_union P S"
+  using assms(1) assms(2) general_union_def by blast
+
+lemma general_unionE:
+  assumes "general_union P S"
+  obtains F where "S = Union F" "\<And>S'. S' \<in> F \<Longrightarrow> P S'"
+  by (metis assms general_union_def)
+
+
+(* Derived *)
+proposition rule_BigUnion:
+  fixes P :: "((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)"
+  assumes "\<Turnstile> {P} C {Q}"
+  shows "\<Turnstile> {general_union P} C {general_union Q}"
+proof (rule consequence_rule)
+  define PP :: "(('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> (('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool" where
+  "PP = (\<lambda>_. P)"
+  let ?P = "disj (general_join PP) (\<lambda>S. S = {})"
+  show "entails (general_union P) ?P"
+  proof (rule entailsI)
+    fix S assume "general_union P S"
+    then obtain F where "S = Union F" "\<And>S'. S' \<in> F \<Longrightarrow> P S'"
+      by (metis general_union_def)
+    have "general_join PP S \<or> S = {}"
+    proof (cases "S = {}")
+      case True
+      then show ?thesis
+        by simp
+    next
+      case False
+      then obtain S' where "S' \<in> F"
+        using \<open>S = \<Union> F\<close> by blast
+      let ?F = "\<lambda>SS. if SS \<in> F then SS else S'"
+      have "general_join PP S"
+      proof (rule general_joinI)
+        fix x show "PP x (?F x)"
+          by (simp add: PP_def \<open>S' \<in> F\<close> \<open>\<And>S'. S' \<in> F \<Longrightarrow> P S'\<close>)
+      next
+        show "S = (\<Union>x. if x \<in> F then x else S')"
+          using \<open>S = \<Union> F\<close> \<open>S' \<in> F\<close> by force
+      qed
+      then show ?thesis by simp
+    qed
+    then show "disj (general_join PP) (\<lambda>S. S = {}) S"
+      by (simp add: disj_def)
+  qed
+
+  define QQ :: "(('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> (('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool" where
+  "QQ = (\<lambda>_. Q)"
+  let ?Q = "disj (general_join QQ) (\<lambda>S. S = {})"
+
+  show "\<Turnstile> {Logic.disj (general_join PP) (\<lambda>S. S = {})} C {?Q}"
+  proof (rule rule_Or)
+    show "\<Turnstile> {(\<lambda>S. S = {})} C {\<lambda>S. S = {}}"
+      by (metis (mono_tags, lifting) empty_iff equals0I hyper_hoare_triple_def in_sem)
+        (* TODO: Prove this rule *)
+    show "\<Turnstile> {general_join PP} C {general_join QQ}"
+    proof (rule rule_IndexedUnion)
+      fix x show "\<Turnstile> {PP x} C {QQ x}"
+        by (simp add: PP_def QQ_def assms)
+    qed
+  qed
+  show "entails (Logic.disj (general_join QQ) (\<lambda>S. S = {})) (general_union Q)"
+  proof (rule entailsI)
+    fix S assume "Logic.disj (general_join QQ) (\<lambda>S. S = {}) S"
+    then show "general_union Q S"
+    proof (cases "S = {}")
+      case True
+      then show ?thesis
+        using general_union_def by auto
+    next
+      case False
+      then obtain F where "\<And>x. QQ x (F x)" "S = \<Union> (range F)"
+        by (metis (mono_tags, lifting) \<open>Logic.disj (general_join QQ) (\<lambda>S. S = {}) S\<close> disj_def general_join_def)
+      then show ?thesis
+        by (metis QQ_def general_unionI rangeE)
+    qed
+  qed
+qed
+
+
+
+proposition rule_Empty:
+  "\<Turnstile> { (\<lambda>S. S = {}) } C { (\<lambda>S. S = {}) }"
+proof (rule consequence_rule)
+  let ?P = "general_union (\<lambda>_. False)"
+  show "entails (\<lambda>S. S = {}) ?P"
+    by (metis (full_types) Union_empty empty_iff entailsI general_unionI)
+  show "entails ?P (\<lambda>S. S = {})"
+    using entailsI[of ?P "\<lambda>S. S = {}"] general_union_def Sup_bot_conv(2) by metis
+  show "\<Turnstile> {general_union (\<lambda>_. False)} C {general_union (\<lambda>_. False)}"
+  proof (rule rule_BigUnion)
+    show "\<Turnstile> {(\<lambda>_. False)} C {\<lambda>_. False}"
+      using rule_False by auto
+  qed
+qed
+
+definition has_subset where
+  "has_subset P S \<longleftrightarrow> (\<exists>S'. S' \<subseteq> S \<and> P S')"
+
+lemma has_subset_join_same:
+  "entails (has_subset P) (join P (\<lambda>_. True))"
+  "entails (join P (\<lambda>_. True)) (has_subset P)"
+  using entailsI[of "has_subset P" "join P (\<lambda>_. True)"] has_subset_def join_def sup.absorb_iff2
+   apply metis
+  using UnCI entails_def[of "join P (\<lambda>_. True)" "has_subset P"] has_subset_def join_def subset_eq
+  by metis
+
+
+(* derived from join *)
+proposition rule_AtLeast:
+  assumes "\<Turnstile> {P} C {Q}"
+  shows "\<Turnstile> {has_subset P} C {has_subset Q}"
+proof (rule consequence_rule)
+  let ?P = "join P (\<lambda>_. True)"
+  let ?Q = "join Q (\<lambda>_. True)"
+  show "\<Turnstile> {?P} C {?Q}"
+    by (simp add: assms rule_True rule_Union)
+qed (auto simp add: has_subset_join_same)
+
+definition has_superset where
+  "has_superset P S \<longleftrightarrow> (\<exists>S'. S \<subseteq> S' \<and> P S')"
+
+proposition rule_AtMost:
+  assumes "\<Turnstile> {P} C {Q}"
+  shows "\<Turnstile> {has_superset P} C {has_superset Q}"
+proof (rule hyper_hoare_tripleI)
+  fix S :: "(('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set"
+  assume "has_superset P S"
+  then obtain S' where "S \<subseteq> S'" "P S'"
+    by (meson has_superset_def)
+  then have "Q (sem C S')"
+    using assms hyper_hoare_tripleE by blast
+  then show "has_superset Q (sem C S)"
+    by (meson \<open>S \<subseteq> S'\<close> has_superset_def sem_monotonic)
+qed
+
+
+
+
+subsection \<open>Synchronous Reasoning (Proposition 14, Appendix H).\<close>
+
+theorem if_sync_rule:
+  assumes "\<Turnstile> {P} C1 {P1}"
+      and "\<Turnstile> {P} C2 {P2}"
+      and "\<Turnstile> {combine from_nat x P1 P2} C {combine from_nat x R1 R2}"
+      and "\<Turnstile> {R1} C1' {Q1}"
+      and "\<Turnstile> {R2} C2' {Q2}"
+
+      and "not_free_var_hyper x P1"
+      and "not_free_var_hyper x P2"
+      and "from_nat 1 \<noteq> from_nat 2"
+
+      and "not_free_var_hyper x R1"
+      and "not_free_var_hyper x R2"
+
+    shows "\<Turnstile> {P} If (Seq C1 (Seq C C1')) (Seq C2 (Seq C C2')) {join Q1 Q2}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "P S"
+  have r0: "sem (stmt.If (Seq C1 (Seq C C1')) (Seq C2 (Seq C C2'))) S
+  = sem C1' (sem C (sem C1 S)) \<union> sem C2' (sem C (sem C2 S))"
+    by (simp add: sem_if sem_seq)
+  moreover have "P1 (sem C1 S) \<and> P2 (sem C2 S)"
+    using asm0 assms(1) assms(2) hyper_hoare_tripleE by blast
+
+  let ?S1 = "(modify_lvar_to x (from_nat 1)) ` (sem C1 S)"
+  let ?S2 = "(modify_lvar_to x (from_nat 2)) ` (sem C2 S)"
+  let ?f1 = "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 1)"
+  let ?f2 = "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 2)"
+
+  have "P1 ?S1 \<and> P2 ?S2"
+    by (meson \<open>P1 (sem C1 S) \<and> P2 (sem C2 S)\<close> assms(6) assms(7) not_free_var_hyper_def)
+  moreover have rr1: "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 1) (?S1 \<union> ?S2) = ?S1"
+    using injective_then_ok[of "from_nat 1" "from_nat 2" ?S1 x]
+    by (metis (no_types, lifting) assms(8))
+  moreover have rr2: "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 2) (?S1 \<union> ?S2) = ?S2"
+    using injective_then_ok[of "from_nat 2" "from_nat 1" ?S2 x]
+    by (metis (no_types, lifting) assms(8) sup_commute)
+  ultimately have "combine from_nat x P1 P2 (?S1 \<union> ?S2)"
+    by (metis combineI)
+  then have "combine from_nat x R1 R2 (sem C (?S1 \<union> ?S2))"
+    using assms(3) hyper_hoare_tripleE by blast
+  moreover have "?f1 (sem C (?S1 \<union> ?S2)) = sem C ?S1"
+    using recover_after_sem[of "from_nat 1" "from_nat 2" ?S1 x ?S2] assms(8) rr1 rr2
+      member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 1"] member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 2"]
+    by metis
+  then have "R1 (sem C ?S1)"
+    by (metis (mono_tags) calculation combine_def)
+  then have "R1 (sem C (sem C1 S))"
+    by (metis assms(9) not_free_var_hyper_def sem_of_modify_lvar)
+  moreover have "?f2 (sem C (?S1 \<union> ?S2)) = sem C ?S2"
+    using recover_after_sem[of "from_nat 2" "from_nat 1" ?S2 x ?S1] assms(8) rr1 rr2 sup_commute[of ]
+      member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 1" "?S1 \<union> ?S2"] member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 2" "?S1 \<union> ?S2"]
+    by metis
+  then have "R2 (sem C ?S2)"
+    by (metis (mono_tags) calculation(1) combine_def)
+  then have "R2 (sem C (sem C2 S))"
+    by (metis assms(10) not_free_var_hyper_def sem_of_modify_lvar)
+
+  then show "join Q1 Q2 (sem (stmt.If (Seq C1 (Seq C C1')) (Seq C2 (Seq C C2'))) S)"
+    by (metis (full_types) r0 assms(4) assms(5) calculation(2) hyper_hoare_tripleE join_def)
+qed
+
+
+definition update_lvar_set where
+  "update_lvar_set u e S = { ((fst \<phi>')(u := e \<phi>'), snd \<phi>') |\<phi>'. \<phi>' \<in> S}"
+
+lemma equal_outside_set_helper:
+  "equal_outside_set {u} (fst \<phi>) (fst ((fst \<phi>)(u := x), snd \<phi>))"
+  by (simp add: equal_outside_set_def)
+
+lemma same_update_lvar_set:
+  "same_mod_updates {u} S (update_lvar_set u e S)"
+proof (rule same_mod_updatesI)
+  show "\<And>\<omega>'. \<omega>' \<in> update_lvar_set u e S \<Longrightarrow> \<exists>\<omega>\<in>S. snd \<omega> = snd \<omega>' \<and> equal_outside_set {u} (fst \<omega>') (fst \<omega>)"
+  proof -
+    fix \<omega>' assume "\<omega>' \<in> update_lvar_set u e S"
+    then obtain \<phi>' where "\<omega>' = ((fst \<phi>')(u := e \<phi>'), snd \<phi>')" "\<phi>' \<in> S"
+      using mem_Collect_eq update_lvar_set_def[of u e S] by auto
+    then show "\<exists>\<omega>\<in>S. snd \<omega> = snd \<omega>' \<and> equal_outside_set {u} (fst \<omega>') (fst \<omega>)"
+      by (meson equal_outside_set_helper equal_outside_sym snd_eqD)
+  qed
+  show "\<And>\<omega>. \<omega> \<in> S \<Longrightarrow> \<exists>\<omega>'\<in>update_lvar_set u e S. snd \<omega> = snd \<omega>' \<and> equal_outside_set {u} (fst \<omega>) (fst \<omega>')"
+    by (metis (mono_tags, lifting) equal_outside_set_helper mem_Collect_eq snd_conv update_lvar_set_def)
+qed
+
+
+lemma same_mod_updates_empty:
+  assumes "same_mod_updates vars {} S'"
+  shows "S' = {}"
+  by (meson assms equals0D equals0I same_mod_updates_def subset_mod_updatesE)
+
+definition not_fv_hyper where
+  "not_fv_hyper t A \<longleftrightarrow> (\<forall>S S'. same_mod_updates {t} S S' \<and> A S \<longrightarrow> A S')"
+
+lemma not_fv_hyperE:
+  assumes "not_fv_hyper e I"
+      and "same_mod_updates {e} S S'"
+      and "I S"
+    shows "I S'"
+  by (meson assms(1) assms(2) assms(3) not_fv_hyper_def)
+
+definition assign_exp_to_lvar where
+  "assign_exp_to_lvar e l \<phi> = ((fst \<phi>)(l := e (snd \<phi>)), snd \<phi>)"
+
+definition assign_exp_to_lvar_set where
+  "assign_exp_to_lvar_set e l S = assign_exp_to_lvar e l ` S"
+
+lemma same_outside_set_lvar_assign_exp:
+  "snd \<phi> = snd (assign_exp_to_lvar e l \<phi>) \<and> equal_outside_set {l} (fst \<phi>) (fst (assign_exp_to_lvar e l \<phi>))"
+  by (simp add: assign_exp_to_lvar_def equal_outside_set_def)
+
+
+lemma assign_exp_to_lvar_set_same_mod_updates:
+  "same_mod_updates {l} S (assign_exp_to_lvar_set e l S)"
+proof (rule same_mod_updatesI)
+  show "\<And>\<omega>. \<omega> \<in> S \<Longrightarrow> \<exists>\<omega>'\<in>assign_exp_to_lvar_set e l S. snd \<omega> = snd \<omega>' \<and> equal_outside_set {l} (fst \<omega>) (fst \<omega>')"
+    by (metis assign_exp_to_lvar_set_def rev_image_eqI same_outside_set_lvar_assign_exp)
+  show "\<And>\<omega>'. \<omega>' \<in> assign_exp_to_lvar_set e l S \<Longrightarrow> \<exists>\<omega>\<in>S. snd \<omega> = snd \<omega>' \<and> equal_outside_set {l} (fst \<omega>') (fst \<omega>)"
+    by (metis (mono_tags, opaque_lifting) assign_exp_to_lvar_set_def equal_outside_sym imageE same_outside_set_lvar_assign_exp)
+qed
+
+
+lemma holds_forall_same_mod_updates:
+  assumes "same_mod_updates vars S S'"
+      and "holds_forall b S"
+    shows "holds_forall b S'"
+proof (rule holds_forallI)
+  fix \<phi>' assume asm0: "\<phi>' \<in> S'"
+  then obtain \<phi> where "\<phi> \<in> S" "snd \<phi> = snd \<phi>'"
+    by (metis assms(1) same_mod_updates_def subset_mod_updatesE)
+  then show "b (snd \<phi>')"
+    by (metis assms(2) holds_forall_def)
+qed
+
+lemma not_fv_hyper_assign_exp:
+  assumes "not_fv_hyper t A"
+  shows "A S \<longleftrightarrow> A (assign_exp_to_lvar_set e t S)"
+  by (metis assign_exp_to_lvar_set_same_mod_updates assms not_fv_hyper_def same_mod_updates_sym)
+
+lemma holds_forall_same_assign_lvar:
+  "holds_forall b S \<longleftrightarrow> holds_forall b (assign_exp_to_lvar_set e l S)" (is "?A \<longleftrightarrow> ?B")
+proof
+  show "?A \<Longrightarrow> ?B"
+    by (simp add: assign_exp_to_lvar_def assign_exp_to_lvar_set_def holds_forall_def)
+  show "?B \<Longrightarrow> ?A"
+    by (simp add: assign_exp_to_lvar_def assign_exp_to_lvar_set_def holds_forall_def)
+qed
+
+definition e_recorded_in_t where
+  "e_recorded_in_t e t S \<longleftrightarrow> (\<forall>\<phi>\<in>S. fst \<phi> t = e (snd \<phi>))"
+
+lemma e_recorded_in_tI:
+  assumes "\<And>\<phi>. \<phi>\<in>S \<Longrightarrow> fst \<phi> t = e (snd \<phi>)"
+  shows "e_recorded_in_t e t S"
+  by (simp add: assms e_recorded_in_t_def)
+
+definition e_smaller_than_t where
+  "e_smaller_than_t e t lt S \<longleftrightarrow> (\<forall>\<phi>\<in>S. lt (e (snd \<phi>)) (fst \<phi> t))"
+
+
+lemma low_expI:
+  assumes "\<And>\<phi> \<phi>'. \<phi> \<in> S \<and> \<phi>' \<in> S \<Longrightarrow> (e (snd \<phi>) = e (snd \<phi>'))"
+  shows "low_exp e S"
+  using low_exp_def assms by blast
+
+lemma low_exp_forall_same_mod_updates:
+  assumes "same_mod_updates vars S S'"
+      and "low_exp b S"
+    shows "low_exp b S'"
+proof (rule low_expI)
+  fix \<phi>' \<phi>'' assume asm0: "\<phi>' \<in> S' \<and> \<phi>'' \<in> S'"
+  then obtain \<phi> where "\<phi> \<in> S" "snd \<phi> = snd \<phi>'"
+    by (metis assms(1) same_mod_updates_def subset_mod_updatesE)
+  then show "b (snd \<phi>') = b (snd \<phi>'')"
+    using asm0 assms(1) assms(2) low_exp_def[of b S] same_mod_updates_def[of vars S S'] subset_mod_updatesE
+    by metis
+qed
+
+lemma e_recorded_in_t_if_assigned:
+  "e_recorded_in_t e t (assign_exp_to_lvar_set e t S)"
+  by (simp add: assign_exp_to_lvar_def assign_exp_to_lvar_set_def e_recorded_in_t_def)
+
+lemma low_exp_commute_assign_lvar:
+  "low_exp b (assign_exp_to_lvar_set e t S) \<longleftrightarrow> low_exp b S" (is "?A \<longleftrightarrow> ?B")
+proof
+  assume ?A
+  then show ?B
+    by (meson assign_exp_to_lvar_set_same_mod_updates low_exp_forall_same_mod_updates same_mod_updates_sym)
+next
+  assume ?B
+  then show ?A
+    by (meson assign_exp_to_lvar_set_same_mod_updates low_exp_forall_same_mod_updates)
+qed
+
+end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/ExamplesCompositionality.thy b/thys/HyperHoareLogic/ExamplesCompositionality.thy
new file mode 100644
--- /dev/null
+++ b/thys/HyperHoareLogic/ExamplesCompositionality.thy
@@ -0,0 +1,472 @@
+section \<open>Examples\<close>
+
+text \<open>In this file, we prove the correctness of the two compositionality
+proofs presented in Appendix D.2.\<close>
+
+theory ExamplesCompositionality
+  imports Logic Compositionality
+begin
+
+definition low where
+  "low l S \<longleftrightarrow> (\<forall>\<phi>1 \<phi>2. \<phi>1 \<in> S \<and> \<phi>2 \<in> S \<longrightarrow> snd \<phi>1 l = snd \<phi>2 l)"
+
+subsection \<open>Examples using the core rules.\<close>
+
+definition GNI where
+  "GNI l h S \<longleftrightarrow> (\<forall>\<phi>1 \<phi>2. \<phi>1 \<in> S \<and> \<phi>2 \<in> S
+  \<longrightarrow> (\<exists>\<phi> \<in> S. snd \<phi> h = snd \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l))"
+
+lemma GNI_I:
+  assumes "\<And>\<phi>1 \<phi>2. \<phi>1 \<in> S \<and> \<phi>2 \<in> S
+  \<Longrightarrow> (\<exists>\<phi> \<in> S. snd \<phi> h = snd \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l)"
+  shows "GNI l h S"
+  by (simp add: GNI_def assms)
+
+subsection \<open>Examples using the compositionality rules\<close>
+
+
+
+definition has_minimum :: "'c \<Rightarrow> ('d \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> ('a, 'b, 'c, 'd) chyperassertion" where
+  "has_minimum x leq S \<longleftrightarrow> (\<exists>\<omega>\<in>S. \<forall>\<omega>'\<in>S. leq (snd \<omega> x) (snd \<omega>' x))"
+
+lemma has_minimumI:
+  assumes "\<omega> \<in> S"
+      and "\<And>\<omega>'. \<omega>' \<in> S \<Longrightarrow> leq (snd \<omega> x) (snd \<omega>' x)"
+    shows "has_minimum x leq S"
+  by (metis assms(1) assms(2) has_minimum_def)
+
+definition is_monotonic where
+  "is_monotonic i x one two leq S \<longleftrightarrow> (\<forall>\<omega>\<in>S. \<forall>\<omega>'\<in>S. fst \<omega> i = one \<and> fst \<omega>' i = two \<longrightarrow> leq (snd \<omega> x) (snd \<omega>' x))"
+
+lemma is_monotonicI:
+  assumes "\<And>\<omega> \<omega>'. \<omega> \<in> S \<Longrightarrow> \<omega>' \<in> S \<Longrightarrow> fst \<omega> i = one \<and> fst \<omega>' i = two \<Longrightarrow> leq (snd \<omega> x) (snd \<omega>' x)"
+  shows "is_monotonic i x one two leq S"
+  by (simp add: assms is_monotonic_def)
+
+
+
+lemma update_logical_equal_outside:
+  "equal_outside_set {i} (snd \<omega>) (snd (update_logical \<omega> i v))"
+  by (simp add: equal_outside_set_def update_logical_def)
+
+lemma update_logical_read:
+  "fst (update_logical \<omega> i v) i = v"
+  by (simp add: update_logical_def)
+
+lemma snd_update_logical_same:
+  "snd (update_logical \<omega> i v) = snd \<omega>"
+  by (simp add: update_logical_def)
+
+text \<open>Figure 12\<close>
+proposition composing_monotonicity_and_minimum:
+  fixes P :: "((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)"
+  fixes i :: 'a
+  fixes x :: 'c
+  fixes y :: 'c
+  fixes leq :: "'d \<Rightarrow> 'd \<Rightarrow> bool"
+  fixes one :: 'b
+  fixes two :: 'b
+
+  assumes "\<Turnstile> { P } C1 { has_minimum x leq }"
+      and "\<Turnstile> { is_monotonic i x one two leq } C2 { is_monotonic i y one two leq }"
+      and "\<Turnstile> { (is_singleton :: ((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)) } C2 { is_singleton }"
+      and "one \<noteq> two"
+
+      and "\<And>x. leq x x" \<comment>\<open>reflexivity\<close>
+
+    shows "\<Turnstile> { P } C1 ;; C2 { has_minimum y leq }"
+  using assms(1)
+proof (rule seq_rule)
+
+  let ?P1 = "is_singleton \<circ> (Set.filter (\<lambda>\<omega>. fst \<omega> i = one))"
+  let ?P2 = "is_monotonic i x one two leq"
+  let ?P3 = "\<lambda>S. \<forall>\<omega>\<in>S. fst \<omega> i = one \<or> fst \<omega> i = two"
+
+  let ?P = "conj ?P1 (conj ?P2 ?P3)"
+
+  let ?Q1 = "is_singleton \<circ> (Set.filter (\<lambda>\<omega>. fst \<omega> i = one))"
+  let ?Q2 = "is_monotonic i y one two leq"
+  let ?Q3 = "\<lambda>S. \<forall>\<omega>\<in>S. fst \<omega> i = one \<or> fst \<omega> i = two"
+
+  let ?Q = "conj ?Q1 (conj ?Q2 ?Q3)"
+
+
+  show "\<Turnstile> { (has_minimum x leq :: ((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)) } C2 { has_minimum y leq }"
+  proof (rule rule_LUpdate)
+
+    show "entails_with_updates {i} (has_minimum x leq) ?P"
+    proof (rule entails_with_updatesI)
+      fix S :: "(('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set"
+      assume asm0: "has_minimum x leq S"
+      then obtain \<omega> where minimum: "\<omega> \<in> S" "\<And>\<omega>'. \<omega>' \<in> S \<Longrightarrow> leq (snd \<omega> x) (snd \<omega>' x)"
+        by (metis has_minimum_def)
+      let ?\<omega> = "update_logical \<omega> i one"
+      let ?S = "{ update_logical \<omega>' i two |\<omega>'. \<omega>' \<in> S } \<union> {?\<omega>}"
+      have "same_mod_updates {i} S ?S"
+      proof (rule same_mod_updatesI)
+        fix \<omega>' assume asm1: "\<omega>' \<in> S"
+        then have "update_logical \<omega>' i two \<in> ?S"
+          by blast
+        moreover have "snd \<omega>' = snd (update_logical \<omega>' i two) \<and> equal_outside_set {i} (fst \<omega>') (fst (update_logical \<omega>' i two))"
+          by (metis equal_outside_setI fst_eqD fun_upd_other singletonI snd_update_logical_same update_logical_def)
+        ultimately show "\<exists>\<omega>''\<in>?S. snd \<omega>' = snd \<omega>'' \<and> equal_outside_set {i} (fst \<omega>') (fst \<omega>'')"
+          by blast
+      next
+        fix \<omega>'
+        assume asm1: "\<omega>' \<in> {update_logical \<omega>' i two |\<omega>'. \<omega>' \<in> S} \<union> {update_logical \<omega> i one}"
+        show "\<exists>\<omega>\<in>S. snd \<omega> = snd \<omega>' \<and> equal_outside_set {i} (fst \<omega>') (fst \<omega>)"
+        proof (cases "\<omega>' \<in> {update_logical \<omega>' i two |\<omega>'. \<omega>' \<in> S}")
+          case True
+          then obtain \<omega>'' where "\<omega>' = update_logical \<omega>'' i two" "\<omega>'' \<in> S"
+            by blast
+          then show ?thesis
+            by (metis (mono_tags, lifting) equal_outside_set_def fst_conv fun_upd_other insertCI snd_update_logical_same update_logical_def)
+        next
+          case False
+          then show ?thesis
+            by (metis (mono_tags, lifting) UnE asm1 equal_outside_setI fst_eqD fun_upd_other minimum(1) singletonD singletonI snd_update_logical_same update_logical_def)
+        qed
+      qed
+      moreover have "is_singleton (Set.filter (\<lambda>\<omega>. fst \<omega> i = one) ?S)"
+      proof -
+        have "Set.filter (\<lambda>\<omega>. fst \<omega> i = one) ?S \<subseteq> {?\<omega>}"
+        proof
+          fix \<omega> assume "\<omega> \<in> Set.filter (\<lambda>\<omega>. fst \<omega> i = one) ?S"
+          then have "\<omega> \<in> ?S \<and> fst \<omega> i = one"
+            by simp
+          then show "\<omega> \<in> {?\<omega>}"
+            using assms(4) update_logical_read by force
+        qed
+        moreover have "{?\<omega>} \<subseteq> Set.filter (\<lambda>\<omega>. fst \<omega> i = one) ?S"
+          by (simp add: update_logical_read)
+        ultimately show ?thesis
+          by (simp add: is_singleton_def order_antisym_conv)
+      qed
+      moreover have "is_monotonic i x one two leq ?S"
+      proof (rule is_monotonicI)
+        fix \<omega>' \<omega>'' assume asm1: "\<omega>' \<in> ?S" "\<omega>'' \<in> ?S" "fst \<omega>' i = one \<and> fst \<omega>'' i = two"
+        then have " \<omega>' \<in> {update_logical \<omega> i one} \<and> \<omega>'' \<in> {update_logical \<omega>' i two |\<omega>'. \<omega>' \<in> S}"
+          using assms(4) update_logical_read by fastforce
+        then show "leq (snd \<omega>' x) (snd \<omega>'' x)"
+          by (metis (no_types, lifting) asm1(2) calculation(1) minimum(2) same_mod_updates_def singletonD snd_update_logical_same subset_mod_updatesE)
+      qed
+      moreover have "\<And>\<omega>'. \<omega>' \<in> ?S \<Longrightarrow> fst \<omega>' i = one \<or> fst \<omega>' i = two"
+        using update_logical_read by fastforce
+      ultimately have "same_mod_updates {i} S ?S \<and> ?P ?S"
+        using comp_eq_dest_lhs[of is_singleton "Set.filter (\<lambda>\<omega>. fst \<omega> i = one)"] conj_def[of ?P1 "conj ?P2 ?P3"] conj_def[of ?P2 ?P3]
+        by simp
+      then show "\<exists>S'. same_mod_updates {i} S S' \<and> ?P S'"
+        by blast
+    qed
+
+    show "invariant_on_updates {i} (has_minimum y leq :: ((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool))"
+    proof (rule invariant_on_updatesI)
+      fix S :: "(('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set"
+      fix S'
+      assume asm0: "same_mod_updates {i} S S'" "has_minimum y leq S"
+      then show "has_minimum y leq S'"
+        using has_minimum_def[of y leq S'] has_minimum_def[of y leq S] same_mod_updates_def[of "{i}" S S'] subset_mod_updatesE[of "{i}"]
+          by metis
+    qed
+
+    show "\<Turnstile> { ?P } C2 { has_minimum y leq }"
+    proof (rule consequence_rule)
+      show "entails ?Q (has_minimum y leq)"
+      proof (rule entailsI)
+        fix S :: "(('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set"
+        assume "?Q S"
+        then obtain asm0: "is_singleton (Set.filter (\<lambda>\<omega>. fst \<omega> i = one) S)" "is_monotonic i y one two leq S"
+          "\<And>\<omega>'. \<omega>' \<in> S \<Longrightarrow> fst \<omega>' i = one \<or> fst \<omega>' i = two"
+          by (simp add: conj_def)
+        then obtain \<omega> where "Set.filter (\<lambda>\<omega>. fst \<omega> i = one) S = {\<omega>}"
+          by (metis is_singleton_def)
+        then have "\<omega> \<in> S" by auto
+        then show "has_minimum y leq S"
+        proof (rule has_minimumI)
+          fix \<omega>'
+          assume asm1: "\<omega>' \<in> S"
+          show "leq (snd \<omega> y) (snd \<omega>' y)"
+          proof (cases "fst \<omega>' i = one")
+            case True
+            then show ?thesis
+              using \<open>Set.filter (\<lambda>\<omega>. fst \<omega> i = one) S = {\<omega>}\<close> asm1 assms(5) by fastforce
+          next
+            case False
+            then have "fst \<omega>' i = two"
+              using asm0(3) asm1 by blast
+            then show ?thesis
+              using \<open>Set.filter (\<lambda>\<omega>. fst \<omega> i = one) S = {\<omega>}\<close> asm0(2) asm1 is_monotonic_def[of i y one two leq S] member_filter singleton_iff
+              by force
+          qed
+        qed
+      qed
+      show "\<Turnstile> { ?P } C2 { ?Q }"
+      proof (rule rule_and3)
+        show " \<Turnstile> {is_singleton \<circ> Set.filter (\<lambda>\<omega>. fst \<omega> i = one)} C2 {is_singleton \<circ> Set.filter (\<lambda>\<omega>. fst \<omega> i = one)}"
+        proof (rule rule_apply)
+          show "\<Turnstile> { (is_singleton :: ((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)) } C2 {is_singleton}"
+            using assms(3) by blast
+          show "commute_with_sem (Set.filter (\<lambda>\<omega>. fst \<omega> i = one))"
+            by (simp add: filter_prop_commute)
+        qed
+        show "\<Turnstile> {is_monotonic i x one two leq} C2 {is_monotonic i y one two leq}"
+          by (simp add: assms(2))
+  
+        show "\<Turnstile> {(\<lambda>S. \<forall>\<omega>\<in>S. fst \<omega> i = one \<or> fst \<omega> i = two)} C2 {\<lambda>S. \<forall>\<omega>\<in>S. fst \<omega> i = one \<or> fst \<omega> i = two}"
+          using rule_lframe_single by fast
+      qed
+    qed (auto simp add: entails_refl)
+  qed
+qed
+
+text \<open>In this definition, we use a logical variable for h, which records the initial value of the program variable h\<close>
+
+definition lGNI :: "'pvar \<Rightarrow> 'lvar \<Rightarrow> (('lvar, 'lval, 'pvar, 'pval) state) set \<Rightarrow> bool" where
+  "lGNI l h S \<longleftrightarrow> (\<forall>\<phi>1 \<in> S. (\<forall>\<phi>2 \<in> S. \<exists>\<phi> \<in> S. fst \<phi> h = fst \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l))"
+
+text \<open>Figure 13\<close>
+proposition composing_GNI_with_SNI:
+  fixes h :: 'lvar
+  fixes l :: 'pvar
+
+  assumes "\<Turnstile> { (low l :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C2 { low l }"
+      and "\<Turnstile> { (not_empty :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C2 { not_empty }"
+      and "\<Turnstile> { (low l :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C1 { lGNI l h }"
+    shows "\<Turnstile> { (low l :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C1;; C2 { lGNI l h }"
+  using assms(3)
+proof (rule seq_rule)
+  show "\<Turnstile> { (lGNI l h :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion)} C2 {lGNI l h}"
+    unfolding lGNI_def
+  proof (rule rule_linking)
+    fix \<phi>1 \<phi>1' :: "('lvar, 'lval, 'pvar, 'pval) state"
+    assume asm0: "fst \<phi>1 = fst \<phi>1' \<and> \<Turnstile> { (in_set \<phi>1 :: ('lvar, 'lval, 'pvar, 'pval) state hyperassertion)} C2 {in_set \<phi>1'}"
+    show "\<Turnstile> {(\<lambda>S. \<forall>\<phi>2\<in>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l)} C2 {\<lambda>S. \<forall>\<phi>2\<in>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1' h \<and> snd \<phi> l = snd \<phi>2 l}"
+    proof (rule consequence_rule)
+      let ?ex = "\<lambda>S. \<exists>\<phi> \<in> S. fst \<phi> h = fst \<phi>1 h"
+      let ?P = "general_union (conj (low l) ?ex)"
+      show "\<Turnstile> { (?P :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C2 {?P}"
+      proof (rule rule_BigUnion; rule rule_And)
+        show "\<Turnstile> {(low l :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion)} C2 {low l}"
+          using assms(1) by blast
+        show "\<Turnstile> { ?ex } C2 { ?ex }"
+        proof (rule consequence_rule)
+          let ?b = "\<lambda>\<phi>0. \<phi>0 h = fst \<phi>1 h"  
+          show "\<Turnstile> {not_empty \<circ> Set.filter (?b \<circ> fst)} C2 { not_empty \<circ> Set.filter (?b \<circ> fst)}"
+            using assms(2) rule_LFilter by auto
+          show "entails (\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h) (not_empty \<circ> Set.filter ((\<lambda>\<phi>0. \<phi>0 h = fst \<phi>1 h) \<circ> fst))"
+            using CollectI Set.filter_def comp_apply empty_iff not_empty_def
+              entailsI[of "(\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h)" "(not_empty \<circ> Set.filter ((\<lambda>\<phi>0. \<phi>0 h = fst \<phi>1 h) \<circ> fst))"]
+            by fastforce
+          show "entails (not_empty \<circ> Set.filter ((\<lambda>\<phi>0. \<phi>0 h = fst \<phi>1 h) \<circ> fst)) (\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h)"
+          proof (rule entailsI)
+            fix S assume "(not_empty \<circ> Set.filter ((\<lambda>\<phi>0. \<phi>0 h = fst \<phi>1 h) \<circ> fst)) S"
+            then obtain \<phi> where "\<phi> \<in> Set.filter ((\<lambda>\<phi>0. \<phi>0 h = fst \<phi>1 h) \<circ> fst) S"
+              by (metis comp_apply equals0I not_empty_def)
+            then show "\<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h"
+              by auto
+          qed
+        qed
+      qed
+      show "entails (\<lambda>S. \<forall>\<phi>2\<in>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l) ?P"
+      proof (rule entailsI)
+        fix S assume asm0: "\<forall>\<phi>2\<in>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l"
+        thm general_unionI
+        let ?F = "{ {\<phi>, \<phi>2} |\<phi> \<phi>2. \<phi> \<in> S \<and> \<phi>2 \<in> S \<and> snd \<phi> l = snd \<phi>2 l \<and> fst \<phi> h = fst \<phi>1 h }"
+        show "general_union (Logic.conj (low l) (\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h)) S"
+        proof (rule general_unionI)
+          show "S = \<Union> ?F"
+          proof
+            show "S \<subseteq> \<Union> ?F"
+            proof
+              fix \<phi>2 assume "\<phi>2 \<in> S"
+              then obtain \<phi> where "\<phi>\<in>S" "fst \<phi> h = fst \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l"
+                using asm0 by blast
+              then have "{\<phi>, \<phi>2} \<in> ?F"
+                using \<open>\<phi>2 \<in> S\<close> by blast
+              then show "\<phi>2 \<in> \<Union> ?F" by blast
+            qed
+            show "\<Union> ?F \<subseteq> S" by blast
+          qed
+          fix S' assume asm1: "S' \<in> {{\<phi>, \<phi>2} |\<phi> \<phi>2. \<phi> \<in> S \<and> \<phi>2 \<in> S \<and> snd \<phi> l = snd \<phi>2 l \<and> fst \<phi> h = fst \<phi>1 h}"
+          then obtain \<phi> \<phi>2 where "S' = {\<phi>, \<phi>2}" "\<phi> \<in> S \<and> \<phi>2 \<in> S \<and> snd \<phi> l = snd \<phi>2 l \<and> fst \<phi> h = fst \<phi>1 h"
+            by blast
+          then show "Logic.conj (low l) (\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h) S'"
+            using conj_def[of "low l" "\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h"] insert_iff low_def singletonD
+            by fastforce
+        qed
+      qed
+      show "entails ?P (\<lambda>S. \<forall>\<phi>2\<in>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1' h \<and> snd \<phi> l = snd \<phi>2 l)"
+      proof (rule entailsI)
+        fix S assume "general_union (Logic.conj (low l) (\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h)) S"
+        then obtain F where "S = \<Union> F" "\<And>S'. S' \<in> F \<Longrightarrow> low l S' \<and> (\<exists>\<phi>\<in>S'. fst \<phi> h = fst \<phi>1 h)"
+          using conj_def[of "low l" "\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h"]
+            general_unionE[of "Logic.conj (low l) (\<lambda>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1 h)" S]
+          by (metis (mono_tags, lifting))
+        then show "\<forall>\<phi>2\<in>S. \<exists>\<phi>\<in>S. fst \<phi> h = fst \<phi>1' h \<and> snd \<phi> l = snd \<phi>2 l"
+          by (metis (mono_tags, lifting) Union_iff asm0 low_def)
+      qed
+    qed
+  qed
+qed
+
+
+subsection \<open>Other examples\<close>
+
+lemma program_1_sat_gni:
+  assumes "y \<noteq> l \<and> y \<noteq> h \<and> l \<noteq> h"
+  shows "\<turnstile> { low l } Seq (Havoc y) (Assign l (\<lambda>\<sigma>. (\<sigma> h :: int) + \<sigma> y)) { GNI l h }"
+proof (rule RuleSeq)
+  let ?R = "\<lambda>S. \<forall>\<phi>1 \<phi>2. \<phi>1 \<in> S \<and> \<phi>2 \<in> S
+  \<longrightarrow> (\<exists>\<phi> \<in> S. (snd \<phi> h :: int) = snd \<phi>1 h \<and> snd \<phi> h + snd \<phi> y = snd \<phi>2 h + snd \<phi>2 y )"
+
+  show "\<turnstile> { low l } Havoc y {?R}"
+  proof (rule RuleCons)
+    show "\<turnstile> {(\<lambda>S. ?R {(l, \<sigma>(y := v)) |l \<sigma> v. (l, \<sigma>) \<in> S})} Havoc y {?R}"
+      using RuleHavoc[of ?R] by blast
+    show "entails (low l) (\<lambda>S. ?R {(l, \<sigma>(y := v)) |l \<sigma> (v :: int). (l, \<sigma>) \<in> S})"
+    proof (rule entailsI)
+      fix S
+      show "?R {(l, \<sigma>(y := v)) |l \<sigma> (v :: int). (l, \<sigma>) \<in> S}"
+      proof (clarify)
+        fix a b aa ba l la \<sigma> \<sigma>' v va
+        assume asm0: "(l, \<sigma>) \<in> S" "(la, \<sigma>') \<in> S"
+        let ?v = "(\<sigma>'(y := va)) h + (\<sigma>'(y := va)) y + - \<sigma> h"
+        let ?\<phi> = "(l, \<sigma>(y := ?v))"
+        have "snd ?\<phi> h = snd (l, \<sigma>(y := v)) h \<and> snd ?\<phi> h + snd ?\<phi> y = snd (la, \<sigma>'(y := va)) h + snd (la, \<sigma>'(y := va)) y"
+          using assms by force
+        then show "\<exists>\<phi>\<in>{(l, \<sigma>(y := v)) |l \<sigma> v. (l, \<sigma>) \<in> S}.
+          snd \<phi> h = snd (l, \<sigma>(y := v)) h \<and> snd \<phi> h + snd \<phi> y = snd (la, \<sigma>'(y := va)) h + snd (la, \<sigma>'(y := va)) y"
+          using asm0(1) by blast
+      qed
+    qed
+    show "entails ?R ?R"
+      by (meson entailsI)
+  qed
+  show "\<turnstile> {?R} (Assign l (\<lambda>\<sigma>. \<sigma> h + \<sigma> y)) {GNI l h}"
+  proof (rule RuleCons)
+    show "\<turnstile> {(\<lambda>S. GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S})} Assign l (\<lambda>\<sigma>. \<sigma> h + \<sigma> y) {GNI l h}"
+      using RuleAssign[of "GNI l h" l "\<lambda>\<sigma>. \<sigma> h + \<sigma> y"] by blast
+    show "entails (GNI l h) (GNI l h)"
+      by (simp add: entails_def)
+    show "entails ?R (\<lambda>S. GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S})"
+    proof (rule entailsI)
+      fix S
+      assume asm0: "\<forall>\<phi>1 \<phi>2. \<phi>1 \<in> S \<and> \<phi>2 \<in> S \<longrightarrow> (\<exists>\<phi>\<in>S. snd \<phi> h = snd \<phi>1 h \<and> snd \<phi> h + snd \<phi> y = snd \<phi>2 h + snd \<phi>2 y)"
+      show "GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}"
+      proof (rule GNI_I)
+        fix \<phi>1 \<phi>2
+        assume asm1: "\<phi>1 \<in> {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S} \<and> \<phi>2 \<in> {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}"
+        then obtain la \<sigma> la' \<sigma>' where "(la, \<sigma>) \<in> S" "(la', \<sigma>') \<in> S" "\<phi>1 = (la, \<sigma>(l := \<sigma> h + \<sigma> y))" "\<phi>2 = (la', \<sigma>'(l := \<sigma>' h + \<sigma>' y))" 
+          by blast
+        then obtain \<phi> where "\<phi>\<in>S" "snd \<phi> h = \<sigma> h" "snd \<phi> h + snd \<phi> y = \<sigma>' h + \<sigma>' y"
+          using asm0 snd_conv by force
+        let ?\<phi> = "(fst \<phi>, (snd \<phi>)(l := snd \<phi> h + snd \<phi> y))"
+        have "snd ?\<phi> h = snd \<phi>1 h \<and> snd ?\<phi> l = snd \<phi>2 l"
+          using \<open>\<phi>1 = (la, \<sigma>(l := \<sigma> h + \<sigma> y))\<close> \<open>\<phi>2 = (la', \<sigma>'(l := \<sigma>' h + \<sigma>' y))\<close>
+            \<open>snd \<phi> h + snd \<phi> y = \<sigma>' h + \<sigma>' y\<close> \<open>snd \<phi> h = \<sigma> h\<close> assms by force
+        then show "\<exists>\<phi>\<in>{(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}. snd \<phi> h = snd \<phi>1 h \<and> snd \<phi> l = snd \<phi>2 l"
+          using \<open>\<phi> \<in> S\<close> mem_Collect_eq[of ?\<phi>]
+          by (metis (mono_tags, lifting) prod.collapse)
+      qed
+    qed
+  qed
+qed
+
+
+lemma program_2_violates_gni:
+  assumes "y \<noteq> l \<and> y \<noteq> h \<and> l \<noteq> h"
+  shows "\<turnstile> { conj (low l) (\<lambda>S. \<exists>a \<in> S. \<exists>b \<in> S. (snd a h :: nat) \<noteq> snd b h) }
+  Seq (Seq (Havoc y) (Assume (\<lambda>\<sigma>. \<sigma> y \<ge> (0 :: nat) \<and> \<sigma> y \<le> (100 :: nat)))) (Assign l (\<lambda>\<sigma>. \<sigma> h + \<sigma> y))
+  {\<lambda>(S :: (('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set). \<not> GNI l h S}"
+proof (rule RuleSeq)
+
+  let ?R0 = "\<lambda>(S :: (('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set).
+    (\<exists>a \<in> S. \<exists>b \<in> S. snd b h > snd a h \<and> snd a y \<ge> (0 :: nat) \<and> snd a y \<le> 100 \<and> snd b y = 100)"
+  let ?R1 = "\<lambda>(S :: (('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set).
+    (\<exists>a \<in> S. \<exists>b \<in> S. snd b h > snd a h \<and> snd b y = 100) \<and> (\<forall>c \<in> S. snd c y \<le> 100)"
+  let ?R2 = "\<lambda>(S :: (('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set).
+    \<exists>a \<in> S. \<exists>b \<in> S. \<forall>c \<in> S. snd c h = snd a h \<longrightarrow> snd c h + snd c y = snd b h + snd b y"
+
+  show "\<turnstile> { conj (low l) (\<lambda>S. \<exists>a\<in>S. \<exists>b\<in>S. snd a h \<noteq> snd b h)} Seq (Havoc y) (Assume (\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> (100 :: nat))) {?R1}"
+  proof (rule RuleSeq)
+    show "\<turnstile> {conj (low l) (\<lambda>S. \<exists>a\<in>S. \<exists>b\<in>S. snd a h \<noteq> snd b h)} Havoc y { ?R0 }"
+    proof (rule RuleCons)
+      show "\<turnstile> {(\<lambda>S. ?R0 {(l, \<sigma>(y := v)) |l \<sigma> v. (l, \<sigma>) \<in> S})} Havoc y {?R0}"
+        using RuleHavoc[of _ y] by fast
+      show "entails ?R0 ?R0"
+        by (simp add: entailsI)
+      show "entails (conj (low l) (\<lambda>S. \<exists>a\<in>S. \<exists>b\<in>S. snd a h \<noteq> snd b h)) (\<lambda>S. ?R0 {(l, \<sigma>(y := v)) |l \<sigma> v. (l, \<sigma>) \<in> S})"
+      proof (rule entailsI)
+        fix S :: "(('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set"
+        assume "conj (low l) (\<lambda>S. \<exists>a\<in>S. \<exists>b\<in>S. snd a h \<noteq> snd b h) S"
+        then have "\<exists>a\<in>S. \<exists>b\<in>S. snd a h \<noteq> snd b h" using conj_def[of "low l" "\<lambda>S. \<exists>a\<in>S. \<exists>b\<in>S. snd a h \<noteq> snd b h"]
+          by blast
+        then obtain a b where "a \<in> S" "b \<in> S" "snd b h > snd a h"
+          by (meson linorder_neq_iff)
+        let ?a = "(fst a, (snd a)(y := 100))"
+        let ?b = "(fst b, (snd b)(y := 100))"
+        have "?a \<in> {(l, \<sigma>(y := v)) |l \<sigma> v. (l, \<sigma>) \<in> S} \<and> ?b \<in> {(l, \<sigma>(y := v)) |l \<sigma> v. (l, \<sigma>) \<in> S}"
+          using \<open>a \<in> S\<close> \<open>b \<in> S\<close> by fastforce
+        moreover have "snd ?b h > snd ?a h \<and> snd ?a y \<ge> (0 :: nat) \<and> snd ?a y \<le> 100 \<and> snd ?b y = 100"
+          using \<open>snd a h < snd b h\<close> assms by force
+        ultimately show "?R0 {(l, \<sigma>(y := v)) |l \<sigma> v. (l, \<sigma>) \<in> S}" by blast
+      qed
+    qed
+    show "\<turnstile> {?R0} Assume (\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100) {?R1}"
+    proof (rule RuleCons)
+      show "\<turnstile> {(\<lambda>S. ?R1 (Set.filter ((\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100) \<circ> snd)
+              S))} Assume (\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100) {?R1}"
+        using RuleAssume[of _ "\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100"]
+        by fast
+      show "entails ?R1 ?R1"
+        by (simp add: entailsI)
+      show "entails ?R0 (\<lambda>S. ?R1 (Set.filter ((\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100) \<circ> snd) S))"
+      proof (rule entailsI)
+        fix S :: "(('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set"
+        assume asm0: "?R0 S"
+        then obtain a b where "a\<in>S" "b\<in>S" "snd a h < snd b h \<and> 0 \<le> snd a y \<and> snd a y \<le> (100 :: nat) \<and> snd b y = 100 "
+          by blast
+        then have "a \<in> Set.filter ((\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100) \<circ> snd) S \<and> b \<in> Set.filter ((\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100) \<circ> snd) S"
+          by (simp add: \<open>a \<in> S\<close> \<open>b \<in> S\<close>)
+        then show "?R1 (Set.filter ((\<lambda>\<sigma>. 0 \<le> \<sigma> y \<and> \<sigma> y \<le> 100) \<circ> snd) S)"
+          using \<open>snd a h < snd b h \<and> 0 \<le> snd a y \<and> snd a y \<le> 100 \<and> snd b y = 100\<close> by force
+      qed
+    qed
+  qed
+  show "\<turnstile> { ?R1 } Assign l (\<lambda>\<sigma>. \<sigma> h + \<sigma> y) {\<lambda>S. \<not> GNI l h S}"
+  proof (rule RuleCons)
+    show "\<turnstile> {(\<lambda>S. \<not> GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S})} Assign l (\<lambda>\<sigma>. \<sigma> h + \<sigma> y) {\<lambda>S. \<not> GNI l h S}"
+      using RuleAssign[of "\<lambda>S. \<not> GNI l h S" l "\<lambda>\<sigma>. \<sigma> h + \<sigma> y"]
+      by blast
+    show "entails (\<lambda>S. \<not> GNI l h S) (\<lambda>S. \<not> GNI l h S)"
+      by (simp add: entails_def)
+    show "entails (\<lambda>S. (\<exists>a\<in>S. \<exists>b\<in>S. snd a h < snd b h \<and> snd b y = 100) \<and> (\<forall>c\<in>S. snd c y \<le> 100))
+        (\<lambda>(S :: (('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set). \<not> GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S})"
+    proof (rule entailsI)
+      fix S :: "(('lvar \<Rightarrow> 'lval) \<times> ('a \<Rightarrow> nat)) set"
+      assume asm0: "(\<exists>a\<in>S. \<exists>b\<in>S. snd a h < snd b h \<and> snd b y = 100) \<and> (\<forall>c\<in>S. snd c y \<le> 100)"
+      then obtain a b where asm1: "a\<in>S" "b\<in>S" "snd a h < snd b h \<and> snd b y = 100" by blast
+      let ?a = "(fst a, (snd a)(l := snd a h + snd a y))"
+      let ?b = "(fst b, (snd b)(l := snd b h + snd b y))"
+      have "\<And>la \<sigma>. (la, \<sigma>) \<in> S \<Longrightarrow> (\<sigma>(l := \<sigma> h + \<sigma> y)) h = snd ?a h \<Longrightarrow> (\<sigma>(l := \<sigma> h + \<sigma> y)) l \<noteq> snd ?b l"
+        using asm0 asm1(3) assms by fastforce
+      moreover have r: "?a \<in> {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S} \<and> ?b \<in> {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}"
+        using asm1(1) asm1(2) by fastforce
+      show "\<not> GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}"
+      proof (rule ccontr)
+        assume "\<not> \<not> GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}"
+        then have "GNI l h {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}"
+          by blast
+        then obtain \<phi> where "\<phi> \<in> {(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}" "snd \<phi> h = snd ?a h" "snd \<phi> l = snd ?b l"
+          using GNI_def[of l h "{(la, \<sigma>(l := \<sigma> h + \<sigma> y)) |la \<sigma>. (la, \<sigma>) \<in> S}"] r
+          by meson
+        then show False
+          using calculation by auto
+      qed
+    qed
+  qed
+qed
+
+
+
+end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/Expressivity.thy b/thys/HyperHoareLogic/Expressivity.thy
--- a/thys/HyperHoareLogic/Expressivity.thy
+++ b/thys/HyperHoareLogic/Expressivity.thy
@@ -1,1871 +1,1943 @@
-text \<open>In this file, we prove most results of section V: hyper-triples subsume many other triples,
-as well as example 4.\<close>
+text \<open>In this file, we prove most results of Appendix C:
+  hyper-triples subsume many other triples, as well as example 3.\<close>
 
 theory Expressivity
   imports ProgramHyperproperties
 begin
 
 
 subsection \<open>Hoare Logic (HL)~\cite{HoareLogic}\<close>
 
-text \<open>Definition 8\<close>
+paragraph \<open>Definition 16\<close>
 definition HL where
   "HL P C Q \<longleftrightarrow> (\<forall>\<sigma> \<sigma>' l. (l, \<sigma>) \<in> P \<and> (\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>') \<longrightarrow> (l, \<sigma>') \<in> Q)"
 
 lemma HLI:
   assumes "\<And>\<sigma> \<sigma>' l. (l, \<sigma>) \<in> P \<Longrightarrow> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>' \<Longrightarrow> (l, \<sigma>') \<in> Q"
   shows "HL P C Q"
   using assms HL_def by blast
 
 
 lemma hoarifyI:
   assumes "\<And>\<sigma> \<sigma>'. (\<sigma>, \<sigma>') \<in> S \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> \<sigma>' \<in> Q"
   shows "hoarify P Q S"
   by (metis assms hoarify_def prod.collapse)
 
 definition HL_hyperprop where
   "HL_hyperprop P Q S \<longleftrightarrow> (\<forall>l. \<forall>p \<in> S. (l, fst p) \<in> P \<longrightarrow> (l, snd p) \<in> Q)"
 
 lemma connection_HL:
   "HL P C Q \<longleftrightarrow> HL_hyperprop P Q (set_of_traces C)" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   then show ?B
     by (simp add: HL_def HL_hyperprop_def set_of_traces_def)
 next
   assume ?B
   show ?A
   proof (rule HLI)
     fix \<sigma> \<sigma>' l assume asm0: "(l, \<sigma>) \<in> P" "\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
     then have "(\<sigma>, \<sigma>') \<in> set_of_traces C"
       by (simp add: set_of_traces_def)
     then show "(l, \<sigma>') \<in> Q"
       using \<open>HL_hyperprop P Q (set_of_traces C)\<close> asm0(1) HL_hyperprop_def by fastforce
   qed
 qed
 
-text \<open>Proposition 1\<close>
+paragraph \<open>Proposition 1\<close>
 theorem HL_expresses_hyperproperties:
   "\<exists>H. (\<forall>C. hypersat C H \<longleftrightarrow> HL P C Q) \<and> k_hypersafety 1 H"
 proof -
   let ?H = "HL_hyperprop P Q"
   have "\<And>C. hypersat C ?H \<longleftrightarrow> HL P C Q"
     by (simp add: connection_HL hypersat_def)
   moreover have "k_hypersafety 1 ?H"
   proof (rule k_hypersafetyI)
     fix S assume asm0: "\<not> HL_hyperprop P Q S"
     then obtain l p where "p \<in> S" "(l, fst p) \<in> P" "(l, snd p) \<notin> Q"
       using HL_hyperprop_def by blast
     let ?S = "{p}"
     have "max_k 1 ?S \<and> (\<forall>S''. ?S \<subseteq> S'' \<longrightarrow> \<not> HL_hyperprop P Q S'')"
       by (metis (no_types, lifting) One_nat_def \<open>(l, fst p) \<in> P\<close> \<open>(l, snd p) \<notin> Q\<close> card.empty card.insert
           empty_iff finite.intros(1) finite.intros(2) le_numeral_extra(4) max_k_def HL_hyperprop_def singletonI subsetD)
     then show "\<exists>S'\<subseteq>S. max_k 1 S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> HL_hyperprop P Q S'')"
       by (meson \<open>p \<in> S\<close> empty_subsetI insert_subsetI)
   qed
   ultimately show ?thesis
     by blast
 qed
 
-text \<open>Proposition 2\<close>
+paragraph \<open>Proposition 2\<close>
 theorem encoding_HL:
   "HL P C Q \<longleftrightarrow> (hyper_hoare_triple (over_approx P) C (over_approx Q))" (is "?A \<longleftrightarrow> ?B")
 proof (rule iffI)
   show "?B \<Longrightarrow> ?A"
   proof -
     assume asm0: ?B
     show ?A
     proof (rule HLI)
       fix \<sigma> \<sigma>' l
       assume asm1: "(l, \<sigma>) \<in> P" "\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
       then have "over_approx P {(l, \<sigma>)}"
         by (simp add: over_approx_def)
       then have "(over_approx Q) (sem C {(l, \<sigma>)})"
         using asm0 hyper_hoare_tripleE by auto
       then show "(l, \<sigma>') \<in> Q"
         by (simp add: asm1(2) in_mono in_sem over_approx_def)
     qed
   qed
 next
   assume r: ?A
   show ?B
   proof (rule hyper_hoare_tripleI)
     fix S assume asm0: "over_approx P S"
     then have "S \<subseteq> P"
       by (simp add: over_approx_def)
     then have "sem C S \<subseteq> sem C P"
       by (simp add: sem_monotonic)
     then have "sem C S \<subseteq> Q"
       using r HL_def[of P C Q]
       by (metis (no_types, lifting) fst_conv in_mono in_sem snd_conv subrelI)      
     then show "over_approx Q (sem C S)"
       by (simp add: over_approx_def)
   qed
 qed
 
 lemma entailment_order_hoare:
   assumes "P \<subseteq> P'"
   shows "entails (over_approx P) (over_approx P')"
   by (simp add: assms entails_def over_approx_def subset_trans)
 
 
 subsection \<open>Cartesian Hoare Logic (CHL)~\cite{CHL16}\<close>
 
-text \<open>Notation 3\<close>
 definition k_sem where
   "k_sem C states states' \<longleftrightarrow> (\<forall>i. (fst (states i) = fst (states' i) \<and> single_sem C (snd (states i)) (snd (states' i))))"
 
 lemma k_semI:
   assumes "\<And>i. (fst (states i) = fst (states' i) \<and> single_sem C (snd (states i)) (snd (states' i)))"
   shows "k_sem C states states'"
   by (simp add: assms k_sem_def)
 
 lemma k_semE:
   assumes "k_sem C states states'"
   shows "fst (states i) = fst (states' i) \<and> single_sem C (snd (states i)) (snd (states' i))"
   using assms k_sem_def by fastforce
 
-text \<open>Definition 9\<close>
+paragraph \<open>Definition 17\<close>
 definition CHL where
   "CHL P C Q \<longleftrightarrow> (\<forall>states. states \<in> P \<longrightarrow> (\<forall>states'. k_sem C states states' \<longrightarrow> states' \<in> Q))"
 
 lemma CHLI:
   assumes "\<And>states states'. states \<in> P \<Longrightarrow> k_sem C states states' \<Longrightarrow> states' \<in> Q"
   shows "CHL P C Q"
   by (simp add: assms CHL_def)
 
 lemma CHLE:
   assumes "CHL P C Q"
       and "states \<in> P"
       and "k_sem C states states'"
     shows "states' \<in> Q"
   using assms(1) assms(2) assms(3) CHL_def by fast
 
 definition encode_CHL where
   "encode_CHL from_nat x P S \<longleftrightarrow> (\<forall>states. (\<forall>i. states i \<in> S \<and> fst (states i) x = from_nat i) \<longrightarrow> states \<in> P)"
 
 
 lemma encode_CHLI:
   assumes "\<And>states. (\<forall>i. states i \<in> S \<and> fst (states i) x = from_nat i) \<Longrightarrow> states \<in> P"
     shows "encode_CHL from_nat x P S"
   using assms(1) encode_CHL_def by force
 
 lemma encode_CHLE:
   assumes "encode_CHL from_nat x P S"
       and "\<And>i. states i \<in> S"
       and "\<And>i. fst (states i) x = from_nat i"
     shows "states \<in> P"
   by (metis assms(1) assms(2) assms(3) encode_CHL_def)
 
 lemma equal_change_lvar:
   assumes "fst \<phi> x = y"
   shows "\<phi> = ((fst \<phi>)(x := y), snd \<phi>)"
   using assms by fastforce
 
 
-text \<open>Proposition 3\<close>
+paragraph \<open>Proposition 3\<close>
 theorem encoding_CHL:
   assumes "not_free_var_of P x"
       and "not_free_var_of Q x"
       and "injective from_nat"
   shows "CHL P C Q \<longleftrightarrow> \<Turnstile> {encode_CHL from_nat x P} C {encode_CHL from_nat x Q}" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule hyper_hoare_tripleI)
     fix S assume "encode_CHL from_nat x P S"
     then obtain asm0: "\<And>states states'. (\<And>i. states i \<in> S) \<Longrightarrow> (\<And>i.  fst (states i) x = from_nat i) \<Longrightarrow> states \<in> P"
       by (simp add: encode_CHLE)
 
     show "encode_CHL from_nat x Q (sem C S)"
     proof (rule encode_CHLI)
       fix states'
       assume asm1: "\<forall>i. states' i \<in> sem C S \<and> fst (states' i) x = from_nat i"
 
       let ?states = "\<lambda>i. (fst (states' i), SOME \<sigma>. (fst (states' i), \<sigma>) \<in> S \<and> single_sem C \<sigma> (snd (states' i)))"
 
       show "states' \<in> Q"
         using \<open>?A\<close>
       proof (rule CHLE)
         show "?states \<in> P"
         proof (rule asm0)
           fix i
           let ?\<sigma> = "SOME \<sigma>. ((fst (states' i), \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> snd (states' i))"
           have r: "(fst (states' i), ?\<sigma>) \<in> S \<and> \<langle>C, ?\<sigma>\<rangle> \<rightarrow> snd (states' i)"
             using someI_ex[of "\<lambda>\<sigma>. (fst (states' i), \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> snd (states' i)"] asm1 in_sem by blast
           then show "?states i \<in> S"
             by blast
           show "fst (?states i) x = from_nat i"
             by (simp add: asm1)
         qed
         show "k_sem C ?states states'"
         proof (rule k_semI)
           fix i
           let ?\<sigma> = "SOME \<sigma>. ((fst (states' i), \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> snd (states' i))"
           have r: "(fst (states' i), ?\<sigma>) \<in> S \<and> \<langle>C, ?\<sigma>\<rangle> \<rightarrow> snd (states' i)"
             using someI_ex[of "\<lambda>\<sigma>. (fst (states' i), \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> snd (states' i)"] asm1 in_sem by blast
           then show "fst (?states i) = fst (states' i) \<and> \<langle>C, snd (?states i)\<rangle> \<rightarrow> snd (states' i)"
             by simp
         qed
       qed
     qed
   qed
 next
   assume asm0: "\<Turnstile> {encode_CHL from_nat x P} C {encode_CHL from_nat x Q}"
 
   show "CHL P C Q"
   proof (rule CHLI)
     fix states states'
     assume asm1: "states \<in> P" "k_sem C states states'"
 
     let ?states = "\<lambda>i. ((fst (states i))(x := from_nat i), snd (states i))"
     let ?states' = "\<lambda>i. ((fst (states i))(x := from_nat i), snd (states' i))"
     let ?S = "range ?states"
 
     have "encode_CHL from_nat x Q (sem C ?S)"
       using asm0
     proof (rule hyper_hoare_tripleE)
       show "encode_CHL from_nat x P ?S"
       proof (rule encode_CHLI)
         fix f assume asm2: "\<forall>i. f i \<in> ?S \<and> fst (f i) x = from_nat i"
         have "f = ?states"
         proof (rule ext)
           fix i
           obtain j where j_def: "f i = ((fst (states j))(x := from_nat j), snd (states j))"
             using asm2 by fastforce
           then have "from_nat j = from_nat i"
             by (metis asm2 fst_conv fun_upd_same)
           then show "f i = ((fst (states i))(x := from_nat i), snd (states i))"
             by (metis j_def assms(3) injective_def)
         qed
         moreover have "?states \<in> P"
           using assms(1)
         proof (rule not_free_var_ofE)
           show "states \<in> P"
             using asm1(1) by simp
           fix i
           show "differ_only_by (fst (states i)) (fst ((fst (states i))(x := from_nat i), snd (states i))) x"
             by (simp add: differ_only_by_def)
           show "snd (states i) = snd ((fst (states i))(x := from_nat i), snd (states i))"
             by simp
         qed
         ultimately show "f \<in> P"
           by meson
       qed
     qed
     then have "?states' \<in> Q"
     proof (rule encode_CHLE)
       fix i
       show "fst ((fst (states i))(x := from_nat i), snd (states' i)) x = from_nat i"
         by simp
       moreover have "single_sem C (snd (?states i)) (snd (?states' i))"
         using asm1(2) k_sem_def by fastforce
       ultimately show "((fst (states i))(x := from_nat i), snd (states' i)) \<in> sem C ?S"
         using in_sem by fastforce
     qed
     show "states' \<in> Q"
       using assms(2) 
     proof (rule not_free_var_ofE[of Q x])
       show "?states' \<in> Q"
         by (simp add: \<open>(\<lambda>i. ((fst (states i))(x := from_nat i), snd (states' i))) \<in> Q\<close>)
       fix i show "differ_only_by (fst ((fst (states i))(x := from_nat i), snd (states' i))) (fst (states' i)) x"
         by (metis asm1(2) diff_by_update fst_conv k_sem_def)
     qed (auto)
   qed
 qed
 
 definition CHL_hyperprop where
   "CHL_hyperprop P Q S \<longleftrightarrow> (\<forall>l p. (\<forall>i. p i \<in> S) \<and> (\<lambda>i. (l i, fst (p i))) \<in> P \<longrightarrow> (\<lambda>i. (l i, snd (p i))) \<in> Q)"
 
 lemma CHL_hyperpropI:
   assumes "\<And>l p. (\<forall>i. p i \<in> S) \<and> (\<lambda>i. (l i, fst (p i))) \<in> P \<Longrightarrow> (\<lambda>i. (l i, snd (p i))) \<in> Q"
   shows "CHL_hyperprop P Q S"
   by (simp add: assms CHL_hyperprop_def)
 
 lemma CHL_hyperpropE:
   assumes "CHL_hyperprop P Q S"
       and "\<And>i. p i \<in> S"
       and "(\<lambda>i. (l i, fst (p i))) \<in> P"
     shows "(\<lambda>i. (l i, snd (p i))) \<in> Q"
   using assms(1) assms(2) assms(3) CHL_hyperprop_def by blast
 
-text \<open>Proposition 10\<close>
+paragraph \<open>Proposition 3\<close>
 theorem CHL_hyperproperty:
   "hypersat C (CHL_hyperprop P Q) \<longleftrightarrow> CHL P C Q" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule CHLI)
     fix states states'
     assume asm0: "states \<in> P" "k_sem C states states'"
     let ?p = "\<lambda>i. (snd (states i), snd (states' i))"
     let ?l = "\<lambda>i. fst (states i)"
 
     have "range ?p \<subseteq> set_of_traces C"
     proof (rule subsetI)
       fix x assume "x \<in> range ?p"
       then obtain i where "x = (snd (states i), snd (states' i))"
         by blast
       then show "x \<in> set_of_traces C"
         by (metis (mono_tags, lifting) CollectI asm0(2) k_sem_def set_of_traces_def)
     qed
     have "(\<lambda>i. (?l i, snd (?p i))) \<in> Q"
     proof (rule CHL_hyperpropE)
       show "CHL_hyperprop P Q (range ?p)"
       proof (rule CHL_hyperpropI)
         fix l p assume asm1: "(\<forall>i. p i \<in> range (\<lambda>i. (snd (states i), snd (states' i)))) \<and> (\<lambda>i. (l i, fst (p i))) \<in> P"
         then show "(\<lambda>i. (l i, snd (p i))) \<in> Q"
           using CHL_hyperprop_def[of P Q "set_of_traces C"] \<open>hypersat C (CHL_hyperprop P Q)\<close>
             \<open>range (\<lambda>i. (snd (states i), snd (states' i))) \<subseteq> set_of_traces C\<close> hypersat_def subset_iff
           by blast
       qed          
       show "(\<lambda>i. (fst (states i), fst (snd (states i), snd (states' i)))) \<in> P"
         by (simp add: asm0(1))
       fix i show "(snd (states i), snd (states' i)) \<in> range (\<lambda>i. (snd (states i), snd (states' i)))"
         by blast
     qed
     moreover have "states' = (\<lambda>i. (?l i, snd (?p i)))"
     proof (rule ext)
       fix i show "states' i = (fst (states i), snd (snd (states i), snd (states' i)))"
         by (metis asm0(2) k_sem_def prod.exhaust_sel sndI)
     qed
     ultimately show "states' \<in> Q"
       by auto
   qed
 next
   assume asm0: "CHL P C Q"
   have "CHL_hyperprop P Q (set_of_traces C)"
   proof (rule CHL_hyperpropI)
     fix l p assume asm1: "(\<forall>i. p i \<in> set_of_traces C) \<and> (\<lambda>i. (l i, fst (p i))) \<in> P"
 
     show "(\<lambda>i. (l i, snd (p i))) \<in> Q"
       using asm0
     proof (rule CHLE)
       show "(\<lambda>i. (l i, fst (p i))) \<in> P"
         by (simp add: asm1)
       show "k_sem C (\<lambda>i. (l i, fst (p i))) (\<lambda>i. (l i, snd (p i)))"
       proof (rule k_semI)
         fix i show "fst (l i, fst (p i)) = fst (l i, snd (p i)) \<and> \<langle>C, snd (l i, fst (p i))\<rangle> \<rightarrow> snd (l i, snd (p i))"
           using asm1 in_set_of_traces by fastforce
       qed
     qed
   qed
   then show "hypersat C (CHL_hyperprop P Q)"
     by (simp add: hypersat_def)
 qed
 
 
 
 theorem k_hypersafety_HL_hyperprop:
   fixes P :: "('i \<Rightarrow> ('lvar, 'lval, 'pvar, 'pval) state) set"
   assumes "finite (UNIV :: 'i set)"
       and "card (UNIV :: 'i set) = k"
     shows "k_hypersafety k (CHL_hyperprop P Q)"
 proof (rule k_hypersafetyI)
   fix S
   assume "\<not> CHL_hyperprop P Q S"
   then obtain l p where asm0: "\<forall>i. p i \<in> S" "(\<lambda>i. (l i, fst (p i))) \<in> P"
     "(\<lambda>i. (l i, snd (p i))) \<notin> Q"
     using CHL_hyperprop_def by blast
   let ?S = "range p"
   have "max_k k ?S"
     by (metis assms(1) assms(2) card_image_le finite_imageI max_k_def)
   moreover have "\<And>S''. ?S \<subseteq> S'' \<Longrightarrow> \<not> CHL_hyperprop P Q S''"
     by (meson asm0(2) asm0(3) CHL_hyperprop_def range_subsetD)
   ultimately show "\<exists>S'\<subseteq>S. max_k k S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> CHL_hyperprop P Q S'')"
     by (meson asm0(1) image_subsetI)
 qed
 
 
 
 subsection \<open>Incorrectness Logic~\cite{IncorrectnessLogic} or Reverse Hoare Logic~\cite{ReverseHL} (IL))\<close>
 
-text \<open>Definition 11\<close>
+paragraph \<open>Definition 18\<close>
 
 definition IL where
   "IL P C Q \<longleftrightarrow> Q \<subseteq> sem C P"
 
 lemma equiv_def_incorrectness:
   "IL P C Q \<longleftrightarrow> (\<forall>l \<sigma>'. (l, \<sigma>') \<in> Q \<longrightarrow> (\<exists>\<sigma>. (l, \<sigma>) \<in> P \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'))"
   by (simp add: in_sem IL_def subset_iff)
 
 definition IL_hyperprop where
   "IL_hyperprop P Q S \<longleftrightarrow> (\<forall>l \<sigma>'. (l, \<sigma>') \<in> Q \<longrightarrow> (\<exists>\<sigma>. (l, \<sigma>) \<in> P \<and> (\<sigma>, \<sigma>') \<in> S))"
 
 
 lemma IL_hyperpropI:
   assumes "\<And>l \<sigma>'. (l, \<sigma>') \<in> Q \<Longrightarrow> (\<exists>\<sigma>. (l, \<sigma>) \<in> P \<and> (\<sigma>, \<sigma>') \<in> S)"
   shows "IL_hyperprop P Q S"
   by (simp add: assms IL_hyperprop_def)
 
-text \<open>Proposition 11\<close>
+paragraph \<open>Proposition 5\<close>
 lemma IL_expresses_hyperproperties:
   "IL P C Q \<longleftrightarrow> IL_hyperprop P Q (set_of_traces C)" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule IL_hyperpropI)
     fix l \<sigma>' assume asm0: "(l, \<sigma>') \<in> Q"
     then obtain \<sigma> where "(l, \<sigma>) \<in> P" "single_sem C \<sigma> \<sigma>'"
       using \<open>IL P C Q\<close> equiv_def_incorrectness by blast
     then show "\<exists>\<sigma>. (l, \<sigma>) \<in> P \<and> (\<sigma>, \<sigma>') \<in> set_of_traces C"
       using set_of_traces_def by auto
   qed
 next
   assume ?B
   have "Q \<subseteq> sem C P"
   proof (rule subsetPairI)
     fix l \<sigma>' assume "(l, \<sigma>') \<in> Q"
     then obtain \<sigma> where "(\<sigma>, \<sigma>') \<in> set_of_traces C" "(l, \<sigma>) \<in> P"
       by (meson \<open>IL_hyperprop P Q (set_of_traces C)\<close> IL_hyperprop_def)
     then show "(l, \<sigma>') \<in> sem C P"
       using in_set_of_traces_then_in_sem by blast
   qed
   then show ?A
     by (simp add: IL_def)
 qed
 
 
 lemma IL_consequence:
   assumes "IL P C Q"
       and "(l, \<sigma>') \<in> Q"
     shows "\<exists>\<sigma>. (l, \<sigma>) \<in> P \<and> single_sem C \<sigma> \<sigma>'"
   using assms(1) assms(2) equiv_def_incorrectness by blast
 
-text \<open>Proposition 4\<close>
+paragraph \<open>Proposition 6\<close>
 theorem encoding_IL:
   "IL P C Q \<longleftrightarrow> (hyper_hoare_triple (under_approx P) C (under_approx Q))" (is "?A \<longleftrightarrow> ?B")
 proof (rule iffI)
   show "?B \<Longrightarrow> ?A"
   proof -
     assume ?B
     then have "under_approx Q (sem C P)"
       by (simp add: hyper_hoare_triple_def under_approx_def)
     then show ?A
       by (simp add: IL_def under_approx_def)
   qed
   assume ?A
   then show ?B
     by (simp add: hyper_hoare_triple_def sem_monotonic IL_def under_approx_def subset_trans)
 qed
 
 lemma entailment_order_reverse_hoare:
   assumes "P \<subseteq> P'"
   shows "entails (under_approx P') (under_approx P)"
   by (simp add: assms dual_order.trans entails_def under_approx_def)
 
 definition incorrectify where
   "incorrectify p = under_approx { \<sigma> |\<sigma>. p \<sigma>}"
 
 lemma incorrectifyI:
   assumes "\<And>\<sigma>. p \<sigma> \<Longrightarrow> \<sigma> \<in> S"
   shows "incorrectify p S"
   by (metis assms incorrectify_def mem_Collect_eq subsetI under_approx_def)
 
 lemma incorrectifyE:
   assumes "incorrectify p S"
       and "p \<sigma>"
     shows "\<sigma> \<in> S"
   by (metis CollectI assms(1) assms(2) in_mono incorrectify_def under_approx_def)
 
 lemma simple_while_incorrectness:
   assumes "\<And>n. hyper_hoare_triple (incorrectify (p n)) C (incorrectify (p (Suc n)))"
   shows "hyper_hoare_triple (incorrectify (p 0)) (While C) (incorrectify (\<lambda>\<sigma>. \<exists>n. p n \<sigma>))" 
 proof (rule consequence_rule)
   show "entails (incorrectify (p 0)) (incorrectify (p 0))"
     by (simp add: entailsI)
   show "hyper_hoare_triple (incorrectify (p 0)) (While C) (natural_partition (\<lambda>n. incorrectify (p n)))"
     by (meson assms while_rule)
 
   have "entails (incorrectify (\<lambda>\<sigma>. \<exists>n. p n \<sigma>)) (natural_partition (\<lambda>n. incorrectify (p n)))"
   proof (rule entailsI)
     fix S assume asm0: "incorrectify (\<lambda>\<sigma>. \<exists>n. p n \<sigma>) S"
     then have "under_approx { \<sigma> |\<sigma> n. p n \<sigma>} S"
       by (metis incorrectify_def)
     let ?F = "\<lambda>n. S"
     show "natural_partition (\<lambda>n. incorrectify (p n)) S"
     proof (rule natural_partitionI)
       show "\<And>n. incorrectify (p n) (?F n)"
         by (metis asm0 incorrectifyE incorrectifyI)
       show "S = \<Union> (range ?F)"
         by simp
     qed
   qed
 
 
   show "entails (natural_partition (\<lambda>n. incorrectify (p n))) (incorrectify (\<lambda>\<sigma>. \<exists>n. p n \<sigma>))"
   proof (rule entailsI)
     fix S assume asm0: "natural_partition (\<lambda>n. incorrectify (p n)) S"
     then obtain F where "S = (\<Union>n. F n)" "\<And>n. incorrectify (p n) (F n)"
       using natural_partitionE by blast
     show "incorrectify (\<lambda>\<sigma>. \<exists>n. p n \<sigma>) S"
     proof (rule incorrectifyI)
       fix \<sigma> assume "\<exists>n. p n \<sigma>"
       then obtain n where "p n \<sigma>"
         by blast
       then have "\<sigma> \<in> F n"
         by (meson \<open>\<And>n. incorrectify (p n) (F n)\<close> incorrectifyE)
       then show "\<sigma> \<in> S"
         using \<open>S = \<Union> (range F)\<close> by blast
     qed
   qed
 qed
 
 definition sat_for_l where
   "sat_for_l l P \<longleftrightarrow> (\<exists>\<sigma>. (l, \<sigma>) \<in> P)"
 
 theorem incorrectness_hyperliveness:
   assumes "\<And>l. sat_for_l l Q \<Longrightarrow> sat_for_l l P"
   shows "hyperliveness (IL_hyperprop P Q)"
 proof (rule hyperlivenessI)
   fix S
   let ?S = "S \<union> {(\<sigma>, \<sigma>') |\<sigma> \<sigma>' l. (l, \<sigma>') \<in> Q \<and> (l, \<sigma>) \<in> P }"
   have "IL_hyperprop P Q ?S"
   proof (rule IL_hyperpropI)
     fix l \<sigma>'
     assume asm0: "(l, \<sigma>') \<in> Q"
     then obtain \<sigma> where "(l, \<sigma>) \<in> P"
       by (meson assms sat_for_l_def)
     then show "\<exists>\<sigma>. (l, \<sigma>) \<in> P \<and> (\<sigma>, \<sigma>') \<in> ?S"
       using asm0 by auto
   qed
   then show "\<exists>S'. S \<subseteq> S' \<and> IL_hyperprop P Q S'"
     by auto
 qed
 
 
-subsection \<open>Relational Incorrectness Logic~\cite{InsecurityLogic} (RIL)\<close>
+subsection \<open>k-Incorrectness Logic~\cite{InsecurityLogic} (k-IL)\<close>
 
-text \<open>Definition 11\<close>
+text \<open>RIL is the old name of k-IL.\<close>
+
+paragraph \<open>Definition 19\<close>
 definition RIL where
   "RIL P C Q \<longleftrightarrow> (\<forall>states' \<in> Q. \<exists>states \<in> P. k_sem C states states')"
 
 lemma RILI:
   assumes "\<And>states'. states' \<in> Q \<Longrightarrow> (\<exists>states \<in> P. k_sem C states states')"
   shows "RIL P C Q"
   by (simp add: assms RIL_def)
 
 lemma RILE:
   assumes "RIL P C Q"
       and "states' \<in> Q"
     shows "\<exists>states \<in> P. k_sem C states states'"
   using assms(1) assms(2) RIL_def by blast
 
 
 definition RIL_hyperprop where
   "RIL_hyperprop P Q S \<longleftrightarrow> (\<forall>l states'. (\<lambda>i. (l i, states' i)) \<in> Q
          \<longrightarrow> (\<exists>states. (\<lambda>i. (l i, states i)) \<in> P \<and> (\<forall>i. (states i, states' i) \<in> S)))"
 
 lemma RIL_hyperpropI:
   assumes "\<And>l states'. (\<lambda>i. (l i, states' i)) \<in> Q \<Longrightarrow> (\<exists>states. (\<lambda>i. (l i, states i)) \<in> P \<and> (\<forall>i. (states i, states' i) \<in> S))"
   shows "RIL_hyperprop P Q S"
   by (simp add: assms RIL_hyperprop_def)
 
 
 lemma RIL_hyperpropE:
   assumes "RIL_hyperprop P Q S"
       and "(\<lambda>i. (l i, states' i)) \<in> Q"
     shows "\<exists>states. (\<lambda>i. (l i, states i)) \<in> P \<and> (\<forall>i. (states i, states' i) \<in> S)"
   using assms(1) assms(2) RIL_hyperprop_def by blast
 
 lemma useful:
   "states' = (\<lambda>i. ((fst \<circ> states') i, (snd \<circ> states') i))"
 proof (rule ext)
   fix i show "states' i = ((fst \<circ> states') i, (snd \<circ> states') i)"
     by auto
 qed
 
-text \<open>Proposition 12\<close>
+paragraph \<open>Proposition 17\<close>
 theorem RIL_expresses_hyperproperties:
   "hypersat C (RIL_hyperprop P Q) \<longleftrightarrow> RIL P C Q" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule RILI)
     fix states' assume asm0: "states' \<in> Q"
     then obtain states where asm0: "(\<lambda>i. ((fst \<circ> states') i, states i)) \<in> P \<and> (\<forall>i. (states i, (snd \<circ> states') i) \<in> set_of_traces C)"
       using RIL_hyperpropE[of P Q "set_of_traces C" "fst \<circ> states'" "snd \<circ> states'"] \<open>?A\<close>
       using hypersat_def by auto
 
     moreover have "k_sem C (\<lambda>i. ((fst \<circ> states') i, states i)) states'"
     proof (rule k_semI)
       fix i 
       have "\<langle>C, snd ((fst \<circ> states') i, states i)\<rangle> \<rightarrow> snd (states' i)"
         using calculation set_of_traces_def by auto
       then show "fst ((fst \<circ> states') i, states i) = fst (states' i) \<and> \<langle>C, snd ((fst \<circ> states') i, states i)\<rangle> \<rightarrow> snd (states' i)"
         by simp
     qed
     ultimately show "\<exists>states\<in>P. k_sem C states states'"
       by fast
   qed
 next
   assume ?B
   have "RIL_hyperprop P Q (set_of_traces C)"
   proof (rule RIL_hyperpropI)
     fix l states'
     assume asm0: "(\<lambda>i. (l i, states' i)) \<in> Q"
     then obtain states where "states \<in> P" "k_sem C states (\<lambda>i. (l i, states' i))"
       using \<open>RIL P C Q\<close> RILE by blast
     moreover have "(\<lambda>i. (l i, (snd \<circ> states) i)) = states"
     proof (rule ext)
       fix i show "(l i, (snd \<circ> states) i) = states i"
         by (metis calculation(2) comp_apply fst_conv k_sem_def surjective_pairing)
     qed
     moreover have "\<And>i. ((snd \<circ> states) i, states' i) \<in> set_of_traces C"
       by (metis (mono_tags, lifting) calculation(2) comp_apply in_set_of_traces k_sem_def snd_conv)
     ultimately show "\<exists>states. (\<lambda>i. (l i, states i)) \<in> P \<and> (\<forall>i. (states i, states' i) \<in> set_of_traces C)"
       by force
   qed
   then show ?A
     using hypersat_def by blast
 qed
 
 definition k_sat_for_l where
   "k_sat_for_l l P \<longleftrightarrow> (\<exists>\<sigma>. (\<lambda>i. (l i, \<sigma> i)) \<in> P)"
 
 theorem RIL_hyperprop_hyperlive:
   assumes "\<And>l. k_sat_for_l l Q \<Longrightarrow> k_sat_for_l l P"
   shows "hyperliveness (RIL_hyperprop P Q)"
 proof (rule hyperlivenessI)
   fix S
   have "RIL_hyperprop P Q UNIV"
     by (meson assms RIL_hyperpropI iso_tuple_UNIV_I k_sat_for_l_def)
   then show "\<exists>S'. S \<subseteq> S' \<and> RIL_hyperprop P Q S'"
     by blast
 qed
 
 
 definition strong_pre_insec where
   "strong_pre_insec from_nat x c P S \<longleftrightarrow> (\<forall>states \<in> P.
 (\<forall>i. fst (states i) x = from_nat i) \<longrightarrow> (\<exists>r. \<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S)) \<and>
 (\<forall>states. (\<forall>i. states i \<in> S) \<and> (\<forall>i. fst (states i) x = from_nat i) \<and>
 (\<forall>i j. fst (states i) c = fst (states j) c) \<longrightarrow> states \<in> P)"
 
 lemma strong_pre_insecI:
   assumes "\<And>states. states \<in> P \<Longrightarrow> (\<forall>i. fst (states i) x = from_nat i)
   \<Longrightarrow> (\<exists>r. \<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S)"
       and "\<And>states. (\<forall>i. states i \<in> S) \<Longrightarrow> (\<forall>i. fst (states i) x = from_nat i) \<Longrightarrow> (\<forall>i j. fst (states i) c = fst (states j) c) \<Longrightarrow> states \<in> P"
     shows "strong_pre_insec from_nat x c P S"
   by (simp add: assms(1) assms(2) strong_pre_insec_def)
 
 lemma strong_pre_insecE:
   assumes "strong_pre_insec from_nat x c P S"
       and "\<And>i. states i \<in> S"
       and "\<And>i. fst (states i) x = from_nat i"
       and "\<And>i j. fst (states i) c = fst (states j) c"
     shows "states \<in> P"
   by (meson assms(1) assms(2) assms(3) assms(4) strong_pre_insec_def)
 
 
 definition pre_insec where
   "pre_insec from_nat x c P S \<longleftrightarrow> (\<forall>states \<in> P.
 (\<forall>i. fst (states i) x = from_nat i)
   \<longrightarrow> (\<exists>r. \<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S))"
 
 lemma pre_insecI:
   assumes "\<And>states. states \<in> P \<Longrightarrow> (\<forall>i. fst (states i) x = from_nat i)
   \<Longrightarrow> (\<exists>r. \<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S)"
     shows "pre_insec from_nat x c P S"
   by (simp add: assms(1) pre_insec_def)
 
 lemma strong_pre_implies_pre:
   assumes "strong_pre_insec from_nat x c P S"
   shows "pre_insec from_nat x c P S"
   by (meson assms pre_insecI strong_pre_insec_def)
 
 lemma pre_insecE:
   assumes "pre_insec from_nat x c P S"
       and "states \<in> P"
       and "\<And>i. fst (states i) x = from_nat i"
     shows "\<exists>r. \<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S"
   by (meson assms(1) assms(2) assms(3) pre_insec_def)
 
 
 
 
 definition post_insec where
   "post_insec from_nat x c Q S \<longleftrightarrow> (\<forall>states \<in> Q. (\<forall>i. fst (states i) x = from_nat i)
   \<longrightarrow> (\<exists>r. (\<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S)))"
 
 lemma post_insecE:
   assumes "post_insec from_nat x c Q S"
       and "states \<in> Q"
       and "\<And>i. fst (states i) x = from_nat i"
     shows "\<exists>r. (\<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S)"
   by (meson assms(1) assms(2) assms(3) post_insec_def)
 
 lemma post_insecI:
   assumes "\<And>states. states \<in> Q \<Longrightarrow> (\<forall>i. fst (states i) x = from_nat i)
   \<Longrightarrow> (\<exists>r. (\<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> S))"
   shows "post_insec from_nat x c Q S"
   by (simp add: assms post_insec_def)
 
 lemma same_pre_post:
   "pre_insec from_nat x c Q S \<longleftrightarrow> post_insec from_nat x c Q S"
   by (simp add: post_insec_def pre_insec_def)
 
 theorem can_be_sat:
   fixes x :: "'lvar"
   assumes "\<And>l l' \<sigma>. (\<lambda>i. (l i, \<sigma> i)) \<in> P \<longleftrightarrow> (\<lambda>i. (l' i, \<sigma> i)) \<in> P"  (* P does not depend on logical variables *)
       and "injective (indexify :: (('a \<Rightarrow> ('pvar \<Rightarrow> 'pval)) \<Rightarrow> 'lval))" (* |lval| \<ge> |PStates^k| *)
       and "x \<noteq> c"
       and "injective from_nat"
     shows "sat (strong_pre_insec from_nat x c (P :: ('a \<Rightarrow> ('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set))"
 proof -
 
   let ?S = "\<Union>states\<in>P. { (((fst (states i))(x := from_nat i))(c := indexify (\<lambda>i. snd (states i))), snd (states i)) |i. True}"
 
   have "strong_pre_insec from_nat x c P ?S"
   proof (rule strong_pre_insecI)
     fix states
     assume asm0: "states \<in> P" "\<forall>i. fst (states i) x = from_nat i"
     define r where "r = indexify (\<lambda>i. snd (states i))"
     have "\<And>i. ((fst (states i))(c := r), snd (states i)) \<in> { (((fst (states i))(x := from_nat i))(c := indexify (\<lambda>i. snd (states i))), snd (states i)) |i. True}"
     proof -
       fix i
       show "((fst (states i))(c := r), snd (states i)) \<in> { (((fst (states i))(x := from_nat i))(c := indexify (\<lambda>i. snd (states i))), snd (states i)) |i. True}"
         using asm0(2) r_def by fastforce
     qed
     then show "\<exists>r. \<forall>i. ((fst (states i))(c := r), snd (states i)) \<in> ?S"
       by (meson UN_I asm0(1))
   next
     fix states
     
     assume asm0: "\<forall>i. states i \<in> ?S" "\<forall>i. fst (states i) x = from_nat i" "\<forall>i j. fst (states i) c = fst (states j) c"
 
     let ?P = "\<lambda>i states'. states' \<in> P \<and> states i \<in> { (((fst (states' i))(x := from_nat i))(c := indexify (\<lambda>i. snd (states' i))), snd (states' i)) |i. True}"
 
     let ?states = "\<lambda>i. SOME states'. ?P i states'"
     have r: "\<And>i. ?P i (?states i)"
     proof -
       fix i 
       show "?P i (?states i)"
       proof (rule someI_ex[of "?P i"])
         show "\<exists>states'. states' \<in> P \<and> states i \<in> { (((fst (states' i))(x := from_nat i))(c := indexify (\<lambda>i. snd (states' i))), snd (states' i)) |i. True}"
           using asm0(1) by fastforce
       qed
     qed
     moreover have rr: "\<And>i. fst (states i) c = indexify (\<lambda>j. snd (?states i j)) \<and> snd (?states i i) = snd (states i)"
     proof -
       fix i
       obtain j where j_def: "states i = (((fst ((?states i) j))(x := from_nat j))(c := indexify (\<lambda>k. snd ((?states i) k))), snd ((?states i) j))"
         using r[of i] by blast
       then have r1: "snd (?states i j) = snd (states i)"
         by (metis (no_types, lifting) snd_conv)
       then have "from_nat i = from_nat j"
         by (metis (no_types, lifting) j_def asm0(2) assms(3) fst_conv fun_upd_same fun_upd_twist)
       then have "i = j"
         by (meson assms(4) injective_def)
       show "fst (states i) c = indexify (\<lambda>j. snd (?states i j)) \<and> snd (?states i i) = snd (states i)"
       proof
         show "fst (states i) c = indexify (\<lambda>j. snd (?states i j))"
           by (metis (no_types, lifting) j_def fst_conv fun_upd_same)
         show "snd (?states i i) = snd (states i)"
           using \<open>i = j\<close> r1 by blast
       qed
     qed
     moreover have r0: "\<And>i j. (\<lambda>n. snd (?states i n)) = (\<lambda>n. snd (?states j n))"
     proof -
       fix i j
       have "indexify (\<lambda>n. snd (?states i n)) = indexify (\<lambda>n. snd (?states j n))"
         using asm0(3) rr by fastforce
       then show "(\<lambda>n. snd (?states i n)) = (\<lambda>n. snd (?states j n))"
         by (meson assms(2) injective_def)
     qed
     obtain k :: 'a where "True" by blast
     then have "?states k \<in> P"
       using UN_iff[of _ "\<lambda>states. {((fst (states i))(x := from_nat i, c := indexify (\<lambda>i. snd (states i))), snd (states i)) |i. True}" P]
         asm0(1) someI_ex[of "\<lambda>y. y \<in> P \<and> states k \<in> {((fst (y i))(x := from_nat i, c := indexify (\<lambda>i. snd (y i))), snd (y i)) |i. True}"]
       by fast
     moreover have "\<And>i. snd (?states k i) = snd (states i)"
     proof -
       fix i 
       have "snd (?states i i) = snd (states i)"
         using rr by blast
       moreover have "(\<lambda>n. snd (?states i n)) i = (\<lambda>n. snd (?states k n)) i"
         by (metis r0)
       ultimately show "snd (?states k i) = snd (states i)"
         by auto
     qed
     moreover have "(\<lambda>i. ((\<lambda>i. fst (?states k i)) i, (\<lambda>i. snd (states i)) i)) \<in> P \<longleftrightarrow> (\<lambda>i. ((\<lambda>i. fst (states i)) i, (\<lambda>i. snd (states i)) i)) \<in> P" 
       using assms(1) by fast
     moreover have "(\<lambda>i. ((\<lambda>i. fst (states i)) i, (\<lambda>i. snd (states i)) i)) = states"
     proof (rule ext)
       fix i show "(fst (states i), snd (states i)) = states i"
         by simp
     qed
     moreover have "(\<lambda>i. ((\<lambda>i. fst (?states k i)) i, (\<lambda>i. snd (states i)) i)) = ?states k"
     proof (rule ext)
       fix i show "(\<lambda>i. ((\<lambda>i. fst (?states k i)) i, (\<lambda>i. snd (states i)) i)) i = ?states k i"
         by (metis (no_types, lifting) calculation(4) prod.exhaust_sel)
     qed
     ultimately show "states \<in> P" by argo
   qed
   then show "sat (strong_pre_insec from_nat x c P)"
     by (meson sat_def)
 qed
 
 theorem encode_insec:
   assumes "injective from_nat"
       and "sat (strong_pre_insec from_nat x c (P :: ('a \<Rightarrow> ('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set))"
       and "not_free_var_of P x \<and> not_free_var_of P c"
       and "not_free_var_of Q x \<and> not_free_var_of Q c"
       and "c \<noteq> x"
 
     shows "RIL P C Q \<longleftrightarrow> \<Turnstile> {pre_insec from_nat x c P} C {post_insec from_nat x c Q}" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule hyper_hoare_tripleI)
     fix S assume asm0: "pre_insec from_nat x c P S"
 
     show "post_insec from_nat x c Q (sem C S)"
     proof (rule post_insecI)
       fix states' assume asm1: "states' \<in> Q" "\<forall>i. fst (states' i) x = from_nat i"
       then obtain states where "states \<in> P" "k_sem C states states'"
         using \<open>RIL P C Q\<close> RILE by blast
       then obtain r where asm2: "\<And>i. ((fst (states i))(c := r), snd (states i)) \<in> S"
         using pre_insecE[of from_nat x c P S states]
         by (metis asm0 asm1(2) k_sem_def)
       then show "\<exists>r. \<forall>i. ((fst (states' i))(c := r), snd (states' i)) \<in> sem C S"
         by (metis (mono_tags, opaque_lifting) \<open>k_sem C states states'\<close> k_sem_def single_step_then_in_sem)
     qed
   qed
 next
   assume asm0: ?B
   show ?A
   proof (rule RILI)
     fix states' assume asm1: "states' \<in> Q"
     obtain S where asm2: "strong_pre_insec from_nat x c P S"
       by (meson assms(2) sat_def)
     then have asm3: "post_insec from_nat x c Q (sem C S)"
       by (meson asm0 hyper_hoare_tripleE strong_pre_implies_pre)
 
     let ?states' = "\<lambda>i. ((fst (states' i))(x := from_nat i), snd (states' i))"
     have "?states' \<in> Q"
       by (metis (no_types, lifting) asm1 assms(4) diff_by_update fstI not_free_var_of_def snd_conv)
     then obtain r where r_def: "\<And>i. ((fst (?states' i))(c := r), snd (?states' i)) \<in> sem C S"
       using asm3 post_insecE[of from_nat x c Q] by fastforce
 
     let ?states = "\<lambda>i. SOME \<sigma>. ((fst (?states' i))(c := r), \<sigma>) \<in> S \<and> single_sem C \<sigma> (snd (?states' i))"
 
     have asm4: "\<And>i. ((fst (?states' i))(c := r), (?states i)) \<in> S \<and> single_sem C (?states i) (snd (?states' i))"
     proof -
       fix i 
       have "\<exists>\<sigma>. ((fst (?states' i))(c := r), \<sigma>) \<in> S \<and> single_sem C \<sigma> (snd (?states' i))"
         by (metis r_def fst_conv in_sem snd_conv)
       then show "((fst (?states' i))(c := r), (?states i)) \<in> S \<and> single_sem C (?states i) (snd (?states' i))"
         using someI_ex[of "\<lambda>\<sigma>. ((fst (?states' i))(c := r), \<sigma>) \<in> S \<and> single_sem C \<sigma> (snd (?states' i))"]
         by blast
     qed
     moreover have r0: "(\<lambda>i. ((fst (?states' i))(c := r), (?states i))) \<in> P"
       using asm2
     proof (rule strong_pre_insecE)
       fix i
       show "(\<lambda>i. ((fst (?states' i))(c := r), (?states i))) i \<in> S"
         using calculation by blast
       show "fst ((\<lambda>i. ((fst (?states' i))(c := r), (?states i))) i) x = from_nat i"
         using assms(5) by auto
       fix j
       show "fst ((\<lambda>i. ((fst (?states' i))(c := r), (?states i))) i) c = fst ((\<lambda>i. ((fst (?states' i))(c := r), (?states i))) j) c"
         by fastforce
     qed
     have r1: "(\<lambda>i. (((fst (?states' i))(c := r))(x := fst (states' i) x), (?states i))) \<in> P"
     proof (rule not_free_var_ofE[of P x])
       show "(\<lambda>i. ((fst (?states' i))(c := r), (?states i))) \<in> P"
         using r0 by fastforce
       show "not_free_var_of P x"
         by (simp add: assms(3))
       fix i
       show "differ_only_by
           (fst ((fst ((fst (states' i))(x := from_nat i), snd (states' i)))(c := r), ?states i))
           (fst ((fst ((fst (states' i))(x := from_nat i), snd (states' i)))(c := r, x := fst (states' i) x), ?states i)) x"
         by (metis (mono_tags, lifting) diff_by_comm diff_by_update fst_conv)
     qed (auto)
     have "(\<lambda>i. ((((fst (?states' i))(c := r))(x := fst (states' i) x))(c := fst (states' i) c), (?states i))) \<in> P"
     proof (rule not_free_var_ofE)
       show "(\<lambda>i. (((fst (?states' i))(c := r))(x := fst (states' i) x), (?states i))) \<in> P"
         using r1 by fastforce
       show "not_free_var_of P c"
         by (simp add: assms(3))
       fix i show "differ_only_by
           (fst ((fst ((fst (states' i))(x := from_nat i), snd (states' i)))(c := r, x := fst (states' i) x), ?states i))
           (fst ((fst ((fst (states' i))(x := from_nat i), snd (states' i)))(c := r, x := fst (states' i) x, c := fst (states' i) c), ?states i))
           c"
         by (metis (mono_tags, lifting) diff_by_comm diff_by_update fst_conv)
     qed (auto)
     moreover have "(\<lambda>i. ((((fst (?states' i))(c := r))(x := fst (states' i) x))(c := fst (states' i) c), (?states i)))
       = (\<lambda>i. (fst (states' i), (?states i)))"
     proof (rule ext)
       fix i show "(\<lambda>i. ((((fst (?states' i))(c := r))(x := fst (states' i) x))(c := fst (states' i) c), (?states i))) i
       = (\<lambda>i. (fst (states' i), (?states i))) i"
         by force
     qed
     moreover have "k_sem C (\<lambda>i. (fst (states' i), (?states i))) states'"
     proof (rule k_semI)
       fix i
       show "(fst ((\<lambda>i. (fst (states' i), (?states i))) i) = fst (states' i) \<and>
       single_sem C (snd ((\<lambda>i. (fst (states' i), (?states i))) i)) (snd (states' i)))"
         using asm4 by auto
     qed
     ultimately show "\<exists>states\<in>P. k_sem C states states'"
       by auto
   qed
 qed
 
 
-text \<open>Proposition 5\<close>
+paragraph \<open>Proposition 8\<close>
 
 theorem encoding_RIL:
   fixes x :: "'lvar"
   assumes "\<And>l l' \<sigma>. (\<lambda>i. (l i, \<sigma> i)) \<in> P \<longleftrightarrow> (\<lambda>i. (l' i, \<sigma> i)) \<in> P"  (* P does not depend on logical variables *)
       and "injective (indexify :: (('a \<Rightarrow> ('pvar \<Rightarrow> 'pval)) \<Rightarrow> 'lval))" (* |lval| \<ge> |PStates^k| *)
       and "c \<noteq> x"
       and "injective from_nat"
       and "not_free_var_of (P :: ('a \<Rightarrow> ('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set) x \<and> not_free_var_of P c"
       and "not_free_var_of Q x \<and> not_free_var_of Q c"
     shows "RIL P C Q \<longleftrightarrow> \<Turnstile> {pre_insec from_nat x c P} C {post_insec from_nat x c Q}" (is "?A \<longleftrightarrow> ?B")
 proof (rule encode_insec)
   show "sat (strong_pre_insec from_nat x c (P :: ('a \<Rightarrow> ('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set))"
   proof (rule can_be_sat)
     show "injective (indexify :: (('a \<Rightarrow> ('pvar \<Rightarrow> 'pval)) \<Rightarrow> 'lval))"
       by (simp add: assms(2))
     show "x \<noteq> c"
       using assms(3) by auto
   qed (auto simp add: assms)
 qed (auto simp add: assms)
 
 
 subsection \<open>Forward Underapproximation (FU)\<close>
 
 text \<open>As employed by Outcome Logic~\cite{OutcomeLogic}\<close>
 
-text \<open>Definition 12\<close>
+paragraph \<open>Definition 20\<close>
 definition FU where
   "FU P C Q \<longleftrightarrow> (\<forall>l. \<forall>\<sigma>. (l, \<sigma>) \<in> P \<longrightarrow> (\<exists>\<sigma>'. single_sem C \<sigma> \<sigma>' \<and> (l, \<sigma>') \<in> Q))"
 
 lemma FUI:
   assumes "\<And>\<sigma> l. (l, \<sigma>) \<in> P \<Longrightarrow> (\<exists>\<sigma>'. single_sem C \<sigma> \<sigma>' \<and> (l, \<sigma>') \<in> Q)"
   shows "FU P C Q"
   by (simp add: assms FU_def)
 
 definition encode_FU where
   "encode_FU P S \<longleftrightarrow> P \<inter> S \<noteq> {}"
 
-text \<open>Proposition 6\<close>
+paragraph \<open>Proposition 9\<close>
 theorem encoding_FU:
   "FU P C Q \<longleftrightarrow> \<Turnstile> {encode_FU P} C {encode_FU Q}" (is "?A \<longleftrightarrow> ?B")
 proof
   show "?B \<Longrightarrow> ?A"
   proof -
     assume ?B
     show ?A
     proof (rule FUI)
       fix \<sigma> l
       assume asm: "(l, \<sigma>) \<in> P"
       then have "encode_FU P {(l, \<sigma>)}"
         by (simp add: encode_FU_def)
       then have "Q \<inter> sem C {(l, \<sigma>)} \<noteq> {}"
         using \<open>\<Turnstile> {encode_FU P} C {encode_FU Q}\<close> hyper_hoare_tripleE encode_FU_def by blast
       then obtain \<phi>' where "\<phi>' \<in> Q" "\<phi>' \<in> sem C {(l, \<sigma>)}"
         by blast
       then show "\<exists>\<sigma>'. single_sem C \<sigma> \<sigma>' \<and> (l, \<sigma>') \<in> Q"
         by (metis fst_conv in_sem prod.collapse singletonD snd_conv)
     qed
   qed
   assume ?A
   show ?B
   proof (rule hyper_hoare_tripleI)
     fix S assume "encode_FU P S"
     then obtain l \<sigma> where "(l, \<sigma>) \<in> P \<inter> S"
       by (metis Expressivity.encode_FU_def ex_in_conv surj_pair)
     then obtain \<sigma>' where "single_sem C \<sigma> \<sigma>' \<and> (l, \<sigma>') \<in> Q"
       by (meson IntD1 \<open>FU P C Q\<close> FU_def)
     then show "encode_FU Q (sem C S)"
       using Expressivity.encode_FU_def \<open>(l, \<sigma>) \<in> P \<inter> S\<close> sem_def by fastforce
   qed
 qed
 
 definition hyperprop_FU where
   "hyperprop_FU P Q S \<longleftrightarrow> (\<forall>l \<sigma>. (l, \<sigma>) \<in> P \<longrightarrow> (\<exists>\<sigma>'. (l, \<sigma>') \<in> Q \<and> (\<sigma>, \<sigma>') \<in> S))"
 
 lemma hyperprop_FUI:
   assumes "\<And>l \<sigma>. (l, \<sigma>) \<in> P \<Longrightarrow> (\<exists>\<sigma>'. (l, \<sigma>') \<in> Q \<and> (\<sigma>, \<sigma>') \<in> S)"
   shows "hyperprop_FU P Q S"
   by (simp add: hyperprop_FU_def assms)
 
 lemma hyperprop_FUE:
   assumes "hyperprop_FU P Q S"
       and "(l, \<sigma>) \<in> P"
     shows "\<exists>\<sigma>'. (l, \<sigma>') \<in> Q \<and> (\<sigma>, \<sigma>') \<in> S"
   using hyperprop_FU_def assms(1) assms(2) by fastforce
 
 theorem FU_expresses_hyperproperties:
   "hypersat C (hyperprop_FU P Q) \<longleftrightarrow> FU P C Q" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule FUI)
     fix \<sigma> l assume "(l, \<sigma>) \<in> P"
     then obtain \<sigma>' where asm0: "(l, \<sigma>') \<in> Q \<and> (\<sigma>, \<sigma>') \<in> set_of_traces C"
       by (meson \<open>hypersat C (hyperprop_FU P Q)\<close> hyperprop_FUE hypersat_def)
     then show "\<exists>\<sigma>'. (\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>') \<and> (l, \<sigma>') \<in> Q"
       using in_set_of_traces by blast
   qed
 next
   assume ?B
   have "hyperprop_FU P Q (set_of_traces C)"
   proof (rule hyperprop_FUI)
     fix l \<sigma>
     assume asm0: "(l, \<sigma>) \<in> P"
     then show "\<exists>\<sigma>'. (l, \<sigma>') \<in> Q \<and> (\<sigma>, \<sigma>') \<in> set_of_traces C"
       by (metis (mono_tags, lifting) CollectI \<open>FU P C Q\<close> FU_def set_of_traces_def)
   qed
   then show ?A
     by (simp add: hypersat_def)
 qed
 
 theorem hyperliveness_hyperprop_FU:
   assumes "\<And>l. sat_for_l l P \<Longrightarrow> sat_for_l l Q"
   shows "hyperliveness (hyperprop_FU P Q)"
 proof (rule hyperlivenessI)
   fix S show "\<exists>S'. S \<subseteq> S' \<and> hyperprop_FU P Q S'"
     by (meson UNIV_I hyperprop_FU_def assms sat_for_l_def subsetI)
 qed
 
 
-text \<open>No relationship between incorrectness and forward underapproximation\<close>
+paragraph \<open>No relationship between incorrectness and forward underapproximation\<close>
 
 lemma incorrectness_does_not_imply_FU:
   assumes "injective from_nat"
   assumes "P = {(l, \<sigma>) |\<sigma> l. \<sigma> x = from_nat (0 :: nat) \<or> \<sigma> x = from_nat 1}"
       and "Q = {(l, \<sigma>) |\<sigma> l. \<sigma> x = from_nat 1}"
       and "C = Assume (\<lambda>\<sigma>. \<sigma> x = from_nat 1)"
   shows "IL P C Q"
     and "\<not> FU P C Q"
 proof -
   have "Q \<subseteq> sem C P"
   proof (rule subsetPairI)
     fix l \<sigma> assume "(l, \<sigma>) \<in> Q"
     then have "\<sigma> x = from_nat 1"
       using assms(3) by blast
     then have "(l, \<sigma>) \<in> P"
       by (simp add: assms(2))
     then show "(l, \<sigma>) \<in> sem C P"
       by (simp add: \<open>\<sigma> x = from_nat 1\<close> assms(4) sem_assume)
   qed
   then show "IL P C Q"
     by (simp add: IL_def)
   show "\<not> FU P C Q"
   proof (rule ccontr)
     assume "\<not> \<not> FU P C Q"
     then have "FU P C Q"
       by blast
     obtain \<sigma> where "\<sigma> x = from_nat 0"
       by simp
     then obtain l where "(l, \<sigma>) \<in> P"
       using assms(2) by blast
     then obtain \<sigma>' where "single_sem C \<sigma> \<sigma>'" "(l, \<sigma>') \<in> Q"
       by (meson \<open>FU P C Q\<close> FU_def)
     then have "\<sigma>' x = from_nat 0"
       using \<open>\<sigma> x = from_nat 0\<close> assms(4) by blast
     then have "from_nat 0 = from_nat 1"
       using \<open>\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'\<close> assms(4) by force
     then show False
       using assms(1) injective_def[of from_nat] by auto
   qed
 qed
 
 lemma FU_does_not_imply_incorrectness:
   assumes "P = {(l, \<sigma>) |\<sigma> l. \<sigma> x = from_nat (0 :: nat) \<or> \<sigma> x = from_nat 1}"
       and "Q = {(l, \<sigma>) |\<sigma> l. \<sigma> x = from_nat 1}"
   assumes "injective from_nat"
   shows "\<not> IL Q Skip P"
     and "FU Q Skip P"
 proof -
   show "FU Q Skip P"
   proof (rule FUI)
     fix \<sigma> l
     assume "(l, \<sigma>) \<in> Q"
     then show "\<exists>\<sigma>'. (\<langle>Skip, \<sigma>\<rangle> \<rightarrow> \<sigma>') \<and> (l, \<sigma>') \<in> P"
       using SemSkip assms(1) assms(2) by fastforce
   qed
   obtain \<sigma> where "\<sigma> x = from_nat 0"
     by simp
   then obtain l where "(l, \<sigma>) \<in> P"
     using assms(1) by blast
   moreover have "\<sigma> x \<noteq> from_nat 1"
     by (metis \<open>\<sigma> x = from_nat 0\<close> assms(3) injective_def one_neq_zero)
   then have "(l, \<sigma>) \<notin> Q"
     using assms(2) by blast
   ultimately show "\<not> IL Q Skip P"
     using IL_consequence by blast
 qed
 
 
-subsection \<open>Relational Forward Underapproximate logic\<close>
+subsection \<open>k-Forward Underapproximate logic\<close>
 
-text \<open>Definition 13\<close>
+text \<open>RFU is the old name of k-FU.\<close>
+
+paragraph \<open>Definition 21\<close>
 definition RFU where
   "RFU P C Q \<longleftrightarrow> (\<forall>states \<in> P. \<exists>states' \<in> Q. k_sem C states states')"
 
 lemma RFUI:
   assumes "\<And>states. states \<in> P \<Longrightarrow> (\<exists>states' \<in> Q. k_sem C states states')"
   shows "RFU P C Q"
   by (simp add: assms RFU_def)
 
 lemma RFUE:
   assumes "RFU P C Q"
       and "states \<in> P"
     shows "\<exists>states' \<in> Q. k_sem C states states'"
   using assms(1) assms(2) RFU_def by blast
 
 definition encode_RFU where
   "encode_RFU from_nat x P S \<longleftrightarrow> (\<exists>states \<in> P. (\<forall>i. states i \<in> S \<and> fst (states i) x = from_nat i))"
 
-text \<open>Proposition 7\<close>
+paragraph \<open>Proposition 11\<close>
 theorem encode_RFU:
   assumes "not_free_var_of P x"
       and "not_free_var_of Q x"
       and "injective from_nat"
     shows "RFU P C Q \<longleftrightarrow> \<Turnstile> {encode_RFU from_nat x P} C {encode_RFU from_nat x Q}"
 (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule hyper_hoare_tripleI)
     fix S assume "encode_RFU from_nat x P S"
     then obtain states where asm0: "states \<in> P" "\<And>i. states i \<in> S \<and> fst (states i) x = from_nat i"
       by (meson encode_RFU_def)
     then obtain states' where "states' \<in> Q" "k_sem C states states'"
       using \<open>RFU P C Q\<close> RFUE by blast
     then have "\<And>i. states' i \<in> sem C S \<and> fst (states' i) x = from_nat i"
       by (metis (mono_tags, lifting) asm0(2) in_sem k_sem_def prod.collapse)
     then show "encode_RFU from_nat x Q (sem C S)"
       by (meson \<open>states' \<in> Q\<close> encode_RFU_def)
   qed
 next
   assume ?B
   show ?A
   proof (rule RFUI)
     fix states assume asm0: "states \<in> P"
     let ?states = "\<lambda>i. ((fst (states i))(x := from_nat i), snd (states i))"
 
     have "?states \<in> P"
       using assms(1)
     proof (rule not_free_var_ofE)
       show "states \<in> P" using asm0 by simp
       fix i show "differ_only_by (fst (states i)) (fst ((fst (states i))(x := from_nat i), snd (states i))) x"
         using diff_by_comm diff_by_update by fastforce
     qed (auto)
     then have "encode_RFU from_nat x P (range ?states)"
       using encode_RFU_def by fastforce
     then have "encode_RFU from_nat x Q (sem C (range ?states))"
       using \<open>\<Turnstile> {encode_RFU from_nat x P} C {encode_RFU from_nat x Q}\<close> hyper_hoare_tripleE by blast
     then obtain states' where states'_def: "states' \<in> Q" "\<And>i. states' i \<in> sem C (range ?states) \<and> fst (states' i) x = from_nat i"
       by (meson encode_RFU_def)
 
     let ?states' = "\<lambda>i. ((fst (states' i))(x := fst (states i) x), snd (states' i))"
 
     have "?states' \<in> Q"
       using assms(2)
     proof (rule not_free_var_ofE)
       show "states' \<in> Q" using \<open>states' \<in> Q\<close> by simp
       fix i show "differ_only_by (fst (states' i)) (fst ((fst (states' i))(x := fst (states i) x), snd (states' i))) x"
         using diff_by_comm diff_by_update by fastforce
     qed (auto)
     moreover obtain to_pvar where to_pvar_def: "\<And>i. to_pvar (from_nat i) = i"
       using assms(3) injective_then_exists_inverse by blast
     then have inj: "\<And>i j. from_nat i = from_nat j \<Longrightarrow> i = j"
       by metis
 
     moreover have "k_sem C states ?states'"
     proof (rule k_semI)
       fix i 
       obtain \<sigma> where "(fst (states' i), \<sigma>) \<in> range (\<lambda>i. ((fst (states i))(x := from_nat i), snd (states i))) \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> snd (states' i)"
         using states'_def(2) in_sem by blast
       moreover have "fst (states' i) x = from_nat i"
         by (simp add: states'_def)
       then have r: "((fst (states (inv ?states (fst (states' i), \<sigma>))))
       (x := from_nat (inv ?states (fst (states' i), \<sigma>))), snd (states (inv ?states (fst (states' i), \<sigma>))))
         = (fst (states' i), \<sigma>)"
         by (metis (mono_tags, lifting) calculation f_inv_into_f)
       then have "single_sem C (snd (states i)) (snd (states' i))"
         using \<open>fst (states' i) x = from_nat i\<close> calculation inj by fastforce
       moreover have "fst (?states i) = fst (states' i)"
         by (metis (mono_tags, lifting)r \<open>fst (states' i) x = from_nat i\<close> fst_conv fun_upd_same inj)
       ultimately show "fst (states i) = fst ((fst (states' i))(x := fst (states i) x), snd (states' i)) \<and>
          \<langle>C, snd (states i)\<rangle> \<rightarrow> snd ((fst (states' i))(x := fst (states i) x), snd (states' i))"
         by (metis (mono_tags, lifting) fst_conv fun_upd_triv fun_upd_upd snd_conv)
     qed
     ultimately show "\<exists>states'\<in>Q. k_sem C states states'" by blast
   qed
 qed
 
 definition RFU_hyperprop where
   "RFU_hyperprop P Q S \<longleftrightarrow> (\<forall>l states. (\<lambda>i. (l i, states i)) \<in> P
          \<longrightarrow> (\<exists>states'. (\<lambda>i. (l i, states' i)) \<in> Q \<and> (\<forall>i. (states i, states' i) \<in> S)))"
 
 lemma RFU_hyperpropI:
   assumes "\<And>l states. (\<lambda>i. (l i, states i)) \<in> P \<Longrightarrow> (\<exists>states'. (\<lambda>i. (l i, states' i)) \<in> Q \<and> (\<forall>i. (states i, states' i) \<in> S))"
   shows "RFU_hyperprop P Q S"
   by (simp add: assms RFU_hyperprop_def)
 
 lemma RFU_hyperpropE:
   assumes "RFU_hyperprop P Q S"
       and "(\<lambda>i. (l i, states i)) \<in> P"
     shows "\<exists>states'. (\<lambda>i. (l i, states' i)) \<in> Q \<and> (\<forall>i. (states i, states' i) \<in> S)"
   using assms(1) assms(2) RFU_hyperprop_def by blast
 
-text \<open>Proposition 13\<close>
+paragraph \<open>Proposition 10\<close>
 theorem RFU_captures_hyperproperties:
   "hypersat C (RFU_hyperprop P Q) \<longleftrightarrow> RFU P C Q" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule RFUI)
     fix states assume "states \<in> P"
     moreover have "(\<lambda>i. ((fst \<circ> states) i, (snd \<circ> states) i)) = states" by simp
     ultimately obtain states' where asm0: "(\<lambda>i. ((fst \<circ> states) i, states' i)) \<in> Q" "\<And>i. ((snd \<circ> states) i, states' i) \<in> set_of_traces C"
       using RFU_hyperpropE[of P Q "set_of_traces C" "fst \<circ> states" "snd \<circ> states"]
       using \<open>hypersat C (RFU_hyperprop P Q)\<close> hypersat_def by auto
 
     moreover have "k_sem C states (\<lambda>i. ((fst \<circ> states) i, states' i))"
     proof (rule k_semI)
       fix i 
       have "\<langle>C, snd (states i)\<rangle> \<rightarrow> states' i"
         using calculation(2) in_set_of_traces by fastforce
       then show "fst (states i) = fst ((fst \<circ> states) i, states' i) \<and> \<langle>C, snd (states i)\<rangle> \<rightarrow> snd ((fst \<circ> states) i, states' i)"
         by simp
     qed
     ultimately show "\<exists>states'\<in>Q. k_sem C states states'"
       by fast
   qed
 next
   assume ?B
   have "RFU_hyperprop P Q (set_of_traces C)"
   proof (rule RFU_hyperpropI)
     fix l states
     assume "(\<lambda>i. (l i, states i)) \<in> P"
     then obtain states' where asm0: "states' \<in> Q" "k_sem C (\<lambda>i. (l i, states i)) states'"
       using \<open>RFU P C Q\<close> RFUE by blast
     then have "\<And>i. fst (states' i) = l i"
       by (simp add: k_sem_def)
     moreover have "(\<lambda>i. (l i, (snd \<circ> states') i)) = states'"
     proof (rule ext)
       fix i show "(l i, (snd \<circ> states') i) = states' i"
         by (metis calculation comp_apply surjective_pairing)
     qed
     moreover have "\<And>i. (states i, (snd \<circ> states') i) \<in> set_of_traces C"
     proof -
       fix i show "(states i, (snd \<circ> states') i) \<in> set_of_traces C"
         using asm0(2) comp_apply[of snd states'] in_set_of_traces k_sem_def[of C "\<lambda>i. (l i, states i)" states'] snd_conv
         by fastforce
     qed
     ultimately show "\<exists>states'. (\<lambda>i. (l i, states' i)) \<in> Q \<and> (\<forall>i. (states i, states' i) \<in> set_of_traces C)"
       using asm0(1) by force
   qed
   then show ?A
     by (simp add: hypersat_def)
 qed
 
 theorem hyperliveness_encode_RFU:
   assumes "\<And>l. k_sat_for_l l P \<Longrightarrow> k_sat_for_l l Q"
   shows "hyperliveness (RFU_hyperprop P Q)"
 proof (rule hyperlivenessI)
   fix S 
   have "RFU_hyperprop P Q UNIV"
   proof (rule RFU_hyperpropI)
     fix l states assume asm0: "(\<lambda>i. (l i, states i)) \<in> P"
     then obtain states' where "(\<lambda>i. (l i, states' i)) \<in> Q"
       by (metis assms k_sat_for_l_def)
     then show "\<exists>states'. (\<lambda>i. (l i, states' i)) \<in> Q \<and> (\<forall>i. (states i, states' i) \<in> UNIV)"
       by blast
   qed
   then show "\<exists>S'. S \<subseteq> S' \<and> RFU_hyperprop P Q S'"
     by blast
 qed
 
 
-subsection \<open>Relational Universal Existential (RUE)~\cite{RHLE}\<close>
+subsection \<open>k-Universal Existential (RUE)~\cite{RHLE}\<close>
 
-text \<open>Definition 14\<close>
+text \<open>RUE is the old name of k-UE.\<close>
+
+paragraph \<open>Definition 22\<close>
 
 definition RUE where
   "RUE P C Q \<longleftrightarrow> (\<forall>(\<sigma>1, \<sigma>2) \<in> P. \<forall>\<sigma>1'. k_sem C \<sigma>1 \<sigma>1' \<longrightarrow> (\<exists>\<sigma>2'. k_sem C \<sigma>2 \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q))"
 
 lemma RUE_I:
   assumes "\<And>\<sigma>1 \<sigma>2 \<sigma>1'. (\<sigma>1, \<sigma>2) \<in> P \<Longrightarrow> k_sem C \<sigma>1 \<sigma>1' \<Longrightarrow> (\<exists>\<sigma>2'. k_sem C \<sigma>2 \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q)"
   shows "RUE P C Q"
   using assms RUE_def by fastforce
 
 lemma RUE_E:
   assumes "RUE P C Q"
       and "(\<sigma>1, \<sigma>2) \<in> P"
       and "k_sem C \<sigma>1 \<sigma>1'"
     shows "\<exists>\<sigma>2'. k_sem C \<sigma>2 \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q"
   using RUE_def assms(1) assms(2) assms(3) by blast
 
-text \<open>Hyperproperty\<close>
+paragraph \<open>Hyperproperty\<close>
 
 definition hyperprop_RUE where
   "hyperprop_RUE P Q S \<longleftrightarrow> (\<forall>l1 l2 \<sigma>1 \<sigma>2 \<sigma>1'. (\<lambda>i. (l1 i, \<sigma>1 i), \<lambda>k. (l2 k, \<sigma>2 k)) \<in> P \<and>
   (\<forall>i. (\<sigma>1 i, \<sigma>1' i) \<in> S) \<longrightarrow> (\<exists>\<sigma>2'. (\<forall>k. (\<sigma>2 k, \<sigma>2' k) \<in> S) \<and> (\<lambda>i. (l1 i, \<sigma>1' i), \<lambda>k. (l2 k, \<sigma>2' k)) \<in> Q))"
 
 lemma hyperprop_RUE_I:
   assumes "\<And>l1 l2 \<sigma>1 \<sigma>2 \<sigma>1'. (\<lambda>i. (l1 i, \<sigma>1 i), \<lambda>k. (l2 k, \<sigma>2 k)) \<in> P \<Longrightarrow>
   (\<forall>i. (\<sigma>1 i, \<sigma>1' i) \<in> S) \<Longrightarrow> (\<exists>\<sigma>2'. (\<forall>k. (\<sigma>2 k, \<sigma>2' k) \<in> S) \<and> (\<lambda>i. (l1 i, \<sigma>1' i), \<lambda>k. (l2 k, \<sigma>2' k)) \<in> Q)"
   shows "hyperprop_RUE P Q S"
   using assms hyperprop_RUE_def[of P Q S]
   by force
 
 lemma hyperprop_RUE_E:
   assumes "hyperprop_RUE P Q S"
       and "(\<lambda>i. (l1 i, \<sigma>1 i), \<lambda>k. (l2 k, \<sigma>2 k)) \<in> P"
       and "\<And>i. (\<sigma>1 i, \<sigma>1' i) \<in> S"
     shows "\<exists>\<sigma>2'. (\<forall>k. (\<sigma>2 k, \<sigma>2' k) \<in> S) \<and> (\<lambda>i. (l1 i, \<sigma>1' i), \<lambda>k. (l2 k, \<sigma>2' k)) \<in> Q"
   using assms(1) assms(2) assms(3) hyperprop_RUE_def by blast
 
 
-text \<open>Proposition 14\<close>
+paragraph \<open>Proposition 12\<close>
 theorem RUE_express_hyperproperties:
   "RUE P C Q \<longleftrightarrow> hypersat C (hyperprop_RUE P Q)" (is "?A \<longleftrightarrow> ?B")
 proof
   assume asm0: ?A
   have "hyperprop_RUE P Q (set_of_traces C)"
   proof (rule hyperprop_RUE_I)
     fix l1 l2 \<sigma>1 \<sigma>2 \<sigma>1'
     assume asm1: "(\<lambda>i. (l1 i, \<sigma>1 i), \<lambda>k. (l2 k, \<sigma>2 k)) \<in> P" "\<forall>i. (\<sigma>1 i, \<sigma>1' i) \<in> set_of_traces C"
 
     let ?x1 = "\<lambda>i. (l1 i, \<sigma>1 i)"
     let ?x2 = "\<lambda>k. (l2 k, \<sigma>2 k)"
 
     let ?x1' = "\<lambda>i. (l1 i, \<sigma>1' i)"
 
     have "\<exists>\<sigma>2'. k_sem C (\<lambda>k. (l2 k, \<sigma>2 k)) \<sigma>2' \<and> (?x1', \<sigma>2') \<in> Q"
       using asm0 asm1(1)
     proof (rule RUE_E)
       show "k_sem C (\<lambda>i. (l1 i, \<sigma>1 i)) (\<lambda>i. (l1 i, \<sigma>1' i))"
       proof (rule k_semI)
         fix i 
         have "single_sem C (\<sigma>1 i) (\<sigma>1' i)" using asm1(2)
           by (simp add: set_of_traces_def)
         then show "fst (l1 i, \<sigma>1 i) = fst (l1 i, \<sigma>1' i) \<and> \<langle>C, snd (l1 i, \<sigma>1 i)\<rangle> \<rightarrow> snd (l1 i, \<sigma>1' i)"
           by simp
       qed
     qed
     then obtain \<sigma>2' where asm2: "k_sem C (\<lambda>k. (l2 k, \<sigma>2 k)) \<sigma>2'" "(?x1', \<sigma>2') \<in> Q"
       by blast
     let ?\<sigma>2' = "\<lambda>k. snd (\<sigma>2' k)"
 
     have "\<And>k. (\<sigma>2 k, ?\<sigma>2' k) \<in> set_of_traces C"
       by (metis (mono_tags, lifting) asm2(1) in_set_of_traces k_sem_def snd_conv)
     moreover have "(\<lambda>k. (l2 k, ?\<sigma>2' k)) = \<sigma>2'"
     proof (rule ext)
       fix k show "(l2 k, snd (\<sigma>2' k)) = \<sigma>2' k"
         by (metis (mono_tags, lifting) asm2(1) fst_eqD k_sem_def surjective_pairing)
     qed
     ultimately show "\<exists>\<sigma>2'. (\<forall>k. (\<sigma>2 k, \<sigma>2' k) \<in> set_of_traces C) \<and> (\<lambda>i. (l1 i, \<sigma>1' i), \<lambda>k. (l2 k, \<sigma>2' k)) \<in> Q"
       using asm2(2) by fastforce
   qed
   then show ?B
     by (simp add: hypersat_def)
 next
   assume ?B then have asm0: "hyperprop_RUE P Q (set_of_traces C)"
     by (simp add: hypersat_def)
   show ?A
   proof (rule RUE_I)
     fix \<sigma>1 \<sigma>2 \<sigma>1'
     assume asm1: "(\<sigma>1, \<sigma>2) \<in> P" "k_sem C \<sigma>1 \<sigma>1'"
     then have "\<And>i. fst (\<sigma>1 i) = fst (\<sigma>1' i)"
       by (simp add: k_sem_def)
     have "\<exists>\<sigma>2'. (\<forall>k. (snd (\<sigma>2 k), \<sigma>2' k) \<in> set_of_traces C) \<and> (\<lambda>i. (fst (\<sigma>1 i), snd (\<sigma>1' i)), \<lambda>k. (fst (\<sigma>2 k), \<sigma>2' k)) \<in> Q"
       using asm0
     proof (rule hyperprop_RUE_E[of P Q "set_of_traces C" "\<lambda>i. fst (\<sigma>1 i)" "\<lambda>i. snd (\<sigma>1 i)" "\<lambda>k. fst (\<sigma>2 k)" "\<lambda>k. snd (\<sigma>2 k)" "\<lambda>i. snd (\<sigma>1' i)"])
       show "(\<lambda>i. (fst (\<sigma>1 i), snd (\<sigma>1 i)), \<lambda>k. (fst (\<sigma>2 k), snd (\<sigma>2 k))) \<in> P"        
         by (simp add: asm1(1))
       fix i show "(snd (\<sigma>1 i), snd (\<sigma>1' i)) \<in> set_of_traces C"
         by (metis (mono_tags, lifting) CollectI asm1(2) k_sem_def set_of_traces_def)
     qed
     then obtain \<sigma>2' where asm2: "\<And>k. (snd (\<sigma>2 k), \<sigma>2' k) \<in> set_of_traces C" "(\<lambda>i. (fst (\<sigma>1 i), snd (\<sigma>1' i)), \<lambda>k. (fst (\<sigma>2 k), \<sigma>2' k)) \<in> Q"
       by blast
     moreover have "k_sem C \<sigma>2 (\<lambda>k. (fst (\<sigma>2 k), \<sigma>2' k))"
     proof (rule k_semI)
       fix i show "fst (\<sigma>2 i) = fst (fst (\<sigma>2 i), \<sigma>2' i) \<and> \<langle>C, snd (\<sigma>2 i)\<rangle> \<rightarrow> snd (fst (\<sigma>2 i), \<sigma>2' i)"
         using calculation(1) in_set_of_traces by auto
     qed
     ultimately show "\<exists>\<sigma>2'. k_sem C \<sigma>2 \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q"
       using \<open>\<And>i. fst (\<sigma>1 i) = fst (\<sigma>1' i)\<close> by auto
   qed
 qed
 
 definition is_type where
   "is_type type fn x t S \<sigma> \<longleftrightarrow> (\<forall>i. \<sigma> i \<in> S \<and> fst (\<sigma> i) t = type \<and> fst (\<sigma> i) x = fn i)"
 
 lemma is_typeI:
   assumes "\<And>i. \<sigma> i \<in> S"
       and "\<And>i. fst (\<sigma> i) t = type"
       and "\<And>i. fst (\<sigma> i) x = fn i"
     shows "is_type type fn x t S \<sigma>"
   by (simp add: assms(1) assms(2) assms(3) is_type_def)
 
 lemma is_type_E:
   assumes "is_type type fn x t S \<sigma>"
   shows "\<sigma> i \<in> S \<and> fst (\<sigma> i) t = type \<and> fst (\<sigma> i) x = fn i"
   by (meson assms is_type_def)
 
 
 definition encode_RUE_1 where
   "encode_RUE_1 fn fn1 fn2 x t P S \<longleftrightarrow> (\<forall>k. \<exists>\<sigma> \<in> S. fst \<sigma> x = fn2 k \<and> fst \<sigma> t = fn 2)
   \<and> (\<forall>\<sigma> \<sigma>'. is_type (fn 1) fn1 x t S \<sigma> \<and> is_type (fn 2) fn2 x t S \<sigma>'
   \<longrightarrow> (\<sigma>, \<sigma>') \<in> P)"
 
 lemma encode_RUE_1_I:
   assumes "\<And>k. \<exists>\<sigma> \<in> S. fst \<sigma> x = fn2 k \<and> fst \<sigma> t = fn 2"
       and "\<And>\<sigma> \<sigma>'. is_type (fn 1) fn1 x t S \<sigma> \<and> is_type (fn 2) fn2 x t S \<sigma>'
   \<Longrightarrow> (\<sigma>, \<sigma>') \<in> P"
     shows "encode_RUE_1 fn fn1 fn2 x t P S"
   by (simp add: assms(1) assms(2) encode_RUE_1_def)
 
 lemma encode_RUE_1_E1:
   assumes "encode_RUE_1 fn fn1 fn2 x t P S"
   shows "\<exists>\<sigma> \<in> S. fst \<sigma> x = fn2 k \<and> fst \<sigma> t = fn 2"
   by (meson assms encode_RUE_1_def)
 
 lemma encode_RUE_1_E2:
   assumes "encode_RUE_1 fn fn1 fn2 x t P S"
       and "is_type (fn 1) fn1 x t S \<sigma>"
       and "is_type (fn 2) fn2 x t S \<sigma>'"
     shows "(\<sigma>, \<sigma>') \<in> P"
   by (meson assms encode_RUE_1_def)
 
 
 definition encode_RUE_2 where
   "encode_RUE_2 fn fn1 fn2 x t Q S \<longleftrightarrow> (\<forall>\<sigma>. is_type (fn 1) fn1 x t S \<sigma> \<longrightarrow> (\<exists>\<sigma>'. is_type (fn 2) fn2 x t S \<sigma>' \<and> (\<sigma>, \<sigma>') \<in> Q))"
 
 lemma encode_RUE_2I:
   assumes "\<And>\<sigma>. is_type (fn 1) fn1 x t S \<sigma> \<Longrightarrow> (\<exists>\<sigma>'. is_type (fn 2) fn2 x t S \<sigma>' \<and> (\<sigma>, \<sigma>') \<in> Q)"
   shows "encode_RUE_2 fn fn1 fn2 x t Q S"
   by (simp add: assms encode_RUE_2_def)
 
 lemma encode_RUE_2_E:
   assumes "encode_RUE_2 fn fn1 fn2 x t Q S"
       and "is_type (fn 1) fn1 x t S \<sigma>"
     shows "\<exists>\<sigma>'. is_type (fn 2) fn2 x t S \<sigma>' \<and> (\<sigma>, \<sigma>') \<in> Q"
   by (meson assms(1) assms(2) encode_RUE_2_def)
 
 definition differ_only_by_set where
   "differ_only_by_set vars a b \<longleftrightarrow> (\<forall>x. x \<notin> vars \<longrightarrow> a x = b x)"
 
 definition differ_only_by_lset where
   "differ_only_by_lset vars a b \<longleftrightarrow> (\<forall>i. snd (a i) = snd (b i) \<and> differ_only_by_set vars (fst (a i)) (fst (b i)))"
 
 lemma differ_only_by_lsetI:
   assumes "\<And>i. snd (a i) = snd (b i)"
       and "\<And>i. differ_only_by_set vars (fst (a i)) (fst (b i))"
     shows "differ_only_by_lset vars a b"
   using assms(1) assms(2) differ_only_by_lset_def by blast
 
 definition not_in_free_vars_double where
   "not_in_free_vars_double vars P \<longleftrightarrow> (\<forall>\<sigma> \<sigma>'. differ_only_by_lset vars (fst \<sigma>) (fst \<sigma>') \<and>
   differ_only_by_lset vars (snd \<sigma>) (snd \<sigma>') \<longrightarrow> (\<sigma> \<in> P \<longleftrightarrow> \<sigma>' \<in> P))"
 
 lemma not_in_free_vars_doubleE:
   assumes "not_in_free_vars_double vars P"
       and "differ_only_by_lset vars (fst \<sigma>) (fst \<sigma>')"
       and "differ_only_by_lset vars (snd \<sigma>) (snd \<sigma>')"
       and "\<sigma> \<in> P"
     shows "\<sigma>' \<in> P"
   by (meson assms not_in_free_vars_double_def)
 
 
-text \<open>Proposition 8\<close>
+paragraph \<open>Proposition 13\<close>
 
 theorem encoding_RUE:
   assumes "injective fn \<and> injective fn1 \<and> injective fn2"
       and "t \<noteq> x"
 
     and "injective (fn :: nat \<Rightarrow> 'a)"
     and "injective fn1"
     and "injective fn2"
 
     and "not_in_free_vars_double {x, t} P"
     and "not_in_free_vars_double {x, t} Q"
 
     shows "RUE P C Q \<longleftrightarrow> \<Turnstile> {encode_RUE_1 fn fn1 fn2 x t P} C {encode_RUE_2 fn fn1 fn2 x t Q}"
 (is "?A \<longleftrightarrow> ?B")
 proof
   assume asm0: ?A
   show ?B
   proof (rule hyper_hoare_tripleI)
     fix S assume asm1: "encode_RUE_1 fn fn1 fn2 x t P S"
 
     show "encode_RUE_2 fn fn1 fn2 x t Q (sem C S)"
     proof (rule encode_RUE_2I)
       fix \<sigma>1' assume asm2: "is_type (fn 1) fn1 x t (sem C S) \<sigma>1'"
 
       let ?\<sigma>2 = "\<lambda>k. SOME \<sigma>'. \<sigma>'\<in>S \<and> fst \<sigma>' x = fn2 k \<and> fst \<sigma>' t = fn 2"
       have r2: "\<And>k. ?\<sigma>2 k \<in>S \<and> fst (?\<sigma>2 k) x = fn2 k \<and> fst (?\<sigma>2 k) t = fn 2"
       proof -
         fix k
         show "?\<sigma>2 k \<in>S \<and> fst (?\<sigma>2 k) x = fn2 k \<and> fst (?\<sigma>2 k) t = fn 2"
         proof (rule someI_ex)
           show "\<exists>xa. xa \<in> S \<and> fst xa x = fn2 k \<and> fst xa t = fn 2"
             by (meson asm1 encode_RUE_1_E1)
         qed
       qed
       let ?\<sigma>1 = "\<lambda>i. SOME \<sigma>. (fst (\<sigma>1' i), \<sigma>) \<in> S \<and> single_sem C \<sigma> (snd (\<sigma>1' i))"
       have r1: "\<And>i. (fst (\<sigma>1' i), ?\<sigma>1 i) \<in> S \<and> single_sem C (?\<sigma>1 i) (snd (\<sigma>1' i))"
       proof -
         fix i
         show "(fst (\<sigma>1' i), ?\<sigma>1 i) \<in> S \<and> single_sem C (?\<sigma>1 i) (snd (\<sigma>1' i))"
         proof (rule someI_ex[of "\<lambda>\<sigma>. (fst (\<sigma>1' i), \<sigma>) \<in> S \<and> single_sem C \<sigma> (snd (\<sigma>1' i))"])
           show "\<exists>\<sigma>. (fst (\<sigma>1' i), \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> snd (\<sigma>1' i)"
             by (meson asm2 in_sem is_type_def)
         qed
       qed
       have "(\<lambda>i. (fst (\<sigma>1' i), ?\<sigma>1 i), ?\<sigma>2) \<in> P"
         using asm1
       proof (rule encode_RUE_1_E2)
         show "is_type (fn 1) fn1 x t S (\<lambda>i. (fst (\<sigma>1' i), ?\<sigma>1 i))"
           using asm2 fst_conv is_type_def[of "fn 1" fn1 x t S] is_type_def[of "fn 1" fn1 x t "sem C S"] r1
           by force
         show "is_type (fn 2) fn2 x t S ?\<sigma>2"
           by (simp add: is_type_def r2)
       qed
       moreover have "\<exists>\<sigma>2'. k_sem C ?\<sigma>2 \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q"
         using asm0
       proof (rule RUE_E)
         show "(\<lambda>i. (fst (\<sigma>1' i), ?\<sigma>1 i), ?\<sigma>2) \<in> P"
           using calculation by auto
         show "k_sem C (\<lambda>i. (fst (\<sigma>1' i), SOME \<sigma>. (fst (\<sigma>1' i), \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> snd (\<sigma>1' i))) \<sigma>1'"
           by (simp add: k_sem_def r1)
       qed
       then obtain \<sigma>2' where \<sigma>2'_def: "k_sem C ?\<sigma>2 \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q" by blast
       then have "is_type (fn 2) fn2 x t (sem C S) \<sigma>2'"
         using in_sem[of _ C S] k_semE[of C ?\<sigma>2 \<sigma>2']
           prod.collapse r2 is_type_def[of "fn 2" fn2 x t S] is_type_def[of "fn 2" fn2 x t "sem C S"]
         by (metis (no_types, lifting))
       then show "\<exists>\<sigma>2'. is_type (fn 2) fn2 x t (sem C S) \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q"
         using \<sigma>2'_def by blast
     qed
   qed
 next
   assume asm0: "\<Turnstile> {encode_RUE_1 fn fn1 fn2 x t P} C {encode_RUE_2 fn fn1 fn2 x t Q}"
   show ?A
   proof (rule RUE_I)
     fix \<sigma>1 \<sigma>2 \<sigma>1'
     assume asm1: "(\<sigma>1, \<sigma>2) \<in> P" "k_sem C \<sigma>1 \<sigma>1'"
 
     let ?\<sigma>1 = "\<lambda>i. ((((fst (\<sigma>1 i))(t := fn 1))(x := fn1 i)), snd (\<sigma>1 i))"
     let ?\<sigma>2 = "\<lambda>k. ((((fst (\<sigma>2 k))(t := fn 2))(x := fn2 k)), snd (\<sigma>2 k))"
 
     let ?S1 = "{ ?\<sigma>1 i |i. True }"
     let ?S2 = "{ ?\<sigma>2 k |k. True }"
     let ?S = "?S1 \<union> ?S2"
 
     let ?\<sigma>1' = "\<lambda>i. ((((fst (\<sigma>1' i))(t := fn 1))(x := fn1 i)), snd (\<sigma>1' i))"
 
     have "encode_RUE_2 fn fn1 fn2 x t Q (sem C ?S)"
       using asm0       
     proof (rule hyper_hoare_tripleE)
       show "encode_RUE_1 fn fn1 fn2 x t P ?S"
       proof (rule encode_RUE_1_I)
         fix k
         let ?\<sigma> = "((((fst (\<sigma>2 k))(t := fn 2))(x := fn2 k)), snd (\<sigma>2 k))"
         have "?\<sigma> \<in> ?S2"
           by auto
         moreover have "fst ?\<sigma> x = fn2 k"
           by simp
         moreover have "fst ?\<sigma> t = fn 2"
           by (simp add: assms(2))
         ultimately show "\<exists>\<sigma>\<in>?S1 \<union> ?S2. fst \<sigma> x = fn2 k \<and> fst \<sigma> t = fn 2"
           by blast
       next
         fix \<sigma> \<sigma>'
         assume asm2: "is_type (fn (1 :: nat)) fn1 x t (?S1 \<union> ?S2) \<sigma> \<and> is_type (fn 2) fn2 x t (?S1 \<union> ?S2) \<sigma>'"
         moreover have r1: "\<And>i. \<sigma> i = ((fst (\<sigma>1 i))(t := fn 1, x := fn1 i), snd (\<sigma>1 i))"
         proof -
           fix i
           have "fst (\<sigma> i) t = fn 1"
             by (meson calculation is_type_def)
           moreover have "\<sigma> i \<in> ?S1"
           proof (rule ccontr)
             assume "\<not> \<sigma> i \<in> ?S1"
             moreover have "\<sigma> i \<in> ?S1 \<union> ?S2"
               using asm2 is_type_def[of "fn 1" fn1 x t]
               by (metis (no_types, lifting))
             ultimately have "\<sigma> i \<in> ?S2" by simp
             then have "fst (\<sigma> i) t = fn 2"
               using assms(2) by auto
             then show False
               by (metis Suc_1 Suc_eq_numeral \<open>fst (\<sigma> i) t = fn 1\<close> assms(3) injective_def numeral_One one_neq_zero pred_numeral_simps(1))
           qed
           then obtain j where "\<sigma> i = ((fst (\<sigma>1 j))(t := fn 1, x := fn1 j), snd (\<sigma>1 j))"
             by blast
           moreover have "i = j"
             by (metis (mono_tags, lifting) asm2 assms(4) calculation(2) fst_conv fun_upd_same injective_def is_type_def)
           ultimately show "\<sigma> i = ((fst (\<sigma>1 i))(t := fn 1, x := fn1 i), snd (\<sigma>1 i))"
             by blast
         qed
         moreover have "\<And>i. \<sigma>' i = ((fst (\<sigma>2 i))(t := fn 2, x := fn2 i), snd (\<sigma>2 i))"
         proof -
           fix i
           have "fst (\<sigma>' i) t = fn 2"
             by (meson calculation is_type_def)
           moreover have "\<sigma>' i \<in> ?S2"
           proof (rule ccontr)
             assume "\<not> \<sigma>' i \<in> ?S2"
             moreover have "\<sigma>' i \<in> ?S1 \<union> ?S2"
               using asm2 is_type_def[of "fn 2" fn2 x t]
               by (metis (no_types, lifting))
             ultimately have "\<sigma>' i \<in> ?S1" by simp
             then have "fst (\<sigma>' i) t = fn 1"
               using assms(2) by auto
             then show False
               by (metis Suc_1 Suc_eq_numeral \<open>fst (\<sigma>' i) t = fn 2\<close> assms(3) injective_def numeral_One one_neq_zero pred_numeral_simps(1))
           qed
           then obtain j where "\<sigma>' i = ((fst (\<sigma>2 j))(t := fn 2, x := fn2 j), snd (\<sigma>2 j))"
             by blast
           moreover have "i = j"
             by (metis (mono_tags, lifting) asm2 assms(5) calculation(2) fst_conv fun_upd_same injective_def is_type_def)
           ultimately show "\<sigma>' i = ((fst (\<sigma>2 i))(t := fn 2, x := fn2 i), snd (\<sigma>2 i))"
             by blast
         qed
         moreover have "(?\<sigma>1, ?\<sigma>2) \<in> P"
           using assms(6)
         proof (rule not_in_free_vars_doubleE)
           show "(\<sigma>1, \<sigma>2) \<in> P"
             by (simp add: asm1(1))
           show "differ_only_by_lset {x, t} (fst (\<sigma>1, \<sigma>2)) (fst (?\<sigma>1, ?\<sigma>2))"
             by (rule differ_only_by_lsetI) (simp_all add: differ_only_by_set_def)
           show "differ_only_by_lset {x, t} (snd (\<sigma>1, \<sigma>2)) (snd (?\<sigma>1, ?\<sigma>2))"
             by (rule differ_only_by_lsetI) (simp_all add: differ_only_by_set_def)
         qed
         ultimately show "(\<sigma>, \<sigma>') \<in> P"
           by presburger
       qed
     qed
     then have "\<exists>\<sigma>'. is_type (fn 2) fn2 x t (sem C ?S) \<sigma>' \<and> (?\<sigma>1', \<sigma>') \<in> Q"
     proof (rule encode_RUE_2_E)
       show "is_type (fn 1) fn1 x t (sem C ?S) ?\<sigma>1'"
       proof (rule is_typeI)
         fix i show "fst ((fst (\<sigma>1' i))(t := fn 1, x := fn1 i), snd (\<sigma>1' i)) t = fn 1"
           by (simp add: assms(2))
         show " ((fst (\<sigma>1' i))(t := fn 1, x := fn1 i), snd (\<sigma>1' i)) \<in> sem C ?S"
           using UnI1[of _ ?S1 ?S2]
             asm1(2) k_semE[of C \<sigma>1 \<sigma>1' i]
             single_step_then_in_sem[of C "snd (\<sigma>1 i)" "snd (\<sigma>1' i)" _ ?S]
           by force
       qed (auto)
     qed
     then obtain \<sigma>2' where r: "is_type (fn 2) fn2 x t (sem C ?S) \<sigma>2' \<and> (?\<sigma>1', \<sigma>2') \<in> Q"
       by blast
     let ?\<sigma>2' = "\<lambda>k. ((fst (\<sigma>2' k))(x := fst (\<sigma>2 k) x, t := fst (\<sigma>2 k) t), snd (\<sigma>2' k))"
     have "(\<sigma>1', ?\<sigma>2') \<in> Q"
       using assms(7)
     proof (rule not_in_free_vars_doubleE)
       show "(?\<sigma>1', \<sigma>2') \<in> Q"
         using r by blast
       show "differ_only_by_lset {x, t} (fst (?\<sigma>1', \<sigma>2')) (fst (\<sigma>1', ?\<sigma>2'))"
         by (rule differ_only_by_lsetI) (simp_all add: differ_only_by_set_def)
       show "differ_only_by_lset {x, t} (snd (?\<sigma>1', \<sigma>2')) (snd (\<sigma>1', ?\<sigma>2'))"
         by (rule differ_only_by_lsetI) (simp_all add: differ_only_by_set_def)
     qed
     moreover have "k_sem C \<sigma>2 ?\<sigma>2'"
     proof (rule k_semI)
       fix i
       obtain y where y_def: "y \<in> ?S" "fst y = fst (\<sigma>2' i)" "single_sem C (snd y) (snd (\<sigma>2' i))"
         using r in_sem[of "\<sigma>2' i" C ?S]
           is_type_E[of "fn 2" fn2 x t "sem C ?S" \<sigma>2' i]
         by (metis (no_types, lifting) fst_conv snd_conv)
       then have "fst y t = fn 2"
         by (metis (no_types, lifting) is_type_def r)
       moreover have "fn 1 \<noteq> fn 2"
         by (metis Suc_1 assms(3) injective_def n_not_Suc_n)
       then have "y \<notin> ?S1"
         using assms(2) calculation by fastforce
       then have "y \<in> ?S2"
         using y_def(1) by blast
       show "fst (\<sigma>2 i) = fst ((fst (\<sigma>2' i))(x := fst (\<sigma>2 i) x, t := fst (\<sigma>2 i) t), snd (\<sigma>2' i)) \<and>
          \<langle>C, snd (\<sigma>2 i)\<rangle> \<rightarrow> snd ((fst (\<sigma>2' i))(x := fst (\<sigma>2 i) x, t := fst (\<sigma>2 i) t), snd (\<sigma>2' i))"
       proof
         have r1: "\<sigma>2' i \<in> sem C ?S \<and> fst (\<sigma>2' i) t = fn 2 \<and> fst (\<sigma>2' i) x = fn2 i"
         proof (rule is_type_E[of "fn 2" fn2 x t "sem C ?S" \<sigma>2' i])
           show "is_type (fn 2) fn2 x t (sem C ?S) \<sigma>2'"
             using r by blast
         qed
         then obtain \<sigma> where "(fst (\<sigma>2' i), \<sigma>) \<in> ?S" "single_sem C \<sigma> (snd (\<sigma>2' i))"
           by (meson in_sem)
         then have "(fst (\<sigma>2' i), \<sigma>) \<in> ?S2"
           using r1 \<open>fn 1 \<noteq> fn 2\<close> assms(2) by fastforce
         then obtain k where "fst (\<sigma>2' i) = (fst (\<sigma>2 k))(t := fn 2, x := fn2 k)" and "\<sigma> = snd (\<sigma>2 k)"
           by blast
         then have "k = i"
           by (metis r1 assms(5) fun_upd_same injective_def)
         then show "\<langle>C, snd (\<sigma>2 i)\<rangle> \<rightarrow> snd ((fst (\<sigma>2' i))(x := fst (\<sigma>2 i) x, t := fst (\<sigma>2 i) t), snd (\<sigma>2' i))"
           using \<open>\<langle>C, \<sigma>\<rangle> \<rightarrow> snd (\<sigma>2' i)\<close> \<open>\<sigma> = snd (\<sigma>2 k)\<close> by auto
         show "fst (\<sigma>2 i) = fst ((fst (\<sigma>2' i))(x := fst (\<sigma>2 i) x, t := fst (\<sigma>2 i) t), snd (\<sigma>2' i))"
           by (simp add: \<open>fst (\<sigma>2' i) = (fst (\<sigma>2 k))(t := fn 2, x := fn2 k)\<close> \<open>k = i\<close>)
       qed
     qed
     ultimately show "\<exists>\<sigma>2'. k_sem C \<sigma>2 \<sigma>2' \<and> (\<sigma>1', \<sigma>2') \<in> Q"
       by blast
   qed
 qed
 
 subsection \<open>Program Refinement\<close>
 
 lemma sem_assign_single:
   "sem (Assign x e) {(l, \<sigma>)} = {(l, \<sigma>(x := e \<sigma>))}" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix la \<sigma>'
     assume "(la, \<sigma>') \<in> sem (Assign x e) {(l, \<sigma>)}"
     then show "(la, \<sigma>') \<in> {(l, \<sigma>(x := e \<sigma>))}"
       by (metis (mono_tags, lifting) in_sem prod.sel(1) prod.sel(2) single_sem_Assign_elim singleton_iff)
   qed
   show "?B \<subseteq> ?A"
     by (simp add: SemAssign in_sem)
 qed
 
 definition refinement where
   "refinement C1 C2 \<longleftrightarrow> (set_of_traces C1 \<subseteq> set_of_traces C2)"
 
 definition not_free_var_stmt where
   "not_free_var_stmt x C \<longleftrightarrow> (\<forall>\<sigma> \<sigma>' v. (\<sigma>, \<sigma>') \<in> set_of_traces C \<longrightarrow> (\<sigma>(x := v), \<sigma>'(x := v)) \<in> set_of_traces C)
 \<and> (\<forall>\<sigma> \<sigma>'. single_sem C \<sigma> \<sigma>' \<longrightarrow> \<sigma> x = \<sigma>' x)"
 
 lemma not_free_var_stmtE_1:
   assumes "not_free_var_stmt x C"
       and "(\<sigma>, \<sigma>') \<in> set_of_traces C"
     shows "(\<sigma>(x := v), \<sigma>'(x := v)) \<in> set_of_traces C"
   using assms(1) assms(2) not_free_var_stmt_def by force
 
 lemma not_free_in_sem_same_val:
   assumes "not_free_var_stmt x C"
       and "single_sem C \<sigma> \<sigma>'"
     shows "\<sigma> x = \<sigma>' x"
   using assms(1) assms(2) not_free_var_stmt_def by fastforce
 
 lemma not_free_in_sem_equiv:
   assumes "not_free_var_stmt x C"
       and "single_sem C \<sigma> \<sigma>'"
     shows "single_sem C (\<sigma>(x := v)) (\<sigma>'(x := v))"
   by (meson assms(1) assms(2) in_set_of_traces not_free_var_stmtE_1)
       
 
-text \<open>Example 4\<close>
+paragraph \<open>Example 3\<close>
+
+lemma rewrite_if_commute:
+  assumes "\<Turnstile> { P } If C1 C2 {Q}"
+  shows "\<Turnstile> { P } If C2 C1 {Q}"
+  by (metis assms hyper_hoare_triple_def sem_if sup_commute)
+
 theorem encoding_refinement:
   fixes P :: "(('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set \<Rightarrow> bool"
   assumes "(a :: 'pval) \<noteq> b"
     (* and x free var *)
       and "P = (\<lambda>S. card S = 1)"
       and "Q = (\<lambda>S.
   \<forall>\<phi>\<in>S. snd \<phi> x = a \<longrightarrow> (fst \<phi>, (snd \<phi>)(x := b)) \<in> S)"
       and "not_free_var_stmt x C1"
       and "not_free_var_stmt x C2"
   shows "refinement C1 C2 \<longleftrightarrow>
   \<Turnstile> { P } If (Seq (Assign (x :: 'pvar) (\<lambda>_. a)) C1) (Seq (Assign x (\<lambda>_. b)) C2) { Q }"
 (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   show ?B
   proof (rule hyper_hoare_tripleI)
     fix S assume "P (S :: (('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set)"
 
     then obtain \<sigma> l where asm0: "S = {(l, \<sigma>)}"
       by (metis assms(2) card_1_singletonE surj_pair)
 
     let ?C = "If (Seq (Assign x (\<lambda>_. a)) C1) (Seq (Assign x (\<lambda>_. b)) C2)"
     let ?a = "(l, \<sigma>(x := a))"
     let ?b = "(l, \<sigma>(x := b))"
 
     have if_sem: "sem ?C S = sem C1 {?a} \<union> sem C2 {?b}"
       by (simp add: asm0 sem_assign_single sem_if sem_seq)
     then have "\<And>\<phi>. \<phi> \<in> sem ?C S \<Longrightarrow> snd \<phi> x = a \<Longrightarrow> (fst \<phi>, (snd \<phi>)(x := b)) \<in> sem ?C S"
     proof -
       fix \<phi> assume asm1: "\<phi> \<in> sem ?C S" "snd \<phi> x = a"
       have "\<phi> \<in> sem C1 {?a}"
       proof (rule ccontr)
         assume "\<phi> \<notin> sem C1 {(l, \<sigma>(x := a))}"
         then have "\<phi> \<in> sem C2 {(l, \<sigma>(x := b))}"
           using if_sem asm1(1) by force
         then have "snd \<phi> x = b"
           using assms(5) fun_upd_same in_sem not_free_in_sem_same_val[of x C2 "\<sigma>(x := b)" "snd \<phi>"] singletonD snd_conv
           by metis
         then show False
           using asm1(2) assms(1) by blast
       qed
       then have "(\<sigma>(x := a), snd \<phi>) \<in> set_of_traces C1"
         by (simp add: in_sem set_of_traces_def)
       then have "(\<sigma>(x := a), snd \<phi>) \<in> set_of_traces C2"
         using \<open>refinement C1 C2\<close> refinement_def by fastforce
       then have "((\<sigma>(x := a))(x := b), (snd \<phi>)(x := b)) \<in> set_of_traces C2"
         by (meson assms(5) not_free_var_stmtE_1)
       then have "single_sem C2 (\<sigma>(x := b)) ((snd \<phi>)(x := b))"
         by (simp add: set_of_traces_def)
       then have "(fst \<phi>, (snd \<phi>)(x := b)) \<in> sem C2 {?b}"
         by (metis \<open>\<phi> \<in> sem C1 {(l, \<sigma>(x := a))}\<close> fst_eqD in_sem singleton_iff snd_eqD)
       then show "(fst \<phi>, (snd \<phi>)(x := b)) \<in> sem ?C S"
         by (simp add: if_sem)
     qed
     then show "Q (sem ?C S)"
       using assms(3) by blast
   qed
 next
   assume asm0: ?B
 
   have "set_of_traces C1 \<subseteq> set_of_traces C2"
   proof (rule subsetPairI)
     fix \<sigma> \<sigma>' assume asm1: "(\<sigma>, \<sigma>') \<in> set_of_traces C1"
     obtain l S where "(S :: (('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set) = { (l, \<sigma>) }"      
       by simp
 
     let ?a = "(l, \<sigma>(x := a))"
     let ?b = "(l, \<sigma>(x := b))"
 
     let ?C = "If (Seq (Assign (x :: 'pvar) (\<lambda>_. a)) C1) (Seq (Assign x (\<lambda>_. b)) C2)"
     have "Q (sem ?C S)"
     proof (rule hyper_hoare_tripleE)
       show "P S"
         by (simp add: \<open>S = {(l, \<sigma>)}\<close> assms(2))
       show ?B using asm0 by simp
     qed
     moreover have "(l, \<sigma>'(x := a)) \<in> sem ?C S"
     proof -
       have "single_sem (Seq (Assign x (\<lambda>_. a)) C1) \<sigma> (\<sigma>'(x := a))"
         by (meson SemAssign SemSeq asm1 assms(4) in_set_of_traces not_free_in_sem_equiv)
       then show ?thesis
         by (simp add: SemIf1 \<open>S = {(l, \<sigma>)}\<close> in_sem)
     qed
     then have "(l, \<sigma>'(x := b)) \<in> sem ?C S"
       using assms(3) calculation by fastforce
     moreover have "(l, \<sigma>'(x := b)) \<in> sem (Seq (Assign x (\<lambda>_. b)) C2) S"
     proof (rule ccontr)
       assume "\<not> (l, \<sigma>'(x := b)) \<in> sem (Seq (Assign x (\<lambda>_. b)) C2) S"
       then have "(l, \<sigma>'(x := b)) \<in> sem (Seq (Assign x (\<lambda>_. a)) C1) S"
         using calculation(2) sem_if by auto
       then have "(l, \<sigma>'(x := b)) \<in> sem C1 {?a}"
         by (simp add: \<open>S = {(l, \<sigma>)}\<close> sem_assign_single sem_seq)
       then show False
         using assms(1) assms(4) fun_upd_same in_sem not_free_in_sem_same_val[of x C1  "\<sigma>(x := a)" "\<sigma>'(x := b)"] singletonD snd_conv
         by metis
     qed
     then have "single_sem (Seq (Assign x (\<lambda>_. b)) C2) \<sigma> (\<sigma>'(x := b))"
       by (simp add: \<open>S = {(l, \<sigma>)}\<close> in_sem)
     then have "single_sem C2 (\<sigma>(x := b)) (\<sigma>'(x := b))"
       by blast
     then have "(\<sigma>(x := b), \<sigma>'(x := b)) \<in> set_of_traces C2"
       by (simp add: set_of_traces_def)
     then have "((\<sigma>(x := b))(x := \<sigma> x), (\<sigma>'(x := b))(x := \<sigma> x)) \<in> set_of_traces C2"
       by (meson assms(5) not_free_var_stmtE_1)
     then show "(\<sigma>, \<sigma>') \<in> set_of_traces C2"
       by (metis asm1 assms(4) fun_upd_triv fun_upd_upd in_set_of_traces not_free_in_sem_same_val)
   qed
   then show ?A
     by (simp add: refinement_def)
 qed
 
+paragraph \<open>Necessary Preconditions\<close>
+
+definition NC where
+  "NC P C Q \<longleftrightarrow> (\<forall>\<sigma> \<sigma>' l. (l, \<sigma>') \<in> Q \<and> (\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>') \<longrightarrow> (l, \<sigma>) \<in> P)"
+
+lemma NC_I:
+  assumes "\<And>\<sigma> \<sigma>' l. (l, \<sigma>') \<in> Q \<and> (\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>') \<Longrightarrow> (l, \<sigma>) \<in> P"
+  shows "NC P C Q"
+  by (simp add: NC_def assms)
+
+definition backwards_sem where
+  "backwards_sem C S'  = { (l, \<sigma>) |l \<sigma> \<sigma>'. (l, \<sigma>') \<in> S' \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'}"
+
+lemma equiv_def_NC:
+  "NC P C Q \<longleftrightarrow> backwards_sem C Q \<subseteq> P" (is "?A \<longleftrightarrow> ?B")
+proof
+  assume ?A
+  then show ?B
+    using CollectD NC_def backwards_sem_def[of C Q] subsetI[of "backwards_sem C Q" P] by fastforce
+next
+  assume ?B
+  then show ?A 
+    using NC_def backwards_sem_def by fastforce
+qed
+
+lemma equiv_def_FU:
+  "FU P C Q \<longleftrightarrow> P \<subseteq> backwards_sem C Q" (is "?A \<longleftrightarrow> ?B")
+proof
+  show "?A \<Longrightarrow> ?B"
+    using FU_def[of P C Q] backwards_sem_def[of C Q]
+    by fastforce
+  show "?B \<Longrightarrow> ?A"
+    using FU_def[of P C Q] backwards_sem_def[of C Q] by auto
+qed
+
+lemma encoding_NC_in_HL_1:
+  "NC P C Q \<longleftrightarrow> \<Turnstile> { (\<lambda>S. S = -P) } C { (\<lambda>S. S \<inter> Q = {} ) }" (is "?A \<longleftrightarrow> ?B")
+proof
+  assume ?A
+  show ?B
+  proof (rule hyper_hoare_tripleI)
+    fix S assume asm0: "S = - P"
+    then show "sem C S \<inter> Q = {}"
+      by (metis (no_types, lifting) ComplD NC_def \<open>NC P C Q\<close> disjoint_iff in_sem prod.collapse)
+  qed
+next
+  assume ?B
+  show ?A
+  proof (rule NC_I)
+    fix \<sigma> \<sigma>' l
+    assume asm0: "(l, \<sigma>') \<in> Q \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
+    then have "(l, \<sigma>') \<notin> sem C (-P)"
+      using \<open>\<Turnstile> {(\<lambda>S. S = - P)} C {\<lambda>S. S \<inter> Q = {}}\<close> hyper_hoare_tripleE by fastforce
+    then have "(l, \<sigma>) \<notin> -P"
+      by (meson asm0 single_step_then_in_sem)
+    then show "(l, \<sigma>) \<in> P"
+      by simp
+  qed
+qed
+
+
 end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/Language.thy b/thys/HyperHoareLogic/Language.thy
--- a/thys/HyperHoareLogic/Language.thy
+++ b/thys/HyperHoareLogic/Language.thy
@@ -1,341 +1,356 @@
 section \<open>Language and Semantics\<close>
 
-text \<open>In this file, we formalize the programming language from section III, and the extended states
-and semantics from section IV of the paper~\cite{HyperHoareLogic}. We also prove the useful properties described by Lemma 1.\<close>
+text \<open>In this file, we formalize concepts from section 3:
+- Program states and programming language (definition 1)
+- Big-step semantics (figure 2)
+- Extended states (definition 2)
+- Extended semantics (definition 4) and some useful properties (lemma 1)\<close>
 
 theory Language
   imports Main
 begin
 
 subsection Language
 
 text \<open>Definition 1\<close>
 
 type_synonym ('var, 'val) pstate = "'var \<Rightarrow> 'val"
 
-text \<open>Definition 2\<close>
-
 type_synonym ('var, 'val) bexp = "('var, 'val) pstate \<Rightarrow> bool"
 type_synonym ('var, 'val) exp = "('var, 'val) pstate \<Rightarrow> 'val"
 
 
 datatype ('var, 'val) stmt = 
   Assign 'var "('var, 'val) exp"
-  | Seq "('var, 'val) stmt" "('var, 'val) stmt"
-  | If "('var, 'val) stmt" "('var, 'val) stmt"
+  | Seq "('var, 'val) stmt" "('var, 'val) stmt"  (infixl ";;" 60)
+  | If "('var, 'val) stmt" "('var, 'val) stmt"                    \<comment>\<open>Non-deterministic choice\<close>
   | Skip
-  | Havoc 'var
+  | Havoc 'var                                                    \<comment>\<open>Non-deterministic assignment\<close>
   | Assume "('var, 'val) bexp"
-  | While "('var, 'val) stmt"
+  | While "('var, 'val) stmt"                                     \<comment>\<open>Non-deterministic loop\<close>
 
 subsection Semantics
 
 text \<open>Figure 2\<close>
 
 inductive single_sem :: "('var, 'val) stmt \<Rightarrow> ('var, 'val) pstate \<Rightarrow> ('var, 'val) pstate \<Rightarrow> bool"
   ("\<langle>_, _\<rangle> \<rightarrow> _" [51,0] 81)
   where
   SemSkip: "\<langle>Skip, \<sigma>\<rangle> \<rightarrow> \<sigma>"
 | SemAssign: "\<langle>Assign var e, \<sigma>\<rangle> \<rightarrow> \<sigma>(var := (e \<sigma>))"
 | SemSeq: "\<lbrakk> \<langle>C1, \<sigma>\<rangle> \<rightarrow> \<sigma>1; \<langle>C2, \<sigma>1\<rangle> \<rightarrow> \<sigma>2 \<rbrakk> \<Longrightarrow> \<langle>Seq C1 C2, \<sigma>\<rangle> \<rightarrow> \<sigma>2"
 | SemIf1: "\<langle>C1, \<sigma>\<rangle> \<rightarrow> \<sigma>1 \<Longrightarrow> \<langle>If C1 C2, \<sigma>\<rangle> \<rightarrow> \<sigma>1"
 | SemIf2: "\<langle>C2, \<sigma>\<rangle> \<rightarrow> \<sigma>2 \<Longrightarrow> \<langle>If C1 C2, \<sigma>\<rangle> \<rightarrow> \<sigma>2"
 | SemHavoc: "\<langle>Havoc var, \<sigma>\<rangle> \<rightarrow> \<sigma>(var := v)"
 | SemAssume: "b \<sigma> \<Longrightarrow> \<langle>Assume b, \<sigma>\<rangle> \<rightarrow> \<sigma>"
 | SemWhileIter: "\<lbrakk> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>' ; \<langle>While C, \<sigma>'\<rangle> \<rightarrow> \<sigma>'' \<rbrakk> \<Longrightarrow> \<langle>While C, \<sigma>\<rangle> \<rightarrow> \<sigma>''"
 | SemWhileExit: "\<langle>While C, \<sigma>\<rangle> \<rightarrow> \<sigma>"
 
 inductive_cases single_sem_Seq_elim[elim!]: "\<langle>Seq C1 C2, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
 inductive_cases single_sem_Skip_elim[elim!]: "\<langle>Skip, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
 inductive_cases single_sem_While_elim: "\<langle>While C, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
 inductive_cases single_sem_If_elim[elim!]: "\<langle>If C1 C2, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
 inductive_cases single_sem_Assume_elim[elim!]: "\<langle>Assume b, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
 inductive_cases single_sem_Assign_elim[elim!]: "\<langle>Assign x e, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
 inductive_cases single_sem_Havoc_elim[elim!]: "\<langle>Havoc x, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
 
 
-section \<open>Extended States and Extended Semantics\<close>
+subsection \<open>Extended States and Extended Semantics\<close>
 
-text \<open>Definition 3\<close>
+text \<open>Definition 2: Extended states\<close>
 type_synonym ('lvar, 'lval, 'pvar, 'pval) state = "('lvar \<Rightarrow> 'lval) \<times> ('pvar, 'pval) pstate"
 
-text \<open>Definition 5\<close>
+text \<open>Definition 4: Extended semantics\<close>
 definition sem :: "('pvar, 'pval) stmt \<Rightarrow> ('lvar, 'lval, 'pvar, 'pval) state set \<Rightarrow> ('lvar, 'lval, 'pvar, 'pval) state set" where
   "sem C S = { (l, \<sigma>') |\<sigma>' \<sigma> l. (l, \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>' }"
 
 lemma in_sem:
   "\<phi> \<in> sem C S \<longleftrightarrow> (\<exists>\<sigma>. (fst \<phi>, \<sigma>) \<in> S \<and> single_sem C \<sigma> (snd \<phi>))" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?A
   then obtain \<sigma>' \<sigma> l where "\<phi> = (l, \<sigma>')" "(l, \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
     using sem_def[of C S] by auto
   then show ?B
     by auto
 next
   show "?B \<Longrightarrow> ?A"
     by (metis (mono_tags, lifting) CollectI prod.collapse sem_def)
 qed
 
-text \<open>Useful properties\<close>
+text \<open>Lemma 1: Useful properties of the extended semantics\<close>
 
 lemma sem_seq:
   "sem (Seq C1 C2) S = sem C2 (sem C1 S)" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix x2 assume "x2 \<in> ?A"
     then obtain x0 where "(fst x2, x0) \<in> S" "single_sem (Seq C1 C2) x0 (snd x2)"
       by (metis in_sem)
     then obtain x1 where "single_sem C1 x0 x1" "single_sem C2 x1 (snd x2)"
       using single_sem_Seq_elim[of C1 C2 x0 "snd x2"]
       by blast
     then show "x2 \<in> ?B"
       by (metis \<open>(fst x2, x0) \<in> S\<close> fst_conv in_sem snd_conv)
   qed
   show "?B \<subseteq> ?A"
   proof
     fix x2 assume "x2 \<in> ?B"
     then obtain x1 where "(fst x2, x1) \<in> sem C1 S" "single_sem C2 x1 (snd x2)"
       by (metis in_sem)
     then obtain x0 where "(fst x2, x0) \<in> S" "single_sem C1 x0 x1"
       by (metis fst_conv in_sem snd_conv)
     then have "single_sem (Seq C1 C2) x0 (snd x2)"
       by (simp add: SemSeq \<open>\<langle>C2, x1\<rangle> \<rightarrow> snd x2\<close>)
     then show "x2 \<in> ?A"
       by (meson \<open>(fst x2, x0) \<in> S\<close> in_sem)
   qed
 qed
 
 lemma sem_skip:
   "sem Skip S = S"
   using single_sem_Skip_elim SemSkip in_sem[of _ Skip S]
   by fastforce
 
 lemma sem_union:
   "sem C (S1 \<union> S2) = sem C S1 \<union> sem C S2" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B" 
   proof
     fix x assume "x \<in> ?A"
     then obtain y where "(fst x, y) \<in> S1 \<union> S2" "single_sem C y (snd x)"
       using in_sem by blast
     then show "x \<in> ?B"
       by (metis Un_iff in_sem)
   qed
   show "?B \<subseteq> ?A"
   proof
     fix x assume "x \<in> ?B"
     show "x \<in> ?A"
     proof (cases "x \<in> sem C S1")
       case True
       then show ?thesis
         by (metis IntD2 Un_Int_eq(3) in_sem)
     next
       case False
       then show ?thesis
         by (metis Un_iff \<open>x \<in> sem C S1 \<union> sem C S2\<close> in_sem)
     qed
   qed
 qed
 
 lemma sem_union_general:
   "sem C (\<Union>x. f x) = (\<Union>x. sem C (f x))" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix b assume "b \<in> ?A"
     then obtain a where "a \<in> (\<Union>x. f x)" "fst a = fst b" "single_sem C (snd a) (snd b)"
       by (metis fst_conv in_sem snd_conv)
     then obtain x where "a \<in> f x" by blast
     then have "b \<in> sem C (f x)"
       by (metis \<open>\<langle>C, snd a\<rangle> \<rightarrow> snd b\<close> \<open>fst a = fst b\<close> in_sem surjective_pairing)
     then show "b \<in> ?B"
       by blast
   qed
   show "?B \<subseteq> ?A"
   proof
     fix y assume "y \<in> ?B"
     then obtain x where "y \<in> sem C (f x)"
       by blast
     then show "y \<in> ?A"
       by (meson UN_I in_sem iso_tuple_UNIV_I)
   qed
 qed
 
 lemma sem_monotonic:
   assumes "S \<subseteq> S'"
   shows "sem C S \<subseteq> sem C S'"
   by (metis assms sem_union subset_Un_eq)
 
 lemma subsetPairI:
   assumes "\<And>l \<sigma>. (l, \<sigma>) \<in> A \<Longrightarrow> (l, \<sigma>) \<in> B"
   shows "A \<subseteq> B"
   by (simp add: assms subrelI)
 
 
 lemma sem_if:
   "sem (If C1 C2) S = sem C1 S \<union> sem C2 S" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix l y assume "(l, y) \<in> ?A"
     then obtain x where "(l, x) \<in> S" "single_sem (If C1 C2) x y"
       by (metis fst_conv in_sem snd_conv)
     then show "(l, y) \<in> ?B" using single_sem_If_elim
       UnI1 UnI2 in_sem
       by (metis fst_conv snd_conv)
   qed
   show "?B \<subseteq> ?A"
     using SemIf1 SemIf2 in_sem
     by (metis (no_types, lifting) Un_subset_iff subsetI)
 qed
 
 lemma sem_assume:
   "sem (Assume b) S = { (l, \<sigma>) |l \<sigma>. (l, \<sigma>) \<in> S \<and> b \<sigma> }" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix l y assume "(l, y) \<in> ?A" then obtain x where "(l, x) \<in> S" "single_sem (Assume b) x y"
       using in_sem
       by (metis fst_conv snd_conv)
     then show "(l, y) \<in> ?B" using single_sem_Assume_elim by blast
   qed
   show "?B \<subseteq> ?A"
   proof (rule subsetPairI)
     fix l \<sigma> assume asm0: "(l, \<sigma>) \<in> {(l, \<sigma>) |l \<sigma>. (l, \<sigma>) \<in> S \<and> b \<sigma>}"
     then have "(l, \<sigma>) \<in> S" "b \<sigma>" by simp_all
     then show "(l, \<sigma>) \<in> sem (Assume b) S"
       by (metis SemAssume fst_eqD in_sem snd_eqD)
   qed
 qed
 
 lemma while_then_reaches:
   assumes "(single_sem C)\<^sup>*\<^sup>* \<sigma> \<sigma>''"
   shows "single_sem (While C) \<sigma> \<sigma>''"
   using assms
 proof (induct rule: converse_rtranclp_induct)
   case base
   then show ?case
     by (simp add: SemWhileExit)
 next
   case (step y z)
   then show ?case
     using SemWhileIter by blast
 qed
 
 lemma in_closure_then_while:
   assumes "single_sem C' \<sigma> \<sigma>''"
   shows "\<And>C. C' = While C \<Longrightarrow> (single_sem C)\<^sup>*\<^sup>* \<sigma> \<sigma>''"
   using assms
 proof (induct rule: single_sem.induct)
   case (SemWhileIter \<sigma> C' \<sigma>' \<sigma>'')
   then show ?case
     by (metis (no_types, lifting) rtranclp.rtrancl_into_rtrancl rtranclp.rtrancl_refl rtranclp_trans stmt.inject(6))
 next
   case (SemWhileExit \<sigma> C')
   then show ?case
     by blast
 qed (auto)
 
 theorem loop_equiv:
   "single_sem (While C) \<sigma> \<sigma>' \<longleftrightarrow> (single_sem C)\<^sup>*\<^sup>* \<sigma> \<sigma>'"
   using in_closure_then_while while_then_reaches by blast
 
 
 fun iterate_sem where
   "iterate_sem 0 _ S = S"
 | "iterate_sem (Suc n) C S = sem C (iterate_sem n C S)"
 
 lemma in_iterate_then_in_trans:
   assumes "(l, \<sigma>'') \<in> iterate_sem n C S"
   shows "\<exists>\<sigma>. (l, \<sigma>) \<in> S \<and> (single_sem C)\<^sup>*\<^sup>* \<sigma> \<sigma>''"
   using assms
 proof (induct n arbitrary: \<sigma>'' S)
   case 0
   then show ?case
     using iterate_sem.simps(1) by blast
 next
   case (Suc n)
   then show ?case
     using in_sem rtranclp.rtrancl_into_rtrancl
     by (metis (mono_tags, lifting) fst_conv iterate_sem.simps(2) snd_conv)
 qed
 
 lemma reciprocal:
   assumes "(single_sem C)\<^sup>*\<^sup>* \<sigma> \<sigma>''"
       and "(l, \<sigma>) \<in> S"
     shows "\<exists>n. (l, \<sigma>'') \<in> iterate_sem n C S"
   using assms
 proof (induct rule: rtranclp_induct)
   case base
   then show ?case
     using iterate_sem.simps(1) by blast
 next
   case (step y z)
   then obtain n where "(l, y) \<in> iterate_sem n C S" by blast
   then show ?case
     using in_sem iterate_sem.simps(2) step.hyps(2)
     by (metis fst_eqD snd_eqD)
 qed
 
 lemma union_iterate_sem_trans:
   "(l, \<sigma>'') \<in> (\<Union>n. iterate_sem n C S) \<longleftrightarrow> (\<exists>\<sigma>. (l, \<sigma>) \<in> S \<and> (single_sem C)\<^sup>*\<^sup>* \<sigma> \<sigma>'')" (is "?A \<longleftrightarrow> ?B")
   using in_iterate_then_in_trans reciprocal by auto
 
 lemma sem_while:
   "sem (While C) S = (\<Union>n. iterate_sem n C S)" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix l y assume "(l, y) \<in> ?A"
     then obtain x where x_def: "(l, x) \<in> S" "(single_sem C)\<^sup>*\<^sup>* x y"
       using in_closure_then_while in_sem
       by (metis fst_eqD snd_conv)
     then have "single_sem (While C) x y"
       using while_then_reaches by blast
     then show "(l, y) \<in> ?B"
       by (metis x_def union_iterate_sem_trans)
   qed
   show "?B \<subseteq> ?A"
   proof (rule subsetPairI)
     fix l y assume "(l, y) \<in> ?B"
     then obtain x where "(l, x) \<in> S" "(single_sem C)\<^sup>*\<^sup>* x y"
       using union_iterate_sem_trans by blast
     then show "(l, y) \<in> ?A"
       using in_sem while_then_reaches by fastforce
   qed
 qed
 
 
 lemma assume_sem:
   "sem (Assume b) S = Set.filter (b \<circ> snd) S" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix l \<sigma>
     assume asm0: "(l, \<sigma>) \<in> sem (Assume b) S"
     then show "(l, \<sigma>) \<in> Set.filter (b \<circ> snd) S"
       by (metis comp_apply fst_conv in_sem member_filter single_sem_Assume_elim snd_conv)
   qed
   show "?B \<subseteq> ?A"
     by (metis (mono_tags, opaque_lifting) SemAssume comp_apply in_sem member_filter prod.collapse subsetI)
 qed
 
 lemma sem_split_general:
   "sem C (\<Union>x. F x) = (\<Union>x. sem C (F x))" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix l \<sigma>'
     assume asm0: "(l, \<sigma>') \<in> sem C (\<Union> (range F))"
     then obtain x \<sigma> where "(l, \<sigma>) \<in> F x" "single_sem C \<sigma> \<sigma>'"
       by (metis (no_types, lifting) UN_iff fst_conv in_sem snd_conv)
     then show "(l, \<sigma>') \<in> (\<Union>x. sem C (F x))"
       using asm0 sem_union_general by blast
   qed
   show "?B \<subseteq> ?A"
     by (simp add: SUP_least Sup_upper sem_monotonic)
 qed
 
+fun written_vars where
+  "written_vars (Assign x _) = {x}"
+| "written_vars (Havoc x) = {x}"
+| "written_vars (C1;; C2) = written_vars C1 \<union> written_vars C2"
+| "written_vars (If C1 C2) = written_vars C1 \<union> written_vars C2"
+| "written_vars (While C) = written_vars C"
+| "written_vars _ = {}"
+
+lemma written_vars_not_modified:
+  assumes "single_sem C \<phi> \<phi>'"
+    and "x \<notin> written_vars C"
+    shows "\<phi> x = \<phi>' x"
+  using assms
+  by (induct rule: single_sem.induct) auto
 
 end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/Logic.thy b/thys/HyperHoareLogic/Logic.thy
--- a/thys/HyperHoareLogic/Logic.thy
+++ b/thys/HyperHoareLogic/Logic.thy
@@ -1,1018 +1,857 @@
 section \<open>Hyper Hoare Logic\<close>
 
-text \<open>In this file, we define concepts from the logic (section IV): hyper-assertions, hyper-triples,
-and the syntactic rules. We also prove soundness (theorem 1), completeness (theorem 2), the ability
-to disprove hyper-triples in the logic (theorem 4), and the synchronized if rule from appendix C.\<close>
+text \<open>This file contains technical results from sections 3 and 5:
+- Hyper-assertions (definition 3)
+- Hyper-triples (definition 5)
+- Core rules of Hyper Hoare Logic (figure 2)
+- Soundness of the core rules (theorem 1)
+- Completeness of the core rules (theorem 2)
+- Ability to disprove hyper-triples (theorem 5)\<close>
 
 theory Logic
   imports Language
 begin
 
-text \<open>Definition 4\<close>
+text \<open>Definition 3\<close>
 type_synonym 'a hyperassertion = "('a set \<Rightarrow> bool)"
 
 definition entails where
   "entails A B \<longleftrightarrow> (\<forall>S. A S \<longrightarrow> B S)"
 
+lemma entails_refl:
+  "entails A A"
+  by (simp add: entails_def)
+
 lemma entailsI:
   assumes "\<And>S. A S \<Longrightarrow> B S"
   shows "entails A B"
   by (simp add: assms entails_def)
 
 lemma entailsE:
   assumes "entails A B"
       and "A x"
     shows "B x"
   by (meson assms(1) assms(2) entails_def)
 
 lemma bientails_equal:
   assumes "entails A B"
       and "entails B A"
     shows "A = B"
 proof (rule ext)
   fix S show "A S = B S"
     by (meson assms(1) assms(2) entailsE)
 qed
 
 lemma entails_trans:
   assumes "entails A B"
       and "entails B C"
     shows "entails A C"
   by (metis assms(1) assms(2) entails_def)
 
 
 definition setify_prop where
   "setify_prop b = { (l, \<sigma>) |l \<sigma>. b \<sigma>}"
 
 lemma sem_assume_setify:
   "sem (Assume b) S = S \<inter> setify_prop b" (is "?A = ?B")
 proof -
   have "\<And>l \<sigma>. (l, \<sigma>) \<in> ?A \<longleftrightarrow> (l, \<sigma>) \<in> ?B"
   proof -
     fix l \<sigma>
     have "(l, \<sigma>) \<in> ?A \<longleftrightarrow> (l, \<sigma>) \<in> S \<and> b \<sigma>"
       by (simp add: assume_sem)
     then show "(l, \<sigma>) \<in> ?A \<longleftrightarrow> (l, \<sigma>) \<in> ?B"
       by (simp add: setify_prop_def)
   qed
   then show ?thesis
     by auto
 qed
 
 definition over_approx :: "'a set \<Rightarrow> 'a hyperassertion" where
   "over_approx P S \<longleftrightarrow> S \<subseteq> P"
 
 definition lower_closed :: "'a hyperassertion \<Rightarrow> bool" where
   "lower_closed P \<longleftrightarrow> (\<forall>S S'. P S \<and> S' \<subseteq> S \<longrightarrow> P S')"
 
 lemma over_approx_lower_closed:
   "lower_closed (over_approx P)"
   by (metis (full_types) lower_closed_def order_trans over_approx_def)
 
 definition under_approx :: "'a set \<Rightarrow> 'a hyperassertion" where
   "under_approx P S \<longleftrightarrow> P \<subseteq> S"
 
 definition upper_closed :: "'a hyperassertion \<Rightarrow> bool" where
   "upper_closed P \<longleftrightarrow> (\<forall>S S'. P S \<and> S \<subseteq> S' \<longrightarrow> P S')"
 
 lemma under_approx_upper_closed:
   "upper_closed (under_approx P)"
   by (metis (no_types, lifting) order.trans under_approx_def upper_closed_def)
 
 definition closed_by_union :: "'a hyperassertion \<Rightarrow> bool" where
   "closed_by_union P \<longleftrightarrow> (\<forall>S S'. P S \<and> P S' \<longrightarrow> P (S \<union> S'))"
 
 lemma closed_by_unionI:
   assumes "\<And>a b. P a \<Longrightarrow> P b \<Longrightarrow> P (a \<union> b)"
   shows "closed_by_union P"
   by (simp add: assms closed_by_union_def)
 
 lemma closed_by_union_over:
   "closed_by_union (over_approx P)"
   by (simp add: closed_by_union_def over_approx_def)
 
 lemma closed_by_union_under:
   "closed_by_union (under_approx P)"
   by (simp add: closed_by_union_def sup.coboundedI1 under_approx_def)
 
 definition conj where
   "conj P Q S \<longleftrightarrow> P S \<and> Q S"
 
+lemma entail_conj:
+  assumes "entails A B"
+  shows "entails A (conj A B)"
+  by (metis (full_types) assms conj_def entails_def)
+
+lemma entail_conj_weaken:
+  "entails (conj A B) A"
+  by (simp add: conj_def entails_def)
+
 definition disj where
   "disj P Q S \<longleftrightarrow> P S \<or> Q S"
 
 definition exists :: "('c \<Rightarrow> 'a hyperassertion) \<Rightarrow> 'a hyperassertion" where
   "exists P S \<longleftrightarrow> (\<exists>x. P x S)"
 
 definition forall :: "('c \<Rightarrow> 'a hyperassertion) \<Rightarrow> 'a hyperassertion" where
   "forall P S \<longleftrightarrow> (\<forall>x. P x S)"
 
 lemma over_inter:
   "entails (over_approx (P \<inter> Q)) (conj (over_approx P) (over_approx Q))"
   by (simp add: conj_def entails_def over_approx_def)
 
 lemma over_union:
   "entails (disj (over_approx P) (over_approx Q)) (over_approx (P \<union> Q))"
   by (metis disj_def entailsI le_supI1 le_supI2 over_approx_def)
 
 lemma under_union:
   "entails (under_approx (P \<union> Q)) (disj (under_approx P) (under_approx Q))"
   by (simp add: disj_def entails_def under_approx_def)
 
 lemma under_inter:
   "entails (conj (under_approx P) (under_approx Q)) (under_approx (P \<inter> Q))"
   by (simp add: conj_def entails_def le_infI1 under_approx_def)
 
-
-text \<open>Notation 1\<close>
+text \<open>Definition 6: Operator \<open>\<otimes>\<close>\<close>
 definition join :: "'a hyperassertion \<Rightarrow> 'a hyperassertion \<Rightarrow> 'a hyperassertion" where
   "join A B S \<longleftrightarrow> (\<exists>SA SB. A SA \<and> B SB \<and> S = SA \<union> SB)"
 
 definition general_join :: "('b \<Rightarrow> 'a hyperassertion) \<Rightarrow> 'a hyperassertion" where
   "general_join f S \<longleftrightarrow> (\<exists>F. S = (\<Union>x. F x) \<and> (\<forall>x. f x (F x)))"
 
+lemma general_joinI:
+  assumes "S = (\<Union>x. F x)"
+      and "\<And>x. f x (F x)"
+    shows "general_join f S"
+  using assms(1) assms(2) general_join_def by blast
 
 lemma join_closed_by_union:
   assumes "closed_by_union Q"
   shows "join Q Q = Q"
 proof
   fix S
   show "join Q Q S \<longleftrightarrow> Q S"
     by (metis assms closed_by_union_def join_def sup_idem)
 qed
 
 lemma entails_join_entails:
   assumes "entails A1 B1"
       and "entails A2 B2"
     shows "entails (join A1 A2) (join B1 B2)"
 proof (rule entailsI)
   fix S assume "join A1 A2 S"
   then obtain S1 S2 where "A1 S1" "A2 S2" "S = S1 \<union> S2"
     by (metis join_def)
   then show "join B1 B2 S"
     by (metis assms(1) assms(2) entailsE join_def)
 qed
 
 
-text \<open>Notation 2\<close>
+text \<open>Definition 7: Operator \<open>\<Otimes>\<close> (for \<open>x \<in> X\<close>)\<close>
 definition natural_partition where
   "natural_partition I S \<longleftrightarrow> (\<exists>F. S = (\<Union>n. F n) \<and> (\<forall>n. I n (F n)))"
 
 lemma natural_partitionI:
   assumes "S = (\<Union>n. F n)"
       and "\<And>n. I n (F n)"
     shows "natural_partition I S"
   using assms(1) assms(2) natural_partition_def by blast
 
 lemma natural_partitionE:
   assumes "natural_partition I S"
   obtains F where "S = (\<Union>n. F n)" "\<And>n. I n (F n)"
   by (meson assms natural_partition_def)
 
 
 subsection \<open>Rules of the Logic\<close>
 
-text \<open>Rules from figure 3\<close>
+text \<open>Core rules from figure 2\<close>
 
 inductive syntactic_HHT ::
  "(('lvar, 'lval, 'pvar, 'pval) state hyperassertion) \<Rightarrow> ('pvar, 'pval) stmt \<Rightarrow> (('lvar, 'lval, 'pvar, 'pval) state hyperassertion) \<Rightarrow> bool"
    ("\<turnstile> {_} _ {_}" [51,0,0] 81) where
   RuleSkip: "\<turnstile> {P} Skip {P}"
 | RuleCons: "\<lbrakk> entails P P' ; entails Q' Q ; \<turnstile> {P'} C {Q'} \<rbrakk> \<Longrightarrow> \<turnstile> {P} C {Q}"
 | RuleSeq: "\<lbrakk> \<turnstile> {P} C1 {R} ; \<turnstile> {R} C2 {Q} \<rbrakk> \<Longrightarrow> \<turnstile> {P} (Seq C1 C2) {Q}"
 | RuleIf: "\<lbrakk> \<turnstile> {P} C1 {Q1} ; \<turnstile> {P} C2 {Q2} \<rbrakk> \<Longrightarrow> \<turnstile> {P} (If C1 C2) {join Q1 Q2}"
 | RuleWhile: "\<lbrakk> \<And>n. \<turnstile> {I n} C {I (Suc n)} \<rbrakk> \<Longrightarrow> \<turnstile> {I 0} (While C) {natural_partition I}"
 | RuleAssume: "\<turnstile> { (\<lambda>S. P (Set.filter (b \<circ> snd) S)) } (Assume b) {P}"
 | RuleAssign: "\<turnstile> { (\<lambda>S. P { (l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S }) } (Assign x e) {P}"
 | RuleHavoc: "\<turnstile> { (\<lambda>S. P { (l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S }) } (Havoc x) {P}"
 | RuleExistsSet: "\<lbrakk>\<And>x::('lvar, 'lval, 'pvar, 'pval) state set. \<turnstile> {P x} C {Q x}\<rbrakk> \<Longrightarrow> \<turnstile> {exists P} C {exists Q}"
 
 
 subsection \<open>Soundness\<close>
 
-text \<open>Definition 6: Hyper-Triples\<close>
+text \<open>Definition 5: Hyper-Triples\<close>
 definition hyper_hoare_triple ("\<Turnstile> {_} _ {_}" [51,0,0] 81) where
   "\<Turnstile> {P} C {Q} \<longleftrightarrow> (\<forall>S. P S \<longrightarrow> Q (sem C S))"
 
 lemma hyper_hoare_tripleI:
   assumes "\<And>S. P S \<Longrightarrow> Q (sem C S)"
   shows "\<Turnstile> {P} C {Q}"
   by (simp add: assms hyper_hoare_triple_def)
 
 lemma hyper_hoare_tripleE:
   assumes "\<Turnstile> {P} C {Q}"
       and "P S"
     shows "Q (sem C S)"
   using assms(1) assms(2) hyper_hoare_triple_def
   by metis
 
 lemma consequence_rule:
   assumes "entails P P'"
       and "entails Q' Q"
       and "\<Turnstile> {P'} C {Q'}"
     shows "\<Turnstile> {P} C {Q}"
   by (metis (no_types, opaque_lifting) assms(1) assms(2) assms(3) entails_def hyper_hoare_triple_def)
 
 lemma skip_rule:
   "\<Turnstile> {P} Skip {P}"
   by (simp add: hyper_hoare_triple_def sem_skip)
 
 lemma assume_rule:
   "\<Turnstile> { (\<lambda>S. P (Set.filter (b \<circ> snd) S)) } (Assume b) {P}"
 proof (rule hyper_hoare_tripleI)
   fix S assume "P (Set.filter (b \<circ> snd) S)"
   then show "P (sem (Assume b) S)"
     by (simp add: assume_sem)
 qed
 
 lemma seq_rule:
   assumes "\<Turnstile> {P} C1 {R}"
     and "\<Turnstile> {R} C2 {Q}"
     shows "\<Turnstile> {P} Seq C1 C2 {Q}"
   using assms(1) assms(2) hyper_hoare_triple_def sem_seq
   by metis
 
 lemma if_rule:
   assumes "\<Turnstile> {P} C1 {Q1}"
       and "\<Turnstile> {P} C2 {Q2}"
     shows "\<Turnstile> {P} If C1 C2 {join Q1 Q2}"
   by (metis (full_types) assms(1) assms(2) hyper_hoare_triple_def join_def sem_if)
 
 lemma sem_assign:
   "sem (Assign x e) S = {(l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S}" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix l \<sigma>'
     assume "(l, \<sigma>') \<in> sem (Assign x e) S"
     then obtain \<sigma> where "(l, \<sigma>) \<in> S" "single_sem (Assign x e) \<sigma> \<sigma>'"
       by (metis fst_eqD in_sem snd_conv)
     then show "(l, \<sigma>') \<in> {(l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S}"
       by blast
   qed
   show "?B \<subseteq> ?A"
   proof (rule subsetPairI)
     fix l \<sigma>'
     assume "(l, \<sigma>') \<in> ?B"
     then obtain \<sigma> where "\<sigma>' = \<sigma>(x := e \<sigma>)" "(l, \<sigma>) \<in> S"
       by blast
     then show "(l, \<sigma>') \<in> ?A"
       by (metis SemAssign fst_eqD in_sem snd_conv)
   qed
 qed
 
 lemma assign_rule:
   "\<Turnstile> { (\<lambda>S. P { (l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S }) } (Assign x e) {P}"
 proof (rule hyper_hoare_tripleI)
   fix S assume "P {(l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S}"
   then show "P (sem (Assign x e) S)" using sem_assign
     by metis
 qed
 
 lemma sem_havoc:
   "sem (Havoc x) S = {(l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S}" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix l \<sigma>'
     assume "(l, \<sigma>') \<in> sem (Havoc x) S"
     then obtain \<sigma> where "(l, \<sigma>) \<in> S" "single_sem (Havoc x) \<sigma> \<sigma>'"
       by (metis fst_eqD in_sem snd_conv)
     then show "(l, \<sigma>') \<in> {(l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S}"
       by blast
   qed
   show "?B \<subseteq> ?A"
   proof (rule subsetPairI)
     fix l \<sigma>'
     assume "(l, \<sigma>') \<in> ?B"
     then obtain \<sigma> v where "\<sigma>' = \<sigma>(x := v)" "(l, \<sigma>) \<in> S"
       by blast
     then show "(l, \<sigma>') \<in> ?A"
       by (metis SemHavoc fst_eqD in_sem snd_conv)
   qed
 qed
 
 lemma havoc_rule:
   "\<Turnstile> { (\<lambda>S. P { (l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S }) } (Havoc x) {P}"
 proof (rule hyper_hoare_tripleI)
   fix S assume "P { (l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S }"
   then show "P (sem (Havoc x) S)" using sem_havoc by metis
 qed
 
 
 text \<open>Loops\<close>
 
 lemma indexed_invariant_then_power:
   assumes "\<And>n. hyper_hoare_triple (I n) C (I (Suc n))"
       and "I 0 S"
   shows "I n (iterate_sem n C S)"
   using assms
 proof (induct n arbitrary: S)
 next
   case (Suc n)
   then have "I n (iterate_sem n C S)"
     by blast
   then have "I (Suc n) (sem C (iterate_sem n C S))"
     using Suc.prems(1) hyper_hoare_tripleE by blast
   then show ?case
     by (simp add: Suc.hyps Suc.prems(1))
 qed (auto)
 
+lemma indexed_invariant_then_power_bounded:
+  assumes "\<And>m. m < n \<Longrightarrow> hyper_hoare_triple (I m) C (I (Suc m))"
+      and "I 0 S"
+  shows "I n (iterate_sem n C S)"
+  using assms
+proof (induct n arbitrary: S)
+next
+  case (Suc n)
+  then have "I n (iterate_sem n C S)"
+    using less_Suc_eq by presburger
+  then have "I (Suc n) (sem C (iterate_sem n C S))"
+    using Suc.prems(1) hyper_hoare_tripleE by blast
+  then show ?case
+    by (simp add: Suc.hyps Suc.prems(1))
+qed (auto)
+
 lemma while_rule:
   assumes "\<And>n. hyper_hoare_triple (I n) C (I (Suc n))"
   shows "hyper_hoare_triple (I 0) (While C) (natural_partition I)"
 proof (rule hyper_hoare_tripleI)
   fix S assume asm0: "I 0 S"
   show "natural_partition I (sem (While C) S)"
   proof (rule natural_partitionI)
     show "sem (While C) S = \<Union> (range (\<lambda>n. iterate_sem n C S))"
       by (simp add: sem_while)
     fix n show "I n (iterate_sem n C S)"
       by (simp add: asm0 assms indexed_invariant_then_power)
   qed
 qed
 
-
-text \<open>Additional rules\<close>
-
-lemma empty_pre:
-  "hyper_hoare_triple (\<lambda>_. False) C QQ"
-  by (simp add: hyper_hoare_triple_def)
-
-lemma full_post:
-  "hyper_hoare_triple P C (\<lambda>_. True)"
-  by (simp add: hyper_hoare_triple_def)
-
-
-lemma rule_join:
-  assumes "\<Turnstile> {P} C {Q}"
-      and "hyper_hoare_triple P' C Q'"
-    shows "hyper_hoare_triple (join P P') C (join Q Q')"
-proof (rule hyper_hoare_tripleI)
-  fix S assume asm0: "join P P' S"
-  then obtain S1 S2 where "S = S1 \<union> S2" "P S1" "P' S2"
-    by (metis join_def)
-  then have "sem C S = sem C S1 \<union> sem C S2"
-    using sem_union by auto
-  then show "join Q Q' (sem C S)"
-    by (metis \<open>P S1\<close> \<open>P' S2\<close> assms(1) assms(2) hyper_hoare_tripleE join_def)
-qed
-
-lemma rule_general_join:
-  assumes "\<And>x. \<Turnstile> {P x} C {Q x}"
-  shows "hyper_hoare_triple (general_join P) C (general_join Q)"
-proof (rule hyper_hoare_tripleI)
-  fix S assume "general_join P S"
-  then obtain F where asm0: "S = (\<Union>x. F x)" "\<And>x. P x (F x)"
-    by (meson general_join_def)
-  have "sem C S = (\<Union>x. sem C (F x))"
-    by (simp add: asm0(1) sem_split_general)
-  moreover have "\<And>x. Q x (sem C (F x))"
-    using asm0(2) assms hyper_hoare_tripleE by blast
-  ultimately show "general_join Q (sem C S)"
-    by (metis general_join_def)
-qed
-
-lemma rule_conj:
-  assumes "\<Turnstile> {P} C {Q}"
-      and "hyper_hoare_triple P' C Q'"
-    shows "hyper_hoare_triple (conj P P') C (conj Q Q')"
-proof (rule hyper_hoare_tripleI)
-  fix S assume "Logic.conj P P' S"
-  then show "Logic.conj Q Q' (sem C S)"
-    by (metis assms(1) assms(2) conj_def hyper_hoare_tripleE)
-qed
-
-text \<open>Generalization\<close>
-
-lemma rule_forall:
-  assumes "\<And>x. \<Turnstile> {P x} C {Q x}"
-  shows "hyper_hoare_triple (forall P) C (forall Q)"
-  by (metis assms forall_def hyper_hoare_triple_def)
-
-lemma rule_disj:
-  assumes "\<Turnstile> {P} C {Q}"
-      and "\<Turnstile> {P'} C {Q'}"
-    shows "hyper_hoare_triple (disj P P') C (disj Q Q')"
-  by (metis assms(1) assms(2) disj_def hyper_hoare_triple_def)
-
-text \<open>Generalization\<close>
-
 lemma rule_exists:
   assumes "\<And>x. \<Turnstile> {P x} C {Q x}"
   shows "\<Turnstile> {exists P} C {exists Q}"
   by (metis assms exists_def hyper_hoare_triple_def)
 
-corollary variant_if_rule:
-  assumes "hyper_hoare_triple P C1 Q"
-      and "hyper_hoare_triple P C2 Q"
-      and "closed_by_union Q"
-    shows "hyper_hoare_triple P (If C1 C2) Q"
-  by (metis assms(1) assms(2) assms(3) if_rule join_closed_by_union)
-
-
-text \<open>Simplifying the rule\<close>
-
-definition stable_by_infinite_union :: "'a hyperassertion \<Rightarrow> bool" where
-  "stable_by_infinite_union I \<longleftrightarrow> (\<forall>F. (\<forall>S \<in> F. I S) \<longrightarrow> I (\<Union>S \<in> F. S))"
-
-lemma stable_by_infinite_unionE:
-  assumes "stable_by_infinite_union I"
-      and "\<And>S. S \<in> F \<Longrightarrow> I S"
-    shows "I (\<Union>S \<in> F. S)"
-  using assms(1) assms(2) stable_by_infinite_union_def by blast
-
-lemma stable_by_union_and_constant_then_I:
-  assumes "\<And>n. I n = I'"
-      and "stable_by_infinite_union I'"
-    shows "natural_partition I = I'"
-proof (rule ext)
-  fix S show "natural_partition I S = I' S"
-  proof
-    show "I' S \<Longrightarrow> natural_partition I S"
-    proof -
-      assume "I' S"
-      show "natural_partition I S"
-      proof (rule natural_partitionI)
-        show "S = \<Union> (range (\<lambda>n. S))"
-          by simp
-        fix n show "I n S"
-          by (simp add: \<open>I' S\<close> assms(1))
-      qed
-    qed
-    assume asm0: "natural_partition I S"
-    then obtain F where "S = (\<Union>n. F n)" "\<And>n. I n (F n)"
-      using natural_partitionE by blast
-    let ?F = "{F n |n. True}"
-    have "I' (\<Union>S\<in>?F. S)"
-      using assms(2)
-    proof (rule stable_by_infinite_unionE[of I'])
-      fix S assume "S \<in> {F n |n. True}"
-      then show "I' S"
-        using \<open>\<And>n. I n (F n)\<close> assms(1) by force
-    qed
-    moreover have "(\<Union>S\<in>?F. S) = S"
-      using \<open>S = (\<Union>n. F n)\<close> by auto
-    ultimately show "I' S" by blast
-  qed
-qed
-
-corollary simpler_rule_while:
-  assumes "hyper_hoare_triple I C I"
-    and "stable_by_infinite_union I"
-  shows "hyper_hoare_triple I (While C) I"
-proof -
-  let ?I = "\<lambda>n. I"
-  have "hyper_hoare_triple (?I 0) (While C) (natural_partition ?I)"
-    using while_rule[of ?I C]
-    by (simp add: assms(1) assms(2) stable_by_union_and_constant_then_I)
-  then show ?thesis
-    by (simp add: assms(2) stable_by_union_and_constant_then_I)
-qed
-
-
 text \<open>Theorem 1\<close>
 
 theorem soundness:
   assumes "\<turnstile> {A} C {B}"
     shows "\<Turnstile> {A} C {B}"
   using assms
 proof (induct rule: syntactic_HHT.induct)
   case (RuleSkip P)
   then show ?case
     using skip_rule by auto
 next
   case (RuleCons P P' Q' Q C)
   then show ?case
     using consequence_rule by blast
 next
   case (RuleExistsSet P C Q)
   then show ?case
     using rule_exists by blast
 next
   case (RuleSeq P C1 R C2 Q)
   then show ?case
     using seq_rule by meson
 next
   case (RuleIf P C1 Q1 C2 Q2)
   then show ?case
     using if_rule by blast
 next
   case (RuleAssume P b)
   then show ?case
     by (simp add: assume_rule)
 next
   case (RuleWhile I C)
   then show ?case
     using while_rule by blast
 next
   case (RuleAssign x e)
   then show ?case
     by (simp add: assign_rule)
 next
   case (RuleHavoc x)
   then show ?case
     using havoc_rule by fastforce
 qed
 
 
 
 subsection \<open>Completeness\<close>
 
 definition complete
   where
   "complete P C Q \<longleftrightarrow> (\<Turnstile> {P} C {Q} \<longrightarrow> \<turnstile> {P} C {Q})"
 
 lemma completeI:
   assumes "\<Turnstile> {P} C {Q} \<Longrightarrow> \<turnstile> {P} C {Q}"
   shows "complete P C Q"
   by (simp add: assms complete_def)
 
 lemma completeE:
   assumes "complete P C Q"
       and "\<Turnstile> {P} C {Q}"
     shows "\<turnstile> {P} C {Q}"
   using assms complete_def by auto
 
 lemma complete_if_aux:
   assumes "hyper_hoare_triple A (If C1 C2) B"
   shows "entails (\<lambda>S'. \<exists>S. A S \<and> S' = sem C1 S \<union> sem C2 S) B"
 proof (rule entailsI)
   fix S' assume "\<exists>S. A S \<and> S' = sem C1 S \<union> sem C2 S"
   then show "B S'"
     by (metis assms hyper_hoare_tripleE sem_if)
 qed
 
 lemma complete_if:
   fixes P Q :: "('lvar, 'lval, 'pvar, 'pval) state hyperassertion"
   assumes "\<And>P1 Q1 :: ('lvar, 'lval, 'pvar, 'pval) state hyperassertion. complete P1 C1 Q1"
       and "\<And>P2 Q2 :: ('lvar, 'lval, 'pvar, 'pval) state hyperassertion. complete P2 C2 Q2"
     shows "complete P (If C1 C2) Q"
 proof (rule completeI)
   assume asm0: "\<Turnstile> {P} If C1 C2 {Q}"
 
   show "\<turnstile> {P} stmt.If C1 C2 {Q}"
   proof (rule RuleCons)
     show "\<turnstile> {exists (\<lambda>V S. P S \<and> S = V)} stmt.If C1 C2 {exists (\<lambda>V. join (\<lambda>S. S = sem C1 V \<and> P V) (\<lambda>S. S = sem C2 V))}"
     proof (rule RuleExistsSet)
       fix V
       show "\<turnstile> {(\<lambda>S. P S \<and> S = V)} stmt.If C1 C2 {join (\<lambda>S. S = sem C1 V \<and> P V) (\<lambda>S. S = sem C2 V)}"
       proof (rule RuleIf)
         show "\<turnstile> {(\<lambda>S. P S \<and> S = V)} C1 {\<lambda>S. S = sem C1 V \<and> P V}"
           by (simp add: assms(1) completeE hyper_hoare_triple_def)
         show "\<turnstile> {(\<lambda>S. P S \<and> S = V)} C2 {\<lambda>S. S = sem C2 V}"
           by (simp add: assms(2) completeE hyper_hoare_triple_def)
       qed
     qed
     show "entails P (exists (\<lambda>V S. P S \<and> S = V))"
       by (simp add: entailsI exists_def)
     show "entails (exists (\<lambda>V. join (\<lambda>S. S = sem C1 V \<and> P V) (\<lambda>S. S = sem C2 V))) Q"
     proof (rule entailsI)
       fix S assume "exists (\<lambda>V. join (\<lambda>S. S = sem C1 V \<and> P V) (\<lambda>S. S = sem C2 V)) S"
       then obtain V where "join (\<lambda>S. S = sem C1 V \<and> P V) (\<lambda>S. S = sem C2 V) S"
         by (meson exists_def)
       then obtain S1 S2 where "S = S1 \<union> S2" "S1 = sem C1 V \<and> P V" "S2 = sem C2 V"
         by (simp add: join_def)
       then show "Q S"
         by (metis asm0 hyper_hoare_tripleE sem_if)
     qed
   qed
 qed
 
 lemma complete_seq_aux:
   assumes "hyper_hoare_triple A (Seq C1 C2) B"
   shows "\<exists>R. hyper_hoare_triple A C1 R \<and> hyper_hoare_triple R C2 B"
 proof -
   let ?R = "\<lambda>S. \<exists>S'. A S' \<and> S = sem C1 S'"
   have "hyper_hoare_triple A C1 ?R"
     using hyper_hoare_triple_def by blast
   moreover have "hyper_hoare_triple ?R C2 B"
   proof (rule hyper_hoare_tripleI)
     fix S assume "\<exists>S'. A S' \<and> S = sem C1 S'"
     then obtain S' where asm0: "A S'" "S = sem C1 S'"
       by blast
     then show "B (sem C2 S)"
       by (metis assms hyper_hoare_tripleE sem_seq)
   qed
   ultimately show ?thesis by blast
 qed
 
 
 lemma complete_assume:
   "complete P (Assume b) Q"
 proof (rule completeI)
   assume asm0: "\<Turnstile> {P} Assume b {Q}"
   show "\<turnstile> {P} Assume b {Q}"
   proof (rule RuleCons)
     show "\<turnstile> { (\<lambda>S. Q (Set.filter (b \<circ> snd) S)) } (Assume b) {Q}"
       by (simp add: RuleAssume)
     show "entails P (\<lambda>S. Q (Set.filter (b \<circ> snd) S))"
       by (metis (mono_tags, lifting) asm0 assume_sem entails_def hyper_hoare_tripleE)
     show "entails Q Q"      
       by (simp add: entailsI)
   qed
 qed
 
 lemma complete_skip:
   "complete P Skip Q"
   using completeI RuleSkip
   by (metis (mono_tags, lifting) entails_def hyper_hoare_triple_def sem_skip RuleCons)
 
 lemma complete_assign:
   "complete P (Assign x e) Q"
 proof (rule completeI)
   assume asm0: "\<Turnstile> {P} Assign x e {Q}"
   show "\<turnstile> {P} Assign x e {Q}"
   proof (rule RuleCons)
     show "\<turnstile> {(\<lambda>S. Q {(l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S})} Assign x e {Q}"
       by (simp add: RuleAssign)
     show "entails P (\<lambda>S. Q {(l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S})"
     proof (rule entailsI)
       fix S assume "P S"
       then show "Q {(l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S}"
         by (metis asm0 hyper_hoare_triple_def sem_assign)
     qed
     show "entails Q Q"
       by (simp add: entailsI)
   qed
 qed
 
 lemma complete_havoc:
   "complete P (Havoc x) Q"
 proof (rule completeI)
   assume asm0: "\<Turnstile> {P} Havoc x {Q}"
   show "\<turnstile> {P} Havoc x {Q}"
   proof (rule RuleCons)
     show "\<turnstile> { (\<lambda>S. Q { (l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S }) } (Havoc x) {Q}"
       using RuleHavoc by fast
     show "entails P (\<lambda>S. Q {(l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S})"
     proof (rule entailsI)
       fix S assume "P S"
       then show "Q {(l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S}"
         by (metis asm0 hyper_hoare_triple_def sem_havoc)
     qed
     show "entails Q Q"
       by (simp add: entailsI)
   qed
 qed
 
 lemma complete_seq:
   assumes "\<And>R. complete P C1 R"
       and "\<And>R. complete R C2 Q"
     shows "complete P (Seq C1 C2) Q"
   by (meson RuleSeq assms(1) assms(2) completeE completeI complete_seq_aux)
 
 
 
 fun construct_inv
   where
   "construct_inv P C 0 = P"
 | "construct_inv P C (Suc n) = (\<lambda>S. (\<exists>S'. S = sem C S' \<and> construct_inv P C n S'))"
 
 lemma iterate_sem_ind:
   assumes "construct_inv P C n S'"
   shows "\<exists>S. P S \<and> S' = iterate_sem n C S"
   using assms
 by (induct n arbitrary: S') (auto)
 
 
 lemma complete_while_aux:
   assumes "hyper_hoare_triple (\<lambda>S. P S \<and> S = V) (While C) Q"
   shows "entails (natural_partition (construct_inv (\<lambda>S. P S \<and> S = V) C)) Q"
 proof (rule entailsI)
   fix S assume "natural_partition (construct_inv (\<lambda>S. P S \<and> S = V) C) S"
 
   then obtain F where asm0: "S = (\<Union>n. F n)" "\<And>n. construct_inv (\<lambda>S. P S \<and> S = V) C n (F n)"
     using natural_partitionE by blast
   then have "P (F 0) \<and> F 0 = V"
     by (metis (mono_tags, lifting) construct_inv.simps(1))
   then have "Q (\<Union>n. iterate_sem n C (F 0))"
     using assms hyper_hoare_triple_def[of "\<lambda>S. P S \<and> S = V" "While C" Q] sem_while
     by metis
   moreover have "\<And>n. F n = iterate_sem n C V"
   proof -
     fix n
     obtain S' where "P S' \<and> S' = V" "F n = iterate_sem n C S'"
       using asm0(2) iterate_sem_ind by blast
     then show "F n = iterate_sem n C V"
       by simp
   qed
   ultimately show "Q S"
     using asm0(1) by auto
 qed
 
 lemma complete_while:
   fixes P Q :: "('lvar, 'lval, 'pvar, 'pval) state hyperassertion"
   assumes "\<And>P' Q' :: ('lvar, 'lval, 'pvar, 'pval) state hyperassertion. complete P' C Q'"
     shows "complete P (While C) Q"
 proof (rule completeI)
   assume asm0: "hyper_hoare_triple P (While C) Q"
 
   let ?I = "\<lambda>V. construct_inv (\<lambda>S. P S \<and> S = V) C"
 
   have r: "\<And>V. syntactic_HHT (?I V 0) (While C) (natural_partition (?I V))"
   proof (rule RuleWhile)
     fix V n show "syntactic_HHT (construct_inv (\<lambda>S. P S \<and> S = V) C n) C (construct_inv (\<lambda>S. P S \<and> S = V) C (Suc n))"
       by (meson assms completeE construct_inv.simps(2) hyper_hoare_tripleI)
   qed
 
   show "syntactic_HHT P (While C) Q"
   proof (rule RuleCons)
     show "syntactic_HHT (exists (\<lambda>V. ?I V 0)) (While C) (exists (\<lambda>V. ((natural_partition (?I V)))))"
       using r by (rule RuleExistsSet)
     show "entails P (exists (\<lambda>V. construct_inv (\<lambda>S. P S \<and> S = V) C 0))"
       by (simp add: entailsI exists_def)
     show "entails (exists (\<lambda>V. natural_partition (construct_inv (\<lambda>S. P S \<and> S = V) C))) Q"
     proof (rule entailsI)
       fix S' assume "exists (\<lambda>V. natural_partition (construct_inv (\<lambda>S. P S \<and> S = V) C)) S'"
       then obtain V where "natural_partition (construct_inv (\<lambda>S. P S \<and> S = V) C) S'"
         by (meson exists_def)
       moreover have "entails (natural_partition (construct_inv (\<lambda>S. P S \<and> S = V) C)) Q"
       proof (rule complete_while_aux)
         show "hyper_hoare_triple (\<lambda>S. P S \<and> S = V) (While C) Q"
           using asm0 hyper_hoare_triple_def[of "\<lambda>S. P S \<and> S = V"]
           hyper_hoare_triple_def[of P "While C" Q] by auto
       qed
       ultimately show "Q S'"
         by (simp add: entails_def)
     qed
   qed
 qed
 
 
 text \<open>Theorem 2\<close>
 
 theorem completeness:
   fixes P Q :: "('lvar, 'lval, 'pvar, 'pval) state hyperassertion"
   assumes "\<Turnstile> {P} C {Q}"
   shows "\<turnstile> {P} C {Q}"
   using assms
 proof (induct C arbitrary: P Q)
   case (Assign x1 x2)
   then show ?case
     using completeE complete_assign by fast
 next
   case (Seq C1 C2)
   then show ?case
     using complete_def complete_seq by meson
 next
   case (If C1 C2)
   then show ?case
     using complete_def complete_if by meson
 next
   case Skip
   then show ?case
     using complete_def complete_skip by meson
 next
   case (Havoc x)
   then show ?case
     by (simp add: completeE complete_havoc)
 next
   case (Assume b)
   then show ?case
     by (simp add: completeE complete_assume)
 next
   case (While C)
   then show ?case
     using complete_def complete_while by blast
 qed
 
 
+
+
 subsection \<open>Disproving Hyper-Triples\<close>
 
 definition sat where "sat P \<longleftrightarrow> (\<exists>S. P S)"
 
-text \<open>Theorem 4\<close>
+text \<open>Theorem 5\<close>
 
 theorem disproving_triple:
   "\<not> \<Turnstile> {P} C {Q} \<longleftrightarrow> (\<exists>P'. sat P' \<and> entails P' P \<and> \<Turnstile> {P'} C {\<lambda>S. \<not> Q S})" (is "?A \<longleftrightarrow> ?B")
 proof
   assume "\<not> \<Turnstile> {P} C {Q}"
   then obtain S where asm0: "P S" "\<not> Q (sem C S)"
     using hyper_hoare_triple_def by blast
   let ?P = "\<lambda>S'. S = S'"
   have "entails ?P P"
     by (simp add: asm0(1) entails_def)
   moreover have "\<Turnstile> {?P} C {\<lambda>S. \<not> Q S}"
     by (simp add: asm0(2) hyper_hoare_triple_def)
   moreover have "sat ?P"
     by (simp add: sat_def)
   ultimately show ?B by blast
 next
   assume "\<exists>P'. sat P' \<and> entails P' P \<and> \<Turnstile> {P'} C {\<lambda>S. \<not> Q S}"
   then obtain P' where asm0: "sat P'" "entails P' P" "\<Turnstile> {P'} C {\<lambda>S. \<not> Q S}"
     by blast
   then obtain S where "P' S"
     by (meson sat_def)
   then show ?A
     using asm0(2) asm0(3) entailsE hyper_hoare_tripleE
     by (metis (no_types, lifting))
 qed
 
 definition differ_only_by where
   "differ_only_by a b x \<longleftrightarrow> (\<forall>y. y \<noteq> x \<longrightarrow> a y = b y)"
 
 lemma differ_only_byI:
   assumes "\<And>y. y \<noteq> x \<Longrightarrow> a y = b y"
   shows "differ_only_by a b x"
   by (simp add: assms differ_only_by_def)
 
 lemma diff_by_update:
   "differ_only_by (a(x := v)) a x"
   by (simp add: differ_only_by_def)
 
 lemma diff_by_comm:
   "differ_only_by a b x \<longleftrightarrow> differ_only_by b a x"
   by (metis (mono_tags, lifting) differ_only_by_def)
 
 lemma diff_by_trans:
   assumes "differ_only_by a b x"
       and "differ_only_by b c x"
     shows "differ_only_by a c x"
   by (metis assms(1) assms(2) differ_only_by_def)
 
 
 definition not_free_var_of where
   "not_free_var_of P x \<longleftrightarrow> (\<forall>states states'.
   (\<forall>i. differ_only_by (fst (states i)) (fst (states' i)) x \<and> snd (states i) = snd (states' i))
   \<longrightarrow> (states \<in> P \<longleftrightarrow> states' \<in> P))"
 
 
 lemma not_free_var_ofE:
   assumes "not_free_var_of P x"
       and "\<And>i. differ_only_by (fst (states i)) (fst (states' i)) x"
       and "\<And>i. snd (states i) = snd (states' i)"
       and "states \<in> P"
     shows "states' \<in> P"
   using not_free_var_of_def[of P x] assms by blast
 
 
 subsection \<open>Synchronized Rule for Branching\<close>
 
 definition combine where
   "combine from_nat x P1 P2 S \<longleftrightarrow> P1 (Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 1) S) \<and> P2 (Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 2) S)"
 
 lemma combineI:
   assumes "P1 (Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 1) S) \<and> P2 (Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 2) S)"
   shows "combine from_nat x P1 P2 S"
   by (simp add: assms combine_def)
 
 definition modify_lvar_to where
   "modify_lvar_to x v \<phi> = ((fst \<phi>)(x := v), snd \<phi>)"
 
 lemma logical_var_in_sem_same:
   assumes "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> fst \<phi> x = a"
       and "\<phi>' \<in> sem C S"
     shows "fst \<phi>' x = a"
   by (metis assms(1) assms(2) fst_conv in_sem)
 
 lemma recover_after_sem:
   assumes "a \<noteq> b"
       and "\<And>\<phi>. \<phi> \<in> S1 \<Longrightarrow> fst \<phi> x = a"
       and "\<And>\<phi>. \<phi> \<in> S2 \<Longrightarrow> fst \<phi> x = b"
     shows "sem C S1 = Set.filter (\<lambda>\<phi>. fst \<phi> x = a) (sem C (S1 \<union> S2))" (is "?A = ?B")
 proof
   have r: "sem C (S1 \<union> S2) = sem C S1 \<union> sem C S2"
     by (simp add: sem_union)
   moreover have r1: "\<And>\<phi>'. \<phi>' \<in> sem C S1 \<Longrightarrow> fst \<phi>' x = a"
     by (metis assms(2) fst_conv in_sem)
   moreover have r2: "\<And>\<phi>'. \<phi>' \<in> sem C S2 \<Longrightarrow> fst \<phi>' x = b"
     by (metis assms(3) fst_conv in_sem)
   show "?B \<subseteq> ?A"
   proof (rule subsetPairI)
     fix l \<sigma>
     assume "(l, \<sigma>) \<in> Set.filter (\<lambda>\<phi>. fst \<phi> x = a) (sem C (S1 \<union> S2))"
     then show "(l, \<sigma>) \<in> sem C S1"
       using assms(1) r r2 by auto
   qed
   show "?A \<subseteq> ?B"
     by (simp add: r r1 subsetI)
 qed
 
 lemma injective_then_ok:
   assumes "a \<noteq> b"
       and "S1' = (modify_lvar_to x a) ` S1"
       and "S2' = (modify_lvar_to x b) ` S2"
     shows "Set.filter (\<lambda>\<phi>. fst \<phi> x = a) (S1' \<union> S2') = S1'" (is "?A = ?B")
 proof
   show "?B \<subseteq> ?A"
   proof (rule subsetI)
     fix y assume "y \<in> S1'"
     then have "fst y x = a" using modify_lvar_to_def assms(2)
       by (metis (mono_tags, lifting) fst_conv fun_upd_same image_iff)
     then show "y \<in> Set.filter (\<lambda>\<phi>. fst \<phi> x = a) (S1' \<union> S2')"
       by (simp add: \<open>y \<in> S1'\<close>)
   qed
   show "?A \<subseteq> ?B"
   proof
     fix y assume "y \<in> ?A"
     then have "y \<notin> S2'"
       by (metis (mono_tags, lifting) assms(1) assms(3) fun_upd_same image_iff member_filter modify_lvar_to_def prod.sel(1))
     then show "y \<in> ?B"
       using \<open>y \<in> Set.filter (\<lambda>\<phi>. fst \<phi> x = a) (S1' \<union> S2')\<close> by auto
   qed
 qed
 
 definition not_free_var_hyper where
   "not_free_var_hyper x P \<longleftrightarrow> (\<forall>S v. P S \<longleftrightarrow> P ((modify_lvar_to x v) ` S))"
 
 definition injective where
   "injective f \<longleftrightarrow> (\<forall>a b. a \<noteq> b \<longrightarrow> f a \<noteq> f b)"
 
 lemma sem_of_modify_lvar:
   "sem C ((modify_lvar_to r v) ` S) = (modify_lvar_to r v) ` (sem C S)" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetI)
     fix y assume asm0: "y \<in> ?A"
     then obtain x where "x \<in> (modify_lvar_to r v) ` S" "single_sem C (snd x) (snd y)" "fst x = fst y"
       by (metis fst_conv in_sem snd_conv)
     then obtain xx where "xx \<in> S" "x = modify_lvar_to r v xx"
       by blast
     then have "(fst xx, snd y) \<in> sem C S"
       by (metis \<open>\<langle>C, snd x\<rangle> \<rightarrow> snd y\<close> fst_conv in_sem modify_lvar_to_def prod.collapse snd_conv)
     then show "y \<in> ?B"
       by (metis \<open>fst x = fst y\<close> \<open>x = modify_lvar_to r v xx\<close> fst_eqD modify_lvar_to_def prod.exhaust_sel rev_image_eqI snd_eqD)
   qed
   show "?B \<subseteq> ?A"
   proof (rule subsetI)
     fix y assume "y \<in> modify_lvar_to r v ` sem C S"
     then obtain yy where "y = modify_lvar_to r v yy" "yy \<in> sem C S"
       by blast
     then obtain x where "x \<in> S" "fst x = fst yy" "single_sem C (snd x) (snd yy)"
       by (metis fst_conv in_sem snd_conv)
     then have "fst (modify_lvar_to r v x) = fst y"
       by (simp add: \<open>y = modify_lvar_to r v yy\<close> modify_lvar_to_def)
     then show "y \<in> sem C (modify_lvar_to r v ` S)"
       by (metis (mono_tags, lifting) \<open>\<langle>C, snd x\<rangle> \<rightarrow> snd yy\<close> \<open>x \<in> S\<close> \<open>y = modify_lvar_to r v yy\<close> fst_conv
           image_eqI in_sem modify_lvar_to_def snd_conv)
   qed
 qed
 
-text \<open>Proposition 15 (appendix C).\<close>
-
-theorem if_sync_rule:
-  assumes "\<Turnstile> {P} C1 {P1}"
-      and "\<Turnstile> {P} C2 {P2}"
-      and "\<Turnstile> {combine from_nat x P1 P2} C {combine from_nat x R1 R2}"
-      and "\<Turnstile> {R1} C1' {Q1}"
-      and "\<Turnstile> {R2} C2' {Q2}"
-
-      and "not_free_var_hyper x P1"
-      and "not_free_var_hyper x P2"
-      and "injective (from_nat :: nat \<Rightarrow> 'a)"
-
-      and "not_free_var_hyper x R1"
-      and "not_free_var_hyper x R2"
-
-    shows "\<Turnstile> {P} If (Seq C1 (Seq C C1')) (Seq C2 (Seq C C2')) {join Q1 Q2}"
-proof (rule hyper_hoare_tripleI)
-  fix S assume asm0: "P S"
-  have r0: "sem (stmt.If (Seq C1 (Seq C C1')) (Seq C2 (Seq C C2'))) S
-  = sem C1' (sem C (sem C1 S)) \<union> sem C2' (sem C (sem C2 S))"
-    by (simp add: sem_if sem_seq)
-  moreover have "P1 (sem C1 S) \<and> P2 (sem C2 S)"
-    using asm0 assms(1) assms(2) hyper_hoare_tripleE by blast
-
-  let ?S1 = "(modify_lvar_to x (from_nat 1)) ` (sem C1 S)"
-  let ?S2 = "(modify_lvar_to x (from_nat 2)) ` (sem C2 S)"
-  let ?f1 = "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 1)"
-  let ?f2 = "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 2)"
-
-  have r: "from_nat 1 \<noteq> from_nat 2"
-    by (metis Suc_1 assms(8) injective_def n_not_Suc_n)
-
-  have "P1 ?S1 \<and> P2 ?S2"
-    by (meson \<open>P1 (sem C1 S) \<and> P2 (sem C2 S)\<close> assms(6) assms(7) not_free_var_hyper_def)
-  moreover have rr1: "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 1) (?S1 \<union> ?S2) = ?S1"
-    using injective_then_ok[of "from_nat 1" "from_nat 2" ?S1 x]
-    by (metis (no_types, lifting) assms(8) injective_def num.simps(4) one_eq_numeral_iff)
-  moreover have rr2: "Set.filter (\<lambda>\<phi>. fst \<phi> x = from_nat 2) (?S1 \<union> ?S2) = ?S2"
-    using injective_then_ok[of "from_nat 2" "from_nat 1" ?S2 x]
-    by (metis (no_types, lifting) assms(8) injective_def one_eq_numeral_iff sup_commute verit_eq_simplify(10))
-  ultimately have "combine from_nat x P1 P2 (?S1 \<union> ?S2)"
-    by (metis combineI)
-  then have "combine from_nat x R1 R2 (sem C (?S1 \<union> ?S2))"
-    using assms(3) hyper_hoare_tripleE by blast
-  moreover have "?f1 (sem C (?S1 \<union> ?S2)) = sem C ?S1"
-    using recover_after_sem[of "from_nat 1" "from_nat 2" ?S1 x ?S2] r rr1 rr2
-      member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 1"] member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 2"]
-    by metis
-  then have "R1 (sem C ?S1)"
-    by (metis (mono_tags) calculation combine_def)
-  then have "R1 (sem C (sem C1 S))"
-    by (metis assms(9) not_free_var_hyper_def sem_of_modify_lvar)
-  moreover have "?f2 (sem C (?S1 \<union> ?S2)) = sem C ?S2"
-    using recover_after_sem[of "from_nat 2" "from_nat 1" ?S2 x ?S1] r rr1 rr2 sup_commute[of ]
-      member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 1" "?S1 \<union> ?S2"] member_filter[of _ "\<lambda>\<phi>. fst \<phi> x = from_nat 2" "?S1 \<union> ?S2"]
-    by metis
-  then have "R2 (sem C ?S2)"
-    by (metis (mono_tags) calculation(1) combine_def)
-  then have "R2 (sem C (sem C2 S))"
-    by (metis assms(10) not_free_var_hyper_def sem_of_modify_lvar)
-
-  then show "join Q1 Q2 (sem (stmt.If (Seq C1 (Seq C C1')) (Seq C2 (Seq C C2'))) S)"
-    by (metis (full_types) r0 assms(4) assms(5) calculation(2) hyper_hoare_tripleE join_def)
-qed
-
 end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/Loops.thy b/thys/HyperHoareLogic/Loops.thy
new file mode 100644
--- /dev/null
+++ b/thys/HyperHoareLogic/Loops.thy
@@ -0,0 +1,1029 @@
+theory Loops
+  imports Logic HOL.Wellfounded Expressivity
+begin
+
+section \<open>Rules for Loops\<close>
+
+definition lnot where
+  "lnot b \<sigma> = (\<not>b \<sigma>)"
+
+definition if_then_else where
+  "if_then_else b C1 C2 = If (Assume b;; C1) (Assume (lnot b);; C2)"
+
+definition low_exp where
+  "low_exp e S = (\<forall>\<phi> \<phi>'. \<phi> \<in> S \<and> \<phi>' \<in> S \<longrightarrow> (e (snd \<phi>) = e (snd \<phi>')))"
+
+lemma low_exp_lnot:
+  "low_exp b S \<longleftrightarrow> low_exp (lnot b) S"
+  by (simp add: lnot_def low_exp_def)
+
+definition holds_forall where
+  "holds_forall b S \<longleftrightarrow> (\<forall>\<phi>\<in>S. b (snd \<phi>))"
+
+lemma holds_forallI:
+  assumes "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> b (snd \<phi>)"
+  shows "holds_forall b S"
+  using assms holds_forall_def by blast
+
+lemma low_exp_two_cases:
+  assumes "low_exp b S"
+  shows "holds_forall b S \<or> holds_forall (lnot b) S"
+  by (metis assms holds_forall_def lnot_def low_exp_def)
+
+lemma sem_assume_low_exp:
+  assumes "holds_forall b S"
+  shows "sem (Assume b) S = S"
+    and "sem (Assume (lnot b)) S = {}"
+  using assume_sem[of b S] assms holds_forall_def[of b S] apply fastforce
+  using assume_sem[of "lnot b" S] assms holds_forall_def[of b S] lnot_def[of b]
+    by fastforce
+
+lemma sem_assume_low_exp_seq:
+  assumes "holds_forall b S"
+  shows "sem (Assume b;; C) S = sem C S"
+    and "sem (Assume (lnot b);; C) S = {}"
+  apply (simp add: assms sem_assume_low_exp(1) sem_seq)
+  by (metis assms empty_iff equals0I in_sem sem_assume_low_exp(2) sem_seq)
+
+lemma lnot_involution:
+  "lnot (lnot b) = b"
+proof (rule ext)
+  fix x show "lnot (lnot b) x = b x"
+    by (simp add: lnot_def)
+qed
+
+lemma sem_if_then_else:
+  shows "holds_forall b S \<Longrightarrow> sem (if_then_else b C1 C2) S = sem C1 S"
+    and "holds_forall (lnot b) S \<Longrightarrow> sem (if_then_else b C1 C2) S = sem C2 S"
+  apply (simp add: if_then_else_def sem_assume_low_exp_seq(1) sem_assume_low_exp_seq(2) sem_if)
+  by (metis (no_types, opaque_lifting) if_then_else_def lnot_involution sem_assume_low_exp_seq(1) sem_assume_low_exp_seq(2) sem_if sup_bot_left)
+
+lemma if_synchronized_aux:
+  assumes "\<Turnstile> {P} C1 {Q}"
+      and "\<Turnstile> {P} C2 {Q}"
+      and "entails P (low_exp b)"
+    shows "\<Turnstile> {P} if_then_else b C1 C2 {Q}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "P S"
+  then have r: "low_exp b S" using assms(3) entailsE
+    by metis
+  show "Q (sem (if_then_else b C1 C2) S)"
+  proof (cases "holds_forall b S")
+    case True
+    then show ?thesis
+      by (metis asm0 assms(1) hyper_hoare_triple_def sem_if_then_else(1))
+  next
+    case False
+    then show ?thesis
+      by (metis asm0 assms(2) hyper_hoare_tripleE low_exp_two_cases r sem_if_then_else(2))
+  qed
+qed
+
+theorem if_synchronized:
+  assumes "\<Turnstile> {conj P (holds_forall b)} C1 {Q}"
+      and "\<Turnstile> {conj P (holds_forall (lnot b))} C2 {Q}"
+    shows "\<Turnstile> {conj P (low_exp b)} if_then_else b C1 C2 {Q}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "conj P (low_exp b) S"
+  show "Q (sem (if_then_else b C1 C2) S)"
+  proof (cases "holds_forall b S")
+    case True
+    then show ?thesis
+      by (metis asm0 assms(1) conj_def hyper_hoare_triple_def sem_if_then_else(1))
+  next
+    case False
+    then show ?thesis
+      by (metis asm0 assms(2) conj_def hyper_hoare_triple_def low_exp_two_cases sem_if_then_else(2))
+  qed
+qed
+
+
+definition while_cond where
+  "while_cond b C = While (Assume b;; C);; Assume (lnot b)"
+
+
+lemma while_synchronized_rec:
+  assumes "\<And>n. \<Turnstile> {conj (I n) (holds_forall b)} Assume b;; C {conj (I (Suc n)) (low_exp b)}"
+      and "conj (I 0) (low_exp b) S"
+    shows "conj (I n) (low_exp b) (iterate_sem n (Assume b;; C) S) \<or> holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+  using assms
+proof (induct n)
+  case (Suc n)
+  then have r: "conj (I n) (low_exp b) (iterate_sem n (Assume b;; C) S) \<or> holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+    by blast
+  then show ?case
+  proof (cases "conj (I n) (holds_forall b) (iterate_sem n (Assume b;; C) S)")
+    case True
+    then show ?thesis
+      using Suc.prems(1) hyper_hoare_tripleE by fastforce
+  next
+    case False
+    then have "holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+      by (metis conj_def low_exp_two_cases r)
+    then have "iterate_sem (Suc n) (Assume b;; C) S = {}"
+      by (metis iterate_sem.simps(2) lnot_involution sem_assume_low_exp_seq(2))
+    then show ?thesis
+      by (simp add: holds_forall_def)
+  qed
+qed (auto)
+
+lemma false_then_empty_later:
+  assumes "holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+      and "m > n"
+    shows "iterate_sem m (Assume b;; C) S = {}"
+  using assms
+proof (induct "m - n" arbitrary: n m)
+  case (Suc x)
+  then show ?case
+  proof (cases x)
+    case 0
+    then show ?thesis
+      by (metis One_nat_def Suc.hyps(2) Suc.prems(1) Suc.prems(2) Suc_eq_plus1 iterate_sem.simps(2) le_add_diff_inverse linorder_not_le lnot_involution order.asym sem_assume_low_exp_seq(2))
+  next
+    case (Suc nat)
+    then have "m - 1 > n"
+      using Suc.hyps(2) by auto
+    then have "iterate_sem (m-1) (Assume b ;; C) S = {}"
+      by (metis (no_types, lifting) Suc.hyps(1) Suc.hyps(2) Suc.prems(1) diff_Suc_1 diff_commute)
+    then show ?thesis
+      by (metis Nat.lessE Suc.prems(1) Suc.prems(2) diff_Suc_1 iterate_sem.simps(2) sem_assume_low_exp_seq(2) sem_seq)
+  qed
+qed (simp)
+
+lemma split_union_triple:
+  "(\<Union>(m::nat). f m) = (\<Union>m\<in>{m |m. m < n}. f m) \<union> f n \<union> (\<Union>m\<in>{m |m. m > n}. f m)" (is "?A = ?B")
+proof
+  show "?B \<subseteq> ?A"
+    by blast
+  show "?A \<subseteq> ?B"
+  proof
+    fix x assume "x \<in> ?A"
+    then obtain m where "x \<in> f m"
+      by blast
+    then have "m < n \<or> m = n \<or> m > n"
+      by force
+    then show "x \<in> ?B"
+      using \<open>x \<in> f m\<close> by auto
+  qed
+qed
+
+
+lemma sem_union_swap:
+  "sem C (\<Union>x\<in>S. f x) = (\<Union>x\<in>S. sem C (f x))" (is "?A = ?B")
+proof
+  show "?A \<subseteq> ?B"
+  proof
+    fix y assume "y \<in> ?A"
+    then obtain x where "x \<in> S" "y \<in> sem C (f x)"
+      using UN_iff in_sem[of y C] by force
+    then show "y \<in> ?B"
+      by blast
+  qed
+  show "?B \<subseteq> ?A"
+    by (simp add: SUP_least SUP_upper sem_monotonic)
+qed
+
+
+
+lemma while_synchronized_case_1:
+  assumes "\<And>m. m < n \<Longrightarrow> holds_forall b (iterate_sem m (Assume b;; C) S)"
+      and "holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+      and "\<And>n. \<Turnstile> {conj (I n) (holds_forall b)} Assume b;; C {conj (I (Suc n)) (low_exp b)}"
+      and "conj (I 0) (low_exp b) S"
+    shows "sem (while_cond b C) S = iterate_sem n (Assume b;; C) S"
+proof -
+  have "\<And>m. m > n \<Longrightarrow> iterate_sem m (Assume b;; C) S = {}"
+    using assms(2) false_then_empty_later by blast
+  moreover have "sem (While (Assume b;; C)) S =
+  (\<Union>m\<in>{m|m. m < n}. iterate_sem m (Assume b ;; C) S) \<union> iterate_sem n (Assume b ;; C) S \<union> (\<Union>m\<in>{m|m. m > n}. iterate_sem m (Assume b ;; C) S)"
+    using sem_while[of "Assume b;; C" S] split_union_triple by metis
+  ultimately have "sem (While (Assume b;; C)) S = (\<Union>m\<in>{m|m. m < n}. iterate_sem m (Assume b ;; C) S) \<union> iterate_sem n (Assume b ;; C) S "
+    by auto
+  moreover have "\<And>m. m < n \<Longrightarrow> sem (Assume (lnot b)) (iterate_sem m (Assume b ;; C) S) = {}"
+    using assms(1) sem_assume_low_exp(2) by blast
+  then have "sem (Assume (lnot b)) (\<Union>m\<in>{m|m. m < n}. iterate_sem m (Assume b ;; C) S) = {}"
+    by (simp add: sem_union_swap)
+  then have "sem (while_cond b C) S = sem (Assume (lnot b)) (iterate_sem n (Assume b ;; C) S)"
+    by (simp add: calculation sem_seq sem_union while_cond_def)
+  then show ?thesis
+    using assms(2) sem_assume_low_exp(1) by blast
+qed
+
+lemma while_synchronized_case_2:
+  assumes "\<And>m. holds_forall b (iterate_sem m (Assume b;; C) S)"
+      and "\<And>n. \<Turnstile> {conj (I n) (holds_forall b)} Assume b;; C {conj (I (Suc n)) (low_exp b)}"
+      and "conj (I 0) (low_exp b) S"
+  shows "sem (while_cond b C) S = {}"
+proof -
+  have "sem (While (Assume b ;; C)) S = (\<Union>n. iterate_sem n (Assume b ;; C) S)"
+    by (simp add: sem_while)
+  then have "holds_forall b (sem (While (Assume b;; C)) S)"
+    by (metis (no_types, lifting) UN_iff assms(1) holds_forall_def)
+  then show ?thesis
+    by (simp add: sem_assume_low_exp(2) sem_seq while_cond_def)
+qed
+
+definition emp where
+  "emp S \<longleftrightarrow> S = {}"
+
+lemma holds_forall_empty:
+  "holds_forall b {}"
+  by (simp add: holds_forall_def)
+
+definition exists where
+  "exists I S \<longleftrightarrow> (\<exists>n. I n S)"
+
+theorem while_synchronized:
+  assumes "\<And>n. \<Turnstile> {conj (I n) (holds_forall b)} C {conj (I (Suc n)) (low_exp b)}"
+  shows "\<Turnstile> {conj (I 0) (low_exp b)} while_cond b C {conj (disj (exists I) emp) (holds_forall (lnot b))}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "conj (I 0) (low_exp b) S"
+  have triple: "\<And>n. \<Turnstile> {conj (I n) (holds_forall b)} Assume b ;; C {conj (I (Suc n)) (low_exp b)}"
+  proof (rule hyper_hoare_tripleI)
+    fix n S assume "conj (I n) (holds_forall b) S"
+    then have "sem (Assume b) S = S"
+      by (simp add: conj_def sem_assume_low_exp(1))
+    then show "conj (I (Suc n)) (low_exp b) (sem (Assume b ;; C) S)"
+      by (metis \<open>conj (I n) (holds_forall b) S\<close> assms hyper_hoare_tripleE sem_seq)
+  qed
+  show "conj (disj (exists I) emp) (holds_forall (lnot b)) (sem (while_cond b C) S)"
+  proof (cases "\<forall>m. holds_forall b (iterate_sem m (Assume b;; C) S)")
+    case True
+    then have "sem (while_cond b C) S = {}"
+      using while_synchronized_case_2[of b C S I]
+      by (metis (no_types, opaque_lifting) asm0 assms hyper_hoare_tripleI conj_def sem_assume_low_exp(1) seq_rule)
+    then show ?thesis
+      by (simp add: disj_def conj_def emp_def holds_forall_empty)
+  next
+    case False
+    then have F: "\<not> (\<forall>m. holds_forall b (iterate_sem m (Assume b;; C) S))" by simp
+    have "\<exists>n. (\<forall>m. m < n \<longrightarrow> holds_forall b (iterate_sem m (Assume b;; C) S)) \<and> holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+    proof (cases "\<exists>n. \<not> holds_forall b (iterate_sem n (Assume b;; C) S) \<and> iterate_sem n (Assume b;; C) S \<noteq> {}")
+      case True
+      then obtain n where "\<not> holds_forall b (iterate_sem n (Assume b;; C) S) \<and> iterate_sem n (Assume b;; C) S \<noteq> {}"
+        by blast
+      then have "holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+        by (metis asm0 conj_def low_exp_two_cases triple while_synchronized_rec)
+      moreover have "\<And>m. m < n \<Longrightarrow> holds_forall b (iterate_sem m (Assume b;; C) S)"
+      proof -
+        fix m assume asm1: "m < n"
+        show "holds_forall b (iterate_sem m (Assume b;; C) S)"
+        proof (rule ccontr)
+          assume "\<not> holds_forall b (iterate_sem m (Assume b ;; C) S)"
+          then have "holds_forall (lnot b) (iterate_sem m (Assume b;; C) S)"
+            by (metis asm0 conj_def low_exp_two_cases triple while_synchronized_rec)
+          then have "iterate_sem n (Assume b;; C) S = {}"
+            using asm1 false_then_empty_later by blast
+          then show False
+            using \<open>\<not> holds_forall b (iterate_sem n (Assume b ;; C) S) \<and> iterate_sem n (Assume b ;; C) S \<noteq> {}\<close> by fastforce
+        qed
+      qed
+      ultimately show ?thesis 
+        by blast
+    next
+      case False
+      then have "\<And>n. holds_forall b (iterate_sem n (Assume b;; C) S)"
+        using holds_forall_empty by fastforce
+      then show ?thesis using F by blast
+    qed
+    then obtain n where "\<And>m. m < n \<Longrightarrow> holds_forall b (iterate_sem m (Assume b;; C) S)"
+      and "holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+      by blast
+    then have "sem (while_cond b C) S = iterate_sem n (Assume b;; C) S"
+      using triple
+    proof (rule while_synchronized_case_1)
+    qed (simp_all add: asm0)
+    moreover have "I n (iterate_sem n (Assume b;; C) S)"
+    proof (cases n)
+      case 0
+      then show ?thesis
+        by (metis asm0 iterate_sem.simps(1) conj_def)
+    next
+      case (Suc k)
+      then have "conj (I k) (low_exp b) (iterate_sem k (Assume b ;; C) S) \<or> holds_forall (lnot b) (iterate_sem k (Assume b ;; C) S)"
+        using while_synchronized_rec[of I b C S k] asm0 triple by blast      
+      then show ?thesis
+      proof (cases "conj (I k) (low_exp b) (iterate_sem k (Assume b ;; C) S)")
+        case True
+        then show ?thesis
+          using conj_def[of _ "holds_forall b"] conj_def[of _ "low_exp b"] Suc
+            \<open>\<And>m. m < n \<Longrightarrow> holds_forall b (iterate_sem m (Assume b ;; C) S)\<close> assms
+            hyper_hoare_triple_def[of ] iterate_sem.simps(2) lessI sem_assume_low_exp(1)[of b "iterate_sem k (Assume b ;; C) S"]
+            sem_seq[of "Assume b" C] by metis
+      next
+        case False
+        then show ?thesis
+          by (metis F Suc \<open>\<And>m. m < n \<Longrightarrow> holds_forall b (iterate_sem m (Assume b ;; C) S)\<close> \<open>conj (I k) (low_exp b) (iterate_sem k (Assume b ;; C) S) \<or> holds_forall (lnot b) (iterate_sem k (Assume b ;; C) S)\<close> empty_iff false_then_empty_later holds_forall_def not_less_eq)
+      qed
+    qed
+    ultimately show ?thesis
+      by (metis disj_def Loops.exists_def \<open>holds_forall (lnot b) (iterate_sem n (Assume b ;; C) S)\<close> conj_def)
+  qed
+qed
+
+lemma WhileSync_simpler:
+  assumes "\<Turnstile> {conj I (holds_forall b)} C {conj I (low_exp b)}"
+  shows "\<Turnstile> {conj I (low_exp b)} while_cond b C {conj (disj I emp) (holds_forall (lnot b))}"
+  using assms while_synchronized[of "\<lambda>n. I"]
+  by (simp add: disj_def Loops.exists_def conj_def hyper_hoare_triple_def)
+
+definition if_then where
+  "if_then b C = If (Assume b;; C) (Assume (lnot b))"
+
+definition filter_exp where
+  "filter_exp b S = Set.filter (b \<circ> snd) S"
+
+lemma filter_exp_union:
+  "filter_exp b (S1 \<union> S2) = filter_exp b S1 \<union> filter_exp b S2" (is "?A = ?B")
+proof
+  show "?A \<subseteq> ?B"
+  proof
+    fix x assume "x \<in> ?A"
+    then show "x \<in> ?B"
+    proof (cases "x \<in> S1")
+      case True
+      then show ?thesis
+        by (metis UnI1 \<open>x \<in> filter_exp b (S1 \<union> S2)\<close> filter_exp_def member_filter)
+    next
+      case False
+      then show ?thesis
+        by (metis Un_iff \<open>x \<in> filter_exp b (S1 \<union> S2)\<close> filter_exp_def member_filter)
+    qed
+  qed
+  show "?B \<subseteq> ?A"
+    by (simp add: filter_exp_def subset_iff)
+qed
+
+lemma filter_exp_union_general:
+  "filter_exp b (\<Union>x. f x) = (\<Union>x. filter_exp b (f x))" (is "?A = ?B")
+proof
+  show "?A \<subseteq> ?B"
+  proof
+    fix y assume "y \<in> ?A"
+    then obtain x where "y \<in> f x"
+      by (metis UN_iff filter_exp_def member_filter)
+    then show "y \<in> ?B"
+      by (metis UN_iff \<open>y \<in> filter_exp b (\<Union> (range f))\<close> filter_exp_def member_filter)
+  qed
+  show "?B \<subseteq> ?A"
+    by (simp add: filter_exp_def subset_iff)
+qed
+
+lemma filter_exp_contradict:
+  "filter_exp b (filter_exp (lnot b) S) = {}"
+  by (metis (mono_tags, lifting) all_not_in_conv filter_exp_def lnot_def member_filter o_apply)
+
+lemma filter_exp_same:
+  "filter_exp b (filter_exp b S) = filter_exp b S" (is "?A = ?B")
+proof
+  show "?A \<subseteq> ?B"
+    by (metis filter_exp_def member_filter subsetI)
+  show "?B \<subseteq> ?A"
+    by (metis filter_exp_def member_filter subrelI)
+qed
+
+lemma if_then_sem:
+  "sem (if_then b C) S = sem C (filter_exp b S) \<union> filter_exp (lnot b) S"
+  by (simp add: assume_sem filter_exp_def if_then_def sem_if sem_seq)
+
+fun union_up_to_n where
+  "union_up_to_n C S 0 = iterate_sem 0 C S"
+| "union_up_to_n C S (Suc n) = iterate_sem (Suc n) C S \<union> union_up_to_n C S n"
+
+lemma union_up_to_increasing:
+  assumes "m \<le> n"
+  shows "union_up_to_n C S m \<subseteq> union_up_to_n C S n"
+  using assms
+proof (induct "n - m" arbitrary: m n)
+  case (Suc x)
+  then show ?case
+    by (simp add: lift_Suc_mono_le)
+qed (simp)
+
+lemma union_union_up_to_n_equiv_aux:
+  "union_up_to_n C S n \<subseteq> (\<Union>m. iterate_sem m C S)"
+proof (induct n)
+  case 0
+  then show ?case
+    by (metis UN_upper iso_tuple_UNIV_I union_up_to_n.simps(1))
+next
+  case (Suc n)
+  show ?case
+  proof
+    fix x assume "x \<in> union_up_to_n C S (Suc n)" (* \<subseteq> (\<Union>m. iterate_sem m C S) *)
+    then have "x \<in> iterate_sem (Suc n) C S \<or> x \<in> union_up_to_n C S n"
+      by simp
+    then show "x \<in> (\<Union>m. iterate_sem m C S)"
+      using Suc by blast
+  qed
+qed
+
+lemma union_union_up_to_n_equiv:
+  "(\<Union>n. union_up_to_n C S n) = (\<Union>n. iterate_sem n C S)" (is "?A = ?B")
+proof
+  show "?B \<subseteq> ?A"
+    by (metis (no_types, lifting) SUP_subset_mono UnCI subsetI union_up_to_n.elims)
+  show "?A \<subseteq> ?B"
+    by (simp add: SUP_le_iff union_union_up_to_n_equiv_aux)
+qed
+
+
+lemma filter_exp_union_itself:
+  "filter_exp b S \<union> S = S"
+  by (metis Un_absorb1 filter_exp_def member_filter subsetI)
+
+lemma iterate_sem_equiv:
+  "iterate_sem m (if_then b C) S
+  = filter_exp (lnot b) (union_up_to_n (Assume b;; C) S m) \<union> iterate_sem m (Assume b;; C) S"
+proof (induct m)
+  case 0
+  have "union_up_to_n (Assume b ;; C) S 0 = S"
+    by auto
+  then show "iterate_sem 0 (if_then b C) S = filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S 0) \<union> iterate_sem 0 (Assume b ;; C) S"
+    using filter_exp_def
+    by (metis Un_commute iterate_sem.simps(1) member_filter subset_iff sup.order_iff)
+next
+  case (Suc m)
+
+  let ?S = "iterate_sem m (if_then b C) S"
+  let ?SU = "union_up_to_n (Assume b ;; C) S m"
+  let ?SN = "iterate_sem m (Assume b ;; C) S"
+  have "iterate_sem (Suc m) (if_then b C) S = sem C (filter_exp b ?S) \<union> filter_exp (lnot b) ?S"
+    by (simp add: if_then_sem)
+  also have "... = sem C (filter_exp b (filter_exp (lnot b) ?SU)) \<union> sem C (filter_exp b ?SN)
+  \<union> filter_exp (lnot b) (filter_exp (lnot b) ?SU) \<union> filter_exp (lnot b) ?SN"
+    by (simp add: Suc filter_exp_union sem_union sup_assoc)
+  also have "... = sem C (filter_exp b ?SN) \<union> filter_exp (lnot b) ?SU \<union> filter_exp (lnot b) ?SN"
+    by (metis Un_empty_left filter_exp_contradict filter_exp_same sem_union)
+  moreover have "iterate_sem (Suc m) (Assume b ;; C) S = sem C (filter_exp b ?SN)"
+    by (simp add: assume_sem filter_exp_def sem_seq)
+  moreover have "union_up_to_n (Assume b ;; C) S (Suc m) = sem C (filter_exp b ?SN) \<union> ?SU"
+    using calculation(3) by force
+  moreover have "filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S (Suc m)) \<union> iterate_sem (Suc m) (Assume b ;; C) S
+  = filter_exp (lnot b) (sem C (filter_exp b ?SN) \<union> ?SU) \<union> sem C (filter_exp b ?SN)"
+    using calculation(3) by force
+  then have "... = filter_exp (lnot b) ?SU \<union> sem C (filter_exp b ?SN)"
+    using filter_exp_union_itself[of "lnot b"] filter_exp_union[of "lnot b"] Un_commute sup_assoc by blast
+  moreover have "?SN \<subseteq> ?SU"
+    by (metis UnCI subsetI union_up_to_n.elims)
+  ultimately have "filter_exp (lnot b) ?SU \<union> sem C (filter_exp b ?SN)
+  = sem C (filter_exp b ?SN) \<union> filter_exp (lnot b) ?SU \<union> filter_exp (lnot b) ?SN"
+    using filter_exp_union[of "lnot b" ?SU ?SN]
+    using Un_commute[of "filter_exp (lnot b) ?SU" "sem C (filter_exp b ?SN)"]
+      sup.orderE sup_assoc[of "sem C (filter_exp b ?SN)"] by metis
+  then show ?case
+    using \<open>filter_exp (lnot b) (sem C (filter_exp b (iterate_sem m (Assume b ;; C) S)) \<union> union_up_to_n (Assume b ;; C) S m) \<union> sem C (filter_exp b (iterate_sem m (Assume b ;; C) S)) = filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S m) \<union> sem C (filter_exp b (iterate_sem m (Assume b ;; C) S))\<close> \<open>iterate_sem (Suc m) (Assume b ;; C) S = sem C (filter_exp b (iterate_sem m (Assume b ;; C) S))\<close> \<open>iterate_sem (Suc m) (if_then b C) S = sem C (filter_exp b (iterate_sem m (if_then b C) S)) \<union> filter_exp (lnot b) (iterate_sem m (if_then b C) S)\<close> \<open>sem C (filter_exp b (filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S m))) \<union> sem C (filter_exp b (iterate_sem m (Assume b ;; C) S)) \<union> filter_exp (lnot b) (filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S m)) \<union> filter_exp (lnot b) (iterate_sem m (Assume b ;; C) S) = sem C (filter_exp b (iterate_sem m (Assume b ;; C) S)) \<union> filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S m) \<union> filter_exp (lnot b) (iterate_sem m (Assume b ;; C) S)\<close> \<open>sem C (filter_exp b (iterate_sem m (if_then b C) S)) \<union> filter_exp (lnot b) (iterate_sem m (if_then b C) S) = sem C (filter_exp b (filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S m))) \<union> sem C (filter_exp b (iterate_sem m (Assume b ;; C) S)) \<union> filter_exp (lnot b) (filter_exp (lnot b) (union_up_to_n (Assume b ;; C) S m)) \<union> filter_exp (lnot b) (iterate_sem m (Assume b ;; C) S)\<close> by auto
+qed
+
+
+lemma sem_while_with_if:
+  "sem (while_cond b C) S = filter_exp (lnot b) (\<Union>n. iterate_sem n (if_then b C) S)"
+proof -
+  have "(\<Union>n. iterate_sem n (if_then b C) S)
+  = (\<Union>n. filter_exp (lnot b) (union_up_to_n (Assume b;; C) S n) \<union> iterate_sem n (Assume b;; C) S)"
+    by (simp add: iterate_sem_equiv)
+  also have "... = filter_exp (lnot b) (\<Union>n. union_up_to_n (Assume b;; C) S n) \<union> (\<Union>n. iterate_sem n (Assume b;; C) S)"
+    by (simp add: complete_lattice_class.SUP_sup_distrib filter_exp_union_general)
+  also have "... = filter_exp (lnot b) (\<Union>n. iterate_sem n (Assume b;; C) S) \<union> (\<Union>n. iterate_sem n (Assume b;; C) S)"
+    by (simp add: union_union_up_to_n_equiv)
+  also have "... = (\<Union>n. iterate_sem n (Assume b;; C) S)"
+    by (meson filter_exp_union_itself)
+  moreover have "sem (while_cond b C) S = filter_exp (lnot b) (\<Union>n. iterate_sem n (Assume b ;; C) S)"
+    by (simp add: assume_sem filter_exp_def sem_seq sem_while while_cond_def)
+  ultimately show ?thesis
+    by presburger
+qed
+
+lemma iterate_sem_assume_increasing:
+  "filter_exp (lnot b) (iterate_sem n (if_then b C) S) \<subseteq> filter_exp (lnot b) (iterate_sem (Suc n) (if_then b C) S)"
+  by (metis (no_types, lifting) UnCI filter_exp_def if_then_sem iterate_sem.simps(2) member_filter subsetI)
+
+lemma iterate_sem_assume_increasing_union_up_to:
+  "filter_exp (lnot b) (iterate_sem n (if_then b C) S) = filter_exp (lnot b) (union_up_to_n (if_then b C) S n)"
+proof (induct n)
+  case (Suc n)
+  then show ?case
+    by (metis filter_exp_union iterate_sem_assume_increasing sup.orderE union_up_to_n.simps(2))
+qed (simp)
+
+(* Set becomes larger *)
+definition ascending :: "(nat \<Rightarrow> 'b set) \<Rightarrow> bool" where
+  "ascending S \<longleftrightarrow> (\<forall>n m. n \<le> m \<longrightarrow> S n \<subseteq> S m)"
+
+lemma ascendingI_direct:
+  assumes "\<And>n m. n \<le> m \<Longrightarrow> S n \<subseteq> S m"
+  shows "ascending S"
+  by (simp add: ascending_def assms)
+
+lemma ascendingI:
+  assumes "\<And>n. S n \<subseteq> S (Suc n)"
+  shows "ascending S"
+proof (rule ascendingI_direct)
+  fix n m :: nat assume asm0: "n \<le> m"
+  moreover have "n \<le> m \<Longrightarrow> S n \<subseteq> S m"
+  proof (induct "m - n" arbitrary: m n)
+    case (Suc x)
+    then show ?case
+      using assms lift_Suc_mono_le by blast
+  qed (simp)
+  ultimately show "S n \<subseteq> S m" 
+    by blast
+qed
+
+
+
+definition upwards_closed where
+  "upwards_closed P P_inf \<longleftrightarrow> (\<forall>S. ascending S \<and> (\<forall>n. P n (S n)) \<longrightarrow> P_inf (\<Union>n. S n))"
+
+lemma upwards_closedI:
+  assumes "\<And>S. ascending S \<Longrightarrow> (\<forall>n. P n (S n)) \<Longrightarrow> P_inf (\<Union>n. S n)"
+  shows "upwards_closed P P_inf"
+  using assms upwards_closed_def by blast
+
+lemma upwards_closedE:
+  assumes "upwards_closed P P_inf"
+      and "ascending S"
+      and "\<And>n. P n (S n)"
+    shows "P_inf (\<Union>n. S n)"
+  using assms(1) assms(2) assms(3) upwards_closed_def by blast
+
+lemma ascending_iterate_filter:
+  "ascending (\<lambda>n. filter_exp (lnot b) (union_up_to_n (if_then b C) S n))"
+  by (metis ascendingI iterate_sem_assume_increasing iterate_sem_assume_increasing_union_up_to)
+
+
+theorem while_general:
+  assumes "\<And>n. \<Turnstile> {P n} if_then b C {P (Suc n)}"
+      and "\<And>n. \<Turnstile> {P n} Assume (lnot b) {Q n}"
+      and "upwards_closed Q Q_inf"
+    shows "\<Turnstile> {P 0} while_cond b C {conj Q_inf (holds_forall (lnot b))}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "P 0 S"
+  then have "\<And>n. P n (iterate_sem n (if_then b C) S)"
+    by (meson assms(1) indexed_invariant_then_power)
+  then have "\<And>n. Q n (filter_exp (lnot b) (union_up_to_n (if_then b C) S n))"
+    by (metis assms(2) assume_sem filter_exp_def hyper_hoare_triple_def iterate_sem_assume_increasing_union_up_to)
+  moreover have "ascending (\<lambda>n. filter_exp (lnot b) (union_up_to_n (if_then b C) S n))"
+    by (simp add: ascending_iterate_filter)
+  ultimately have "Q_inf (sem (while_cond b C) S)"
+    by (metis (no_types, lifting) SUP_cong assms(3) filter_exp_union_general iterate_sem_assume_increasing_union_up_to sem_while_with_if upwards_closed_def)
+  then show "Logic.conj Q_inf (holds_forall (lnot b)) (sem (while_cond b C) S)"
+    by (simp add: conj_def filter_exp_def holds_forall_def sem_while_with_if)
+qed
+
+definition while_loop_assertion_n where
+  "while_loop_assertion_n C S0 n S \<longleftrightarrow> (S = union_up_to_n C S0 n)"
+
+definition while_loop_assertion_inf where
+  "while_loop_assertion_inf C S0 S \<longleftrightarrow> (S = (\<Union>n. union_up_to_n C S0 n))"
+
+(* Probably could have completeness with this? *)
+lemma while_loop_assertion_upwards_closed:
+  "upwards_closed (while_loop_assertion_n C S0) (while_loop_assertion_inf C S0)"
+proof (rule upwards_closedI)
+  fix S assume asm0: "ascending S" "\<forall>n. while_loop_assertion_n C S0 n (S n)"
+  then have "\<And>n. S n = union_up_to_n C S0 n"
+    by (simp add: while_loop_assertion_n_def)
+  then have "\<Union> (range S) = (\<Union>n. union_up_to_n C S0 n)"
+    by auto
+  then show "while_loop_assertion_inf C S0 (\<Union> (range S))"
+    by (simp add: while_loop_assertion_inf_def)
+qed
+
+(* Each element is either always in the sets, or never in the sets, from some point *)
+definition converges_sets where
+  "converges_sets S \<longleftrightarrow> (\<forall>x. \<exists>n. (\<forall>m. m \<ge> n \<longrightarrow> (x \<in> S m)) \<or> (\<forall>m. m \<ge> n \<longrightarrow> (x \<notin> S m)))"
+
+lemma converges_setsI:
+  assumes "\<And>x. \<exists>n. (\<forall>m. m \<ge> n \<longrightarrow> (x \<in> S m)) \<or> (\<forall>m. m \<ge> n \<longrightarrow> (x \<notin> S m))"
+  shows "converges_sets S"
+  by (simp add: assms converges_sets_def)
+
+lemma ascending_converges:
+  assumes "ascending S"
+  shows "converges_sets S"
+proof (rule converges_setsI)
+  fix x
+  show "\<exists>n. (\<forall>m\<ge>n. x \<in> S m) \<or> (\<forall>m\<ge>n. x \<notin> S m)"
+  proof (cases "x \<in> (\<Union>n. S n)")
+    case True
+    then show ?thesis
+      by (meson ascending_def assms in_mono)
+  qed (blast)
+qed
+
+(* Set becomes smaller *)
+definition descending :: "(nat \<Rightarrow> 'b set) \<Rightarrow> bool" where
+  "descending S \<longleftrightarrow> (\<forall>n m. n \<ge> m \<longrightarrow> S n \<subseteq> S m)"
+
+lemma descending_converges:
+  assumes "descending S"
+  shows "converges_sets S"
+proof (rule converges_setsI)
+  fix x
+  show "\<exists>n. (\<forall>m\<ge>n. x \<in> S m) \<or> (\<forall>m\<ge>n. x \<notin> S m)"
+  proof (cases "x \<in> (\<Inter>n. S n)")
+    case False
+    then show ?thesis
+      by (meson assms descending_def in_mono)
+  qed (blast)
+qed
+
+
+definition limit_sets where
+  "limit_sets S = {x |x. \<exists>n. \<forall>m. m \<ge> n \<longrightarrow> (x \<in> S m)}"
+
+lemma in_limit_sets:
+  "x \<in> limit_sets S \<longleftrightarrow> (\<exists>n. \<forall>m. m \<ge> n \<longrightarrow> (x \<in> S m))"
+  by (simp add: limit_sets_def)
+
+lemma ascending_limits_union:
+  assumes "ascending S"
+  shows "limit_sets S = (\<Union>n. S n)" (is "?A = ?B")
+proof
+  show "?A \<subseteq> ?B" using limit_sets_def[of S] by auto
+  show "?B \<subseteq> ?A"
+  proof
+    fix x assume "x \<in> ?B"
+    then obtain n where "x \<in> S n"
+      by blast
+    then have "\<forall>m. m \<ge> n \<longrightarrow> (x \<in> S m)"
+      by (meson ascending_def assms subsetD)
+    then show "x \<in> ?A"
+      using limit_sets_def[of S] by auto
+  qed
+qed
+
+lemma descending_limits_union:
+  assumes "descending S"
+  shows "limit_sets S = (\<Inter>n. S n)" (is "?A = ?B")
+proof
+  show "?B \<subseteq> ?A" using limit_sets_def[of S] by fastforce
+  show "?A \<subseteq> ?B"
+  proof
+    fix x assume "x \<in> ?A"
+    then obtain n where "\<forall>m. m \<ge> n \<longrightarrow> (x \<in> S m)"
+      using limit_sets_def[of S] by blast
+    then have "\<forall>m. m < n \<longrightarrow> (x \<in> S m)"
+      by (meson assms descending_def lessI less_imp_le_nat subsetD)
+    then show "x \<in> ?B"
+      by (meson INT_I \<open>\<forall>m\<ge>n. x \<in> S m\<close> linorder_not_le)
+  qed
+qed
+
+
+
+definition t_closed where
+  "t_closed P P_inf \<longleftrightarrow> (\<forall>S. converges_sets S \<and> (\<forall>n. P n (S n)) \<longrightarrow> P_inf (limit_sets S))"
+
+lemma t_closed_implies_u_closed:
+  assumes "t_closed P P_inf"
+  shows "upwards_closed P P_inf"
+proof (rule upwards_closedI)
+  fix S assume "ascending S" "\<forall>n. P n (S n)"
+  then have "converges_sets S"
+    using ascending_converges by blast
+  then show "P_inf (\<Union> (range S))"
+    by (metis \<open>\<forall>n. P n (S n)\<close> \<open>ascending S\<close> ascending_limits_union assms t_closed_def)
+qed
+
+(* forall assertions *)
+definition downwards_closed where
+  "downwards_closed P_inf \<longleftrightarrow> (\<forall>S S'. S \<subseteq> S' \<and> P_inf S' \<longrightarrow> P_inf S)"
+
+(* Slight change compared to Ellora paper *)
+definition d_closed where
+  "d_closed P P_inf \<longleftrightarrow> t_closed P P_inf \<and> downwards_closed P_inf"
+
+lemma converges_to_merged:
+  assumes "\<And>x. x \<in> S_inf \<Longrightarrow> \<exists>n. \<forall>m. m \<ge> n \<longrightarrow> (x \<in> S (m::nat))"
+      and "\<And>x. x \<notin> S_inf \<Longrightarrow> \<exists>n. \<forall>m. m \<ge> n \<longrightarrow> (x \<notin> S m)"
+    shows "converges_sets S \<and> limit_sets S = S_inf"
+proof (rule conjI)
+  show "converges_sets S" using converges_setsI assms by metis
+  show "limit_sets S = S_inf" (is "?A = ?B")
+  proof
+    show "?B \<subseteq> ?A"
+      by (simp add: assms(1) limit_sets_def subsetI)
+    show "?A \<subseteq> ?B"
+    proof
+      fix x assume "x \<in> ?A"
+      then obtain n where n_def: "\<forall>m. m \<ge> n \<longrightarrow> (x \<in> S m)"
+        using in_limit_sets by metis
+      show "x \<in> ?B"
+      proof (rule ccontr)
+        assume "x \<notin> S_inf"
+        then obtain n' where "\<forall>m. m \<ge> n' \<longrightarrow> (x \<notin> S m)"
+          using assms(2) by presburger
+        then have "x \<in> S (max n n') \<and> x \<notin> S (max n n')"
+          using n_def by fastforce
+        then show False by blast
+      qed
+    qed
+  qed
+qed
+
+lemma ascending_union_up:
+  "ascending (\<lambda>n. union_up_to_n C S n)"
+  by (simp add: ascending_def union_up_to_increasing)
+
+(* actually ascending... *)
+lemma converges_union:
+  "converges_sets (\<lambda>n. union_up_to_n C S n) \<and> limit_sets (\<lambda>n. union_up_to_n C S n) = (\<Union>n. union_up_to_n C S n)"
+proof (rule converges_to_merged)
+  fix x
+  show "x \<in> \<Union> (range (union_up_to_n C S)) \<Longrightarrow> \<exists>n. \<forall>m\<ge>n. x \<in> union_up_to_n C S m"
+    by (meson UN_iff subset_eq union_up_to_increasing)
+  show "x \<notin> \<Union> (range (union_up_to_n C S)) \<Longrightarrow> \<exists>n. \<forall>m\<ge>n. x \<notin> union_up_to_n C S m"
+    by blast
+qed
+
+
+theorem while_d:
+  assumes "\<And>n. \<Turnstile> {P n} if_then b C {P (Suc n)}"
+      and "upwards_closed P P_inf"
+      and "\<And>n. downwards_closed (P n)" \<comment>\<open>Satisfied by hyper-assertions that do not existentially quantify over states\<close>
+    shows "\<Turnstile> {P 0} while_cond b C {conj P_inf (holds_forall (lnot b))}"
+  using assms(1)
+proof (rule while_general)
+  show "upwards_closed P P_inf"
+    using assms(2) by blast
+  fix n show "\<Turnstile> {P n} Assume (lnot b) {P n}"
+  proof (rule hyper_hoare_tripleI)
+    fix S assume "P n S"
+    moreover have "sem (Assume (lnot b)) S \<subseteq> S"
+      by (metis assume_sem member_filter subsetI)
+    ultimately show "P n (sem (Assume (lnot b)) S)"
+      by (meson assms(3) downwards_closed_def)
+  qed
+qed
+
+
+
+lemma in_union_up_to:
+  "x \<in> union_up_to_n C S n \<longleftrightarrow> (\<exists>m. m \<le> n \<and> x \<in> iterate_sem m C S)"
+proof (induct n)
+  case (Suc n)
+  then show ?case
+    by (metis UnCI UnE le_SucE le_SucI order_refl union_up_to_n.simps(2))
+qed (simp)
+
+
+theorem rule_while_terminates_strong:
+  assumes "\<And>n. n < m \<Longrightarrow> \<Turnstile> {P n} if_then b C {P (Suc n)}"
+      and "\<And>S. P m S \<longrightarrow> holds_forall (lnot b) S"
+  shows "\<Turnstile> {P 0} while_cond b C {P m}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "P 0 S"
+  let ?S = "iterate_sem m (if_then b C) S"
+  let ?S' = "iterate_sem (Suc m) (if_then b C) S"
+  have "P m ?S"
+    using asm0 assms(1) indexed_invariant_then_power_bounded by blast
+  then have "holds_forall (lnot b) ?S"    
+    using assms(2) by auto
+  moreover have "sem (while_cond b C) S = filter_exp (lnot b) (\<Union>n. iterate_sem n (Assume b ;; C) S)"
+    by (simp add: assume_sem filter_exp_def sem_seq sem_while while_cond_def)
+
+
+(* this is constant *)
+  then have "P m (filter_exp (lnot b) (union_up_to_n (Assume b;; C) S m) \<union> iterate_sem m (Assume b;; C) S)"
+    by (metis \<open>P m (iterate_sem m (if_then b C) S)\<close> iterate_sem_equiv)
+
+  moreover have "iterate_sem m (Assume b;; C) S \<subseteq> filter_exp (lnot b) (union_up_to_n (Assume b;; C) S m)"
+  proof
+    fix x assume "x \<in> iterate_sem m (Assume b;; C) S"
+    then have "x \<in> union_up_to_n (Assume b;; C) S m"
+      by (metis UnCI union_up_to_n.elims)
+    then have "x \<in> ?S"
+      by (simp add: \<open>x \<in> iterate_sem m (Assume b ;; C) S\<close> iterate_sem_equiv)
+    then have "lnot b (snd x)"
+      by (metis calculation(1) holds_forall_def)
+    then show "x \<in> filter_exp (lnot b) (union_up_to_n (Assume b;; C) S m)"
+      using \<open>x \<in> union_up_to_n (Assume b;; C) S m\<close> filter_exp_def
+      by force
+  qed
+  moreover have "filter_exp (lnot b) (\<Union>n. iterate_sem n (Assume b ;; C) S)
+  = filter_exp (lnot b) (union_up_to_n (Assume b;; C) S m)"
+  proof -
+    have "\<And>n. n > m \<Longrightarrow> iterate_sem n (Assume b ;; C) S = {}"
+    proof -
+      fix n show "n > m \<Longrightarrow> iterate_sem n (Assume b ;; C) S = {}"
+      proof (induct "n - m - 1")
+        case 0
+        then show ?case
+          by (metis (no_types, lifting) UnCI calculation(1) false_then_empty_later holds_forall_def iterate_sem_equiv)
+      next
+        case (Suc x)
+        then show ?case
+          by (metis (no_types, lifting) UnCI calculation(1) false_then_empty_later holds_forall_def iterate_sem_equiv)
+      qed
+    qed
+    moreover have "union_up_to_n (Assume b;; C) S m = (\<Union>n. union_up_to_n (Assume b;; C) S n)" (is "?A = ?B")
+    proof
+      show "?B \<subseteq> ?A"
+      proof
+        fix x assume "x \<in> ?B"
+        then obtain n where "x \<in> union_up_to_n (Assume b;; C) S n"
+          by blast
+        then show "x \<in> ?A"
+          by (metis calculation empty_iff in_union_up_to linorder_not_le)
+      qed
+    qed (blast)
+    then have "(\<Union>n. iterate_sem n (Assume b ;; C) S) = union_up_to_n (Assume b;; C) S m"
+      by (simp add: union_union_up_to_n_equiv)
+    then show ?thesis
+      by auto
+  qed
+  ultimately show "P m (sem (while_cond b C) S)"
+    by (simp add: \<open>sem (while_cond b C) S = filter_exp (lnot b) (\<Union>n. iterate_sem n (Assume b ;; C) S)\<close> sup.absorb1)
+qed
+
+
+lemma false_state_in_if_then:
+  assumes "\<phi> \<in> S"
+      and "\<not> b (snd \<phi>)"
+    shows "\<phi> \<in> sem (if_then b C) S"
+proof -
+  have "\<phi> \<in> sem (Assume (lnot b)) S"
+    by (metis SemAssume assms(1) assms(2) in_sem lnot_def prod.collapse)
+  then show ?thesis
+    by (simp add: assume_sem filter_exp_def if_then_sem)
+qed
+
+lemma false_state_in_while_cond_aux:
+  assumes "\<phi> \<in> S"
+      and "\<not> b (snd \<phi>)"
+    shows "\<phi> \<in> iterate_sem n (if_then b C) S"
+proof (induct n)
+  case 0
+  then show ?case
+    by (simp add: assms(1))
+next
+  case (Suc n)
+  then show ?case
+    by (simp add: assms(2) false_state_in_if_then)
+qed
+
+lemma false_state_in_while_cond:
+  assumes "\<phi> \<in> S"
+      and "\<not> b (snd \<phi>)"
+    shows "\<phi> \<in> sem (while_cond b C) S"
+proof -
+  have "\<phi> \<in> (\<Union>n. iterate_sem n (if_then b C) S)"
+    by (simp add: assms(1) assms(2) false_state_in_while_cond_aux)
+  then show ?thesis using sem_while_with_if[of b C S] filter_exp_def lnot_def
+    by (metis assms(2) comp_apply member_filter)
+qed
+
+theorem while_exists:
+  assumes "\<And>\<phi>. \<Turnstile> { P \<phi> } while_cond b C { Q \<phi> }"
+  shows "\<Turnstile> { (\<lambda>S. \<exists>\<phi> \<in> S. \<not> b (snd \<phi>) \<and> P \<phi> S) } while_cond b C { (\<lambda>S. \<exists>\<phi> \<in> S. Q \<phi> S) }"
+proof (rule hyper_hoare_tripleI)
+  fix S assume "\<exists>\<phi>\<in>S. \<not> b (snd \<phi>) \<and> P \<phi> S"
+  then obtain \<phi> where asm0: "\<phi>\<in>S" "\<not> b (snd \<phi>) \<and> P \<phi> S" by blast
+  then have "Q \<phi> (sem (while_cond b C) S)"
+    using assms hyper_hoare_tripleE by blast
+  then show "\<exists>\<phi>\<in>sem (while_cond b C) S. Q \<phi> (sem (while_cond b C) S)"
+    using asm0(1) asm0(2) false_state_in_while_cond by blast
+qed
+
+lemma sem_while_cond_union_up_to:
+  "sem (while_cond b C) S = filter_exp (lnot b) (\<Union>n. union_up_to_n (if_then b C) S n)"
+  by (simp add: sem_while_with_if union_union_up_to_n_equiv)
+
+lemma iterate_sem_sum:
+  "iterate_sem n C (iterate_sem m C S) = iterate_sem (n + m) C S"
+  by (induct n) simp_all
+
+
+lemma unroll_while_sem:
+  "sem (while_cond b C) (iterate_sem n (if_then b C) S) = sem (while_cond b C) S"
+proof -
+  let ?S = "iterate_sem n (if_then b C) S"
+  have "filter_exp (lnot b) (\<Union>m. iterate_sem m (if_then b C) S) = filter_exp (lnot b) (\<Union>m. iterate_sem (n + m) (if_then b C) S)" (is "?A = ?B")
+  proof
+    show "?A \<subseteq> ?B"
+    proof
+      fix x assume "x \<in> ?A"
+      then obtain m where "x \<in> iterate_sem m (if_then b C) S" "\<not> b (snd x)"
+        using filter_exp_def lnot_def
+        by (metis (no_types, lifting) UN_iff comp_apply member_filter)
+      then have "x \<in> iterate_sem (n + m) (if_then b C) S"
+        using false_state_in_while_cond_aux[of x "iterate_sem m (if_then b C) S" b n C] iterate_sem_sum[of n "if_then b C" m S]
+        by blast
+      then have "x \<in> (\<Union>m. iterate_sem (n + m) (if_then b C) S)"
+        by blast
+      then show "x \<in> ?B"
+        by (metis \<open>x \<in> filter_exp (lnot b) (\<Union>m. iterate_sem m (if_then b C) S)\<close> filter_exp_def member_filter)
+    qed
+    show "?B \<subseteq> ?A"
+    proof
+      fix x assume "x \<in> ?B"
+      then obtain m where "x \<in> iterate_sem (n + m) (if_then b C) S" "\<not> b (snd x)"
+        by (metis (no_types, lifting) UN_iff comp_apply filter_exp_def lnot_def member_filter)
+      then show "x \<in> ?A"
+        by (metis (no_types, lifting) UNIV_I UN_iff \<open>x \<in> filter_exp (lnot b) (\<Union>m. iterate_sem (n + m) (if_then b C) S)\<close> filter_exp_def member_filter)
+    qed
+  qed
+  then show ?thesis
+    using iterate_sem_sum[of _ "if_then b C" n S] sem_while_with_if[of b C S] sem_while_with_if[of b C ?S]
+    by (simp add: add.commute)
+qed
+
+
+theorem while_unroll:
+  assumes "\<And>n. n < m \<Longrightarrow> \<Turnstile> {P n} if_then b C {P (Suc n)}"
+      and "\<Turnstile> {P m} while_cond b C {Q}"
+    shows "\<Turnstile> {P 0} while_cond b C {Q}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume "P 0 S"
+  let ?S = "iterate_sem m (if_then b C) S"
+  have "(\<forall>n. n < m \<longrightarrow> (\<Turnstile> {P n} if_then b C {P (Suc n)})) \<longrightarrow> P m ?S"
+  proof (induct m)
+    case 0
+    then show ?case
+      by (simp add: \<open>P 0 S\<close>)
+  next
+    case (Suc m)
+    then show ?case
+      by (simp add: hyper_hoare_triple_def)
+  qed
+  then have "P m ?S" using assms(1)
+    by blast
+  then have "Q (sem (while_cond b C) ?S)"
+    using assms(2) hyper_hoare_tripleE by blast
+  then show "Q (sem (while_cond b C) S)"
+    by (metis unroll_while_sem)
+qed
+
+
+
+
+
+
+
+
+text \<open>Deriving LoopExit from NormalWhile, and ForLoop from LoopExit and Unroll\<close>
+
+lemma while_desugared_easy:
+  assumes "\<And>n. \<Turnstile> {I n} Assume b;; C {I (Suc n)}"
+      and "\<Turnstile> { natural_partition I } Assume (lnot b) { Q }"
+    shows "\<Turnstile> {I 0} while_cond b C { Q }"
+  by (metis assms(1) assms(2) seq_rule while_cond_def while_rule)
+
+
+corollary loop_exit:
+  assumes "entails P (holds_forall (lnot b))"
+  shows "\<Turnstile> {P} while_cond b C {P}"
+proof -
+  have "\<Turnstile> {(if (0::nat) = 0 then P else emp)} while_cond b C {P}"
+  proof (rule while_desugared_easy[of "\<lambda>(n::nat). if n = 0 then P else emp" b C P])
+    show "\<Turnstile> {natural_partition (\<lambda>(n::nat). if n = 0 then P else emp)} Assume (lnot b) {P}"
+    proof (rule hyper_hoare_tripleI)
+      fix S assume asm0: "natural_partition (\<lambda>(n::nat). if n = 0 then P else emp) S"
+      then obtain F where "S = (\<Union>(n::nat). F n)" "\<And>(n::nat). (\<lambda>(n::nat). if n = 0 then P else emp) n (F n)"
+        using natural_partitionE by blast
+      then have "\<And>n. F (Suc n) = {}"
+        by (metis (mono_tags, lifting) emp_def old.nat.distinct(2))
+      moreover have "S = F 0"
+      proof
+        show "S \<subseteq> F 0"
+        proof
+          fix x assume "x \<in> S"
+          then obtain n where "x \<in> F n"
+            using \<open>S = \<Union> (range F)\<close> by blast
+          then show "x \<in> F 0"
+            by (metis calculation empty_iff gr0_implies_Suc zero_less_iff_neq_zero)
+        qed
+        show "F 0 \<subseteq> S"
+          using \<open>S = \<Union> (range F)\<close> by blast
+      qed
+      ultimately have "P S"
+        using \<open>\<And>n. (if n = 0 then P else emp) (F n)\<close> by presburger
+      then show "P (sem (Assume (lnot b)) S)"
+        by (metis assms entailsE sem_assume_low_exp(1))
+    qed
+    fix n :: nat
+    show "\<Turnstile> {(if n = 0 then P else emp)} Assume b ;; C {if Suc n = 0 then P else emp}"
+    proof (rule hyper_hoare_tripleI)
+      fix S assume asm0: "(if n = 0 then P else emp) S"
+      then show "(if Suc n = 0 then P else emp) (sem (Assume b ;; C) S)"
+        by (metis (mono_tags, lifting) assms emp_def entailsE holds_forall_empty lnot_involution nat.distinct(1) sem_assume_low_exp_seq(2))
+    qed
+  qed
+  then show ?thesis
+    by fastforce
+qed
+
+corollary for_loop:
+  assumes "\<And>n. n < m \<Longrightarrow> \<Turnstile> {P n} if_then b C {P (Suc n)}"
+      and "entails (P m) (holds_forall (lnot b))"
+    shows "\<Turnstile> {P 0} while_cond b C {P m}"
+  using assms(1)
+proof (rule while_unroll)
+  show "\<Turnstile> {P m} while_cond b C {P m}"
+    using assms(2) loop_exit by blast
+qed
+
+
+end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/PaperResults.thy b/thys/HyperHoareLogic/PaperResults.thy
new file mode 100644
--- /dev/null
+++ b/thys/HyperHoareLogic/PaperResults.thy
@@ -0,0 +1,540 @@
+theory PaperResults
+  imports Loops SyntacticAssertions Compositionality TotalLogic ExamplesCompositionality
+begin
+
+section \<open>Summary of the Results from the Paper\<close>
+
+text \<open>This file contains the formal results mentioned the paper. It is organized in the same order
+and with the same structure as the paper.
+\<^item> You can use the panel "Sidekick" on the right to see and navigate the structure of the file, via sections and subsections.
+\<^item> You can ctrl+click on terms to jump to their definition.
+\<^item> After jumping to another location, you can come back to the previous location by clicking the
+  green left arrow, on the right side of the menu above.\<close>
+
+
+
+subsection \<open>3: Hyper Hoare Logic\<close>
+
+subsubsection \<open>3.1: Language and Semantics\<close>
+
+text \<open>The programming language is defined in the file Language.thy:
+\<^item> The type of program state (definition 1) is \<^typ>\<open>('pvar, 'pval) pstate\<close>
+  (<-- you can ctrl+click on the name \<open>pstate\<close> above to jump to its definition).
+\<^item> Program commands (definition 1) are defined via the type \<^typ>\<open>('var, 'val) stmt\<close>.
+\<^item> The big-step semantics (figure 9) is defined as \<^const>\<open>single_sem\<close>. We also use the notation \<^term>\<open>\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'\<close>.\<close>
+
+subsubsection \<open>3.2: Hyper-Triples, Formally\<close>
+
+text \<open>
+\<^item> Extended states (definition 2) are defined as \<^typ>\<open>('lvar, 'lval, 'pvar, 'pval) state\<close> (file Language.thy).
+\<^item> Hyper-assertions (definition 3) are defined as \<^typ>\<open>('lvar, 'lval, 'pvar, 'pval) state hyperassertion\<close> (file Logic.thy).
+\<^item> The extended semantics (definition 4) is defined as \<^const>\<open>sem\<close>  (file Language.thy).
+\<^item> Lemma 1 is shown and proven below.
+\<^item> Hyper-triples (definition 5) are defined as \<^const>\<open>hyper_hoare_triple\<close> (file Logic.thy).
+  We also use the notation \<^term>\<open>\<Turnstile> {P} C {Q}\<close>.\<close>
+
+lemma lemma1:
+  "sem C (S1 \<union> S2) = sem C S1 \<union> sem C S2"
+  "S \<subseteq> S' \<Longrightarrow> sem C S \<subseteq> sem C S'"
+  "sem C (\<Union>x. f x) = (\<Union>x. sem C (f x))"
+  "sem Skip S = S"
+  "sem (C1;; C2) S = sem C2 (sem C1 S)"
+  "sem (If C1 C2) S = sem C1 S \<union> sem C2 S"
+  "sem (While C) S = (\<Union>n. iterate_sem n C S)"
+  using sem_if sem_seq sem_union sem_skip sem_union_general sem_monotonic sem_while by metis+
+
+subsubsection \<open>3.3: Core Rules\<close>
+
+text \<open>The core rules (from figure 2) are defined in the file Logic.thy as \<^const>\<open>syntactic_HHT\<close>.
+We also use the notation \<^term>\<open>\<turnstile> {P} C {Q}\<close>. Operators \<open>\<otimes>\<close> (definition 6) and \<open>\<Otimes>\<close> (definition 7)
+are defined as \<^const>\<open>join\<close> and \<^const>\<open>natural_partition\<close>, respectively.\<close>
+
+subsubsection \<open>3.4: Soundness and Completeness\<close>
+
+text \<open>Theorem 1: Soundness\<close>
+theorem thm1_soundness:
+  assumes "\<turnstile> {P} C {Q}"
+  shows "\<Turnstile> {P} C {Q}"
+  using assms soundness by auto
+
+text \<open>Theorem 2: Completeness\<close>
+theorem thm2_completeness:
+  assumes "\<Turnstile> {P} C {Q}"
+  shows "\<turnstile> {P} C {Q}"
+  using assms completeness by auto
+
+subsubsection \<open>3.5: Expressivity of Hyper-Triples\<close>
+
+text \<open>Program hyperproperties (definition 8) are defined in the file ProgramHyperproperties as
+the type \<^typ>\<open>('pvar, 'pval) program_hyperproperty\<close>, which is syntactic sugar for the type
+\<^typ>\<open>(('pvar, 'pval) pstate \<times> ('pvar, 'pval) pstate) set \<Rightarrow> bool\<close>. As written in the paper (after the definition),
+this type is equivalent to the type \<^typ>\<open>((('pvar, 'pval) pstate \<times> ('pvar, 'pval) pstate) set) set\<close>.
+The satisfiability of program hyperproperties is defined via the function \<^const>\<open>hypersat\<close>.\<close>
+
+text \<open>Theorem 3: Expressing hyperproperties as hyper-triples\<close>
+theorem thm3_expressing_hyperproperties_as_hyper_triples:
+  fixes to_lvar :: "'pvar \<Rightarrow> 'lvar"
+  fixes to_lval :: "'pval \<Rightarrow> 'lval"
+  fixes H :: "('pvar, 'pval) program_hyperproperty"
+  assumes "injective to_lvar" \<comment>\<open>The cardinality of \<^typ>\<open>'lvar\<close> is at least the cardinality of \<^typ>\<open>'pvar\<close>.\<close>
+      and "injective to_lval" \<comment>\<open>The cardinality of \<^typ>\<open>'lval\<close> is at least the cardinality of \<^typ>\<open>'pval\<close>.\<close>
+    shows "\<exists>P Q::('lvar, 'lval, 'pvar, 'pval) state hyperassertion. (\<forall>C. hypersat C H \<longleftrightarrow> \<Turnstile> {P} C {Q})"
+  using assms proving_hyperproperties
+  by blast
+
+text \<open>Theorem 4: Expressing hyper-triples as hyperproperties\<close>
+theorem thm4_expressing_hyper_triples_as_hyperproperties:
+  "\<Turnstile> {P} C {Q} \<longleftrightarrow> hypersat C (hyperprop_hht P Q)"
+  by (simp add: any_hht_hyperprop)
+
+text \<open>Theorem 5: Disproving hyper-triples\<close>
+theorem thm5_disproving_triples:
+  "\<not> \<Turnstile> {P} C {Q} \<longleftrightarrow> (\<exists>P'. sat P' \<and> entails P' P \<and> \<Turnstile> {P'} C {\<lambda>S. \<not> Q S})"
+  using disproving_triple by auto
+
+
+
+
+subsection \<open>4: Syntactic Rules\<close>
+
+subsubsection \<open>4.1: Syntactic Hyper-Assertions\<close>
+
+text \<open>Syntactic hyper-expressions and hyper-assertions (definition 9) are defined in the file
+SyntacticAssertions.thy as \<^typ>\<open>'val exp\<close> and \<^typ>\<open>'val assertion\<close> respectively, where 'val is the
+type of both logical and program values. Note that we use de Bruijn indices (i.e, natural numbers)
+for states and variables bound by quantifiers.\<close>
+
+subsubsection \<open>4.2: Syntactic Rules for Deterministic and Non-Deterministic Assignments.\<close>
+
+text \<open>We prove semantic versions of the syntactic rules from subsection 4 (figure 3).
+We use \<^const>\<open>interp_assert\<close> to convert a syntactic hyper-assertion into a semantic one, because
+our hyper-triples require semantic hyper-assertions. Similarly, we use \<^const>\<open>interp_pexp\<close> to convert
+a syntactic program expression into a semantic one.
+\<^term>\<open>transform_assign x e P\<close> and \<^term>\<open>transform_havoc x P\<close> correspond to \<open>A\<^sup>e\<^sub>x\<close> and \<open>H\<^sub>x\<close> from definition 10.\<close>
+
+text \<open>Rule AssignS from figure 3\<close>
+proposition AssignS:
+  "\<turnstile> { interp_assert (transform_assign x e P) } Assign x (interp_pexp e) {interp_assert P}"
+  using completeness rule_assign_syntactic by blast
+
+text \<open>Rule HavocS from figure 3\<close>
+proposition HavocS:
+  "\<turnstile> { interp_assert (transform_havoc x P) } Havoc x {interp_assert P}"
+  using completeness rule_havoc_syntactic by blast
+
+subsubsection \<open>4.3: Syntactic Rules for Assume Statements\<close>
+
+text \<open>\<^const>\<open>transform_assume\<close> corresponds to \<open>\<Pi>\<^sub>b\<close> (definition 11).\<close>
+
+text \<open>Rule AssumeS from figure 3\<close>
+proposition AssumeS:
+  "\<turnstile> { interp_assert (transform_assume (pbexp_to_assertion 0 b) P) } Assume (interp_pbexp b) {interp_assert P}"
+  using completeness rule_assume_syntactic by blast
+
+text \<open>As before, we use \<^const>\<open>interp_pbexp\<close> to convert the syntactic program Boolean expression b into
+a semantic one. Similarly, \<^term>\<open>pbexp_to_assertion 0 b\<close> converts the syntactic program Boolean expression
+p into a syntactic hyper-assertion. The number 0 is a de Bruijn index, which corresponds to the closest
+quantified state. For example, the hyper-assertion \<open>\<forall><\<phi>>. \<phi>(a)=\<phi>(b) \<and> (\<exists><\<phi>'>. \<phi>(x) \<succeq> \<phi>'(y))\<close> would
+be written as \<open>\<forall>. 0(a)=0(b) \<and> (\<exists>. 1(x) \<succeq> 0(y))\<close> with de Bruijn indices. Thus, one can think of
+\<open>pbexp_to_assertion 0 b\<close> as \<open>b(\<phi>)\<close>, where \<open>\<phi>\<close> is simply the innermost quantified state.\<close>
+
+
+
+
+subsection \<open>5: Proof Principles for Loops\<close>
+
+text \<open>We show in the following our proof rules for loops, presented in figure 5.\<close>
+
+text \<open>Rule WhileDesugared from figure 5\<close>
+theorem while_desugared:
+  assumes "\<And>n. \<turnstile> {I n} Assume b;; C {I (Suc n)}"
+      and "\<turnstile> { natural_partition I } Assume (lnot b) { Q }"
+    shows "\<turnstile> {I 0} while_cond b C { Q }"
+  by (metis completeness soundness assms(1) assms(2) seq_rule while_cond_def while_rule)
+
+text \<open>This result uses the following constructs:
+\<^item> \<^term>\<open>natural_partition I\<close> corresponds to the \<open>\<Otimes>\<close> operator from definition 7.
+\<^item> \<^term>\<open>lnot b\<close> negates b.
+\<^item> \<^term>\<open>while_cond b C\<close> is defined as \<^term>\<open>While (Assume b;; C);; Assume (lnot b)\<close>.\<close>
+
+text \<open>Rule WhileSync from figure 5 (presented in subsubsection 5.1)\<close>
+lemma WhileSync:
+  assumes "entails I (low_exp b)"
+      and "\<turnstile> {conj I (holds_forall b)} C {I}"
+    shows "\<turnstile> {conj I (low_exp b)} while_cond b C {conj (disj I emp) (holds_forall (lnot b))}"
+  using WhileSync_simpler entail_conj completeness soundness assms(1) assms(2) entails_refl 
+  consequence_rule[of "conj I (holds_forall b)" "conj I (holds_forall b)" I "conj I (low_exp b)"] by blast
+
+text \<open>This result uses the following constructs:
+\<^item> \<^term>\<open>conj A B\<close> corresponds to the hyper-assertion \<open>A \<and> B\<close>.
+\<^item> \<^term>\<open>holds_forall b\<close> corresponds to \<open>box(b)\<close>.
+\<^item> \<^term>\<open>low_exp b\<close> corresponds to \<open>low(b)\<close>.
+\<^item> \<^term>\<open>disj A B\<close> corresponds to the hyper-assertion \<open>A \<or> B\<close>.
+\<^item> \<^term>\<open>emp\<close> checks whether the set of states is empty.\<close>
+
+text \<open>Rule IfSync from figure 5 (presented in subsubsection 5.1)\<close>
+theorem IfSync:
+  assumes "entails P (low_exp b)"
+      and "\<turnstile> {conj P (holds_forall b)} C1 {Q}"
+      and "\<turnstile> {conj P (holds_forall (lnot b))} C2 {Q}"
+    shows "\<turnstile> {P} if_then_else b C1 C2 {Q}"
+  using completeness soundness consequence_rule[of _ "conj P (low_exp b)" Q] assms(1) entail_conj entails_refl assms if_synchronized by metis
+
+text \<open>This result uses the following construct:
+\<^item> \<^term>\<open>if_then_else b C1 C2\<close> is syntactic sugar for \<^term>\<open>If (Assume b;; C1) (Assume (lnot b);; C2)\<close>.\<close>
+
+text \<open>Rule \<open>While-\<forall>*\<exists>*\<close> from figure 5 (presented in subsubsection 5.2)\<close>
+theorem while_forall_exists:
+  assumes "\<turnstile> {I} if_then b C {I}"
+      and "\<turnstile> {I} Assume (lnot b) {interp_assert Q}"
+      and "no_forall_state_after_existential Q"
+    shows "\<turnstile> {I} while_cond b C {interp_assert Q}"
+  using consequence_rule[of I I "conj (interp_assert Q) (holds_forall (lnot b))" "interp_assert Q"]
+  using completeness soundness while_forall_exists_simpler assms entail_conj_weaken entails_refl by metis
+
+text \<open>This result uses the following constructs:
+\<^item> \<^term>\<open>if_then b C\<close> is syntactic sugar for \<^term>\<open>If (Assume b;; C) (Assume (lnot b))\<close>.
+\<^item> \<^term>\<open>no_forall_state_after_existential Q\<close> holds iff there is no universal state quantifier \<open>\<forall>\<langle>_\<rangle>\<close> after any \<open>\<exists>\<close> in Q.\<close>
+
+text \<open>Rule \<open>While-\<exists>\<close> from figure 5 (presented in subsubsection 5.3)\<close>
+theorem while_loop_exists:
+  assumes  "\<And>v. \<turnstile> { (\<lambda>S. \<exists>\<phi>\<in>S. e (snd \<phi>) = v \<and> b (snd \<phi>) \<and> P \<phi> S) } if_then b C { (\<lambda>S. \<exists>\<phi>\<in>S. lt (e (snd \<phi>)) v \<and> P \<phi> S) }"
+      and "\<And>\<phi>. \<turnstile> { P \<phi> } while_cond b C { Q \<phi> }"
+      and "wfP lt"
+    shows "\<turnstile> { (\<lambda>S. \<exists>\<phi>\<in>S. P \<phi> S) } while_cond b C { (\<lambda>S. \<exists>\<phi>\<in>S. Q \<phi> S)}"
+  using completeness soundness exists_terminates_loop assms by blast
+
+text \<open>\<^term>\<open>wfP lt\<close> in this result ensures that the binary operator \<open>lt\<close> is well-founded.
+\<open>e\<close> is a function of a program state, which must decrease after each iteration.\<close>
+
+
+
+
+subsection \<open>Appendix A: Technical Definitions Omitted from the Paper\<close>
+
+text \<open>The big-step semantics (figure 9) is defined as \<^const>\<open>single_sem\<close>. We also use the notation \<^term>\<open>\<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'\<close>.
+The following definitions are formalized in the file SyntacticAssertions.thy:
+\<^item> Evaluation of hyper-expressions (definition 12): \<^const>\<open>interp_exp\<close>.
+\<^item> Satisfiability of hyper-assertions (definition 12): \<^const>\<open>sat_assertion\<close>.
+\<^item> Syntactic transformation for deterministic assignments (definition 13): \<^const>\<open>transform_assign\<close>.
+\<^item> Syntactic transformation for non-deterministic assignments (definition 14): \<^const>\<open>transform_havoc\<close>.
+\<^item> Syntactic transformation for assume statements. (definition 15): \<^const>\<open>transform_assume\<close>.\<close>
+
+
+
+subsection \<open>Appendix C: Expressing Judgments of Hoare Logics as Hyper-Triples\<close>
+
+subsubsection \<open>Appendix C.1: Overapproximate Hoare Logics\<close>
+
+text \<open>The following judgments are defined in the file Expressivity.thy as follows:
+\<^item> Definition 16 (Hoare Logic): \<^term>\<open>HL P C Q\<close>.
+\<^item> Definition 17 (Cartesian Hoare Logic): \<^term>\<open>CHL P C Q\<close>.\<close>
+
+text \<open>Proposition 1: HL triples express hyperproperties\<close>
+proposition prop_1_HL_expresses_hyperproperties:
+  "\<exists>H. (\<forall>C. hypersat C H \<longleftrightarrow> HL P C Q)"
+  using HL_expresses_hyperproperties by blast
+
+text \<open>Proposition 2: Expressing HL in Hyper Hoare Logic\<close>
+proposition prop_2_expressing_HL_in_HHL:
+  "HL P C Q \<longleftrightarrow> (hyper_hoare_triple (over_approx P) C (over_approx Q))"
+  using encoding_HL by auto
+
+text \<open>Proposition 3: CHL triples express hyperproperties\<close>
+proposition prop_3_CHL_is_hyperproperty:
+  "hypersat C (CHL_hyperprop P Q) \<longleftrightarrow> CHL P C Q"
+  using CHL_hyperproperty by fast
+
+text \<open>Proposition 4: Expressing CHL in Hyper Hoare Logic\<close>
+proposition prop_4_encoding_CHL_in_HHL:
+  assumes "not_free_var_of P x"
+      and "not_free_var_of Q x"
+      and "injective from_nat"
+    shows "CHL P C Q \<longleftrightarrow> \<Turnstile> {encode_CHL from_nat x P} C {encode_CHL from_nat x Q}"
+  using encoding_CHL assms by fast
+
+text \<open>The function \<open>from_nat\<close> gives us a way to encode numbers from 1 to k as logical values.
+Moreover, note that we represent k-tuples implicitly, as mappings of type \<^typ>\<open>'a \<Rightarrow> 'b\<close>: When the type
+\<open>'a\<close> has k elements, a function of type \<^typ>\<open>'a \<Rightarrow> 'b\<close> corresponds to a k-tuple of elements of type 'b.
+This representation is more convenient to work with, and more general, since it also captures infinite sequences.\<close>
+
+subsubsection \<open>Appendix C.2: Underapproximate Hoare Logics\<close>
+
+text \<open>The following judgments are defined in the file Expressivity.thy as follows:
+\<^item> Definition 18 (Incorrectness Logic): \<^term>\<open>IL P C Q\<close>.
+\<^item> Definition 19 (k-Incorrectness Logic): \<^term>\<open>RIL P C Q\<close>.
+\<^item> Definition 20 (Forward Underapproximation): \<^term>\<open>FU P C Q\<close>.
+\<^item> Definition 21 (k-Forward Underapproximation): \<^term>\<open>RFU P C Q\<close>.\<close>
+
+text \<open>RIL is the old name of k-IL, and RFU is the old name of k-FU.\<close>
+
+text \<open>Proposition 5: IL triples express hyperproperties\<close>
+proposition prop_5_IL_hyperproperties:
+  "IL P C Q \<longleftrightarrow> IL_hyperprop P Q (set_of_traces C)"
+  using IL_expresses_hyperproperties by fast
+
+text \<open>Proposition 6: Expressing IL in Hyper Hoare Logic\<close>
+proposition prop_6_expressing_IL_in_HHL:
+  "IL P C Q \<longleftrightarrow> (hyper_hoare_triple (under_approx P) C (under_approx Q))"
+  using encoding_IL by fast
+
+text \<open>Proposition 7: k-IL triples express hyperproperties\<close>
+proposition prop_7_kIL_hyperproperties:
+  "hypersat C (RIL_hyperprop P Q) \<longleftrightarrow> RIL P C Q"
+  using RIL_expresses_hyperproperties by fast
+
+text \<open>Proposition 8: Expressing k-IL in Hyper Hoare Logic\<close>
+proposition prop_8_expressing_kIL_in_HHL:
+  fixes x :: "'lvar"
+  assumes "\<And>l l' \<sigma>. (\<lambda>i. (l i, \<sigma> i)) \<in> P \<longleftrightarrow> (\<lambda>i. (l' i, \<sigma> i)) \<in> P"  (* P does not depend on logical variables *)
+      and "injective (indexify :: (('a \<Rightarrow> ('pvar \<Rightarrow> 'pval)) \<Rightarrow> 'lval))" (* |lval| \<ge> |PStates^k| *)
+      and "c \<noteq> x"
+      and "injective from_nat"
+      and "not_free_var_of (P :: ('a \<Rightarrow> ('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set) x \<and> not_free_var_of P c"
+      and "not_free_var_of Q x \<and> not_free_var_of Q c"
+    shows "RIL P C Q \<longleftrightarrow> \<Turnstile> {pre_insec from_nat x c P} C {post_insec from_nat x c Q}"
+  using assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) by (rule encoding_RIL)
+
+proposition FU_hyperproperties:
+  "hypersat C (hyperprop_FU P Q) \<longleftrightarrow> FU P C Q"
+  by (rule FU_expresses_hyperproperties)
+
+text \<open>Proposition 9: Expressing FU in Hyper Hoare Logic\<close>
+proposition prop_9_expressing_FU_in_HHL:
+  "FU P C Q \<longleftrightarrow> \<Turnstile> {encode_FU P} C {encode_FU Q}"
+  by (rule encoding_FU)
+
+text \<open>Proposition 10: k-FU triples express hyperproperties\<close>
+proposition prop_10_kFU_expresses_hyperproperties:
+  "hypersat C (RFU_hyperprop P Q) \<longleftrightarrow> RFU P C Q"
+  by (rule RFU_captures_hyperproperties)
+
+text \<open>Proposition 11: Expressing k-FU in Hyper Hoare Logic\<close>
+proposition prop_11_encode_kFU_in_HHL:
+  assumes "not_free_var_of P x"
+      and "not_free_var_of Q x"
+      and "injective from_nat"
+    shows "RFU P C Q \<longleftrightarrow> \<Turnstile> {encode_RFU from_nat x P} C {encode_RFU from_nat x Q}"
+  using assms
+  by (rule encode_RFU)
+
+subsubsection \<open>Appendix C.3: Beyond Over- and Underapproximation\<close>
+
+text \<open>The following judgment is defined in the file Expressivity.thy as follows:
+\<^item> Definition 22 (k-Universal Existential): \<^term>\<open>RUE P C Q\<close>.
+Note that RUE is the old name of k-UE.\<close>
+
+text \<open>Proposition 12: k-UE triples express hyperproperties\<close>
+proposition prop_12_kUE_expresses_hyperproperty:
+  "RUE P C Q \<longleftrightarrow> hypersat C (hyperprop_RUE P Q)"
+  by (rule RUE_express_hyperproperties)
+
+text \<open>Proposition 13: Expressing k-UE in Hyper Hoare Logic\<close>
+proposition prop_13_expressing_kUE_in_HHL:
+  assumes "injective fn \<and> injective fn1 \<and> injective fn2"
+      and "t \<noteq> x"
+      and "injective (fn :: nat \<Rightarrow> 'a)"
+      and "injective fn1"
+      and "injective fn2"
+      and "not_in_free_vars_double {x, t} P"
+      and "not_in_free_vars_double {x, t} Q"
+  shows "RUE P C Q \<longleftrightarrow> \<Turnstile> {encode_RUE_1 fn fn1 fn2 x t P} C {encode_RUE_2 fn fn1 fn2 x t Q}"
+  using assms by (rule encoding_RUE)
+
+
+text \<open>Example 3\<close>
+proposition proving_refinement:
+  fixes P :: "(('lvar \<Rightarrow> 'lval) \<times> ('pvar \<Rightarrow> 'pval)) set \<Rightarrow> bool"
+    and t :: 'pvar
+  assumes "(one :: 'pval) \<noteq> two" \<comment>\<open>We assume two distinct program values \<open>one\<close> and \<open>two\<close>, to represent 1 and 2.\<close>
+      and "P = (\<lambda>S. card S = 1)"
+      and "Q = (\<lambda>S. \<forall>\<phi>\<in>S. snd \<phi> t = two \<longrightarrow> (fst \<phi>, (snd \<phi>)(t := one)) \<in> S)"
+      and "not_free_var_stmt t C1"
+      and "not_free_var_stmt t C2"
+  shows "refinement C2 C1 \<longleftrightarrow>
+  \<Turnstile> { P } If (Seq (Assign t (\<lambda>_. one)) C1) (Seq (Assign t (\<lambda>_. two)) C2) { Q }"
+proof -
+  have "refinement C2 C1 \<longleftrightarrow> \<Turnstile> { P } If (Seq (Assign t (\<lambda>_. two)) C2) (Seq (Assign t (\<lambda>_. one)) C1) { Q }"
+    using encoding_refinement[of two one P Q t C2 C1] assms by blast
+  then show ?thesis using rewrite_if_commute by blast
+qed
+
+
+
+
+subsection \<open>Appendix D: Compositionality\<close>
+
+subsubsection \<open>Appendix D.1: Compositionality Rules\<close>
+
+text \<open>In the following, we show the rules from figure 11, in the order in which they appear.\<close>
+
+proposition rule_Linking:
+  assumes "\<And>\<phi>1 (\<phi>2 :: ('a, 'b, 'c, 'd) state). fst \<phi>1 = fst \<phi>2 \<and> ( \<turnstile> { (in_set \<phi>1 :: (('a, 'b, 'c, 'd) state) hyperassertion) } C { in_set \<phi>2 } )
+  \<Longrightarrow> ( \<turnstile> { (P \<phi>1 :: (('a, 'b, 'c, 'd) state) hyperassertion) } C { Q \<phi>2 } )"
+  shows "\<turnstile> { ((\<lambda>S. \<forall>\<phi>1 \<in> S. P \<phi>1 S) :: (('a, 'b, 'c, 'd) state) hyperassertion) } C { (\<lambda>S. \<forall>\<phi>2 \<in> S. Q \<phi>2 S) }"
+  using assms soundness completeness rule_linking by blast
+
+proposition rule_And:
+  assumes "\<turnstile> {P} C {Q}"
+      and "\<turnstile> {P'} C {Q'}"
+    shows "\<turnstile> {conj P P'} C {conj Q Q'}"
+  using assms soundness completeness rule_And by metis
+
+proposition rule_Or:
+  assumes "\<turnstile> {P} C {Q}"
+      and "\<turnstile> {P'} C {Q'}"
+    shows "\<turnstile> {disj P P'} C {disj Q Q'}"
+  using assms soundness completeness rule_Or by metis
+
+proposition rule_FrameSafe:
+  assumes "wr C \<inter> fv F = {}"
+      and "wf_assertion F"
+      and "no_exists_state F"
+    shows "\<turnstile> {interp_assert F} C {interp_assert F}"
+  using safe_frame_rule_syntactic assms completeness by metis
+
+proposition rule_Forall:
+  assumes "\<And>x. \<turnstile> {P x} C {Q x}"
+  shows "\<turnstile> {forall P} C {forall Q}"
+  using assms soundness completeness rule_Forall by metis
+
+proposition rule_IndexedUnion:
+  assumes "\<And>x. \<turnstile> {P x} C {Q x}"
+  shows "\<turnstile> {general_join P} C {general_join Q}"
+  using assms soundness completeness rule_IndexedUnion by metis
+
+proposition rule_Union:
+  assumes "\<turnstile> {P} C {Q}"
+      and "\<turnstile> {P'} C {Q'}"
+    shows "\<turnstile> {join P P'} C {join Q Q'}"
+  using assms soundness completeness rule_Union by metis
+
+proposition rule_BigUnion:
+  fixes P :: "((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)"
+  assumes "\<turnstile>  {P} C {Q}"
+  shows "\<turnstile> {general_union P} C {general_union Q}"
+  using assms soundness completeness rule_BigUnion by blast
+
+proposition rule_Specialize:
+  assumes "\<turnstile> {interp_assert P} C {interp_assert Q}"
+      and "indep_of_set b"
+      and "wf_assertion_aux 0 1 b"
+      and "wr C \<inter> fv b = {}"
+    shows "\<turnstile> { interp_assert (transform_assume b P) } C { interp_assert (transform_assume b Q) }"
+  using filter_rule_syntactic assms soundness completeness by blast
+
+text \<open>In the following, \<^term>\<open>entails_with_updates vars P P'\<close> and \<^term>\<open>invariant_on_updates vars Q\<close>
+respectively correspond to the notions of entailments modulo logical variables and invariance with
+respect to logical updates, as described in definition 23.\<close>
+
+proposition rule_LUpdate:
+  assumes "\<turnstile> {P'} C {Q}"
+      and "entails_with_updates vars P P'"
+      and "invariant_on_updates vars Q"
+    shows "\<turnstile> {P} C {Q}"
+  using assms soundness completeness rule_LUpdate by blast
+
+proposition rule_LUpdateSyntactic:
+  assumes "\<turnstile> { (\<lambda>S. P S \<and> e_recorded_in_t e t S) } C { Q }"
+      and "not_fv_hyper t P"
+      and "not_fv_hyper t Q"
+    shows "\<turnstile> { P } C { Q }"
+  using LUpdateS soundness completeness assms by fast
+
+proposition rule_AtMost:
+  assumes "\<turnstile> {P} C {Q}"
+  shows "\<turnstile> {has_superset P} C {has_superset Q}"
+  using assms soundness completeness rule_AtMost by blast
+
+(* derived from join *)
+proposition rule_AtLeast:
+  assumes "\<turnstile> {P} C {Q}"
+  shows "\<turnstile> {has_subset P} C {has_subset Q}"
+  using assms soundness completeness rule_AtLeast by blast
+
+proposition rule_True:
+  "\<turnstile> {P} C {\<lambda>_. True}"
+  using rule_True completeness by blast
+
+proposition rule_False:
+  "\<turnstile> { (\<lambda>_. False) } C {Q}"
+  using rule_False completeness by blast
+
+proposition rule_Empty:
+  "\<turnstile> { (\<lambda>S. S = {}) } C { (\<lambda>S. S = {}) }"
+  using completeness rule_Empty by blast
+
+
+subsubsection \<open>Appendix D.2: Examples\<close>
+
+text \<open>Example shown in figure 12. To see the actual proof, ctrl+click on @{thm composing_monotonicity_and_minimum}.\<close>
+proposition fig_12_composing_monotonicity_and_minimum:
+  fixes P :: "((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)"
+  fixes i :: 'a
+  fixes x y :: 'c
+  fixes leq :: "'d \<Rightarrow> 'd \<Rightarrow> bool"
+  fixes one two :: 'b
+  assumes "\<turnstile> { P } C1 { has_minimum x leq }"
+      and "\<turnstile> { is_monotonic i x one two leq } C2 { is_monotonic i y one two leq }"
+      and "\<turnstile> { (is_singleton :: ((('a \<Rightarrow> 'b) \<times> ('c \<Rightarrow> 'd)) set \<Rightarrow> bool)) } C2 { is_singleton }"
+      and "one \<noteq> two" \<comment>\<open>We use distinct logical values \<open>one\<close> and \<open>two\<close> to represent 1 and 2.\<close>
+      and "\<And>x. leq x x" \<comment>\<open>We assume that \<open>leq\<close> is a partial order, and thus that it satisfies reflexivity.\<close>
+    shows "\<turnstile> { P } C1 ;; C2 { has_minimum y leq }"
+  using assms soundness completeness composing_monotonicity_and_minimum by metis
+
+text \<open>Example shown in figure 13. To see the actual proof, ctrl+click on @{thm composing_GNI_with_SNI}.\<close>
+proposition fig_13_composing_GNI_with_SNI:
+  fixes h :: 'lvar
+  fixes l :: 'pvar
+  assumes "\<turnstile> { (low l :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C2 { low l }"
+      and "\<turnstile> { (not_empty :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C2 { not_empty }"
+      and "\<turnstile> { (low l :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C1 { lGNI l h }"
+    shows "\<turnstile> { (low l :: (('lvar, 'lval, 'pvar, 'pval) state) hyperassertion) } C1;; C2 { lGNI l h }"
+  using assms soundness completeness composing_GNI_with_SNI by metis
+
+
+
+
+
+subsection \<open>Appendix E: Termination-Based Reasoning\<close>
+
+text \<open>Terminating hyper-triples (definition 24) are defined as \<^const>\<open>total_hyper_triple\<close>, and usually
+written \<^term>\<open>\<Turnstile>TERM {P} C {Q}\<close>.\<close>
+
+theorem rule_Frame:
+  assumes "\<Turnstile>TERM {P} C {Q}"
+      and "wr C \<inter> fv F = {}"
+      and "wf_assertion F"
+    shows "\<Turnstile>TERM {conj P (interp_assert F)} C {conj Q (interp_assert F)}"
+  by (simp add: assms(1) assms(2) assms(3) frame_rule_syntactic)
+
+theorem rule_WhileSyncTerm:
+  assumes "\<Turnstile>TERM {conj I (\<lambda>S. \<forall>\<phi>\<in>S. b (snd \<phi>) \<and> fst \<phi> t = e (snd \<phi>))} C {conj (conj I (low_exp b)) (e_smaller_than_t e t lt)}"
+      and "wfP lt"
+      and "not_fv_hyper t I"
+    shows "\<Turnstile>TERM {conj I (low_exp b)} while_cond b C {conj I (holds_forall (lnot b))}"
+  by (meson WhileSyncTot assms(1) assms(2) assms(3))
+
+
+
+
+subsection \<open>Appendix H: Synchronous Reasoning over Different Branches\<close>
+
+text \<open>Proposition 14: Synchronous if rule\<close>
+proposition prop_14_synchronized_if_rule:
+  assumes "\<Turnstile> {P} C1 {P1}"
+      and "\<Turnstile> {P} C2 {P2}"
+      and "\<Turnstile> {combine from_nat x P1 P2} C {combine from_nat x R1 R2}"
+      and "\<Turnstile> {R1} C1' {Q1}"
+      and "\<Turnstile> {R2} C2' {Q2}"
+      and "not_free_var_hyper x P1"
+      and "not_free_var_hyper x P2"
+      and "from_nat 1 \<noteq> from_nat 2" \<comment>\<open>We can represent 1 and 2 as distinct logical values.\<close>
+      and "not_free_var_hyper x R1"
+      and "not_free_var_hyper x R2"
+    shows "\<Turnstile> {P} If (Seq C1 (Seq C C1')) (Seq C2 (Seq C C2')) {join Q1 Q2}"
+  using if_sync_rule assms by meson
+
+
+
+end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/ProgramHyperproperties.thy b/thys/HyperHoareLogic/ProgramHyperproperties.thy
--- a/thys/HyperHoareLogic/ProgramHyperproperties.thy
+++ b/thys/HyperHoareLogic/ProgramHyperproperties.thy
@@ -1,339 +1,341 @@
 section \<open>Expressivity of Hyper Hoare Logic\<close>
 
-text \<open>In this file, we define program hyperproperties (definition 7), and prove theorem 3.\<close>
+text \<open>In this file, we define program hyperproperties (definition 8), and prove theorems 3 and 4.\<close>
 
 subsection \<open>Program Hyperproperties\<close>
 
 theory ProgramHyperproperties
   imports Logic
 begin
 
-text \<open>Definition 7\<close>
+text \<open>Definition 8\<close>
 
 type_synonym 'a hyperproperty = "('a \<times> 'a) set \<Rightarrow> bool"
+type_synonym ('pvar, 'pval) program_hyperproperty = "('pvar, 'pval) pstate hyperproperty"
+
 
 definition set_of_traces where
   "set_of_traces C = { (\<sigma>, \<sigma>') |\<sigma> \<sigma>'. \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>' }"
 
-definition hypersat where
+definition hypersat :: "('pvar, 'pval) stmt \<Rightarrow> ('pvar, 'pval) program_hyperproperty \<Rightarrow> bool" where
   "hypersat C H \<longleftrightarrow> H (set_of_traces C)"
 
 definition copy_p_state where
   "copy_p_state to_pvar to_lval \<sigma> x = to_lval (\<sigma> (to_pvar x))"
 
 definition recover_p_state where
   "recover_p_state to_pval to_lvar l x = to_pval (l (to_lvar x))"
 
 lemma injective_then_exists_inverse:
   assumes "injective to_lvar"
   shows "\<exists>to_pvar. (\<forall>x. to_pvar (to_lvar x) = x)"
 proof -
   let ?to_pvar = "\<lambda>y. SOME x. to_lvar x = y"
   have "\<And>x. ?to_pvar (to_lvar x) = x"
     by (metis (mono_tags, lifting) assms injective_def someI)
   then show ?thesis
     by force
 qed
 
 lemma single_step_then_in_sem:
   assumes "single_sem C \<sigma> \<sigma>'"
       and "(l, \<sigma>) \<in> S"
     shows "(l, \<sigma>') \<in> sem C S"
   using assms(1) assms(2) in_sem by fastforce
 
 lemma in_set_of_traces:
   "(\<sigma>, \<sigma>') \<in> set_of_traces C \<longleftrightarrow> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
   by (simp add: set_of_traces_def)
 
 
 lemma in_set_of_traces_then_in_sem:
   assumes "(\<sigma>, \<sigma>') \<in> set_of_traces C"
       and "(l, \<sigma>) \<in> S"
     shows "(l, \<sigma>') \<in> sem C S"
   using in_set_of_traces assms single_step_then_in_sem by metis
 
 lemma set_of_traces_same:
   assumes "\<And>x. to_pvar (to_lvar x) = x"
       and "\<And>x. to_pval (to_lval x) = x"
       and "S = {(copy_p_state to_pvar to_lval \<sigma>, \<sigma>) |\<sigma>. True}"
     shows "{(recover_p_state to_pval to_lvar l, \<sigma>') |l \<sigma>'. (l, \<sigma>') \<in> sem C S} = set_of_traces C"
 (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof (rule subsetPairI)
     fix \<sigma> \<sigma>' assume asm0: "(\<sigma>, \<sigma>') \<in> {(recover_p_state to_pval to_lvar l, \<sigma>') |l \<sigma>'. (l, \<sigma>') \<in> sem C S}"
     then obtain l where "\<sigma> = recover_p_state to_pval to_lvar l" "(l, \<sigma>') \<in> sem C S"
       by blast
     then obtain x where "(l, x) \<in> S" "\<langle>C, x\<rangle> \<rightarrow> \<sigma>'"
       by (metis fst_conv in_sem snd_conv)
     then have "l = copy_p_state to_pvar to_lval x"
       using assms(3) by blast
     moreover have "\<sigma> = x"
     proof (rule ext)
       fix y show "\<sigma> y = x y"
         by (simp add: \<open>\<sigma> = recover_p_state to_pval to_lvar l\<close> assms(1) assms(2) calculation copy_p_state_def recover_p_state_def)
     qed
     ultimately show "(\<sigma>, \<sigma>') \<in> set_of_traces C"
       by (simp add: \<open>\<langle>C, x\<rangle> \<rightarrow> \<sigma>'\<close> set_of_traces_def)
   qed
   show "?B \<subseteq> ?A"
   proof (rule subsetPairI)
     fix \<sigma> \<sigma>' assume asm0: "(\<sigma>, \<sigma>') \<in> set_of_traces C"
     let ?l = "copy_p_state to_pvar to_lval \<sigma>"
     have "(?l, \<sigma>) \<in> S"
       using assms(3) by blast
     then have "(?l, \<sigma>') \<in> sem C S"
       using asm0 in_set_of_traces_then_in_sem by blast
     moreover have "recover_p_state to_pval to_lvar ?l = \<sigma>"
     proof (rule ext)
       fix x show "recover_p_state to_pval to_lvar (copy_p_state to_pvar to_lval \<sigma>) x = \<sigma> x"
         by (simp add: assms(1) assms(2) copy_p_state_def recover_p_state_def)
     qed
     ultimately show "(\<sigma>, \<sigma>') \<in> {(recover_p_state to_pval to_lvar l, \<sigma>') |l \<sigma>'. (l, \<sigma>') \<in> sem C S}"
       by force
     qed
 qed
 
 text \<open>Theorem 3\<close>
 
 theorem proving_hyperproperties:
 
   fixes to_lvar :: "'pvar \<Rightarrow> 'lvar"
   fixes to_lval :: "'pval \<Rightarrow> 'lval"
 
   assumes "injective to_lvar"
       and "injective to_lval"
 
     shows "\<exists>P Q::('lvar, 'lval, 'pvar, 'pval) state hyperassertion. (\<forall>C. hypersat C H \<longleftrightarrow> \<Turnstile> {P} C {Q})"
 proof -
 
   obtain to_pval :: "'lval \<Rightarrow> 'pval" where r1: "\<And>x. to_pval (to_lval x) = x"
     using assms(2) injective_then_exists_inverse by blast
 
   obtain to_pvar :: "'lvar \<Rightarrow> 'pvar" where r2: "\<And>x. to_pvar (to_lvar x) = x"
     using assms(1) injective_then_exists_inverse by blast
 
   let ?P = "\<lambda>S. S = {(copy_p_state to_pvar to_lval \<sigma>, \<sigma>) |\<sigma>. True }"
   let ?Q = "\<lambda>S. H { (recover_p_state to_pval to_lvar l, \<sigma>') |l \<sigma>'. (l, \<sigma>') \<in> S }"
 
   have "\<And>C. hypersat C H \<longleftrightarrow> \<Turnstile> {?P} C {?Q}"
   proof
     fix C
     assume "hypersat C H"
     show "\<Turnstile> {?P} C {?Q}"
     proof (rule hyper_hoare_tripleI)
       fix S assume "S = {(copy_p_state to_pvar to_lval \<sigma>, \<sigma>) |\<sigma>. True}"
       have "{(recover_p_state to_pval to_lvar l, \<sigma>') |l \<sigma>'. (l, \<sigma>') \<in> sem C S}
   = set_of_traces C"
         using \<open>S = {(copy_p_state to_pvar to_lval \<sigma>, \<sigma>) |\<sigma>. True}\<close> set_of_traces_same[of to_pvar to_lvar to_pval to_lval]
         r1 r2 by presburger
       then show "H {(recover_p_state to_pval to_lvar l, \<sigma>') |l \<sigma>'. (l, \<sigma>') \<in> sem C S}"
         using \<open>hypersat C H\<close> hypersat_def by metis
     qed
   next
     fix C
     let ?S = "{(copy_p_state to_pvar to_lval \<sigma>, \<sigma>) |\<sigma>. True }"
     assume "\<Turnstile> {?P} C {?Q}"
     then have "?Q (sem C ?S)"
       by (simp add: hyper_hoare_triple_def)
     moreover have "{(recover_p_state to_pval to_lvar l, \<sigma>') |l \<sigma>'. (l, \<sigma>') \<in> sem C ?S} = set_of_traces C"
       using r1 r2 set_of_traces_same[of to_pvar to_lvar to_pval to_lval]
       by presburger
     ultimately show "hypersat C H"
       by (simp add: hypersat_def)
   qed
   then show ?thesis 
     by auto
 qed
 
 
 
 
 
 text \<open>Hypersafety, hyperliveness\<close>
 
 definition max_k where
   "max_k k S \<longleftrightarrow> finite S \<and> card S \<le> k"
 
 definition hypersafety where
   "hypersafety P \<longleftrightarrow> (\<forall>S. \<not> P S \<longrightarrow> (\<forall>S'. S \<subseteq> S' \<longrightarrow> \<not> P S'))"
 
 definition k_hypersafety where
   "k_hypersafety k P \<longleftrightarrow> (\<forall>S. \<not> P S \<longrightarrow> (\<exists>S'. S' \<subseteq> S \<and> max_k k S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> P S'')))"
 
 definition hyperliveness where
   "hyperliveness P \<longleftrightarrow> (\<forall>S. \<exists>S'. S \<subseteq> S' \<and> P S')"
 
 lemma k_hypersafetyI:
   assumes "\<And>S. \<not> P S \<Longrightarrow> \<exists>S'. S' \<subseteq> S \<and> max_k k S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> P S'')"
   shows "k_hypersafety k P"
   by (simp add: assms k_hypersafety_def)
 
 
 lemma hypersafetyI:
   assumes "\<And>S S'. \<not> P S \<Longrightarrow> S \<subseteq> S' \<Longrightarrow> \<not> P S'"
   shows "hypersafety P"
   by (metis assms hypersafety_def)
 
 lemma hyperlivenessI:
   assumes "\<And>S. \<exists>S'. S \<subseteq> S' \<and> P S'"
   shows "hyperliveness P"
   using assms hyperliveness_def by blast
 
 lemma k_hypersafe_is_hypersafe:
   assumes "k_hypersafety k P"
   shows "hypersafety P"
   by (metis (full_types) assms dual_order.trans hypersafety_def k_hypersafety_def)
 
 
 lemma one_safety_equiv:
   assumes "sat H"
   shows "k_hypersafety 1 H \<longleftrightarrow> (\<exists>P. \<forall>S. H S \<longleftrightarrow> (\<forall>\<tau> \<in> S. P \<tau>))" (is "?A \<longleftrightarrow> ?B")
 proof
   assume ?B
   then obtain P where asm0: "\<And>S. H S \<longleftrightarrow> (\<forall>\<tau> \<in> S. P \<tau>)"
     by auto
   show ?A
   proof (rule k_hypersafetyI)
     fix S
     assume asm1: "\<not> H S"
     then obtain \<tau> where "\<tau> \<in> S" "\<not> P \<tau>"
       using asm0 by blast
     let ?S = "{\<tau>}"
     have "?S \<subseteq> S \<and> max_k 1 ?S \<and> (\<forall>S''. ?S \<subseteq> S'' \<longrightarrow> \<not> H S'')"
       using \<open>\<not> P \<tau>\<close> \<open>\<tau> \<in> S\<close> asm0 max_k_def by fastforce
     then show "\<exists>S'\<subseteq>S. max_k 1 S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> H S'')" by blast
   qed
 next
   assume ?A
   let ?P = "\<lambda>\<tau>. H {\<tau>}"
   have "\<And>S. H S \<longleftrightarrow> (\<forall>\<tau> \<in> S. ?P \<tau>)"
   proof
     fix S assume "H S"
     then show "\<forall>\<tau> \<in> S. ?P \<tau>"
       using \<open>k_hypersafety 1 H\<close> hypersafety_def k_hypersafe_is_hypersafe by auto
   next
     fix S assume asm0: "\<forall>\<tau> \<in> S. ?P \<tau>"
     show "H S"
     proof (rule ccontr)
       assume "\<not> H S"
       then obtain S' where "S' \<subseteq> S \<and> max_k 1 S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> H S'')"
         by (metis \<open>k_hypersafety 1 H\<close> k_hypersafety_def)
       then show False
       proof (cases "S' = {}")
         case True
         then show ?thesis
           by (metis \<open>S' \<subseteq> S \<and> max_k 1 S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> H S'')\<close> assms empty_subsetI sat_def)
       next
         case False
         then obtain \<tau> where "\<tau> \<in> S'"
           by blast
         then have "card S' = 1"
           by (metis False One_nat_def Suc_leI \<open>S' \<subseteq> S \<and> max_k 1 S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> H S'')\<close> card_gt_0_iff le_antisym max_k_def)
         then have "S' = {\<tau>}"
           using \<open>\<tau> \<in> S'\<close> card_1_singletonE by auto
         then show ?thesis
           using \<open>S' \<subseteq> S \<and> max_k 1 S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> H S'')\<close> asm0 by fastforce
       qed
     qed
   qed
   then show ?B by blast
 qed
 
 
 
 
 
 definition hoarify where
   "hoarify P Q S \<longleftrightarrow> (\<forall>p \<in> S. fst p \<in> P \<longrightarrow> snd p \<in> Q)"
 
 lemma hoarify_hypersafety:
   "hypersafety (hoarify P Q)"
   by (metis (no_types, opaque_lifting) hoarify_def hypersafetyI subsetD)
 
 theorem hypersafety_1_hoare_logic:
   "k_hypersafety 1 (hoarify P Q)"
 proof (rule k_hypersafetyI)
   fix S assume "\<not> hoarify P Q S"
   then obtain \<tau> where "\<tau> \<in> S" "fst \<tau> \<in> P" "snd \<tau> \<notin> Q"      
     using hoarify_def by blast
   let ?S = "{\<tau>}"
   have "?S \<subseteq> S \<and> max_k 1 ?S \<and> (\<forall>S''. ?S \<subseteq> S'' \<longrightarrow> \<not> hoarify P Q S'')"
     by (metis Compl_iff One_nat_def \<open>\<tau> \<in> S\<close> \<open>fst \<tau> \<in> P\<close> \<open>snd \<tau> \<notin> Q\<close> card.empty card.insert compl_le_compl_iff empty_not_insert finite.intros(1) finite.intros(2) hoarify_def insert_absorb le_numeral_extra(4) max_k_def subset_Compl_singleton)
   then show "\<exists>S'\<subseteq>S. max_k 1 S' \<and> (\<forall>S''. S' \<subseteq> S'' \<longrightarrow> \<not> hoarify P Q S'')"
     by meson
 qed
 
 definition incorrectnessify where
   "incorrectnessify P Q S \<longleftrightarrow> (\<forall>\<sigma>' \<in> Q. \<exists>\<sigma> \<in> P. (\<sigma>, \<sigma>') \<in> S)"
 
 lemma incorrectnessify_liveness:
   assumes "P \<noteq> {}"
   shows "hyperliveness (incorrectnessify P Q)"
 proof (rule hyperlivenessI)
   fix S
   obtain \<sigma> where asm0: "\<sigma> \<in> P"
     using assms by blast
   let ?S = "S \<union> {(\<sigma>, \<sigma>') |\<sigma>'. \<sigma>' \<in> Q}"
   have "incorrectnessify P Q ?S"
     using asm0 incorrectnessify_def by force
   then show "\<exists>S'. S \<subseteq> S' \<and> incorrectnessify P Q S'"
     using sup.cobounded1 by blast
 qed
 
 definition real_incorrectnessify where
   "real_incorrectnessify P Q S \<longleftrightarrow> (\<forall>\<sigma> \<in> P. \<exists>\<sigma>' \<in> Q. (\<sigma>, \<sigma>') \<in> S)"
 
 lemma real_incorrectnessify_liveness:
   assumes "Q \<noteq> {}"
   shows "hyperliveness (real_incorrectnessify P Q)"
   by (metis UNIV_I assms equals0I hyperliveness_def real_incorrectnessify_def subsetI)
 
 
 
 
 
 
 
 
 
 
 
 text \<open>Verifying GNI\<close>
 
 definition gni_hyperassertion :: "'n \<Rightarrow> 'n \<Rightarrow> ('n \<Rightarrow> 'v) hyperassertion" where
   "gni_hyperassertion h l S \<longleftrightarrow> (\<forall>\<sigma> \<in> S. \<forall>v. \<exists>\<sigma>' \<in> S. \<sigma>' h = v \<and> \<sigma> l = \<sigma>' l)"
 
 definition semify where
   "semify \<Sigma> S = { (l, \<sigma>') |\<sigma>' \<sigma> l. (l, \<sigma>) \<in> S \<and> (\<sigma>, \<sigma>') \<in> \<Sigma> }"
 
 definition hyperprop_hht where
   "hyperprop_hht P Q \<Sigma> \<longleftrightarrow> (\<forall>S. P S \<longrightarrow> Q (semify \<Sigma> S))"
 
-text \<open>Footnote 4\<close>
+text \<open>Theorem 4\<close>
 theorem any_hht_hyperprop:
   "\<Turnstile> {P} C {Q} \<longleftrightarrow> hypersat C (hyperprop_hht P Q)" (is "?A \<longleftrightarrow> ?B")
 proof
   have "\<And>S. semify (set_of_traces C) S = sem C S"
   proof -
     fix S
     have "\<And>l \<sigma>'. (l, \<sigma>') \<in> sem C S \<longleftrightarrow> (l, \<sigma>') \<in> semify (set_of_traces C) S"
     proof -
       fix l \<sigma>'
       have "(l, \<sigma>') \<in> sem C S \<longleftrightarrow> (\<exists>\<sigma>. (l, \<sigma>) \<in> S \<and> \<langle>C, \<sigma>\<rangle> \<rightarrow> \<sigma>')"
         by (simp add: in_sem)
       also have "... \<longleftrightarrow> (\<exists>\<sigma>. (l, \<sigma>) \<in> S \<and> (\<sigma>, \<sigma>') \<in> set_of_traces C)"
         using set_of_traces_def by fastforce
       then show "(l, \<sigma>') \<in> sem C S \<longleftrightarrow> (l, \<sigma>') \<in> semify (set_of_traces C) S"
         by (simp add: calculation semify_def)
     qed
     then show "semify (set_of_traces C) S = sem C S"
       by auto
   qed
   show "?A \<Longrightarrow> ?B"
     by (simp add: \<open>\<And>S. semify (set_of_traces C) S = sem C S\<close> hyper_hoare_tripleE hyperprop_hht_def hypersat_def)
   show "?B \<Longrightarrow> ?A"
     by (simp add: \<open>\<And>S. semify (set_of_traces C) S = sem C S\<close> hyper_hoare_triple_def hyperprop_hht_def hypersat_def)
 qed
 
 end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/ROOT b/thys/HyperHoareLogic/ROOT
--- a/thys/HyperHoareLogic/ROOT
+++ b/thys/HyperHoareLogic/ROOT
@@ -1,13 +1,18 @@
 chapter AFP
 
 session HyperHoareLogic = HOL +
   options [timeout = 600]
   theories
-    Language
-    Logic
-    Examples
-    ProgramHyperproperties
-    Expressivity
+	PaperResults
+	Language
+	Logic
+	ProgramHyperproperties
+	SyntacticAssertions
+	Loops
+	Expressivity
+	Compositionality
+	ExamplesCompositionality
+	TotalLogic
   document_files
     "root.bib"
     "root.tex"
diff --git a/thys/HyperHoareLogic/SyntacticAssertions.thy b/thys/HyperHoareLogic/SyntacticAssertions.thy
new file mode 100644
--- /dev/null
+++ b/thys/HyperHoareLogic/SyntacticAssertions.thy
@@ -0,0 +1,1656 @@
+section \<open>Syntactic Assertions\<close>
+
+theory SyntacticAssertions
+  imports Logic Loops ProgramHyperproperties Compositionality
+begin
+
+subsection \<open>Preliminaries: Types, expressions, 'a assertions\<close>
+
+type_synonym var = nat
+type_synonym qstate = nat
+type_synonym qvar = nat
+
+type_synonym 'a nstate = "(var, 'a, var, 'a) state"
+type_synonym 'a npstate = "(var, 'a) pstate"
+
+type_synonym 'a binop = "'a \<Rightarrow> 'a \<Rightarrow> 'a"
+type_synonym 'a comp = "'a \<Rightarrow> 'a \<Rightarrow> bool"
+
+text \<open>Quantified variables and quantified states are represented as de Bruijn indices (natural numbers).\<close>
+
+datatype 'a exp =
+  EPVar qstate var    \<comment>\<open>\<open>\<phi>\<^sup>P(x)\<close>: Program variable\<close>
+  | ELVar qstate var  \<comment>\<open>\<open>\<phi>\<^sup>L(x)\<close>: Logical variable\<close>
+  | EQVar qvar        \<comment>\<open>\<open>y\<close>: Quantified variable\<close>
+  | EConst 'a
+  | EBinop "'a exp" "'a binop" "'a exp" \<comment>\<open>\<open>e \<oplus> e\<close>\<close>
+  | EFun "'a \<Rightarrow> 'a" "'a exp"            \<comment>\<open>\<open>f(e)\<close>\<close>
+
+text \<open>Quantified variables and quantified states are represented as de Bruijn indices (natural numbers).
+Thus, quantifiers do not have a name for the variable or state they quantify over.\<close>
+
+datatype 'a assertion =
+  AConst bool
+  | AComp "'a exp" "'a comp" "'a exp"  \<comment>\<open>\<open>e \<succeq> e\<close>\<close>
+  | AForallState "'a assertion"        \<comment>\<open>\<open>\<forall><\<phi>>. A\<close>\<close>
+  | AExistsState "'a assertion"        \<comment>\<open>\<open>\<exists><\<phi>>. A\<close>\<close>
+  | AForall "'a assertion"             \<comment>\<open>\<open>\<forall>y. A\<close>\<close>
+  | AExists "'a assertion"             \<comment>\<open>\<open>\<exists>y. A\<close>\<close>
+  | AOr "'a assertion" "'a assertion"  \<comment>\<open>\<open>A \<or> A\<close>\<close>
+  | AAnd "'a assertion" "'a assertion" \<comment>\<open>\<open>A \<and> A\<close>\<close>
+
+text \<open>We use a list of values and a list of states to track quantified values and states, respectively.\<close>
+
+fun interp_exp :: "'a list \<Rightarrow> 'a nstate list \<Rightarrow> 'a exp \<Rightarrow> 'a" where
+  "interp_exp vals states (EPVar st x) = snd (states ! st) x"
+| "interp_exp vals states (ELVar st x) = fst (states ! st) x"
+| "interp_exp vals states (EQVar x) = vals ! x"
+| "interp_exp vals states (EConst v) = v"
+| "interp_exp vals states (EBinop e1 op e2) = op (interp_exp vals states e1) (interp_exp vals states e2)"
+| "interp_exp vals states (EFun f e) = f (interp_exp vals states e)"
+
+fun sat_assertion :: "'a list \<Rightarrow> 'a nstate list \<Rightarrow> 'a assertion \<Rightarrow> 'a nstate set \<Rightarrow> bool" where
+  "sat_assertion vals states (AConst b) _ \<longleftrightarrow> b"
+| "sat_assertion vals states (AComp e1 cmp e2) _ \<longleftrightarrow> cmp (interp_exp vals states e1) (interp_exp vals states e2)"
+| "sat_assertion vals states (AForallState A) S \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (\<phi> # states) A S)"
+| "sat_assertion vals states (AExistsState A) S \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (\<phi> # states) A S)"
+| "sat_assertion vals states (AForall A) S \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states A S)"
+| "sat_assertion vals states (AExists A) S \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states A S)"
+| "sat_assertion vals states (AAnd A B) S \<longleftrightarrow> (sat_assertion vals states A S \<and> sat_assertion vals states B S)"
+| "sat_assertion vals states (AOr A B) S \<longleftrightarrow> (sat_assertion vals states A S \<or> sat_assertion vals states B S)"
+
+text \<open>Negation and implication are defined on top of this base language.\<close>
+
+definition neg_cmp :: "'a comp \<Rightarrow> 'a comp" where
+  "neg_cmp cmp v1 v2 \<longleftrightarrow> \<not> (cmp v1 v2)"
+
+fun ANot where
+  "ANot (AConst b) = AConst (\<not> b)"
+| "ANot (AComp e1 cmp e2) = AComp e1 (neg_cmp cmp) e2"
+| "ANot (AForallState A) = AExistsState (ANot A)"
+| "ANot (AExistsState A) = AForallState (ANot A)"
+| "ANot (AOr A B) = AAnd (ANot A) (ANot B)"
+| "ANot (AAnd A B) = AOr (ANot A) (ANot B)"
+| "ANot (AForall A) = AExists (ANot A)"
+| "ANot (AExists A) = AForall (ANot A)"
+
+definition AImp where
+  "AImp A B = AOr (ANot A) B"
+
+lemma sat_assertion_Not:
+  "sat_assertion vals states (ANot A) S \<longleftrightarrow> \<not>(sat_assertion vals states A S)"
+  by (induct A arbitrary: vals states) (simp_all add: neg_cmp_def)
+
+lemma sat_assertion_Imp:
+  "sat_assertion vals states (AImp A B) S \<longleftrightarrow> (sat_assertion vals states A S \<longrightarrow> sat_assertion vals states B S)"
+  by (simp add: AImp_def sat_assertion_Not)
+
+abbreviation interp_assert where "interp_assert \<equiv> sat_assertion [] []"
+
+
+subsection \<open>Assume rule\<close>
+
+fun transform_assume :: "'a assertion \<Rightarrow> 'a assertion \<Rightarrow> 'a assertion" where
+  "transform_assume _ (AConst b) = AConst b"
+| "transform_assume _ (AComp e1 cmp e2) = AComp e1 cmp e2"
+| "transform_assume b (AForallState A) = AForallState (AImp b (transform_assume b A))"
+| "transform_assume b (AExistsState A) = AExistsState (AAnd b (transform_assume b A))"
+| "transform_assume b (AForall A) = AForall (transform_assume b A)"
+| "transform_assume b (AExists A) = AExists (transform_assume b A)"
+| "transform_assume b (AAnd A B) = AAnd (transform_assume b A) (transform_assume b B)"
+| "transform_assume b (AOr A B) = AOr (transform_assume b A) (transform_assume b B)"
+
+
+definition same_syn_sem :: "'a assertion \<Rightarrow> ('a npstate \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "same_syn_sem bsyn bsem \<longleftrightarrow>
+  (\<forall>states vals S. length states > 0 \<longrightarrow> bsem (snd (hd states)) = sat_assertion vals states bsyn S)"
+
+lemma same_syn_semI:
+  assumes "\<And>states vals S. length states > 0 \<Longrightarrow> bsem (snd (hd states)) \<longleftrightarrow> sat_assertion vals states bsyn S"
+  shows "same_syn_sem bsyn bsem"
+  by (simp add: assms same_syn_sem_def)
+
+lemma transform_assume_valid:
+  assumes "same_syn_sem bsyn bsem"
+  shows "sat_assertion vals states A (Set.filter (bsem \<circ> snd) S)
+  \<longleftrightarrow> sat_assertion vals states (transform_assume bsyn A) S"
+proof (induct A arbitrary: vals states)
+  case (AForallState A)
+  let ?S = "Set.filter (bsem \<circ> snd) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AForallState A) ?S \<longleftrightarrow> (\<forall>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) ?A S)"
+    using AForallState by presburger
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. bsem (snd \<phi>) \<longrightarrow> sat_assertion vals (\<phi> # states) ?A S)"
+    by fastforce
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (\<phi> # states) bsyn S \<longrightarrow> sat_assertion vals (\<phi> # states) ?A S)"
+    using assms same_syn_sem_def[of bsyn bsem] by auto
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (\<phi> # states) (AImp bsyn ?A) S)"
+    using sat_assertion_Imp by fast
+  also have "... \<longleftrightarrow> sat_assertion vals states (AForallState (AImp bsyn ?A)) S"
+    using sat_assertion.simps(2) by force
+  finally show ?case
+    using transform_assume.simps(1) by fastforce
+next
+  case (AExistsState A)
+  let ?S = "Set.filter (bsem \<circ> snd) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AExistsState A) ?S \<longleftrightarrow> (\<exists>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) ?A S)"
+    using AExistsState by presburger
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. bsem (snd \<phi>) \<and> sat_assertion vals (\<phi> # states) ?A S)"
+    by force
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (\<phi> # states) bsyn S \<and> sat_assertion vals (\<phi> # states) ?A S)"
+    using assms same_syn_sem_def[of bsyn bsem] by auto
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (\<phi> # states) (AAnd bsyn ?A) S)"
+    by simp
+  also have "... \<longleftrightarrow> sat_assertion vals states (AExistsState (AAnd bsyn ?A)) S"
+    using sat_assertion.simps(3) by force
+  then show ?case
+    using calculation transform_assume.simps(2) by fastforce
+next
+  case (AForall A)
+  let ?S = "Set.filter (bsem \<circ> snd) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AForall A) ?S \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states ?A S)"
+    using AForall by presburger
+  also have "... \<longleftrightarrow> sat_assertion vals states (AForall ?A) S"
+    by simp
+  then show ?case
+    using calculation transform_assume.simps(3) by fastforce
+next
+  case (AExists A)
+  let ?S = "Set.filter (bsem \<circ> snd) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AExists A) ?S \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states ?A S)"
+    using AExists by presburger
+  also have "... \<longleftrightarrow> sat_assertion vals states (AExists ?A) S"
+    by simp
+  then show ?case
+    using calculation transform_assume.simps(4) by fastforce
+qed (simp_all)
+
+
+
+subsubsection \<open>Program expressions (values)\<close>
+
+datatype 'a pexp =
+  PVar var \<comment>\<open>Normal variable, like x\<close>
+  | PConst 'a
+  | PBinop "'a pexp" "'a binop" "'a pexp"
+  | PFun "'a \<Rightarrow> 'a" "'a pexp"
+
+
+fun interp_pexp :: "'a pexp \<Rightarrow> 'a npstate \<Rightarrow> 'a"
+  where
+  "interp_pexp (PVar x) \<phi> = \<phi> x"
+| "interp_pexp (PConst n) _ = n"
+| "interp_pexp (PBinop p1 op p2) \<phi> = op (interp_pexp p1 \<phi>) (interp_pexp p2 \<phi>)"
+| "interp_pexp (PFun f p) \<phi> = f (interp_pexp p \<phi>)"
+
+fun pexp_to_exp where
+  "pexp_to_exp st (PVar x) = EPVar st x"
+| "pexp_to_exp _ (PConst n) = EConst n"
+| "pexp_to_exp st (PBinop p1 op p2) = EBinop (pexp_to_exp st p1) op (pexp_to_exp st p2)"
+| "pexp_to_exp st (PFun f p) = EFun f (pexp_to_exp st p)"
+
+lemma same_syn_sem_exp:
+  "interp_pexp p (snd (states ! st)) = interp_exp vals states (pexp_to_exp st p)"
+proof (induct p)
+  case (PVar x)
+  then show ?case
+    using hd_conv_nth by force
+qed (simp_all)
+
+
+subsubsection \<open>Program expressions (booleans)\<close>
+
+datatype 'a pbexp =
+  PBConst bool
+  | PBAnd "'a pbexp" "'a pbexp"
+  | PBOr "'a pbexp" "'a pbexp"
+  | PBComp "'a pexp" "'a comp" "'a pexp"
+
+fun interp_pbexp :: "'a pbexp \<Rightarrow> 'a npstate \<Rightarrow> bool"
+  where
+  "interp_pbexp (PBConst b) _ \<longleftrightarrow> b"
+| "interp_pbexp (PBAnd pb1 pb2) \<phi> \<longleftrightarrow> interp_pbexp pb1 \<phi> \<and> interp_pbexp pb2 \<phi>"
+| "interp_pbexp (PBOr pb1 pb2) \<phi> \<longleftrightarrow> interp_pbexp pb1 \<phi> \<or> interp_pbexp pb2 \<phi>"
+| "interp_pbexp (PBComp p1 cmp p2) \<phi> \<longleftrightarrow> cmp (interp_pexp p1 \<phi>) (interp_pexp p2 \<phi>)"
+
+fun pbexp_to_assertion where
+  "pbexp_to_assertion _ (PBConst b) = AConst b"
+| "pbexp_to_assertion st (PBAnd pb1 pb2) = AAnd (pbexp_to_assertion st pb1) (pbexp_to_assertion st pb2)"
+| "pbexp_to_assertion st (PBOr pb1 pb2) = AOr (pbexp_to_assertion st pb1) (pbexp_to_assertion st pb2)"
+| "pbexp_to_assertion st (PBComp p1 cmp p2) = AComp (pexp_to_exp st p1) cmp (pexp_to_exp st p2)"
+
+lemma same_syn_sem_assertion:
+  "interp_pbexp pb (snd (states ! st)) = sat_assertion vals states (pbexp_to_assertion st pb) S"
+proof (induct pb)
+  case (PBComp x1 x2 x3)
+  then show ?case
+    by (metis interp_pbexp.simps(4) pbexp_to_assertion.simps(4) same_syn_sem_exp sat_assertion.simps(2))
+qed (simp_all)
+
+lemma pexp_to_exp_same:
+  shows "same_syn_sem (pbexp_to_assertion 0 pb) (interp_pbexp pb)"
+proof (rule same_syn_semI)
+  fix states :: "'a nstate list"
+  fix vals S
+  assume "0 < length states"
+  then have "sat_assertion vals states (pbexp_to_assertion 0 pb) S = sat_assertion [] states (pbexp_to_assertion 0 pb) S"
+    using same_syn_sem_assertion by blast
+  then show "interp_pbexp pb (snd (hd states)) = sat_assertion vals states (pbexp_to_assertion 0 pb) S"
+    by (metis \<open>0 < length states\<close> hd_conv_nth length_greater_0_conv same_syn_sem_assertion)
+qed
+
+
+
+subsubsection \<open>Syntactic rule for assume\<close>
+
+theorem rule_assume_syntactic_general:
+  "\<Turnstile> { sat_assertion states vals (transform_assume (pbexp_to_assertion 0 pb) P) } Assume (interp_pbexp pb) {sat_assertion states vals P}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "sat_assertion states vals (transform_assume (pbexp_to_assertion 0 pb) P) S"
+  then have "sat_assertion states vals P (Set.filter (interp_pbexp pb \<circ> snd) S)"
+    using pexp_to_exp_same transform_assume_valid by blast
+  then show "sat_assertion states vals P (sem (Assume (interp_pbexp pb)) S)"
+    by (simp add: assume_sem)
+qed
+
+theorem rule_assume_syntactic:
+  "\<Turnstile> { interp_assert (transform_assume (pbexp_to_assertion 0 pb) P) } Assume (interp_pbexp pb) {interp_assert P}"
+  by (simp add: rule_assume_syntactic_general)
+
+
+
+subsection \<open>Havoc rule\<close>
+
+subsubsection \<open>Shifting variables\<close>
+
+fun insert_at where
+  "insert_at 0 x l = x # l"
+| "insert_at (Suc n) x (t # q) = t # (insert_at n x q)"
+| "insert_at (Suc n) x [] = [x]"
+
+lemma length_insert_at:
+  "length (insert_at n x l) = length l + 1"
+proof (induct n arbitrary: l)
+  case (Suc n)
+  then show ?case
+  proof (cases l)
+    case (Cons t q)
+    then show ?thesis
+      by (simp add: Suc)
+  qed (simp)
+qed (simp_all)
+
+
+lemma insert_at_charact_1:
+  "n \<le> length l \<Longrightarrow> k < n \<Longrightarrow> (insert_at n x l) ! k = l ! k"
+proof (induct k arbitrary: l n)
+  case 0
+  then show ?case
+    by (metis bot_nat_0.not_eq_extremum insert_at.elims le_zero_eq list.size(3) nth_Cons_0)
+next
+  case (Suc k)
+  then obtain nn t q where "n = Suc nn" "l = t # q"
+    by (metis Suc_less_eq2 le_antisym list.exhaust list.size(3) not_less_zero zero_le)
+  then show ?case
+    using Suc.hyps Suc.prems(1) Suc.prems(2) by force
+qed
+
+lemma insert_at_charact_2:
+  "n  \<le> length l \<Longrightarrow> (insert_at n x l) ! n = x"
+proof (induct n arbitrary: l)
+  case (Suc n)
+  then show ?case
+    by (metis Suc_le_length_iff insert_at.simps(2) nth_Cons_Suc)
+qed (simp)
+
+lemma insert_at_charact_3:
+  "n  \<le> length l \<Longrightarrow> k \<ge> n \<Longrightarrow> (insert_at n x l) ! (Suc k) = l ! k"
+proof (induct n arbitrary: l k)
+  case (Suc xa)
+  then obtain t q kk where "k = Suc kk" "l = t # q"
+    by (meson Suc_le_D Suc_le_length_iff)
+  then show ?case
+    using Suc.hyps Suc.prems(1) Suc.prems(2) by auto
+qed (simp)
+
+
+(* Shift only stuff above *)
+fun shift_vars_exp where
+  "shift_vars_exp n (EQVar x) = (if x \<ge> n then EQVar (Suc x) else EQVar x)"
+| "shift_vars_exp n (EBinop e1 op e2) = EBinop (shift_vars_exp n e1) op (shift_vars_exp n e2)"
+| "shift_vars_exp n (EFun p e) = EFun p (shift_vars_exp n e)"
+| "shift_vars_exp _ e = e"
+
+fun shift_states_exp where
+  "shift_states_exp n (EPVar \<phi> x) = (if \<phi> \<ge> n then EPVar (Suc \<phi>) x else EPVar \<phi> x)"
+| "shift_states_exp n (ELVar \<phi> x) = (if \<phi> \<ge> n then ELVar (Suc \<phi>) x else ELVar \<phi> x)"
+| "shift_states_exp n (EBinop e1 op e2) = EBinop (shift_states_exp n e1) op (shift_states_exp n e2)"
+| "shift_states_exp n (EFun p e) = EFun p (shift_states_exp n e)"
+| "shift_states_exp _ e = e"
+
+fun wf_exp :: "nat \<Rightarrow> nat \<Rightarrow> 'a exp \<Rightarrow> bool" where
+  "wf_exp nv ns (EPVar st _) \<longleftrightarrow> st < ns"
+| "wf_exp nv ns (ELVar st _) \<longleftrightarrow> st < ns"
+| "wf_exp nv ns (EQVar x) \<longleftrightarrow> x < nv"
+| "wf_exp nv ns (EBinop e1 _ e2) \<longleftrightarrow> wf_exp nv ns e1 \<and> wf_exp nv ns e2"
+| "wf_exp nv ns (EFun f e) \<longleftrightarrow> wf_exp nv ns e"
+| "wf_exp nv ns (EConst _) \<longleftrightarrow> True"
+
+lemma wf_shift_vars_exp:
+  assumes "wf_exp nv ns e"
+  shows "wf_exp (Suc nv) ns (shift_vars_exp n e)"
+  using assms
+  by (induct e) simp_all
+
+lemma wf_shift_states_exp:
+  assumes "wf_exp nv ns e"
+  shows "wf_exp nv (Suc ns) (shift_states_exp n e)"
+  using assms
+  by (induct e) simp_all
+
+lemma shift_vars_exp_charact:
+  assumes "n \<le> length vals"
+  shows "interp_exp vals states e = interp_exp (insert_at n v vals) states (shift_vars_exp n e)"
+  using assms
+proof (induct e)
+  case (EQVar x)
+  then show ?case
+    by (simp add: insert_at_charact_1 insert_at_charact_3)
+qed (simp_all)
+
+lemma shift_states_exp_charact:
+  assumes "n \<le> length states"
+  shows "interp_exp vals states e = interp_exp vals (insert_at n \<phi> states) (shift_states_exp n e)"
+  using assms
+proof (induct e)
+  case (EPVar x1 x2)
+  then show ?case
+    by (simp add: insert_at_charact_1 insert_at_charact_3)
+next
+  case (ELVar x1 x2)
+  then show ?case
+    by (simp add: insert_at_charact_1 insert_at_charact_3)
+qed (simp_all)
+
+
+fun shift_vars where
+  "shift_vars n (AConst b) = AConst b"
+| "shift_vars n (AComp e1 cmp e2) = AComp (shift_vars_exp n e1) cmp (shift_vars_exp n e2)"
+| "shift_vars n (AForall A) = AForall (shift_vars (Suc n) A)"
+| "shift_vars n (AExists A) = AExists (shift_vars (Suc n) A)"
+| "shift_vars n (AForallState A) = AForallState (shift_vars n A)"
+| "shift_vars n (AExistsState A) = AExistsState (shift_vars n A)"
+| "shift_vars n (AOr A B) = AOr (shift_vars n A) (shift_vars n B)"
+| "shift_vars n (AAnd A B) = AAnd (shift_vars n A) (shift_vars n B)"
+
+lemma shift_vars_charact:
+  assumes "n \<le> length vals"
+  shows "sat_assertion vals states A S \<longleftrightarrow> sat_assertion (insert_at n x vals) states (shift_vars n A) S"
+  using assms
+proof (induct A arbitrary: vals states n)
+  case (AComp x1a x2 x3a)
+  then show ?case
+    using shift_vars_exp_charact by fastforce
+next
+  case (AForall A)
+  have "sat_assertion vals states (AForall A) S \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states A S)"
+    by simp
+  also have "... \<longleftrightarrow> (\<forall>v. sat_assertion (insert_at (Suc n) x (v # vals)) states (shift_vars (Suc n) A) S)"
+    using AForall(2) AForall(1)[of "Suc n" _ states] by simp
+  also have "... \<longleftrightarrow> (\<forall>v. sat_assertion (v # insert_at n x vals) states (shift_vars (Suc n) A) S)"
+    by simp
+  also have "... \<longleftrightarrow> sat_assertion (insert_at n x vals) states (AForall (shift_vars (Suc n) A)) S"
+    by simp
+  then show "sat_assertion vals states (AForall A) S = sat_assertion (insert_at n x vals) states (shift_vars n (AForall A)) S"
+    using calculation by simp
+next
+  case (AExists A)
+  have "sat_assertion vals states (AExists A) S \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states A S)"
+    by simp
+  also have "... \<longleftrightarrow> (\<exists>v. sat_assertion (insert_at (Suc n) x (v # vals)) states (shift_vars (Suc n) A) S)"
+    using AExists(2) AExists(1)[of "Suc n" _ states] by simp
+  also have "... \<longleftrightarrow> (\<exists>v. sat_assertion (v # insert_at n x vals) states (shift_vars (Suc n) A) S)"
+    by simp
+  also have "... \<longleftrightarrow> sat_assertion (insert_at n x vals) states (AExists (shift_vars (Suc n) A)) S"
+    by simp
+  then show "sat_assertion vals states (AExists A) S = sat_assertion (insert_at n x vals) states (shift_vars n (AExists A)) S"
+    using calculation by simp
+qed (simp_all)
+
+
+
+subsubsection \<open>Expressions (Boolean and values)\<close>
+
+definition update_state where
+  "update_state \<phi> x v = (fst \<phi>, (snd \<phi>)(x := v))"
+
+
+(* Replacing \<phi>(x) by v *)
+(* for havoc, should be used with (EQVar v) *)
+fun subst_exp_single :: "qstate \<Rightarrow> var \<Rightarrow> 'a exp \<Rightarrow> 'a exp \<Rightarrow> 'a exp" where
+  "subst_exp_single \<phi> x e' (EPVar st y) = (if \<phi> = st \<and> x = y then e' else EPVar st y)"
+| "subst_exp_single \<phi> x e' (EBinop e1 bop e2) = EBinop (subst_exp_single \<phi> x e' e1) bop (subst_exp_single \<phi> x e' e2)"
+| "subst_exp_single \<phi> x e' (EFun f e) = EFun f (subst_exp_single \<phi> x e' e)"
+| "subst_exp_single _ _ _ e = e" (* Logical variables, quantified variables, constants *)
+
+lemma wf_subst_exp:
+  assumes "wf_exp nv ns e"
+      and "wf_exp nv ns e'"
+    shows "wf_exp nv ns (subst_exp_single \<phi> x e' e)"
+  using assms
+  by (induct e) simp_all
+
+
+
+lemma subst_exp_single_charact:
+  assumes "interp_exp vals states e' = snd (states ! st) x"
+  shows "interp_exp vals states (subst_exp_single st x e' e) = interp_exp vals states e"
+  using assms
+  by (induct e) simp_all
+
+
+definition subst_state where
+  "subst_state x pe \<phi> = (fst \<phi>, (snd \<phi>)(x := interp_pexp pe (snd \<phi>)))"
+
+definition update_state_at where
+  "update_state_at states n x v = list_update states n (update_state (states ! n) x v)"
+
+lemma update_state_at_fst:
+  "fst (update_state_at states n x v ! st) = fst (states ! st)"
+proof (cases "n = st")
+  case True
+  then show ?thesis
+    by (metis fst_conv linorder_not_less list_update_beyond nth_list_update_eq update_state_at_def update_state_def)
+next
+  case False
+  then show ?thesis
+    by (simp add: update_state_at_def)
+qed
+
+lemma update_state_at_snd_1:
+  "x \<noteq> y \<Longrightarrow> snd (update_state_at states n x v ! st) y = snd (states ! st) y"
+  apply (cases "n = st")
+   apply (metis fun_upd_other linorder_not_less list_update_beyond nth_list_update_eq snd_conv update_state_at_def update_state_def)
+  by (simp add: update_state_at_def)
+
+lemma update_state_at_snd_2:
+  "st \<noteq> n \<Longrightarrow> snd (update_state_at states n x v ! st) y = snd (states ! st) y"
+  by (simp add: update_state_at_def)
+
+lemma update_state_at_snd_3:
+  assumes "n < length states"
+  shows "snd (update_state_at states n x v ! n) x = v"
+  by (simp add: assms update_state_at_def update_state_def)
+
+lemma subst_exp_more_complex_charact:
+  assumes "states' = update_state_at states st x (interp_exp vals states e')"
+      and "st < length states"
+  shows "interp_exp vals states (subst_exp_single st x e' e) = interp_exp vals states' e"
+  using assms
+proof (induct e)
+  case (EPVar \<phi> y)
+  then show ?case
+    by (metis interp_exp.simps(1) subst_exp_single.simps(1) update_state_at_snd_1 update_state_at_snd_2 update_state_at_snd_3)
+next
+  case (ELVar x1 x2)
+  then show ?case
+    by (simp add: update_state_at_fst)
+qed (simp_all)
+
+
+subsubsection \<open>Assertions\<close>
+
+fun subst_assertion_single :: "qstate \<Rightarrow> var \<Rightarrow> 'a exp \<Rightarrow> 'a assertion \<Rightarrow> 'a assertion" where
+  "subst_assertion_single st x e (AConst b) = AConst b"
+| "subst_assertion_single st x e (AComp e1 cmp e2) = AComp (subst_exp_single st x e e1) cmp (subst_exp_single st x e e2)"
+| "subst_assertion_single st x e (AForall A) = AForall (subst_assertion_single st x (shift_vars_exp 0 e) A)"
+| "subst_assertion_single st x e (AExists A) = AExists (subst_assertion_single st x (shift_vars_exp 0 e) A)"
+| "subst_assertion_single st x e (AOr A B) = AOr (subst_assertion_single st x e A) (subst_assertion_single st x e B)"
+| "subst_assertion_single st x e (AAnd A B) = AAnd (subst_assertion_single st x e A) (subst_assertion_single st x e B)"
+| "subst_assertion_single st x e (AForallState A) = AForallState (subst_assertion_single (Suc st) x (shift_states_exp 0 e) A)"
+| "subst_assertion_single st x e (AExistsState A) = AExistsState (subst_assertion_single (Suc st) x (shift_states_exp 0 e) A)"
+
+fun wf_assertion_aux :: "nat \<Rightarrow> nat \<Rightarrow> 'a assertion \<Rightarrow> bool" where
+  "wf_assertion_aux nv ns (AConst b) \<longleftrightarrow> True"
+| "wf_assertion_aux nv ns (AComp e1 cmp e2) \<longleftrightarrow> wf_exp nv ns e1 \<and> wf_exp nv ns e2"
+| "wf_assertion_aux nv ns (AAnd A B) \<longleftrightarrow> wf_assertion_aux nv ns A \<and> wf_assertion_aux nv ns B"
+| "wf_assertion_aux nv ns (AOr A B) \<longleftrightarrow> wf_assertion_aux nv ns A \<and> wf_assertion_aux nv ns B"
+
+| "wf_assertion_aux nv ns (AForall A) \<longleftrightarrow> wf_assertion_aux (Suc nv) ns A"
+| "wf_assertion_aux nv ns (AExists A) \<longleftrightarrow> wf_assertion_aux (Suc nv) ns A"
+| "wf_assertion_aux nv ns (AForallState A) \<longleftrightarrow> wf_assertion_aux nv (Suc ns) A"
+| "wf_assertion_aux nv ns (AExistsState A) \<longleftrightarrow> wf_assertion_aux nv (Suc ns) A"
+
+
+abbreviation wf_assertion where "wf_assertion \<equiv> wf_assertion_aux 0 0"
+
+
+lemma wf_shift_vars:
+  assumes "wf_assertion_aux nv ns A"
+  shows "wf_assertion_aux (Suc nv) ns (shift_vars n A)"
+  using assms
+  by (induct A arbitrary: n nv ns) (simp_all add: wf_shift_vars_exp)
+
+lemma wf_subst_assertion:
+  assumes "wf_assertion_aux nv ns A"
+      and "wf_exp nv ns e"
+    shows "wf_assertion_aux nv ns (subst_assertion_single \<phi> x e A)"
+  using assms
+proof (induct A arbitrary: nv ns e \<phi>)
+  case (AComp x1a x2 x3a)
+  then show ?case
+    by (simp add: wf_subst_exp)
+qed (simp_all add: wf_shift_vars_exp wf_shift_states_exp)
+
+lemma subst_assertion_single_charact:
+  assumes "interp_exp vals states e = snd (states ! st) x"
+  shows "sat_assertion vals states (subst_assertion_single st x e A) S \<longleftrightarrow> sat_assertion vals states A S"
+  using assms
+proof (induct A arbitrary: vals states st e)
+  case (AForallState A)
+  have "sat_assertion vals states (AForallState A) S \<longleftrightarrow> (\<forall>\<phi> \<in> S. sat_assertion vals (\<phi> # states) A S)"
+    by simp
+  also have "... \<longleftrightarrow> (\<forall>\<phi> \<in> S. sat_assertion vals (\<phi> # states) (subst_assertion_single (Suc st) x (shift_states_exp 0 e) A) S)"
+    using AForallState(1)[of vals _ "shift_states_exp 0 e" "Suc st"] AForallState(2)
+    by (metis insert_at.simps(1) nth_Cons_Suc shift_states_exp_charact zero_le)
+  finally show ?case by simp
+next
+  case (AExistsState A)
+  have "sat_assertion vals states (AExistsState A) S \<longleftrightarrow> (\<exists>\<phi> \<in> S. sat_assertion vals (\<phi> # states) A S)"
+    by simp
+  also have "... \<longleftrightarrow> (\<exists>\<phi> \<in> S. sat_assertion vals (\<phi> # states) (subst_assertion_single (Suc st) x (shift_states_exp 0 e) A) S)"
+    by (metis AExistsState.hyps AExistsState.prems insert_at.simps(1) nth_Cons_Suc shift_states_exp_charact zero_le)
+  finally show ?case by simp
+next
+  case (AForall A)
+  have "sat_assertion vals states (AForall A) S \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states A S)"
+    by simp
+  also have "... \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states (subst_assertion_single st x (shift_vars_exp 0 e) A) S)"
+    by (metis AForall.hyps AForall.prems insert_at.simps(1) shift_vars_exp_charact zero_le)
+  finally show ?case
+    by simp
+next
+  case (AExists A)
+  have "sat_assertion vals states (AExists A) S \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states A S)"
+    by simp
+  also have "... \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states (subst_assertion_single st x (shift_vars_exp 0 e) A) S)"
+    by (metis AExists.hyps AExists.prems insert_at.simps(1) shift_vars_exp_charact zero_le)
+  finally show ?case
+    by simp
+next
+  case (AComp e1 cmp e2)
+  then show ?case
+    using subst_exp_single_charact[of vals states e st x] by auto
+qed (simp_all)
+
+
+
+lemma update_state_at_cons:
+  "update_state_at (\<phi> # states) (Suc n) x v = \<phi> # update_state_at states n x v"
+  by (simp add: update_state_at_def)
+
+
+lemma subst_assertion_single_charact_better:
+  assumes "states' = update_state_at states st x (interp_exp vals states e)"
+      and "st < length states"
+    shows "sat_assertion vals states (subst_assertion_single st x e A) S \<longleftrightarrow> sat_assertion vals states' A S"
+  using assms
+proof (induct A arbitrary: vals states states' st e)
+  case (AComp x1a x2 x3a)
+  then show ?case
+    by (simp add: subst_exp_more_complex_charact)
+next
+  case (AForallState A)
+  have "sat_assertion vals states (subst_assertion_single st x e (AForallState A)) S
+  \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (update_state_at (\<phi> # states) (Suc st) x (interp_exp vals (\<phi> # states) (shift_states_exp 0 e))) A S)"
+    by (simp add: AForallState.hyps AForallState.prems(2))
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (\<phi> # update_state_at states st x (interp_exp vals states e)) A S)"
+    by (metis update_state_at_cons insert_at.simps(1) shift_states_exp_charact zero_le)
+  finally show "sat_assertion vals states (subst_assertion_single st x e (AForallState A)) S = sat_assertion vals states' (AForallState A) S"
+    by (simp add: AForallState.prems(1))
+next
+  case (AExistsState A)
+  have "sat_assertion vals states (subst_assertion_single st x e (AExistsState A)) S
+  \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (update_state_at (\<phi> # states) (Suc st) x (interp_exp vals (\<phi> # states) (shift_states_exp 0 e))) A S)"
+    by (simp add: AExistsState.hyps AExistsState.prems(2))
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (\<phi> # update_state_at states st x (interp_exp vals states e)) A S)"
+    by (metis update_state_at_cons insert_at.simps(1) shift_states_exp_charact zero_le)
+  finally show "sat_assertion vals states (subst_assertion_single st x e (AExistsState A)) S = sat_assertion vals states' (AExistsState A) S"
+    by (simp add: AExistsState.prems(1))
+next
+  case (AForall A)
+  have "sat_assertion vals states (subst_assertion_single st x e (AForall A)) S
+  \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states (subst_assertion_single st x (shift_vars_exp 0 e) A) S)"
+    by (simp add: AForall.hyps AForall.prems(2))
+  then show ?case
+    by (metis AForall.hyps AForall.prems(1) AForall.prems(2) insert_at.simps(1) sat_assertion.simps(5) shift_vars_exp_charact zero_le)
+next
+  case (AExists A)
+  have "sat_assertion vals states (subst_assertion_single st x e (AExists A)) S
+  \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states (subst_assertion_single st x (shift_vars_exp 0 e) A) S)"
+    by (simp add: AExists.hyps AExists.prems(2))
+  then show ?case
+    by (metis AExists.hyps AExists.prems(1) AExists.prems(2) insert_at.simps(1) sat_assertion.simps(6) shift_vars_exp_charact zero_le)
+qed (simp_all)
+
+
+subsubsection \<open>Transformation for havoc\<close>
+
+
+fun transform_havoc where
+  "transform_havoc x (AForallState A) = AForallState (AForall (subst_assertion_single 0 x (EQVar 0) (shift_vars 0 (transform_havoc x A))))"
+| "transform_havoc x (AExistsState A) = AExistsState (AExists (subst_assertion_single 0 x (EQVar 0) (shift_vars 0 (transform_havoc x A))))"
+| "transform_havoc x (AExists A) = AExists (transform_havoc x A)"
+| "transform_havoc x (AForall A) = AForall (transform_havoc x A)"
+| "transform_havoc x (AOr A B) = AOr (transform_havoc x A) (transform_havoc x B)"
+| "transform_havoc x (AAnd A B) = AAnd (transform_havoc x A) (transform_havoc x B)"
+| "transform_havoc x (AConst b) = AConst b"
+| "transform_havoc x (AComp e1 cmp e2) = AComp e1 cmp e2"
+
+
+lemma sem_havoc_bis:
+  "sem (Havoc x) S = {(fst \<phi>, (snd \<phi>)(x := v)) |\<phi> v. \<phi> \<in> S}" (is "?A = ?B")
+proof
+  show "?B \<subseteq> ?A"
+    using sem_havoc by fastforce
+  show "?A \<subseteq> ?B"
+  proof
+    fix \<phi> assume "\<phi> \<in> ?A"
+    then obtain l \<sigma> v where "\<phi> = (l, \<sigma>(x := v))" "(l, \<sigma>) \<in> S"
+      by (metis in_sem prod.collapse single_sem_Havoc_elim)
+    then show "\<phi> \<in> ?B"
+      by auto
+  qed
+qed
+
+lemma helper_update_state:
+  "(v # vals) ! 0 = snd ((update_state \<phi> x v # states) ! 0) x"
+  by (simp add: update_state_def)
+
+lemma helper_S_update_states:
+  assumes "S' = { update_state \<phi> x v |\<phi> v. \<phi> \<in> S}"
+  shows "(\<forall>\<phi> \<in> S'. Q \<phi>) \<longleftrightarrow> (\<forall>\<phi> \<in> S. \<forall>v. Q (update_state \<phi> x v))"
+proof
+  show "\<forall>\<phi>\<in>S'. Q \<phi> \<Longrightarrow> \<forall>\<phi>\<in>S. \<forall>v. Q (update_state \<phi> x v)"
+    using assms by blast
+  show "\<forall>\<phi>\<in>S. \<forall>v. Q (update_state \<phi> x v) \<Longrightarrow> \<forall>\<phi>\<in>S'. Q \<phi>"
+    using assms by force
+qed
+
+lemma helper_S_update_states_exists:
+  assumes "S' = { update_state \<phi> x v |\<phi> v. \<phi> \<in> S}"
+  shows "(\<exists>\<phi> \<in> S'. Q \<phi>) \<longleftrightarrow> (\<exists>\<phi> \<in> S. \<exists>v. Q (update_state \<phi> x v))"
+proof
+  show "\<exists>\<phi>\<in>S'. Q \<phi> \<Longrightarrow> \<exists>\<phi>\<in>S. \<exists>v. Q (update_state \<phi> x v)"
+    using assms by force
+  show "\<exists>\<phi>\<in>S. \<exists>v. Q (update_state \<phi> x v) \<Longrightarrow> \<exists>\<phi>\<in>S'. Q \<phi>"
+    using assms by blast
+qed
+
+
+
+lemma equiv_havoc_transform:
+  assumes "S' = { update_state \<phi> x v |\<phi> v. \<phi> \<in> S}"
+  shows "sat_assertion vals states P S' \<longleftrightarrow> sat_assertion vals states (transform_havoc x P) S"
+proof (induct P arbitrary: vals states)
+  case (AForallState P)
+
+  let ?PP = "shift_vars 0 (transform_havoc x P)"
+  let ?P = "subst_assertion_single 0 x (EQVar 0) ?PP"
+
+  have rr: "\<And>\<phi> v. sat_assertion (v # vals) (\<phi> # states) ?P S
+   \<longleftrightarrow> sat_assertion (v # vals) (update_state \<phi> x v # states) ?P S"
+  proof -
+    fix \<phi> v
+    have "sat_assertion (v # vals) (insert_at 0 \<phi> states) (subst_assertion_single 0 x (EQVar 0) (shift_vars 0 (transform_havoc x P))) S =
+sat_assertion (v # vals) (insert_at 0 (update_state \<phi> x v) states) (subst_assertion_single 0 x (EQVar 0) (shift_vars 0 (transform_havoc x P))) S"
+      by (metis (no_types, lifting) One_nat_def helper_update_state insert_at.simps(1) interp_exp.simps(3) length_insert_at list_update_code(2) nth_Cons_0 subst_assertion_single_charact subst_assertion_single_charact_better trans_less_add2 update_state_at_def zero_less_Suc)
+    then show "sat_assertion (v # vals) (\<phi> # states) ?P S \<longleftrightarrow> sat_assertion (v # vals) (update_state \<phi> x v # states) ?P S"
+      by simp
+  qed
+  have "sat_assertion vals states (transform_havoc x (AForallState P)) S \<longleftrightarrow> sat_assertion vals states (AForallState (AForall ?P)) S"
+    by simp
+  also have "... \<longleftrightarrow> (\<forall>\<phi> \<in> S. \<forall>v. sat_assertion (v # vals) (update_state \<phi> x v # states) ?P S)"
+    using rr by simp
+  also have "... \<longleftrightarrow> (\<forall>\<phi> \<in> S. \<forall>v. sat_assertion (v # vals) (update_state \<phi> x v # states) ?PP S)"
+    using rr subst_assertion_single_charact[of _ _ _ _ x ?PP S] helper_update_state
+    by (metis interp_exp.simps(3))
+  also have "... \<longleftrightarrow> (\<forall>\<phi> \<in> S. \<forall>v. sat_assertion vals (update_state \<phi> x v # states) (transform_havoc x P) S)"
+    by (metis insert_at.simps(1) le0 shift_vars_charact)
+  also have "... \<longleftrightarrow> (\<forall>\<phi> \<in> S. \<forall>v. sat_assertion vals (update_state \<phi> x v # states) P S')"
+    using AForallState.hyps AForallState.prems by force
+  also have "... \<longleftrightarrow> sat_assertion vals states (AForallState P) S'"
+    using helper_S_update_states[of S' x S "\<lambda>\<phi>. sat_assertion vals (\<phi> # states) P S'"] assms by force
+  then show ?case
+    using calculation by blast
+next
+  case (AExistsState P)
+
+  let ?PP = "shift_vars 0 (transform_havoc x P)"
+  let ?P = "subst_assertion_single 0 x (EQVar 0) ?PP"
+
+  have rr: "\<And>\<phi> v. sat_assertion (v # vals) (\<phi> # states) ?P S
+   \<longleftrightarrow> sat_assertion (v # vals) (update_state \<phi> x v # states) ?P S"
+  proof -
+    fix \<phi> v
+    have "sat_assertion (v # vals) (insert_at 0 \<phi> states) (subst_assertion_single 0 x (EQVar 0) (shift_vars 0 (transform_havoc x P))) S =
+sat_assertion (v # vals) (insert_at 0 (update_state \<phi> x v) states) (subst_assertion_single 0 x (EQVar 0) (shift_vars 0 (transform_havoc x P))) S"
+      by (metis (no_types, lifting) One_nat_def helper_update_state insert_at.simps(1) insert_at_charact_2 interp_exp.simps(3) length_insert_at list_update_code(2) subst_assertion_single_charact subst_assertion_single_charact_better trans_less_add2 update_state_at_def zero_le zero_less_Suc)
+    then show "sat_assertion (v # vals) (\<phi> # states) ?P S \<longleftrightarrow> sat_assertion (v # vals) (update_state \<phi> x v # states) ?P S"
+      by simp
+  qed
+  have "sat_assertion vals states (transform_havoc x (AExistsState P)) S \<longleftrightarrow> sat_assertion vals states (AExistsState (AExists ?P)) S"
+    by simp
+  also have "... \<longleftrightarrow> (\<exists>\<phi> \<in> S. \<exists>v. sat_assertion (v # vals) (update_state \<phi> x v # states) ?P S)"
+    using rr by simp
+  also have "... \<longleftrightarrow> (\<exists>\<phi> \<in> S. \<exists>v. sat_assertion (v # vals) (update_state \<phi> x v # states) ?PP S)"
+    by (metis helper_update_state interp_exp.simps(3) subst_assertion_single_charact)
+  also have "... \<longleftrightarrow> (\<exists>\<phi> \<in> S. \<exists>v. sat_assertion vals (update_state \<phi> x v # states) (transform_havoc x P) S)"
+    by (metis insert_at.simps(1) le0 shift_vars_charact)
+  also have "... \<longleftrightarrow> (\<exists>\<phi> \<in> S. \<exists>v. sat_assertion vals (update_state \<phi> x v # states) P S')"
+    using AExistsState.hyps AExistsState.prems by force
+  also have "... \<longleftrightarrow> sat_assertion vals states (AExistsState P) S'"
+    using helper_S_update_states_exists[of S' x S "\<lambda>\<phi>. sat_assertion vals (\<phi> # states) P S'"] assms
+    by simp
+  then show ?case
+    using calculation by blast
+qed (simp_all)
+
+
+
+
+subsubsection \<open>Syntactic rule for havoc\<close>
+
+theorem rule_havoc_syntactic_general:
+  "\<Turnstile> { sat_assertion states vals (transform_havoc x P) } Havoc x {sat_assertion states vals P}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "sat_assertion states vals (transform_havoc x P) S"
+  let ?S = "sem (Havoc x) S"
+  have "sat_assertion states vals P ?S \<longleftrightarrow> sat_assertion states vals (transform_havoc x P) S"
+  proof (rule equiv_havoc_transform)
+    show "sem (Havoc x) S = {update_state \<phi> x v |\<phi> v. \<phi> \<in> S}"
+      by (simp add: sem_havoc_bis update_state_def)
+  qed
+  then show "sat_assertion states vals P (sem (Havoc x) S)"
+    using asm0 by fastforce
+qed
+
+
+theorem rule_havoc_syntactic:
+  "\<Turnstile> { interp_assert (transform_havoc x P) } Havoc x {interp_assert P}"
+  by (simp add: rule_havoc_syntactic_general)
+
+
+
+
+
+
+
+
+
+
+
+subsection \<open>Assignment rule\<close>
+
+subsubsection \<open>Program expressions\<close>
+
+fun subst_pexp :: "var \<Rightarrow> 'a pexp \<Rightarrow> 'a pexp \<Rightarrow> 'a pexp" where
+  "subst_pexp x e (PVar y) = (if x = y then e else PVar y)"
+| "subst_pexp x e (PBinop p1 op p2) = PBinop (subst_pexp x e p1) op (subst_pexp x e p2)"
+| "subst_pexp x e (PFun f p) = PFun f (subst_pexp x e p)"
+| "subst_pexp _ _ e = e" (* Constants and quantified vars *)
+
+lemma subst_pexp_charact:
+  "interp_pexp (subst_pexp x e' e) \<sigma> = interp_pexp e (\<sigma>(x := interp_pexp e' \<sigma>))"
+proof (induct e)
+  case (PVar x)
+  then show ?case
+    by (metis fun_upd_apply interp_pexp.simps(1) subst_pexp.simps(1))
+qed (simp_all)
+
+fun subst_pbexp :: "var \<Rightarrow> 'a pexp \<Rightarrow> 'a pbexp \<Rightarrow> 'a pbexp" where
+  "subst_pbexp x e (PBAnd pb1 pb2) = PBAnd (subst_pbexp x e pb1) (subst_pbexp x e pb2)"
+| "subst_pbexp x e (PBOr pb1 pb2) = PBOr (subst_pbexp x e pb1) (subst_pbexp x e pb2)"
+| "subst_pbexp x e (PBComp p1 cmp p2) = PBComp (subst_pexp x e p1) cmp (subst_pexp x e p2)"
+| "subst_pbexp _ _ (PBConst b) = PBConst b"
+
+lemma subst_pbexp_charact:
+  "interp_pbexp (subst_pbexp x e pb) \<sigma> \<longleftrightarrow> interp_pbexp pb (\<sigma>(x := interp_pexp e \<sigma>))"
+proof (induct pb)
+  case (PBComp x1 x2 x3)
+  then show ?case
+    using interp_pbexp.simps(4) subst_pexp_charact
+    by (metis subst_pbexp.simps(3))
+qed (simp_all)
+
+
+subsubsection \<open>Expressions (Boolean and values)\<close>
+
+
+definition subst_all_states where
+  "subst_all_states x pe states = map (subst_state x pe) states"
+
+fun subst_exp :: "var \<Rightarrow> 'a pexp \<Rightarrow> 'a exp \<Rightarrow> 'a exp" where
+  "subst_exp x pe (EPVar st y) = (if x = y then pexp_to_exp st pe else EPVar st y)"
+| "subst_exp x pe (EBinop e1 bop e2) = EBinop (subst_exp x pe e1) bop (subst_exp x pe e2)"
+| "subst_exp x pe (EFun f e) = EFun f (subst_exp x pe e)"
+| "subst_exp _ _ e = e" (* Logical variables, quantified variables, constants *)
+
+
+lemma subst_exp_charact_aux:
+  "snd (subst_state x pe (states ! st)) x = interp_exp vals states (pexp_to_exp st pe)"
+  by (induct pe) (simp_all add: subst_state_def)
+
+lemma subst_exp_charact:
+  assumes "wf_exp nv (length states) e"
+    shows "interp_exp vals states (subst_exp x pe e) = interp_exp vals (subst_all_states x pe states) e"
+  using assms
+proof (induct e)
+  case (EPVar st y)
+  let ?states = "subst_all_states x pe states"
+  have "snd (subst_state x pe (states ! st)) = snd (?states ! st)"
+    by (metis EPVar.prems(1) nth_map subst_all_states_def wf_exp.simps(1))
+  show "interp_exp vals states (subst_exp x pe (EPVar st y)) = interp_exp vals ?states (EPVar st y)"
+  proof (cases "x = y")
+    case True
+    then have "interp_exp vals states (subst_exp x pe (EPVar st y)) = interp_exp vals states (pexp_to_exp st pe)"
+      by simp
+    moreover have "interp_exp vals ?states (EPVar st y) = snd (?states ! st) y"
+      by simp
+    moreover have "... = snd (subst_state x pe (states ! st)) y"
+      by (simp add: \<open>snd (subst_state x pe (states ! st)) = snd (subst_all_states x pe states ! st)\<close>)
+    moreover have "snd (subst_state x pe (states ! st)) x = interp_exp vals states (pexp_to_exp st pe)"
+      by (metis subst_exp_charact_aux)
+    ultimately show ?thesis
+      using True by fastforce
+  next
+    case False
+    then show ?thesis
+      by (metis \<open>snd (subst_state x pe (states ! st)) = snd (subst_all_states x pe states ! st)\<close> fun_upd_other interp_exp.simps(1) snd_conv subst_exp.simps(1) subst_state_def)
+  qed
+next
+  case (ELVar st y)
+  let ?states = "subst_all_states x pe states"
+  have "fst (states ! st) = fst (?states ! st)"
+    by (metis ELVar.prems(1) fst_conv nth_map subst_all_states_def subst_state_def wf_exp.simps(2))
+  have "interp_exp vals states (subst_exp x pe (ELVar st y)) = interp_exp vals states (ELVar st y)"
+    by simp
+  also have "... = fst (states ! st) y"
+    by simp
+  also have "... = fst (?states ! st) y"
+    by (simp add: \<open>fst (states ! st) = fst (subst_all_states x pe states ! st)\<close>)
+  also have "... = interp_exp vals ?states (ELVar st y)"
+    by auto
+  then show "interp_exp vals states (subst_exp x pe (ELVar st y)) = interp_exp vals ?states (ELVar st y)"
+    using calculation by presburger
+qed (simp_all)
+
+
+
+subsubsection \<open>Assertions\<close>
+
+fun transform_assign where
+  "transform_assign x pe (AForallState A) = AForallState (subst_assertion_single 0 x (pexp_to_exp 0 pe) (transform_assign x pe A))"
+| "transform_assign x pe (AExistsState A) = AExistsState (subst_assertion_single 0 x (pexp_to_exp 0 pe) (transform_assign x pe A))"
+| "transform_assign x pe (AExists A) = AExists (transform_assign x pe A)"
+| "transform_assign x pe (AForall A) = AForall (transform_assign x pe A)"
+| "transform_assign x pe (AOr A B) = AOr (transform_assign x pe A) (transform_assign x pe B)"
+| "transform_assign x pe (AAnd A B) = AAnd (transform_assign x pe A) (transform_assign x pe B)"
+| "transform_assign x pe (AConst b) = AConst b"
+| "transform_assign x pe (AComp e1 cmp e2) = AComp e1 cmp e2"
+
+
+lemma transform_assign_works:
+  "sat_assertion vals states (transform_assign x pe A) S = sat_assertion vals states A (subst_state x pe ` S)"
+proof (induct A arbitrary: vals states)
+  case (AForallState A)
+  have "sat_assertion vals states (transform_assign x pe (AForallState A)) S
+  \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (\<phi> # states) (subst_assertion_single 0 x (pexp_to_exp 0 pe) (transform_assign x pe A)) S)"
+    by auto
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (update_state_at (\<phi> # states) 0 x (interp_exp vals (\<phi> # states) (pexp_to_exp 0 pe))) (transform_assign x pe A) S)"
+    by (simp add: subst_assertion_single_charact_better)
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (update_state_at (\<phi> # states) 0 x (interp_exp vals (\<phi> # states) (pexp_to_exp 0 pe))) A (subst_state x pe ` S))"
+    using AForallState by presburger
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (update_state \<phi> x (interp_exp vals (\<phi> # states) (pexp_to_exp 0 pe)) # states) A (subst_state x pe ` S))"
+    using update_state_at_def
+    by (metis list_update_code(2) nth_Cons_0)
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (update_state \<phi> x (interp_pexp pe (snd \<phi>)) # states) A (subst_state x pe ` S))"
+    by (metis nth_Cons_0 same_syn_sem_exp)
+  finally show "sat_assertion vals states (transform_assign x pe (AForallState A)) S = sat_assertion vals states (AForallState A) (subst_state x pe ` S)"
+    by (simp add: subst_state_def update_state_def)
+next
+  case (AExistsState A)
+  have "sat_assertion vals states (transform_assign x pe (AExistsState A)) S
+  \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (\<phi> # states) (subst_assertion_single 0 x (pexp_to_exp 0 pe) (transform_assign x pe A)) S)"
+    by auto
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (update_state_at (\<phi> # states) 0 x (interp_exp vals (\<phi> # states) (pexp_to_exp 0 pe))) (transform_assign x pe A) S)"
+    by (simp add: subst_assertion_single_charact_better)
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (update_state_at (\<phi> # states) 0 x (interp_exp vals (\<phi> # states) (pexp_to_exp 0 pe))) A (subst_state x pe ` S))"
+    using AExistsState by presburger
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (update_state \<phi> x (interp_exp vals (\<phi> # states) (pexp_to_exp 0 pe)) # states) A (subst_state x pe ` S))"
+    using update_state_at_def
+    by (metis list_update_code(2) nth_Cons_0)
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (update_state \<phi> x (interp_pexp pe (snd \<phi>)) # states) A (subst_state x pe ` S))"
+    by (metis nth_Cons_0 same_syn_sem_exp)
+  finally show "sat_assertion vals states (transform_assign x pe (AExistsState A)) S = sat_assertion vals states (AExistsState A) (subst_state x pe ` S)"
+    by (simp add: subst_state_def update_state_def)
+qed (simp_all)
+
+
+subsubsection \<open>Syntactic rule for assignments\<close>
+
+theorem rule_assign_syntactic_general:
+  "\<Turnstile> { sat_assertion vals states (transform_assign x pe P) } Assign x (interp_pexp pe) {sat_assertion vals states P}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "sat_assertion vals states (transform_assign x pe P) S"
+  then have "sat_assertion vals states P (subst_state x pe ` S)"
+    using transform_assign_works by blast
+  moreover have "{(l, \<sigma>(x := interp_pexp pe \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S} = subst_state x pe ` S" (is "?A = ?B")
+  proof
+    show "?A \<subseteq> ?B"
+    proof
+      fix \<phi> assume "\<phi> \<in> ?A"
+      then obtain l \<sigma> where "\<phi> = (l, \<sigma>(x := interp_pexp pe \<sigma>))" "(l, \<sigma>) \<in> S"
+        by blast
+      then show "\<phi> \<in> ?B"
+        by (metis (mono_tags, lifting) fst_conv image_iff snd_conv subst_state_def)
+    qed
+    show "?B \<subseteq> ?A"
+      using subst_state_def by fastforce
+  qed
+  ultimately show "sat_assertion vals states P (sem (Assign x (interp_pexp pe)) S)"
+    by (simp add: sem_assign)
+qed
+
+
+
+theorem rule_assign_syntactic:
+  "\<Turnstile> { interp_assert (transform_assign x pe P) } Assign x (interp_pexp pe) {interp_assert P}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "interp_assert (transform_assign x pe P) S"
+  then have "sat_assertion [] [] P (subst_state x pe ` S)"
+    using transform_assign_works by blast
+  moreover have "{(l, \<sigma>(x := interp_pexp pe \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S} = subst_state x pe ` S" (is "?A = ?B")
+  proof
+    show "?A \<subseteq> ?B"
+    proof
+      fix \<phi> assume "\<phi> \<in> ?A"
+      then obtain l \<sigma> where "\<phi> = (l, \<sigma>(x := interp_pexp pe \<sigma>))" "(l, \<sigma>) \<in> S"
+        by blast
+      then show "\<phi> \<in> ?B"
+        by (metis (mono_tags, lifting) fst_conv image_iff snd_conv subst_state_def)
+    qed
+    show "?B \<subseteq> ?A"
+      using subst_state_def by fastforce
+  qed
+  ultimately show "interp_assert P (sem (Assign x (interp_pexp pe)) S)"
+    by (simp add: sem_assign)
+qed
+
+
+
+
+
+subsection \<open>Loop rules\<close>
+
+
+fun no_exists_state :: "'a assertion \<Rightarrow> bool"
+  where
+  "no_exists_state (AConst _) \<longleftrightarrow> True"
+| "no_exists_state (AComp _ _ _) \<longleftrightarrow> True"
+| "no_exists_state (AForallState A) \<longleftrightarrow> no_exists_state A"
+| "no_exists_state (AExistsState A) \<longleftrightarrow> False"
+| "no_exists_state (AForall A) \<longleftrightarrow> no_exists_state A"
+| "no_exists_state (AExists A) \<longleftrightarrow> no_exists_state A"
+| "no_exists_state (AAnd A B) \<longleftrightarrow> no_exists_state A \<and> no_exists_state B"
+| "no_exists_state (AOr A B) \<longleftrightarrow> no_exists_state A \<and> no_exists_state B"
+
+lemma mono_sym_then_up_closed:
+  assumes "no_exists_state A"
+      and "S \<subseteq> S'"
+      and "sat_assertion vals states A S'"
+    shows "sat_assertion vals states A S"
+  using assms
+proof (induct A arbitrary: vals states)
+  case (AExistsState A)
+  then show ?case
+    by (metis no_exists_state.simps(4))
+qed (auto)
+
+definition up_closed where
+  "up_closed A \<longleftrightarrow> (\<forall>S S' vals states. S \<subseteq> S' \<and> sat_assertion vals states A S \<longrightarrow> sat_assertion vals states A S')"
+
+lemma up_closedE:
+  assumes "up_closed A"
+      and "S \<subseteq> S'"
+      and "sat_assertion vals states A S"
+    shows "sat_assertion vals states A S'"
+  using assms(1) assms(2) assms(3) up_closed_def by blast
+
+
+
+lemma sat_assertion_aforallstateI:
+  assumes "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> sat_assertion vals (\<phi> # states) A S"
+  shows "sat_assertion vals states (AForallState A) S"
+  using assms sat_assertion.simps(3) by blast
+
+
+lemma join_entails:
+  assumes "up_closed A"
+      and "sat_assertion vals states (AForallState A) S1"
+      and "sat_assertion vals states (AForallState A) S2"
+    shows "sat_assertion vals states (AForallState A) (S1 \<union> S2)"
+proof (rule sat_assertion_aforallstateI)
+  fix \<phi>
+  assume asm0: "\<phi> \<in> S1 \<union> S2"
+  show "sat_assertion vals (\<phi> # states) A (S1 \<union> S2)"
+  proof (cases "\<phi> \<in> S1")
+    case True
+    then have "sat_assertion vals (\<phi> # states) A S1"
+      using assms(2) sat_assertion.simps(3) by blast
+    then show ?thesis
+      by (meson assms(1) sup_ge1 up_closedE)
+  next
+    case False
+    then show ?thesis
+      by (metis UnE asm0 assms(1) assms(3) sat_assertion.simps(3) sup_ge2 up_closedE)
+  qed
+qed
+
+
+lemma general_join_entails:
+  assumes "up_closed A"
+      and "\<And>x. sat_assertion vals states (AForallState A) (F x)"
+    shows "sat_assertion vals states (AForallState A) (\<Union>x. F x)"
+proof (rule sat_assertion_aforallstateI)
+  fix \<phi>
+  assume asm0: "\<phi> \<in> \<Union> (range F)"
+  then obtain x where "\<phi> \<in> F x"
+    by blast
+  then have "sat_assertion vals (\<phi> # states) A (F x)"
+    using assms(2) by force
+  then show "sat_assertion vals (\<phi> # states) A (\<Union> (range F))"
+    by (meson Union_upper assms(1) range_eqI up_closedE)
+qed
+
+
+
+fun no_forall_state :: "'a assertion \<Rightarrow> bool"
+  where
+  "no_forall_state (AConst _) \<longleftrightarrow> True"
+| "no_forall_state (AComp _ _ _) \<longleftrightarrow> True"
+| "no_forall_state (AForallState A) \<longleftrightarrow> False"
+| "no_forall_state (AExistsState A) \<longleftrightarrow> no_forall_state A"
+| "no_forall_state (AForall A) \<longleftrightarrow> no_forall_state A"
+| "no_forall_state (AExists A) \<longleftrightarrow> no_forall_state A"
+| "no_forall_state (AAnd A B) \<longleftrightarrow> no_forall_state A \<and> no_forall_state B"
+| "no_forall_state (AOr A B) \<longleftrightarrow> no_forall_state A \<and> no_forall_state B"
+
+lemma no_forall_exists_state_not:
+  "no_forall_state A \<equiv> no_exists_state (ANot A)"
+  by (induct A) auto
+
+
+
+fun no_forall_state_after_existential :: "'a assertion \<Rightarrow> bool"
+  where
+  "no_forall_state_after_existential (AConst _) \<longleftrightarrow> True"
+| "no_forall_state_after_existential (AComp _ _ _) \<longleftrightarrow> True"
+| "no_forall_state_after_existential (AForallState A) \<longleftrightarrow> no_forall_state_after_existential A"
+| "no_forall_state_after_existential (AForall A) \<longleftrightarrow> no_forall_state_after_existential A"
+| "no_forall_state_after_existential (AAnd A B) \<longleftrightarrow> no_forall_state_after_existential A \<and> no_forall_state_after_existential B"
+| "no_forall_state_after_existential (AOr A B) \<longleftrightarrow> no_forall_state_after_existential A \<and> no_forall_state_after_existential B"
+| "no_forall_state_after_existential (AExists A) \<longleftrightarrow> no_forall_state A"
+| "no_forall_state_after_existential (AExistsState A) \<longleftrightarrow> no_forall_state A"
+
+
+lemma up_closed_from_no_exists_state_false:
+  assumes "no_forall_state A"
+      and "sat_assertion vals states A (S n)"
+    shows "sat_assertion vals states A (\<Union>n. S n)"
+  using assms
+proof (induct A)
+  case (AExistsState A)
+  then show ?case
+    by (meson UN_upper no_forall_exists_state_not iso_tuple_UNIV_I mono_sym_then_up_closed sat_assertion_Not)
+next
+  case (AForall A)
+  then show ?case
+    by (meson UN_upper no_forall_exists_state_not iso_tuple_UNIV_I mono_sym_then_up_closed sat_assertion_Not)
+next
+  case (AExists A)
+  then show ?case
+    by (meson UNIV_I no_forall_exists_state_not UN_upper mono_sym_then_up_closed sat_assertion_Not)
+qed (force+)
+
+
+definition shift_sequence :: "(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> (nat \<Rightarrow> 'a)"
+  where
+  "shift_sequence S n m = S (m + n)"
+
+lemma shift_sequence_properties:
+  assumes "ascending S"
+    shows "ascending (shift_sequence S n)"
+      and "(\<Union>m. S m) = (\<Union>m. (shift_sequence S n) m)" (is "?A = ?B")
+  apply (metis (mono_tags, lifting) Suc_n_not_le_n add_Suc ascendingI ascending_def assms nle_le shift_sequence_def)
+proof
+  show "?B \<subseteq> ?A"
+    by (simp add: SUP_le_iff UN_upper shift_sequence_def)
+  show "?A \<subseteq> ?B"
+    by (metis SUP_mono' ascending_def assms le_add1 shift_sequence_def)
+qed
+
+fun extract_indices_sat_P where
+  "extract_indices_sat_P P S 0 = (SOME n. P (S n))"
+| "extract_indices_sat_P P S (Suc m) = (SOME n. P (S n) \<and> n > extract_indices_sat_P P S m)"
+
+definition holds_infinitely_often where
+  "holds_infinitely_often P S \<longleftrightarrow> (\<forall>m. \<exists>n. n > m \<and> P (S n))"
+
+lemma extract_indices_sat_P_properties:
+  assumes "holds_infinitely_often P S"
+    shows "P (S (extract_indices_sat_P P S 0))"
+      and "n > 0 \<Longrightarrow> P (S (extract_indices_sat_P P S n))
+  \<and> extract_indices_sat_P P S n > extract_indices_sat_P P S (n - 1)"
+  apply (metis assms extract_indices_sat_P.simps(1) holds_infinitely_often_def someI_ex)
+  using assms
+proof (induct n)
+  case (Suc n)
+  then have "P (S (extract_indices_sat_P P S n))"
+    by (metis bot_nat_0.not_eq_extremum extract_indices_sat_P.simps(1) holds_infinitely_often_def someI_ex)
+  let ?P = "\<lambda>m. P (S m) \<and> m > extract_indices_sat_P P S n"
+  have "?P (SOME m. ?P m)"
+  proof (rule someI_ex)
+    show "\<exists>x. P (S x) \<and> extract_indices_sat_P P S n < x"
+      by (meson Suc.prems(2) holds_infinitely_often_def)
+  qed
+  then show ?case
+    by simp
+qed (simp)
+
+lemma extract_indices_sat_P_larger:
+  assumes "holds_infinitely_often P S"
+  shows "extract_indices_sat_P P S n \<ge> n"
+  using assms
+proof (induct n)
+  case (Suc n)
+  then show ?case
+    by (metis Suc_leI diff_Suc_1 diff_diff_cancel extract_indices_sat_P_properties(2) less_imp_diff_less zero_less_Suc)
+qed (simp)
+
+definition subseq_sat where
+  "subseq_sat P S n = S (extract_indices_sat_P P S n)"
+
+lemma subseq_sat_properties:
+  assumes "holds_infinitely_often P S"
+      and "ascending S"
+    shows "ascending (subseq_sat P S)"
+      and "\<And>n. P (subseq_sat P S n)"
+      and "(\<Union>n. S n) = (\<Union>n. subseq_sat P S n)" (is "?A = ?B")
+proof (rule ascendingI)
+  fix n
+  have "extract_indices_sat_P P S (Suc n) > extract_indices_sat_P P S n"
+    by (metis assms(1) diff_Suc_1 extract_indices_sat_P_properties(2) zero_less_Suc)
+  then show "subseq_sat P S n \<subseteq> subseq_sat P S (Suc n)"
+    by (metis ascending_def assms(2) less_imp_le_nat subseq_sat_def)
+  fix n show "P (subseq_sat P S n)"
+    by (metis assms(1) extract_indices_sat_P_properties(1) extract_indices_sat_P_properties(2) gr0I subseq_sat_def)
+next
+  show "?A = ?B"
+  proof
+    show "?B \<subseteq> ?A"
+      by (simp add: SUP_le_iff UN_upper subseq_sat_def)
+    show "?A \<subseteq> ?B"
+    proof
+      fix x assume "x \<in> \<Union> (range S)"
+      then obtain n where "x \<in> S n" by blast
+      then have "x \<in> subseq_sat P S n"
+        by (metis ascending_def assms(1) assms(2) extract_indices_sat_P_larger subseq_sat_def subsetD)
+      then show "x \<in> ?B" by blast
+    qed
+  qed
+qed
+
+
+lemma no_forall_state_after_existential_sem:
+  assumes "no_forall_state_after_existential A"
+      and "ascending S"
+      and "\<And>n. sat_assertion vals states A (S n)"
+    shows "sat_assertion vals states A (\<Union>n. S n)"
+  using assms
+proof (induct A arbitrary: vals states S)
+  case (AForallState A)
+  show ?case
+  proof (rule sat_assertion_aforallstateI)
+    fix \<phi>
+    assume "\<phi> \<in> \<Union> (range S)"
+    then obtain n where "\<phi> \<in> S n" by blast
+    then have "\<And>m. m \<ge> n \<Longrightarrow> sat_assertion vals (\<phi> # states) A (S m)"
+      by (meson AForallState.prems(2) AForallState.prems(3) ascending_def sat_assertion.simps(3) subsetD)
+    let ?S = "shift_sequence S n"
+    have "sat_assertion vals (\<phi> # states) A (\<Union> (range ?S))"
+    proof (rule AForallState(1))
+      show "no_forall_state_after_existential A"
+        using AForallState.prems(1) by auto
+      show "ascending ?S"
+        by (simp add: AForallState.prems(2) shift_sequence_properties(1))
+      fix m show "sat_assertion vals (\<phi> # states) A (shift_sequence S n m)"
+        by (simp add: \<open>\<And>m. n \<le> m \<Longrightarrow> sat_assertion vals (\<phi> # states) A (S m)\<close> shift_sequence_def)
+    qed
+    then show "sat_assertion vals (\<phi> # states) A (\<Union> (range S))"
+      by (metis AForallState.prems(2) shift_sequence_properties(2))
+  qed
+next
+  case (AExistsState A)
+  then show ?case
+    by (meson no_forall_state.simps(4) no_forall_state_after_existential.simps(8) up_closed_from_no_exists_state_false)
+next
+  case (AExists A)
+  then show ?case
+    by (meson no_forall_state.simps(6) no_forall_state_after_existential.simps(7) up_closed_from_no_exists_state_false)
+next
+  case (AOr A1 A2)
+(* either A1 is infinitely often true, or either A2 is... *)
+  show ?case
+  proof (cases "holds_infinitely_often (sat_assertion vals states A1) S")
+    case True
+    then have "sat_assertion vals states A1 (\<Union> (range (subseq_sat (sat_assertion vals states A1) S)))"
+      using AOr.hyps(1) AOr.prems(1) AOr.prems(2) subseq_sat_properties(1) subseq_sat_properties(2) no_forall_state_after_existential.simps(6) by blast
+    then show ?thesis
+      using AOr.prems(2) True subseq_sat_properties(3) by fastforce
+  next
+    case False
+    then have "holds_infinitely_often (sat_assertion vals states A2) S"
+      using AOr.prems(3) sat_assertion.simps(8) holds_infinitely_often_def
+      by (metis gt_ex max_less_iff_conj)
+    then have "sat_assertion vals states A2 (\<Union> (range (subseq_sat (sat_assertion vals states A2) S)))"
+      using AOr.hyps(2) AOr.prems(1) AOr.prems(2) subseq_sat_properties(1) subseq_sat_properties(2) no_forall_state_after_existential.simps(6) by blast
+    then show ?thesis
+      using AOr.prems(2) \<open>holds_infinitely_often (sat_assertion vals states A2) S\<close> subseq_sat_properties(3) by fastforce
+  qed
+next
+  case (AAnd A1 A2)
+  then show ?case
+    using sat_assertion.simps(7) no_forall_state_after_existential.simps(5) by blast
+qed (simp_all)
+
+
+(* Can be used with while rule! *)
+lemma upwards_closed_syn_sem_practical:
+  assumes "no_forall_state_after_existential A"
+  shows "upwards_closed (\<lambda>n. interp_assert A) (interp_assert A)"
+  by (simp add: assms no_forall_state_after_existential_sem upwards_closed_def)
+
+theorem while_general_syntactic:
+  assumes "\<And>n. \<Turnstile> {P n} if_then b C {P (Suc n)}"
+      and "\<And>n. \<Turnstile> {P n} Assume (lnot b) {interp_assert A}"
+      and "no_forall_state_after_existential A"
+    shows "\<Turnstile> {P 0} while_cond b C {conj (interp_assert A) (holds_forall (lnot b))}"
+  by (metis assms(1) assms(2) assms(3) upwards_closed_syn_sem_practical while_general)
+
+theorem while_forall_exists_simpler:
+  assumes "\<Turnstile> {I} if_then b C {I}"
+      and "\<Turnstile> {I} Assume (lnot b) {interp_assert Q}"
+      and "no_forall_state_after_existential Q"
+    shows "\<Turnstile> {I} while_cond b C {conj (interp_assert Q) (holds_forall (lnot b))}"
+  by (metis assms(1) assms(2) assms(3) upwards_closed_syn_sem_practical while_general)
+
+(* Side-conditions: No normal existential on the left of a forallstate, no existential state *)
+theorem while_d_syntactic:
+  assumes "\<Turnstile> { interp_assert A } if_then b C { interp_assert A }"
+      and "no_forall_state_after_existential A"
+      and "no_exists_state A"
+    shows "\<Turnstile> { interp_assert A } while_cond b C {conj (interp_assert A) (holds_forall (lnot b))}"
+  using assms(1)
+proof (rule while_d)
+  show "upwards_closed (\<lambda>a. interp_assert A) (interp_assert A)"
+    by (simp add: assms(2) no_forall_state_after_existential_sem upwards_closed_def)
+  fix n show "downwards_closed (interp_assert A)"
+    using assms(3) downwards_closed_def mono_sym_then_up_closed by fastforce
+qed
+
+
+
+lemma downwards_closed_is_hypersafety:
+  "hypersafety P \<longleftrightarrow> downwards_closed P"
+  using downwards_closed_def hypersafety_def by metis
+
+
+subsection \<open>Rewrite rules for 'a assertions\<close>
+
+definition equiv where
+  "equiv A B \<longleftrightarrow> (\<forall>vals states S. sat_assertion vals states A S \<longleftrightarrow> sat_assertion vals states B S)"
+
+lemma forall_commute:
+  "equiv (AForallState (AForall A)) (AForall (AForallState A))"
+  using equiv_def by force
+
+lemma exists_commute:
+  "equiv (AExistsState (AExists A)) (AExists (AExistsState A))"
+  using equiv_def by force
+
+lemma forall_state_and:
+  "equiv (AForallState (AAnd A B)) (AAnd (AForallState A) (AForallState B))"
+  using equiv_def by force
+
+lemma exists_state_or:
+  "equiv (AExistsState (AOr A B)) (AOr (AExistsState A) (AExistsState B))"
+  using equiv_def by force
+
+lemma forall_and:
+  "equiv (AForall (AAnd A B)) (AAnd (AForall A) (AForall B))"
+  using equiv_def by force
+
+lemma exists_or:
+  "equiv (AExists (AOr A B)) (AOr (AExists A) (AExists B))"
+  using equiv_def by force
+
+lemma entailment_natural_partition:
+  assumes "no_forall_state P"
+  shows "entails (natural_partition (\<lambda>(n::nat). interp_assert (AForallState P))) (interp_assert (AForallState P))"
+proof (rule entailsI)
+  fix S :: "((nat \<Rightarrow> 'a) \<times> (nat \<Rightarrow> 'a)) set"
+
+  assume asm0: "natural_partition (\<lambda>(n::nat). interp_assert (AForallState P)) S"
+  then obtain F where "S = (\<Union>(n::nat). F n)" "\<And>n. interp_assert (AForallState P) (F n)"
+    using natural_partitionE[of "\<lambda>n. interp_assert (AForallState P)" S] by blast
+  then have "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> sat_assertion [] [\<phi>] P S"    
+    by (meson UN_iff assms sat_assertion.simps(3) up_closed_from_no_exists_state_false)
+  then show "interp_assert (AForallState P) S"
+    by simp
+qed
+
+
+lemma no_forall_state_mono:
+  assumes "no_forall_state A"
+      and "sat_assertion vals states A S"
+      and "S \<subseteq> S'"
+    shows "sat_assertion vals states A S'"
+by (metis assms(1) assms(2) assms(3) mono_sym_then_up_closed no_forall_exists_state_not sat_assertion_Not)
+
+
+lemma entailment_loop_join:
+  assumes "no_forall_state P"
+  shows "entails (join (interp_assert (AForallState P)) (interp_assert (AForallState P))) (interp_assert (AForallState P))"
+proof (rule entailsI)
+  fix S :: "((nat \<Rightarrow> 'a) \<times> (nat \<Rightarrow> 'a)) set"
+
+  assume asm0: "join (interp_assert (AForallState P)) (interp_assert (AForallState P)) S"
+  then obtain S1 S2 where r: "S = S1 \<union> S2" "interp_assert (AForallState P) S1" "interp_assert (AForallState P) S2"
+    by (metis join_def)
+  have "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> sat_assertion [] [\<phi>] P S"    
+  proof -
+    fix \<phi> assume asm1: "\<phi> \<in> S"
+    then show "sat_assertion [] [\<phi>] P S"
+      by (metis Un_iff r assms no_forall_state_mono sat_assertion.simps(3) sup_ge1 sup_ge2)
+  qed
+  then show "interp_assert (AForallState P) S"
+    by simp
+qed
+
+
+
+
+subsection \<open>Free variables and safe frame rule\<close>
+
+fun wr :: "(nat, nat) stmt \<Rightarrow> nat set" where
+  "wr Skip = {}"
+| "wr (Assign x _) = {x}"
+| "wr (Havoc x) = {x}"
+| "wr (Assume b) = {}"
+| "wr (C1;; C2) = wr C1 \<union> wr C2"
+| "wr (If C1 C2) = wr C1 \<union> wr C2"
+| "wr (While C) = wr C"
+
+
+definition agree_on where
+  "agree_on V \<sigma> \<sigma>' \<longleftrightarrow> (\<forall>x\<in>V. \<sigma> x = \<sigma>' x)"
+
+lemma agree_onI:
+  assumes "\<And>x. x\<in>V \<Longrightarrow> \<sigma> x = \<sigma>' x"
+  shows "agree_on V \<sigma> \<sigma>'"
+  using agree_on_def assms by blast
+
+lemma agree_onE:
+  assumes "agree_on V \<sigma> \<sigma>'"
+      and "x \<in> V"
+    shows "\<sigma> x = \<sigma>' x"
+  by (meson agree_on_def assms(1) assms(2))
+
+lemma agree_on_subset:
+  assumes "agree_on V' \<sigma> \<sigma>'"
+      and "V \<subseteq> V'"
+    shows "agree_on V \<sigma> \<sigma>'"
+  by (meson agree_on_def assms(1) assms(2) in_mono)
+
+lemma agree_on_trans:
+  assumes "agree_on V \<sigma> \<sigma>'"
+      and "agree_on V \<sigma>' \<sigma>''"
+    shows "agree_on V \<sigma> \<sigma>''"
+proof (rule agree_onI)
+  fix x assume "x \<in> V"
+  then show "\<sigma> x = \<sigma>'' x"
+    by (metis agree_on_def assms(1) assms(2))
+qed
+
+lemma agree_on_sym:
+  assumes "agree_on V \<sigma> \<sigma>'"
+  shows "agree_on V \<sigma>' \<sigma>"
+  by (metis agree_on_def assms)
+
+lemma wr_charact:
+  assumes "single_sem C \<sigma> \<sigma>'"
+      and "wr C \<inter> V = {}"
+  shows "agree_on V \<sigma> \<sigma>'"
+  using assms
+proof (induct rule: single_sem.induct)
+  case (SemSeq C1 \<sigma> \<sigma>1 C2 \<sigma>2)
+  then show ?case
+    by (metis Un_empty agree_on_trans inf_sup_distrib2 wr.simps(5))
+qed (auto simp add: agree_on_def)
+
+fun fv_exp :: "'a exp \<Rightarrow> var set" where
+  "fv_exp (EBinop e1 _ e2) = fv_exp e1 \<union> fv_exp e2"
+| "fv_exp (EPVar _ x) = {x}"
+| "fv_exp (EFun _ e) = fv_exp e"
+| "fv_exp _ = {}"
+
+lemma fv_wr_charact_exp:
+(* all program variables *)
+  assumes "agree_on (fv_exp e) \<sigma> \<sigma>'"
+      and "n \<le> length states"
+      and "wf_exp nv (Suc (length states)) e"
+    shows "interp_exp vals (insert_at n (l, \<sigma>) states) e = interp_exp vals (insert_at n (l, \<sigma>') states) e"
+  using assms
+proof (induct e)
+  case (EPVar st x)
+  then show ?case
+  proof (cases "st < n")
+    case True
+    then show ?thesis
+      by (simp add: assms(2) insert_at_charact_1)
+  next
+    case False
+    then have "st \<ge> n" by simp
+    then show ?thesis
+    proof (cases "st = n")
+      case True
+      then have "interp_exp vals (insert_at n (l, \<sigma>) states) (EPVar st x) = \<sigma> x"
+        by (simp add: assms(2) insert_at_charact_2)
+      also have "... = \<sigma>' x"
+        by (metis EPVar.prems(1) agree_on_def fv_exp.simps(2) insertCI)
+      then show ?thesis
+        by (simp add: True assms(2) insert_at_charact_2)
+    next
+      case False
+      then have "interp_exp vals (insert_at n (l, \<sigma>) states) (EPVar st x) = snd ((insert_at n (l, \<sigma>) states) ! st) x"
+        by simp
+      also have "... = snd (states ! (st - 1)) x"        
+        by (metis False One_nat_def \<open>n \<le> st\<close> add_diff_inverse_nat assms(2) dual_order.antisym insert_at_charact_3 le_less_Suc_eq le_zero_eq not_less_eq_eq plus_1_eq_Suc)
+      then show ?thesis
+        by (metis False One_nat_def \<open>n \<le> st\<close> add_diff_inverse_nat assms(2) dual_order.antisym insert_at_charact_3 interp_exp.simps(1) le_less_Suc_eq le_zero_eq not_less_eq_eq plus_1_eq_Suc)
+    qed
+  qed
+next
+  case (ELVar st x)
+  then show ?case
+  proof (cases "st < n")
+    case True
+    then show ?thesis
+      by (simp add: assms(2) insert_at_charact_1)
+  next
+    case False
+    then have "st \<ge> n" by simp
+    then show ?thesis
+    proof (cases "st = n")
+      case True
+      then have "interp_exp vals (insert_at n (l, \<sigma>) states) (ELVar st x) = l x"
+        by (simp add: assms(2) insert_at_charact_2)
+      then show ?thesis
+        by (simp add: True assms(2) insert_at_charact_2)
+    next
+      case False
+      then have "interp_exp vals (insert_at n (l, \<sigma>) states) (ELVar st x) = fst ((insert_at n (l, \<sigma>) states) ! st) x"
+        by simp
+      also have "... = fst (states ! (st - 1)) x"        
+        by (metis False One_nat_def \<open>n \<le> st\<close> add_diff_inverse_nat assms(2) dual_order.antisym insert_at_charact_3 le_less_Suc_eq le_zero_eq not_less_eq_eq plus_1_eq_Suc)
+      then show ?thesis
+        by (metis False One_nat_def \<open>n \<le> st\<close> add_diff_inverse_nat assms(2) dual_order.antisym insert_at_charact_3 interp_exp.simps(2) le_less_Suc_eq le_zero_eq not_less_eq_eq plus_1_eq_Suc)
+    qed
+  qed
+next
+  case (EBinop e1 x2 e2)
+  then show ?case
+    by (simp add: agree_on_def)
+qed (simp_all)
+
+
+(* program variables... *)
+fun fv where
+  "fv (AAnd F1 F2) = fv F1 \<union> fv F2"
+| "fv (AOr F1 F2) = fv F1 \<union> fv F2"
+| "fv (AForall F) = fv F"
+| "fv (AExists F) = fv F"
+| "fv (AForallState F) = fv F"
+| "fv (AExistsState F) = fv F"
+| "fv (AConst b) = {}"
+| "fv (AComp e1 cmp e2) = fv_exp e1 \<union> fv_exp e2"
+
+
+
+
+lemma fv_wr_charact_aux:
+(* all program variables *)
+  assumes "agree_on (fv F) \<sigma> \<sigma>'"
+      and "n \<le> length states"
+      and "sat_assertion vals (insert_at n (l, \<sigma>) states) F S"
+      and "wf_assertion_aux nv (Suc (length states)) F"
+    shows "sat_assertion vals (insert_at n (l, \<sigma>') states) F S"
+  using assms
+proof (induct F arbitrary: vals states n nv)
+  case (AExists F)
+  then show ?case
+    by (metis fv.simps(4) sat_assertion.simps(6) wf_assertion_aux.simps(6))
+next
+  case (AComp e1 cmp e2)
+  then have "interp_exp vals (insert_at n (l, \<sigma>) states) e1 = interp_exp vals (insert_at n (l, \<sigma>') states) e1"
+    using fv_wr_charact_exp[of e1 \<sigma> \<sigma>' n states nv vals l] agree_on_subset by fastforce
+  moreover have "interp_exp vals (insert_at n (l, \<sigma>) states) e2 = interp_exp vals (insert_at n (l, \<sigma>') states) e2"
+    using fv_wr_charact_exp[of e2 \<sigma> \<sigma>' n states nv vals l] agree_on_subset AComp by auto
+  ultimately show "sat_assertion vals (insert_at n (l, \<sigma>') states) (AComp e1 cmp e2) S"
+    using AComp.prems(3) by auto
+next
+  case (AForallState F)
+  then have "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> sat_assertion vals (insert_at (Suc n) (l, \<sigma>) (\<phi> # states)) F S"
+    by simp
+  then have "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> sat_assertion vals (insert_at (Suc n) (l, \<sigma>') (\<phi> # states)) F S"
+    by (metis AForallState.hyps AForallState.prems(1) AForallState.prems(2) AForallState.prems(4) Suc_le_mono fv.simps(5) length_Cons wf_assertion_aux.simps(7))
+  then show ?case by simp
+next
+  case (AExistsState F)
+  then obtain \<phi> where asm0: "\<phi> \<in> S" "sat_assertion vals (insert_at (Suc n) (l, \<sigma>) (\<phi> # states)) F S"
+    by auto
+  then have "sat_assertion vals (insert_at (Suc n) (l, \<sigma>') (\<phi> # states)) F S"
+    by (metis AExistsState.hyps AExistsState.prems(1) AExistsState.prems(2) AExistsState.prems(4) Suc_le_mono fv.simps(6) length_Cons wf_assertion_aux.simps(8))
+  then show ?case using asm0 by auto
+qed (auto simp add: agree_on_def)
+
+
+lemma fv_wr_charact:
+  assumes "agree_on (fv F) \<sigma> \<sigma>'"
+      and "sat_assertion vals ((l, \<sigma>) # states) F S"
+      and "wf_assertion_aux nv (Suc (length states)) F"
+    shows "sat_assertion vals ((l, \<sigma>') # states) F S"
+proof -
+  have "sat_assertion vals (insert_at 0 (l, \<sigma>') states) F S"
+    using assms fv_wr_charact_aux by fastforce
+  then show ?thesis
+    by simp
+qed
+
+
+lemma syntactic_safe_frame_preserved:
+  assumes "wr C \<inter> fv F = {}"
+      and "sat_assertion vals states F S"
+      and "wf_assertion_aux nv (length states) F"
+      and "no_exists_state F"
+    shows "sat_assertion vals states F (sem C S)"
+  using assms
+proof (induct F arbitrary: vals states nv)
+  case (AForallState F)
+  then have "\<And>\<phi>. \<phi> \<in> sem C S \<Longrightarrow> sat_assertion vals (\<phi> # states) F (sem C S)"
+  proof -
+    fix \<phi> assume asm0: "\<phi> \<in> sem C S"
+    then obtain \<sigma> where "single_sem C \<sigma> (snd \<phi>)" "(fst \<phi>, \<sigma>) \<in> S"
+      using in_sem by blast
+    then have "sat_assertion vals ((fst \<phi>, \<sigma>) # states) F (sem C S)"
+      using AForallState.hyps AForallState.prems assms(1) by auto
+    moreover have "agree_on (fv F) \<sigma> (snd \<phi>)"
+      using AForallState.prems(1) \<open>\<langle>(C::(nat, nat) stmt), \<sigma>::nat \<Rightarrow> nat\<rangle> \<rightarrow> snd (\<phi>::(nat \<Rightarrow> nat) \<times> (nat \<Rightarrow> nat))\<close> wr_charact by auto
+    moreover have "wf_assertion_aux nv (Suc (length states)) F"
+      using AForallState.prems(3) by auto
+    ultimately have "sat_assertion vals ((fst \<phi>, snd \<phi>) # states) F (sem C S)"
+      using fv_wr_charact[of F \<sigma> "snd \<phi>" vals "fst \<phi>" states "sem C S"]
+      by fast
+    then show "sat_assertion vals (\<phi> # states) F (sem C S)"
+      by simp
+  qed
+  then show ?case
+    using AForallState.hyps AForallState.prems(2) assms(1) by auto
+qed (fastforce+)
+
+theorem safe_frame_rule_syntactic:
+  assumes "wr C \<inter> fv F = {}"
+      and "wf_assertion F"
+      and "no_exists_state F"
+    shows "\<Turnstile> {interp_assert F} C {interp_assert F}"
+  by (metis assms(1) assms(2) assms(3) hyper_hoare_tripleI list.size(3) syntactic_safe_frame_preserved)
+
+theorem LUpdateS:
+  assumes "\<Turnstile> { (\<lambda>S. P S \<and> e_recorded_in_t e t S) } C { Q }"
+      and "not_fv_hyper t P"
+      and "not_fv_hyper t Q"
+  shows "\<Turnstile> { P } C { Q }"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm: "P S"
+  let ?S = "assign_exp_to_lvar_set e t S"
+  have "Q (sem C ?S)"
+    using asm assms(1) assms(2) e_recorded_in_t_if_assigned hyper_hoare_tripleE not_fv_hyper_assign_exp by fastforce
+  then show "Q (sem C S)"
+    by (meson assign_exp_to_lvar_set_same_mod_updates assms(3) not_fv_hyper_def same_mod_updates_sym sem_update_commute)
+qed
+
+
+end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/TotalLogic.thy b/thys/HyperHoareLogic/TotalLogic.thy
new file mode 100644
--- /dev/null
+++ b/thys/HyperHoareLogic/TotalLogic.thy
@@ -0,0 +1,1105 @@
+theory TotalLogic
+  imports Loops Compositionality SyntacticAssertions
+begin
+
+section \<open>Terminating Hyper-Triples\<close>
+
+definition total_hyper_triple ("\<Turnstile>TERM {_} _ {_}" [51,0,0] 81) where
+  "\<Turnstile>TERM {P} C {Q} \<longleftrightarrow> ( \<Turnstile> {P} C {Q} \<and> (\<forall>S. P S \<longrightarrow> (\<forall>\<phi> \<in> S. \<exists>\<sigma>'. single_sem C (snd \<phi>) \<sigma>' )))"
+
+lemma total_hyper_triple_equiv:
+  "\<Turnstile>TERM {P} C {Q} \<longleftrightarrow> ( \<Turnstile> {P} C {Q} \<and> (\<forall>S. P S \<longrightarrow> (\<forall>\<phi> \<in> S. \<exists>\<sigma>'. (fst \<phi>, \<sigma>') \<in> sem C S \<and> single_sem C (snd \<phi>) \<sigma>' )))"
+  by (metis prod.collapse single_step_then_in_sem total_hyper_triple_def)
+
+lemma total_hyper_tripleI:
+  assumes "\<Turnstile> {P} C {Q}"
+      and "\<And>\<phi> S. P S \<and> \<phi> \<in> S \<Longrightarrow> (\<exists>\<sigma>'. single_sem C (snd \<phi>) \<sigma>' )"
+    shows "\<Turnstile>TERM {P} C {Q}"
+  by (simp add: assms(1) assms(2) total_hyper_triple_def)
+
+definition terminates_in where
+  "terminates_in C S \<longleftrightarrow> (\<forall>\<phi> \<in> S. \<exists>\<sigma>'. single_sem C (snd \<phi>) \<sigma>')"
+
+lemma terminates_inI:
+  assumes "\<And>\<phi>. \<phi> \<in> S \<Longrightarrow> \<exists>\<sigma>'. single_sem C (snd \<phi>) \<sigma>'"
+  shows "terminates_in C S"
+  using assms terminates_in_def by blast
+
+lemma iterate_sem_mono:
+  assumes "S \<subseteq> S'"
+  shows "iterate_sem n C S \<subseteq> iterate_sem n C S'"
+  using assms
+  by (induct n arbitrary: S S') (simp_all add: sem_monotonic)
+
+lemma terminates_in_while_loop:
+  assumes "wfP lt"
+      and "\<And>\<phi> n. \<phi> \<in> iterate_sem n (Assume b;; C) S \<and> b (snd \<phi>) \<Longrightarrow> (\<exists>\<sigma>'. single_sem C (snd \<phi>) \<sigma>' \<and> (\<not> b \<sigma>' \<or> lt (e \<sigma>') (e (snd \<phi>))))"
+  shows "terminates_in (while_cond b C) S"
+proof (rule terminates_inI)
+  fix \<phi> assume asm0: "\<phi> \<in> S"
+  let ?S = "{\<phi>}"
+  let ?R = "{(x, y). lt x y}"
+  let ?Q = "{ e (snd \<phi>) |\<phi> n. b (snd \<phi>) \<and> \<phi> \<in> iterate_sem n (Assume b;; C) ?S}"
+
+  show "\<exists>\<sigma>'. \<langle>while_cond b C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+  proof (cases "b (snd \<phi>)")
+    case False
+    then show ?thesis
+      by (metis SemAssume SemSeq SemWhileExit lnot_def while_cond_def)
+  next
+    case True
+    show ?thesis
+    proof (rule wfE_min)
+      show "wf ?R"
+        using assms(1) wfP_def by blast
+      show "e (snd \<phi>) \<in> ?Q"
+        using True asm0 iterate_sem.simps(1) by fastforce
+      fix z assume asm1: "z \<in> ?Q" "(\<And>y. (y, z) \<in> {(x, y). lt x y} \<Longrightarrow> y \<notin> ?Q)"
+      then obtain \<phi>' n where "z = e (snd \<phi>')" "b (snd \<phi>')" "\<phi>' \<in> iterate_sem n (Assume b;; C) ?S"
+        by blast
+      then obtain \<sigma>' where "single_sem C (snd \<phi>') \<sigma>' \<and> (\<not> b \<sigma>' \<or> lt (e \<sigma>') (e (snd \<phi>')))"
+        using assms(2) iterate_sem_mono[of ?S S n "Assume b;; C"]
+        by (meson asm0 empty_subsetI in_mono insert_subsetI)
+      then have "\<not> b \<sigma>' \<or> e \<sigma>' \<notin> ?Q"
+        using \<open>z = e (snd \<phi>')\<close> asm1(2) by blast
+      moreover have "(fst \<phi>', \<sigma>') \<in> sem (Assume b;; C) (iterate_sem n (Assume b;; C) ?S)"
+        by (metis (no_types, opaque_lifting) SemAssume SemSeq \<open>(\<langle>C, snd \<phi>'\<rangle> \<rightarrow> \<sigma>') \<and> (\<not> b \<sigma>' \<or> lt (e \<sigma>') (e (snd \<phi>')))\<close> \<open>\<phi>' \<in> iterate_sem n (Assume b ;; C) ?S\<close> \<open>b (snd \<phi>')\<close> single_step_then_in_sem surjective_pairing)
+      ultimately have "\<not> b \<sigma>'"
+        using iterate_sem.simps(2)[of n "Assume b;; C" "{\<phi>}"] mem_Collect_eq snd_conv
+        by (metis (mono_tags, lifting))
+      then have "(fst \<phi>', \<sigma>') \<in> iterate_sem (Suc n) (Assume b;; C) ?S"
+        by (simp add: \<open>(fst \<phi>', \<sigma>') \<in> sem (Assume b ;; C) (iterate_sem n (Assume b ;; C) ?S)\<close>)
+      then have "(fst \<phi>', \<sigma>') \<in> (\<Union>n. iterate_sem n (Assume b;; C) ?S)" by blast
+      then have "(fst \<phi>', \<sigma>') \<in> filter_exp (lnot b) (\<Union>n. iterate_sem n (Assume b;; C) ?S)"
+        using filter_exp_def[of "lnot b"] lnot_def[of b \<sigma>'] \<open>\<not> b \<sigma>'\<close> by force
+      then have "(fst \<phi>', \<sigma>') \<in> sem (while_cond b C) ?S"
+        by (simp add: assume_sem filter_exp_def sem_seq sem_while while_cond_def)
+      then show "\<exists>\<sigma>'. \<langle>while_cond b C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+        by (metis in_sem singletonD snd_conv)
+    qed
+  qed
+qed
+
+lemma total_hyper_triple_altI:
+  assumes "\<And>S. P S \<Longrightarrow> Q (sem C S)"
+      and "\<And>S. P S \<Longrightarrow> terminates_in C S"
+    shows "\<Turnstile>TERM {P} C {Q}"
+  by (metis assms(1) assms(2) hyper_hoare_tripleI terminates_in_def total_hyper_triple_def)
+
+
+
+lemma syntactic_frame_preserved:
+  assumes "terminates_in C S"
+      and "wr C \<inter> fv F = {}"
+      and "sat_assertion vals states F S"
+      and "wf_assertion_aux nv (length states) F"
+    shows "sat_assertion vals states F (sem C S)"
+  using assms
+proof (induct F arbitrary: vals states nv)
+  case (AForallState F)
+  then have "\<And>\<phi>. \<phi> \<in> sem C S \<Longrightarrow> sat_assertion vals (\<phi> # states) F (sem C S)"
+  proof -
+    fix \<phi> assume asm0: "\<phi> \<in> sem C S"
+    then obtain \<sigma> where "single_sem C \<sigma> (snd \<phi>)" "(fst \<phi>, \<sigma>) \<in> S"
+      using in_sem by blast
+    then have "sat_assertion vals ((fst \<phi>, \<sigma>) # states) F (sem C S)"
+      using AForallState.hyps AForallState.prems assms(1) by auto
+    moreover have "agree_on (fv F) \<sigma> (snd \<phi>)"
+      using AForallState.prems(2) \<open>\<langle>(C::(nat, nat) stmt), \<sigma>::nat \<Rightarrow> nat\<rangle> \<rightarrow> snd (\<phi>::(nat \<Rightarrow> nat) \<times> (nat \<Rightarrow> nat))\<close> wr_charact by auto
+    moreover have "wf_assertion_aux nv (Suc (length states)) F"
+      using AForallState.prems(4) by auto
+    ultimately have "sat_assertion vals ((fst \<phi>, snd \<phi>) # states) F (sem C S)"
+      using fv_wr_charact[of F \<sigma> "snd \<phi>" vals "fst \<phi>" states "sem C S"]
+      by fast
+    then show "sat_assertion vals (\<phi> # states) F (sem C S)"
+      by simp
+  qed
+  then show ?case
+    using AForallState.hyps AForallState.prems(2) assms(1) by auto
+next
+  case (AExistsState F)
+  then obtain \<phi> where asm0: "\<phi> \<in> S" "sat_assertion vals (\<phi> # states) F S"
+    by auto
+  then obtain \<sigma>' where "single_sem C (snd \<phi>) \<sigma>'"
+    using assms(1) terminates_in_def by blast
+  then have "sat_assertion vals ((fst \<phi>, \<sigma>') # states) F S"
+    by (metis AExistsState.prems(2) AExistsState.prems(4) asm0(2) fv.simps(6) fv_wr_charact prod.collapse wf_assertion_aux.simps(8) wr_charact)
+  then show ?case
+    by (metis AExistsState.hyps AExistsState.prems(2) AExistsState.prems(4) \<open>\<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'\<close> asm0(1) assms(1) fv.simps(6) length_Cons prod.collapse sat_assertion.simps(4) single_step_then_in_sem wf_assertion_aux.simps(8))
+qed (fastforce+)
+
+
+theorem frame_rule_syntactic:
+  assumes "\<Turnstile>TERM {P} C {Q}"
+      and "wr C \<inter> fv F = {}" (* free *program* variables *)
+      and "wf_assertion F" (* No unbound free variable *)
+    shows "\<Turnstile>TERM {conj P (interp_assert F)} C {conj Q (interp_assert F)}"
+proof (rule total_hyper_tripleI)
+  let ?F = "interp_assert F"
+  show "\<And>\<phi> S. Logic.conj P ?F S \<and> \<phi> \<in> S \<Longrightarrow> \<exists>\<sigma>'. \<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+    by (metis assms(1) conj_def total_hyper_triple_def)
+  show "\<Turnstile> {Logic.conj P ?F} C {Logic.conj Q ?F}"
+  proof (rule hyper_hoare_tripleI)
+    fix S assume asm0: "Logic.conj P ?F S"
+    then have "terminates_in C S"
+      by (simp add: \<open>\<And>\<phi> S. Logic.conj P ?F S \<and> \<phi> \<in> S \<Longrightarrow> \<exists>\<sigma>'. \<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'\<close> terminates_in_def)
+    moreover have "?F (sem C S)"
+      by (metis asm0 assms(2) assms(3) calculation conj_def list.size(3) syntactic_frame_preserved)
+    ultimately show "Logic.conj Q ?F (sem C S)"
+      by (metis asm0 assms(1) conj_def hyper_hoare_tripleE total_hyper_triple_def)
+  qed
+qed
+
+
+
+
+subsection \<open>Specialize rule\<close>
+
+
+definition same_syn_sem_all :: "'a assertion \<Rightarrow> ((nat, 'a, nat, 'a) state \<Rightarrow> bool) \<Rightarrow> bool"
+  where
+  "same_syn_sem_all bsyn bsem \<longleftrightarrow>
+  (\<forall>states vals S. length states > 0 \<longrightarrow> bsem (hd states) = sat_assertion vals states bsyn S)"
+
+lemma same_syn_sem_allI:
+  assumes "\<And>states vals S. length states > 0 \<Longrightarrow> bsem (hd states) \<longleftrightarrow> sat_assertion vals states bsyn S"
+  shows "same_syn_sem_all bsyn bsem"
+  by (simp add: assms same_syn_sem_all_def)
+
+lemma transform_assume_valid:
+  assumes "same_syn_sem_all bsyn bsem"
+  shows "sat_assertion vals states A (Set.filter bsem S)
+  \<longleftrightarrow> sat_assertion vals states (transform_assume bsyn A) S"
+proof (induct A arbitrary: vals states)
+  case (AForallState A)
+  let ?S = "Set.filter (bsem) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AForallState A) ?S \<longleftrightarrow> (\<forall>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) ?A S)"
+    using AForallState by presburger
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. bsem \<phi> \<longrightarrow> sat_assertion vals (\<phi> # states) ?A S)"
+    by fastforce
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (\<phi> # states) bsyn S \<longrightarrow> sat_assertion vals (\<phi> # states) ?A S)"
+    using assms same_syn_sem_all_def[of bsyn bsem] by auto
+  also have "... \<longleftrightarrow> (\<forall>\<phi>\<in>S. sat_assertion vals (\<phi> # states) (AImp bsyn ?A) S)"
+    using sat_assertion_Imp by fast
+  also have "... \<longleftrightarrow> sat_assertion vals states (AForallState (AImp bsyn ?A)) S"
+    using sat_assertion.simps(2) by force
+  then show ?case
+    using calculation transform_assume.simps(1) by fastforce
+next
+  case (AExistsState A)
+  let ?S = "Set.filter (bsem) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AExistsState A) ?S \<longleftrightarrow> (\<exists>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>?S. sat_assertion vals (\<phi> # states) ?A S)"
+    using AExistsState by presburger
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. bsem \<phi> \<and> sat_assertion vals (\<phi> # states) ?A S)"
+    by force
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (\<phi> # states) bsyn S \<and> sat_assertion vals (\<phi> # states) ?A S)"
+    using assms same_syn_sem_all_def[of bsyn bsem] by auto
+  also have "... \<longleftrightarrow> (\<exists>\<phi>\<in>S. sat_assertion vals (\<phi> # states) (AAnd bsyn ?A) S)"
+    by simp
+  also have "... \<longleftrightarrow> sat_assertion vals states (AExistsState (AAnd bsyn ?A)) S"
+    using sat_assertion.simps(3) by force
+  then show ?case
+    using calculation transform_assume.simps(2) by fastforce
+next
+  case (AForall A)
+  let ?S = "Set.filter (bsem) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AForall A) ?S \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<forall>v. sat_assertion (v # vals) states ?A S)"
+    using AForall by presburger
+  also have "... \<longleftrightarrow> sat_assertion vals states (AForall ?A) S"
+    by simp
+  then show ?case
+    using calculation transform_assume.simps(3) by fastforce
+next
+  case (AExists A)
+  let ?S = "Set.filter (bsem) S"
+  let ?A = "transform_assume bsyn A"
+  have "sat_assertion vals states (AExists A) ?S \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states A ?S)"
+    by force
+  also have "... \<longleftrightarrow> (\<exists>v. sat_assertion (v # vals) states ?A S)"
+    using AExists by presburger
+  also have "... \<longleftrightarrow> sat_assertion vals states (AExists ?A) S"
+    by simp
+  then show ?case
+    using calculation transform_assume.simps(4) by fastforce
+qed (simp_all)
+
+
+fun indep_of_set where
+  "indep_of_set (AForall A) \<longleftrightarrow> indep_of_set A"
+| "indep_of_set (AExists A) \<longleftrightarrow> indep_of_set A"
+| "indep_of_set (AOr A B) \<longleftrightarrow> indep_of_set A \<and> indep_of_set B"
+| "indep_of_set (AAnd A B) \<longleftrightarrow> indep_of_set A \<and> indep_of_set B"
+| "indep_of_set (AComp _ _ _) \<longleftrightarrow> True"
+| "indep_of_set (AConst _) \<longleftrightarrow> True"
+| "indep_of_set (AForallState _) \<longleftrightarrow> False"
+| "indep_of_set (AExistsState _) \<longleftrightarrow> False"
+
+lemma indep_of_set_charact:
+  assumes "indep_of_set A"
+      and "sat_assertion vals states A S"
+    shows "sat_assertion vals states A S'"
+  using assms
+by (induct A arbitrary: vals states) (auto)
+
+lemma wf_exp_take:
+  assumes "wf_exp nv ns e"
+  shows "interp_exp vals states e = interp_exp (take nv vals) (take ns states) e"
+  using assms
+proof (induct e arbitrary: nv ns vals states)
+  case (EQVar x)
+  then show ?case
+    by force
+next
+  case (EBinop e1 x2 e2)
+  then show ?case
+    by (metis interp_exp.simps(5) wf_exp.simps(4))
+next
+  case (EFun f e)
+  then show ?case
+    by (metis interp_exp.simps(6) wf_exp.simps(5))
+qed (simp_all)
+
+lemma wf_assertion_aux_take:
+  assumes "wf_assertion_aux nv ns A"
+  shows "sat_assertion vals states A S \<longleftrightarrow> sat_assertion (take nv vals) (take ns states) A S"
+  using assms
+proof (induct A arbitrary: nv ns vals states)
+  case (AConst x)
+  then show ?case
+    by simp
+next
+  case (AComp x1a x2 x3a)
+  then show ?case
+    by (metis sat_assertion.simps(2) wf_assertion_aux.simps(2) wf_exp_take)
+next
+  case (AForallState A)
+  then show ?case using AForallState.hyps[of nv "Suc ns" vals]
+    by (metis sat_assertion.simps(3) take_Suc_Cons wf_assertion_aux.simps(7))
+next
+  case (AExistsState A)
+  then show ?case using AExistsState.hyps[of nv "Suc ns" vals]
+    by (metis sat_assertion.simps(4) take_Suc_Cons wf_assertion_aux.simps(8))
+next
+  case (AForall A)
+  then show ?case using AForall.hyps[of "Suc nv" ns _ states]
+    by (metis sat_assertion.simps(5) take_Suc_Cons wf_assertion_aux.simps(5))
+next
+  case (AExists A)
+  then show ?case using AExists.hyps[of "Suc nv" ns _ states]
+    by (metis sat_assertion.simps(6) take_Suc_Cons wf_assertion_aux.simps(6))
+next
+  case (AOr A1 A2)
+  then show ?case
+    by (metis sat_assertion.simps(8) wf_assertion_aux.simps(4))
+next
+  case (AAnd A1 A2)
+  then show ?case
+    by (metis sat_assertion.simps(7) wf_assertion_aux.simps(3))
+qed
+
+lemma syntactic_charact_for_equivalence:
+  assumes "indep_of_set A"
+      and "wf_assertion_aux (0::nat) (1::nat) A"
+    shows "sat_assertion vals (\<phi> # states) A S \<longleftrightarrow> sat_assertion [] [\<phi>] A {}" (is "?A \<longleftrightarrow> ?B")
+proof -
+  have "?A \<longleftrightarrow> sat_assertion vals (\<phi> # states) A {}"
+    using assms(1) indep_of_set_charact by blast
+  also have "... \<longleftrightarrow> sat_assertion (take (0::nat) vals) (take (1::nat) (\<phi> # states)) A {}"
+    using wf_assertion_aux_take[of 0 1 A vals "\<phi> # states" "{}"] assms(2)
+    by blast
+  ultimately show ?thesis by simp
+qed
+
+
+definition get_bsem where
+  "get_bsem bsyn \<phi> \<longleftrightarrow> sat_assertion [] [\<phi>] bsyn {}"
+
+lemma syntactic_charact_for_bsem:
+  assumes "indep_of_set A"
+      and "wf_assertion_aux (0::nat) (1::nat) A"
+    shows "same_syn_sem_all A (get_bsem A)"
+proof (rule same_syn_sem_allI)
+  fix states :: "((nat \<Rightarrow> 'a) \<times> (nat \<Rightarrow> 'a)) list"
+  fix vals S
+  assume asm0: "0 < length states"
+  then show "get_bsem A (hd states) = sat_assertion vals states A S"
+    by (metis assms(1) assms(2) get_bsem_def length_greater_0_conv list.collapse syntactic_charact_for_equivalence)
+qed
+
+
+
+lemma get_bsem_is_bsem:
+  assumes "same_syn_sem_all bsyn bsem"
+  shows "bsem = get_bsem bsyn"
+proof (rule ext)
+  fix x
+  have "bsem (hd [x]) = sat_assertion [] [x] bsyn {}"
+    using assms same_syn_sem_all_def by fastforce
+  then show "bsem x = get_bsem bsyn x"
+    by (simp add: get_bsem_def)
+qed
+
+
+lemma free_vars_syn_sem:
+  assumes "same_syn_sem_all bsyn bsem"
+      and "fst \<phi> = fst \<phi>'"
+      and "agree_on (fv bsyn) (snd \<phi>) (snd \<phi>')"
+      and "bsem \<phi>"
+      and "wf_assertion_aux 0 (Suc 0) bsyn"
+    shows "bsem \<phi>'"
+proof -
+  have "sat_assertion [] (insert_at 0 (fst \<phi>, snd \<phi>') []) bsyn {}"
+    using assms(3)
+  proof (rule fv_wr_charact_aux)
+    show "sat_assertion [] (insert_at 0 (fst \<phi>, snd \<phi>) []) bsyn {}"
+      by (metis assms(1) assms(4) get_bsem_def get_bsem_is_bsem insert_at.simps(1) prod.collapse)
+    show "wf_assertion_aux 0 (Suc (length [])) bsyn"
+      by (simp add: assms(5))
+  qed (simp)
+  then show ?thesis
+    by (metis assms(1) assms(2) get_bsem_def get_bsem_is_bsem insert_at.simps(1) prod.collapse)
+qed
+
+
+lemma free_vars_charact:
+  assumes "wr C \<inter> fv bsyn = {}"
+      and "same_syn_sem_all bsyn bsem"
+      and "wf_assertion_aux 0 (Suc 0) bsyn"
+    shows "sem C (Set.filter bsem S) = Set.filter bsem (sem C S)" (is "?A = ?B")
+proof
+  show "?A \<subseteq> ?B"
+  proof
+    fix x assume asm0: "x \<in> sem C (Set.filter bsem S)"
+    then obtain \<sigma> where "(fst x, \<sigma>) \<in> Set.filter bsem S" "single_sem C \<sigma> (snd x)"
+      by (meson in_sem)
+    then have "agree_on (fv bsyn) \<sigma> (snd x)"
+      using assms(1) wr_charact by blast
+    then show "x \<in> Set.filter bsem (sem C S)"
+      by (metis \<open>(fst x, \<sigma>) \<in> Set.filter bsem S\<close> \<open>\<langle>C, \<sigma>\<rangle> \<rightarrow> snd x\<close> assms(2) assms(3) free_vars_syn_sem fst_conv member_filter prod.collapse single_step_then_in_sem snd_conv)
+  qed
+  show "?B \<subseteq> ?A"
+  proof
+    fix x assume asm0: "x \<in> ?B"
+    then obtain \<sigma> where "bsem x" "(fst x, \<sigma>) \<in> S" "single_sem C \<sigma> (snd x)"
+      by (metis in_sem member_filter)
+    then have "agree_on (fv bsyn) \<sigma> (snd x)"
+      using assms(1) wr_charact by blast
+    then have "bsem (fst x, \<sigma>)"
+      using \<open>bsem x\<close> agree_on_sym assms(2) assms(3) free_vars_syn_sem by fastforce
+    then show "x \<in> ?A"
+      by (metis \<open>(fst x, \<sigma>) \<in> S\<close> \<open>\<langle>C, \<sigma>\<rangle> \<rightarrow> snd x\<close> in_sem member_filter)
+  qed
+qed
+
+
+lemma filter_rule_semantic:
+  assumes "\<Turnstile> {interp_assert P} C {interp_assert Q}"
+      and "same_syn_sem_all bsyn bsem"
+      and "wr C \<inter> fv bsyn = {}"
+      and "wf_assertion_aux 0 (Suc 0) bsyn"
+    shows "\<Turnstile> { interp_assert (transform_assume bsyn P) } C { interp_assert (transform_assume bsyn Q) }"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "interp_assert (transform_assume bsyn P) S"
+  then have "sat_assertion [] [] P (Set.filter bsem S)"
+    using TotalLogic.transform_assume_valid assms(2) by blast
+  then have "sat_assertion [] [] Q (sem C (Set.filter bsem S))"
+    using assms(1) hyper_hoare_tripleE by blast
+  moreover have "sem C (Set.filter bsem S) = Set.filter bsem (sem C S)"
+    using assms(2) assms(3) assms(4) free_vars_charact by presburger
+  ultimately show "interp_assert (transform_assume bsyn Q) (sem C S)"
+    using TotalLogic.transform_assume_valid assms(2) by fastforce
+qed
+
+lemma filter_rule_syntactic:
+  assumes "\<Turnstile> {interp_assert P} C {interp_assert Q}"
+      and "indep_of_set b"
+      and "wf_assertion_aux 0 1 b"
+      and "wr C \<inter> fv b = {}"
+    shows "\<Turnstile> { interp_assert (transform_assume b P) } C { interp_assert (transform_assume b Q) }"
+  using assms(1) filter_rule_semantic
+  by (metis One_nat_def assms(2) assms(3) assms(4) syntactic_charact_for_bsem)
+
+
+definition terminates where
+  "terminates C \<longleftrightarrow> (\<forall>\<sigma>. \<exists>\<sigma>'. single_sem C \<sigma> \<sigma>')"
+
+lemma terminatesI:
+  assumes "\<And>\<sigma>. \<exists>\<sigma>'. single_sem C \<sigma> \<sigma>'"
+  shows "terminates C"
+  using terminates_def assms by auto
+
+lemma terminates_implies_total:
+  assumes "\<Turnstile> {P} C {Q}"
+      and "terminates C"
+    shows "\<Turnstile>TERM {P} C {Q}"
+  using assms(1)
+proof (rule total_hyper_tripleI)
+  fix \<phi> S assume asm0: "P S \<and> \<phi> \<in> S"
+  then show "\<exists>\<sigma>'. \<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+    by (metis assms(2) terminates_def)
+qed
+
+lemma terminates_seq:
+  assumes "terminates C1"
+      and "terminates C2"
+    shows "terminates (C1;; C2)"
+  by (meson SemSeq assms(1) assms(2) terminates_def)
+
+lemma terminates_assign:
+  "terminates (Assign x e)"
+  by (meson SemAssign terminates_def)
+
+lemma terminates_havoc:
+  "terminates (Havoc c)"
+  by (meson SemHavoc terminates_def)
+
+lemma terminates_if:
+  assumes "terminates C1"
+      and "terminates C2"
+    shows "terminates (If C1 C2)"
+  by (meson SemIf2 assms(2) terminates_def)
+
+
+lemma rule_lframe_exist:
+   fixes b :: "('a \<Rightarrow> ('lvar \<Rightarrow> 'lval)) \<Rightarrow> bool"
+    \<comment>\<open>b takes a mapping from keys to logical states (representing the tuple), and returns a boolean\<close>
+
+   assumes "\<Turnstile>TERM {P} C {Q}"
+     shows "\<Turnstile>TERM { conj P (\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)) } C { conj Q (\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)) }"
+
+proof (rule total_hyper_tripleI)
+  fix \<phi> S
+  show "Logic.conj P (\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)) S \<and> \<phi> \<in> S \<Longrightarrow> \<exists>\<sigma>'. \<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+    by (metis (mono_tags, lifting) assms conj_def total_hyper_triple_equiv)
+next
+  show "\<Turnstile> {Logic.conj P (\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>))} C {Logic.conj Q (\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>))}"
+  proof (rule hyper_hoare_tripleI)
+    fix S :: "('lvar, 'lval, 'b, 'c) state set"
+    assume asm0: "Logic.conj P (\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)) S"
+    then obtain \<phi> where "(\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)"
+      using conj_def[of P "\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)" S] by blast
+    let ?\<sigma> = "\<lambda>k. SOME \<sigma>'. (fst (\<phi> k), \<sigma>') \<in> sem C S \<and> single_sem C (snd (\<phi> k)) \<sigma>'"
+    let ?\<phi> = "\<lambda>k. (fst (\<phi> k), ?\<sigma> k)"
+    have r: "\<And>k. (fst (\<phi> k), ?\<sigma> k) \<in> sem C S \<and> single_sem C (snd (\<phi> k)) (?\<sigma> k)"
+    proof -
+      fix k show "(fst (\<phi> k), ?\<sigma> k) \<in> sem C S \<and> single_sem C (snd (\<phi> k)) (?\<sigma> k)"
+      proof (rule someI_ex[of "\<lambda>\<sigma>'. (fst (\<phi> k), \<sigma>') \<in> sem C S \<and> single_sem C (snd (\<phi> k)) \<sigma>'"])
+        show "\<exists>\<sigma>'. (fst (\<phi> k), \<sigma>') \<in> sem C S \<and> \<langle>C, snd (\<phi> k)\<rangle> \<rightarrow> \<sigma>'"
+          by (metis (mono_tags, lifting) \<open>(\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)\<close> asm0 assms conj_def total_hyper_triple_equiv)
+      qed
+    qed
+    moreover have "fst \<circ> \<phi> = fst \<circ> ?\<phi>" by (rule ext) simp
+    ultimately have "\<exists>\<phi>. (\<forall>k. \<phi> k \<in> sem C S) \<and> b (fst \<circ> \<phi>)"
+      using \<open>(\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)\<close> by force
+    moreover have "Q (sem C S)"
+      by (metis (mono_tags, lifting) asm0 assms conj_def hyper_hoare_tripleE total_hyper_triple_def)
+    ultimately show "Logic.conj Q (\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)) (sem C S)"
+      using conj_def[of Q "\<lambda>S. \<exists>\<phi>. (\<forall>k. \<phi> k \<in> S) \<and> b (fst \<circ> \<phi>)"] by simp
+  qed
+qed
+
+lemma terminates_if_then:
+  assumes "terminates C1"
+      and "terminates C2"
+    shows "terminates (if_then_else b C1 C2)"
+proof (rule terminatesI)
+  fix \<sigma>
+  show "\<exists>\<sigma>'. \<langle>if_then_else b C1 C2, \<sigma>\<rangle> \<rightarrow> \<sigma>'"
+  proof (cases "b \<sigma>")
+    case True
+    then show ?thesis
+      by (metis SemAssume SemIf1 SemSeq assms(1) if_then_else_def terminates_def)
+  next
+    case False
+    then show ?thesis
+      by (metis (no_types, opaque_lifting) SemAssume SemIf2 SemSeq assms(2) if_then_else_def lnot_def terminates_def)
+  qed
+qed
+
+
+definition min_prop :: "(nat \<Rightarrow> bool) \<Rightarrow> nat" where
+  "min_prop P = (SOME n. P n \<and> (\<forall>m. m < n \<longrightarrow> \<not> P m))"
+
+lemma min_prop_charact:
+  assumes "P n"
+  shows "P (min_prop P) \<and> (\<forall>m. m < (min_prop P) \<longrightarrow> \<not> P m)"
+  unfolding min_prop_def
+  using min_prop_def[of P] assms exists_least_iff[of P] someI[of "\<lambda>n. P n \<and> (\<forall>m. m < n \<longrightarrow> \<not> P m)"]
+  by blast
+
+
+lemma hyper_tot_set_not_empty:
+  assumes "\<Turnstile>TERM {P} C {Q}"
+      and "P S"
+      and "S \<noteq> {}"
+    shows "sem C S \<noteq> {}"
+  by (metis assms(1) assms(2) assms(3) ex_in_conv total_hyper_triple_equiv)
+
+lemma iterate_sem_mod_updates_same:
+  assumes "same_mod_updates vars S S'"
+  shows "same_mod_updates vars (iterate_sem n C S) (iterate_sem n C S')"
+  using assms
+proof (induct n)
+  case 0
+  then show ?case by simp
+next
+  case (Suc n)
+  then show ?case
+    by (simp add: sem_update_commute)
+qed
+
+
+theorem while_synchronized_tot:
+  assumes "wfP lt"
+      and "\<And>n. not_fv_hyper t (I n)"
+      and "\<And>n. \<Turnstile>TERM {conj (conj (I n) (holds_forall b)) (e_recorded_in_t e t)} C {conj (conj (I (Suc n)) (low_exp b)) (e_smaller_than_t e t lt)}"
+    shows "\<Turnstile>TERM {conj (I 0) (low_exp b)} while_cond b C {conj (exists I) (holds_forall (lnot b))}"
+proof (rule total_hyper_triple_altI)
+  fix S assume asm0: "conj (I 0) (low_exp b) S"
+  let ?S = "\<lambda>n. assign_exp_to_lvar_set e t (iterate_sem n (Assume b;; C) S)"
+
+  have S_same: "\<And>n. same_mod_updates {t} (?S n) (iterate_sem n (Assume b;; C) S)"
+    by (simp add: assign_exp_to_lvar_set_same_mod_updates same_mod_updates_sym)
+
+
+  have triple: "\<And>n. \<Turnstile> {conj (I n) (holds_forall b)} Assume b ;; C {conj (I (Suc n)) (low_exp b)}"
+  proof (rule hyper_hoare_tripleI)
+    fix n S assume "conj (I n) (holds_forall b) S"
+    let ?S = "assign_exp_to_lvar_set e t S"
+    have "conj (I n) (holds_forall b) ?S"
+      by (metis \<open>Logic.conj (I n) (holds_forall b) S\<close> assms(2) conj_def holds_forall_same_assign_lvar not_fv_hyper_assign_exp)
+    then have "conj (conj (I n) (holds_forall b)) (e_recorded_in_t e t) ?S"
+      by (simp add: conj_def e_recorded_in_t_if_assigned)
+    then have "Logic.conj (I (Suc n)) (low_exp b) (sem (Assume b ;; C) ?S)"
+      by (metis (mono_tags, lifting) assms(3) conj_def hyper_hoare_tripleE sem_assume_low_exp_seq(1) total_hyper_triple_def)
+    moreover have "same_mod_updates {t} (sem (Assume b ;; C) ?S) (sem (Assume b ;; C) S)"
+      by (simp add: assign_exp_to_lvar_set_same_mod_updates same_mod_updates_sym sem_update_commute)
+    ultimately show "conj (I (Suc n)) (low_exp b) (sem (Assume b ;; C) S)"
+      by (metis assms(2) conj_def low_exp_forall_same_mod_updates not_fv_hyperE)
+  qed
+
+  have "\<And>n. iterate_sem n (Assume b ;; C) S \<noteq> {} \<Longrightarrow> conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)"
+  proof -
+    fix n
+    show "iterate_sem n (Assume b ;; C) S \<noteq> {} \<Longrightarrow> conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)"
+    proof (induct n)
+      case 0
+      then show ?case
+        by (simp add: asm0)
+    next
+      case (Suc n)
+      then show ?case
+        by (metis (full_types) conj_def false_then_empty_later holds_forall_empty hyper_hoare_tripleE iterate_sem.simps(2) lessI low_exp_two_cases triple)
+    qed
+  qed
+
+  have terminates: "\<exists>n. iterate_sem n (Assume b;; C) S = {}"
+  proof (rule ccontr)
+    assume asm0: "\<not> (\<exists>n. iterate_sem n (Assume b ;; C) S = {})"
+    
+    let ?R = "{(x, y). lt x y}"
+    let ?Q = "{ e (snd \<phi>) |\<phi> n. \<phi> \<in> ?S n}"
+
+    obtain \<phi>0 where "\<phi>0 \<in> ?S 0"
+      by (metis all_not_in_conv asm0 false_then_empty_later holds_forall_empty holds_forall_same_assign_lvar lessI)
+
+    show False
+    proof (rule wfE_min)
+      show "wf ?R"
+        using assms(1) wfP_def by blast
+      show "e (snd \<phi>0) \<in> ?Q"
+        using \<open>\<phi>0 \<in> assign_exp_to_lvar_set e t (iterate_sem 0 (Assume b ;; C) S)\<close> by blast
+      fix z assume asm1: "z \<in> ?Q" "(\<And>y. (y, z) \<in> {(x, y). lt x y} \<Longrightarrow> y \<notin> ?Q)"
+      then obtain \<phi> n where "z = e (snd \<phi>)" "\<phi> \<in> ?S n" by blast
+      moreover have "conj (I n) (holds_forall b) (iterate_sem n (Assume b ;; C) S)"
+      proof -
+        have "conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)"
+          using \<open>\<And>n. iterate_sem n (Assume b ;; C) S \<noteq> {} \<Longrightarrow> Logic.conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)\<close> asm0 by presburger
+        moreover have "sem (Assume b;; C) (iterate_sem n (Assume b ;; C) S) \<noteq> {}"
+          using asm0 iterate_sem.simps(2) by blast
+        ultimately show ?thesis
+          by (metis asm0 conj_def false_then_empty_later lessI low_exp_two_cases)
+      qed
+      then have "conj (conj (I n) (holds_forall b)) (e_recorded_in_t e t) (?S n)"
+        by (metis (mono_tags, lifting) assms(2) conj_def e_recorded_in_t_if_assigned holds_forall_same_assign_lvar not_fv_hyper_assign_exp)
+      then have "conj (conj (I (Suc n)) (low_exp b)) (e_smaller_than_t e t lt) (sem C (?S n))"
+        using assms(3) hyper_hoare_tripleE total_hyper_triple_def by blast
+      moreover obtain \<sigma>' where "\<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+        by (meson \<open>Logic.conj (Logic.conj (I n) (holds_forall b)) (e_recorded_in_t e t) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))\<close> assms(3) calculation(2) total_hyper_triple_def)
+
+      then have "(fst \<phi>, \<sigma>') \<in> sem (Assume b;; C) (?S n)"
+        by (metis \<open>Logic.conj (Logic.conj (I n) (holds_forall b)) (e_recorded_in_t e t) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))\<close> calculation(2) conj_def prod.collapse sem_assume_low_exp_seq(1) single_step_then_in_sem)
+      then have "lt (e \<sigma>') z"
+        by (metis (no_types, lifting) \<open>Logic.conj (Logic.conj (I n) (holds_forall b)) (e_recorded_in_t e t) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))\<close> calculation(1) calculation(2) calculation(3) conj_def e_recorded_in_t_def e_smaller_than_t_def fst_conv sem_assume_low_exp_seq(1) snd_conv)
+
+      moreover obtain \<sigma> where "(fst \<phi>, \<sigma>) \<in> ?S n" "single_sem (Assume b;; C) \<sigma> \<sigma>'"
+        by (metis \<open>(fst \<phi>, \<sigma>') \<in> sem (Assume b ;; C) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))\<close> fst_conv in_sem snd_conv)
+      then obtain l where "(l, \<sigma>) \<in> iterate_sem n (Assume b;; C) S"
+        using assign_exp_to_lvar_def[of e t] assign_exp_to_lvar_set_def[of e t] image_iff prod.collapse snd_conv
+        by fastforce
+      then have "(l, \<sigma>') \<in> iterate_sem (Suc n) (Assume b;; C) S"
+        by (metis \<open>\<langle>Assume b ;; C, \<sigma>\<rangle> \<rightarrow> \<sigma>'\<close> iterate_sem.simps(2) single_step_then_in_sem)
+      then have "assign_exp_to_lvar e t (l, \<sigma>') \<in> ?S (Suc n)"
+        by (simp add: assign_exp_to_lvar_set_def)
+      then have "e \<sigma>' \<in> ?Q"
+        by (metis (mono_tags, lifting) CollectI same_outside_set_lvar_assign_exp snd_conv)
+      ultimately show False
+        using asm1(2) by blast
+    qed
+  qed
+    
+  show "conj (exists I) (holds_forall (lnot b)) (sem (while_cond b C) S)"
+  proof -
+    let ?n_emp = "min_prop (\<lambda>n. iterate_sem n (Assume b;; C) S = {})"
+    have rr: "iterate_sem ?n_emp (Assume b;; C) S = {} \<and> (\<forall>m<?n_emp. iterate_sem m (Assume b;; C) S \<noteq> {})"
+      using min_prop_charact terminates by fast
+    show ?thesis
+    proof (cases "?n_emp")
+      case 0
+      then have "S = {}"
+        using rr by auto
+      then show ?thesis
+        by (metis Loops.exists_def asm0 conj_def holds_forall_empty sem_assume_low_exp_seq(2) sem_seq)
+    next
+      case (Suc k)
+      then have "iterate_sem k (Assume b;; C) S \<noteq> {}"
+        using lessI rr by presburger
+      then have "conj (I k) (low_exp b) (iterate_sem k (Assume b ;; C) S)"
+        by (simp add: \<open>\<And>n. iterate_sem n (Assume b ;; C) S \<noteq> {} \<Longrightarrow> Logic.conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)\<close>)
+      moreover have "holds_forall (lnot b) (iterate_sem k (Assume b;; C) S)"
+      proof (rule ccontr)
+        assume asm2: "\<not> holds_forall (lnot b) (iterate_sem k (Assume b ;; C) S)"
+        then have "holds_forall b (iterate_sem k (Assume b ;; C) S)"
+          by (metis calculation conj_def low_exp_two_cases)
+        let ?S = "assign_exp_to_lvar_set e t (iterate_sem k (Assume b ;; C) S)"
+        have "conj (conj (I k) (holds_forall b)) (e_recorded_in_t e t) ?S"
+          by (metis (no_types, lifting) \<open>holds_forall b (iterate_sem k (Assume b ;; C) S)\<close> assign_exp_to_lvar_set_same_mod_updates assms(2) calculation conj_def e_recorded_in_t_if_assigned holds_forall_same_mod_updates not_fv_hyperE)
+        moreover have "sem (Assume b) ?S = ?S"
+          by (metis calculation conj_def sem_assume_low_exp(1))
+        ultimately have "sem (Assume b;; C) ?S \<noteq> {}"
+          by (metis asm2 assms(3) holds_forall_empty holds_forall_same_assign_lvar hyper_tot_set_not_empty sem_seq)
+
+        moreover have "same_mod_updates {t} (sem (Assume b;; C) ?S) (assign_exp_to_lvar_set e t (iterate_sem ?n_emp (Assume b;; C) S))"
+          by (metis Suc assign_exp_to_lvar_set_def assign_exp_to_lvar_set_same_mod_updates image_empty iterate_sem.simps(2) rr same_mod_updates_sym sem_update_commute)
+        ultimately show False
+          by (metis assign_exp_to_lvar_set_def image_empty rr same_mod_updates_empty same_mod_updates_sym)
+      qed
+      then have "\<exists>n. holds_forall (lnot b) (iterate_sem n (Assume b;; C) S) \<and> iterate_sem n (Assume b ;; C) S \<noteq> {}
+     \<and> (\<forall>m. m < n \<longrightarrow> \<not> (holds_forall (lnot b) (iterate_sem m (Assume b;; C) S) \<and> iterate_sem m (Assume b ;; C) S \<noteq> {}))"
+        using exists_least_iff[of "\<lambda>n. holds_forall (lnot b) (iterate_sem n (Assume b;; C) S) \<and> iterate_sem n (Assume b ;; C) S \<noteq> {}"]
+        using \<open>iterate_sem k (Assume b ;; C) S \<noteq> {}\<close> by blast
+      then obtain n where def_n: "holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)" "iterate_sem n (Assume b ;; C) S \<noteq> {}"
+        "\<And>m. m < n \<Longrightarrow> \<not> (holds_forall (lnot b) (iterate_sem m (Assume b;; C) S) \<and> iterate_sem m (Assume b ;; C) S \<noteq> {})" by blast
+      moreover have "(\<forall>m. m < n \<longrightarrow> holds_forall b (iterate_sem m (Assume b;; C) S)) \<and> holds_forall (lnot b) (iterate_sem n (Assume b;; C) S)"
+  
+        by (metis \<open>\<And>n. iterate_sem n (Assume b ;; C) S \<noteq> {} \<Longrightarrow> Logic.conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)\<close> conj_def def_n(1) def_n(2) false_then_empty_later holds_forall_empty low_exp_two_cases)
+      then have "sem (while_cond b C) S = iterate_sem n (Assume b;; C) S"
+        using triple while_synchronized_case_1 asm0 by blast
+      ultimately show ?thesis
+        by (metis Loops.exists_def \<open>\<And>n. iterate_sem n (Assume b ;; C) S \<noteq> {} \<Longrightarrow> Logic.conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)\<close> conj_def)
+    qed
+  qed
+
+
+
+  show "terminates_in (while_cond b C) S"
+  proof (rule terminates_in_while_loop)
+    show "wfP lt"
+      by (simp add: assms(1))
+    fix \<phi> n
+    assume asm1: "\<phi> \<in> iterate_sem n (Assume b ;; C) S \<and> b (snd \<phi>)"
+    let ?S = "iterate_sem n (Assume b ;; C) S"
+    have "conj (I n) (low_exp b) ?S"
+      using \<open>\<And>n. iterate_sem n (Assume b ;; C) S \<noteq> {} \<Longrightarrow> Logic.conj (I n) (low_exp b) (iterate_sem n (Assume b ;; C) S)\<close> asm1 by blast
+    then have "conj (I n) (holds_forall b) ?S"
+      by (metis asm1 conj_def holds_forall_def lnot_def low_exp_two_cases)
+    let ?SS = "assign_exp_to_lvar_set e t ?S"
+    have "conj (conj (I n) (holds_forall b)) (e_recorded_in_t e t) ?SS"
+      by (metis (no_types, lifting) \<open>Logic.conj (I n) (holds_forall b) (iterate_sem n (Assume b ;; C) S)\<close> assign_exp_to_lvar_set_same_mod_updates assms(2) conj_def e_recorded_in_t_if_assigned holds_forall_same_mod_updates not_fv_hyperE)
+    then have "conj (conj (I (Suc n)) (low_exp b)) (e_smaller_than_t e t lt) (sem C ?SS)"
+      using assms(3) hyper_hoare_tripleE total_hyper_triple_def by blast
+    moreover have "assign_exp_to_lvar e t \<phi> \<in> ?SS"
+      by (simp add: asm1 assign_exp_to_lvar_set_def)
+    then obtain \<sigma>' where "\<langle>C, snd (assign_exp_to_lvar e t \<phi>)\<rangle> \<rightarrow> \<sigma>'"
+      by (meson \<open>Logic.conj (Logic.conj (I n) (holds_forall b)) (e_recorded_in_t e t) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))\<close> assms(3) total_hyper_triple_def)    
+    then have "(\<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>') \<and> (fst (assign_exp_to_lvar e t \<phi>), \<sigma>') \<in> sem C ?SS"
+      by (metis \<open>assign_exp_to_lvar e t \<phi> \<in> assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S)\<close> assign_exp_to_lvar_def prod.collapse single_step_then_in_sem snd_conv)
+    then have "lt (e \<sigma>') (fst (fst (assign_exp_to_lvar e t \<phi>), \<sigma>') t)"
+      by (metis calculation conj_def e_smaller_than_t_def snd_conv)
+    then show "\<exists>\<sigma>'. (\<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>') \<and> (\<not> b \<sigma>' \<or> lt (e \<sigma>') (e (snd \<phi>)))"
+      by (metis \<open>(\<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>') \<and> (fst (assign_exp_to_lvar e t \<phi>), \<sigma>') \<in> sem C (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))\<close> assign_exp_to_lvar_def fst_conv fun_upd_same)
+  qed
+qed
+
+lemma total_consequence_rule:
+  assumes "entails P P'"
+    and "entails Q' Q"
+      and "\<Turnstile>TERM {P'} C {Q'}"
+    shows "\<Turnstile>TERM {P} C {Q}"
+proof (rule total_hyper_tripleI)
+  show "\<Turnstile> {P} C {Q}"
+    using assms(1) assms(2) assms(3) consequence_rule total_hyper_triple_def by blast
+  fix \<phi> S show "P S \<and> \<phi> \<in> S \<Longrightarrow> \<exists>\<sigma>'. \<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+    by (meson assms(1) assms(3) entailsE total_hyper_triple_def)
+qed
+
+theorem WhileSyncTot:
+  assumes "wfP lt"
+      and "not_fv_hyper t I"
+      and "\<Turnstile>TERM {conj I (\<lambda>S. \<forall>\<phi>\<in>S. b (snd \<phi>) \<and> fst \<phi> t = e (snd \<phi>))} C {conj (conj I (low_exp b)) (e_smaller_than_t e t lt)}"
+    shows "\<Turnstile>TERM {conj I (low_exp b)} while_cond b C {conj I (holds_forall (lnot b))}"
+proof -
+  define I' where "I' = (\<lambda>(n::nat). I)"
+  have "\<Turnstile>TERM {conj (conj I (holds_forall b)) (e_recorded_in_t e t)} C {conj (conj I (low_exp b)) (e_smaller_than_t e t lt)}"
+  proof (rule total_consequence_rule)
+    show "\<Turnstile>TERM {conj I (\<lambda>S. \<forall>\<phi>\<in>S. b (snd \<phi>) \<and> fst \<phi> t = e (snd \<phi>))} C {conj (conj I (low_exp b)) (e_smaller_than_t e t lt)}"
+      using assms(3) by blast
+    show "entails (Logic.conj (Logic.conj I (holds_forall b)) (e_recorded_in_t e t)) (Logic.conj I (\<lambda>S. \<forall>\<phi>\<in>S. b (snd \<phi>) \<and> fst \<phi> t = e (snd \<phi>)))"
+      by (simp add: conj_def e_recorded_in_t_def entails_def holds_forall_def)
+  qed (simp add: entails_refl)
+  then have "\<Turnstile>TERM {Logic.conj (I' 0) (low_exp b)} while_cond b C {Logic.conj (Loops.exists I') (holds_forall (lnot b))}"
+    using while_synchronized_tot[of lt t I' b e C] I'_def assms by blast
+  then show ?thesis using I'_def
+    by (simp add: Loops.exists_def conj_def hyper_hoare_triple_def total_hyper_triple_def)
+qed
+
+
+
+
+lemma total_hyper_tripleE:
+  assumes "\<Turnstile>TERM {P} C {Q}"
+      and "P S"
+      and "\<phi> \<in> S"
+    shows "\<exists>\<sigma>'. (fst \<phi>, \<sigma>') \<in> sem C S \<and> single_sem C (snd \<phi>) \<sigma>'"
+  by (meson assms(1) assms(2) assms(3) total_hyper_triple_equiv)
+
+theorem normal_while_tot:
+  assumes "\<And>n. \<Turnstile> {P n} Assume b {Q n}"
+      and "\<And>n. \<Turnstile>TERM {conj (Q n) (e_recorded_in_t e t)} C {conj (P (Suc n)) (e_smaller_than_t e t lt)}"
+      and "\<Turnstile> {natural_partition P} Assume (lnot b) {R}"
+
+      and "wfP lt"
+      and "\<And>n. not_fv_hyper t (P n)"
+      and "\<And>n. not_fv_hyper t (Q n)"
+
+    shows "\<Turnstile>TERM {P 0} while_cond b C {R}"
+proof (rule total_hyper_triple_altI)
+  fix S assume asm0: "P 0 S"
+  have "\<And>n. P n (iterate_sem n (Assume b;; C) S)"
+  proof (rule indexed_invariant_then_power)
+    fix n
+    have "\<Turnstile> {Q n} C {P (Suc n)}"
+    proof (rule hyper_hoare_tripleI)
+      fix S assume asm1: "Q n S"
+      let ?S = "assign_exp_to_lvar_set e t S"
+      have "conj (Q n) (e_recorded_in_t e t) ?S"
+        by (metis asm1 assms(6) conj_def e_recorded_in_t_if_assigned not_fv_hyper_assign_exp)
+      then have "conj (P (Suc n)) (e_smaller_than_t e t lt) (sem C ?S)"
+        using assms(2) hyper_hoare_tripleE total_hyper_triple_def by blast
+      then show "P (Suc n) (sem C S)"
+        using assign_exp_to_lvar_set_same_mod_updates[of t S e] assms(5) conj_def not_fv_hyperE same_mod_updates_sym[of "{t}"] sem_update_commute[of "{t}"]
+        by metis
+    qed
+    then show " \<Turnstile> {P n} Assume b ;; C {P (Suc n)}"
+      using assms(1) seq_rule total_hyper_triple_def by blast
+  qed (simp add: asm0)
+  then have "natural_partition P (\<Union>n. iterate_sem n (Assume b;; C) S)"
+    by (simp add: natural_partitionI)
+  then show "R (sem (while_cond b C) S)"
+    by (metis (no_types, lifting) SUP_cong assms(3) hyper_hoare_triple_def sem_seq sem_while while_cond_def)
+
+  show "terminates_in (while_cond b C) S"
+  proof (rule terminates_in_while_loop)
+    show "wfP lt"
+      by (simp add: assms(4))
+    fix \<phi> n
+    assume asm1: "\<phi> \<in> iterate_sem n (Assume b ;; C) S \<and> b (snd \<phi>)"
+
+    let ?S = "assign_exp_to_lvar_set e t (iterate_sem n (Assume b;; C) S)"
+    let ?\<phi> = "assign_exp_to_lvar e t \<phi>"
+    have "conj (P n) (e_recorded_in_t e t) ?S"
+      by (metis \<open>\<And>n. P n (iterate_sem n (Assume b ;; C) S)\<close> assms(5) conj_def e_recorded_in_t_if_assigned not_fv_hyper_assign_exp)
+    then have "conj (Q n) (e_recorded_in_t e t) (sem (Assume b) ?S)"
+      
+      by (metis (mono_tags, lifting) assms(1) assume_sem conj_def e_recorded_in_t_def hyper_hoare_tripleE member_filter)
+    then have "conj (P (Suc n)) (e_smaller_than_t e t lt) (sem C (sem (Assume b) ?S))"
+      using assms(2) hyper_hoare_tripleE total_hyper_triple_def by blast
+    moreover have "?\<phi> \<in> (sem (Assume b) ?S)"
+      by (metis asm1 assign_exp_to_lvar_set_def assume_sem comp_apply image_eqI member_filter same_outside_set_lvar_assign_exp)
+    then obtain \<sigma>' where "(fst ?\<phi>, \<sigma>') \<in> sem C (sem (Assume b) ?S) \<and> \<langle>C, snd ?\<phi>\<rangle> \<rightarrow> \<sigma>'"
+      using total_hyper_tripleE assms(2)[of n]
+      using \<open>Logic.conj (Q n) (e_recorded_in_t e t) (sem (Assume b) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S)))\<close> by blast
+    then have "lt (e (snd (fst ?\<phi>, \<sigma>'))) (fst (fst ?\<phi>, \<sigma>') t)"
+      by (metis calculation conj_def e_smaller_than_t_def)
+    ultimately show "\<exists>\<sigma>'. \<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>' \<and> (\<not> b \<sigma>' \<or> lt (e \<sigma>') (e (snd \<phi>)))"
+      by (metis \<open>(fst (assign_exp_to_lvar e t \<phi>), \<sigma>') \<in> sem C (sem (Assume b) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))) \<and> \<langle>C, snd (assign_exp_to_lvar e t \<phi>)\<rangle> \<rightarrow> \<sigma>'\<close> assign_exp_to_lvar_def fst_conv fun_upd_same snd_conv)
+  qed
+qed
+
+
+definition e_smaller_than_t_weaker where
+  "e_smaller_than_t_weaker e t u lt S \<longleftrightarrow> (\<forall>\<phi>\<in>S. \<exists>\<phi>'\<in>S. fst \<phi> u = fst \<phi>' u \<and> lt (e (snd \<phi>)) (fst \<phi>' t))"
+
+
+lemma exists_terminates_loop:
+  assumes "wfP lt"
+      and "\<And>v. \<Turnstile> { (\<lambda>S. \<exists>\<phi>\<in>S. e (snd \<phi>) = v \<and> b (snd \<phi>) \<and> P \<phi> S) } if_then b C { (\<lambda>S. \<exists>\<phi>\<in>S. lt (e (snd \<phi>)) v \<and> P \<phi> S) }"
+      and "\<And>\<phi>. \<Turnstile> { P \<phi> } while_cond b C { Q \<phi> }"
+    shows "\<Turnstile> { (\<lambda>S. \<exists>\<phi>\<in>S. P \<phi> S) } while_cond b C { (\<lambda>S. \<exists>\<phi>\<in>S. Q \<phi> S)}"
+proof (rule hyper_hoare_tripleI)
+  fix S assume asm0: "\<exists>\<phi>\<in>S. P \<phi> S"
+  then obtain \<phi> where "\<phi> \<in> S" "P \<phi> S" by blast
+  show "\<exists>\<phi>\<in>sem (while_cond b C) S. Q \<phi> (sem (while_cond b C) S)"
+  proof (cases "b (snd \<phi>)")
+    case True
+
+    let ?R = "{(x, y). lt x y}"
+    let ?Q = "{ e (snd \<phi>') |\<phi>' n. \<phi>' \<in> iterate_sem n (if_then b C) S \<and> b (snd \<phi>') \<and> P \<phi>' (iterate_sem n (if_then b C) S) }"
+  
+    have main_res: "\<exists>n \<phi>'. \<phi>' \<in> iterate_sem n (if_then b C) S \<and> \<not> b (snd \<phi>') \<and> P \<phi>' (iterate_sem n (if_then b C) S)"
+    proof (rule wfE_min)
+      show "wf ?R"
+        using assms(1) wfP_def by blast
+      show "e (snd \<phi>) \<in> ?Q"
+        using True \<open>P \<phi> S\<close> \<open>\<phi> \<in> S\<close> iterate_sem.simps(1) by fastforce
+      fix z
+      assume asm1: "z \<in> ?Q" "\<And>y. (y, z) \<in> ?R \<Longrightarrow> y \<notin> ?Q"
+      then obtain n \<phi>' where "\<phi>' \<in> iterate_sem n (if_then b C) S" "b (snd \<phi>')" "P \<phi>' (iterate_sem n (if_then b C) S)" "z = e (snd \<phi>')"
+        by blast
+      then have "(\<lambda>S. \<exists>\<phi>\<in>S. (b (snd \<phi>) \<longrightarrow> lt (e (snd \<phi>)) z) \<and> P \<phi> S) (sem (if_then b C) ((iterate_sem n (if_then b C) S)))"
+        using assms(2) hyper_hoare_tripleE by blast
+      then obtain \<phi>'' where "(b (snd \<phi>'') \<longrightarrow> lt (e (snd \<phi>'')) z) \<and> P \<phi>'' (sem (if_then b C) ((iterate_sem n (if_then b C) S)))"
+        "\<phi>'' \<in> (sem (if_then b C) ((iterate_sem n (if_then b C) S)))"
+        by blast
+      then have "\<not> b (snd \<phi>'')"
+        by (metis (mono_tags, lifting) asm1(2) case_prodI iterate_sem.simps(2) mem_Collect_eq)
+      then show "\<exists>n \<phi>'. \<phi>' \<in> iterate_sem n (if_then b C) S \<and> \<not> b (snd \<phi>') \<and> P \<phi>' (iterate_sem n (if_then b C) S)"
+        by (metis \<open>(b (snd \<phi>'') \<longrightarrow> lt (e (snd \<phi>'')) z) \<and> P \<phi>'' (sem (if_then b C) (iterate_sem n (if_then b C) S))\<close> \<open>\<phi>'' \<in> sem (if_then b C) (iterate_sem n (if_then b C) S)\<close> iterate_sem.simps(2))
+    qed
+    then obtain n \<phi>' where "\<phi>' \<in> iterate_sem n (if_then b C) S" "\<not> b (snd \<phi>')" "P \<phi>' (iterate_sem n (if_then b C) S)"
+      by blast
+    then have "\<exists>\<phi>\<in>sem (while_cond b C) (iterate_sem n (if_then b C) S). Q \<phi> (sem (while_cond b C) (iterate_sem n (if_then b C) S))"
+      using while_exists[of P b C Q] assms(3) hyper_hoare_tripleE by blast
+    then show "\<exists>\<phi>\<in>sem (while_cond b C) S. Q \<phi> (sem (while_cond b C) S)"
+      by (simp add: unroll_while_sem)
+  next
+    case False
+    then show ?thesis
+    using while_exists[of P b C Q] assms(3) hyper_hoare_tripleE \<open>P \<phi> S\<close> \<open>\<phi> \<in> S\<close> by blast
+  qed
+qed
+
+definition t_closed where
+  "t_closed P P_inf \<longleftrightarrow> (\<forall>S. converges_sets S \<and> (\<forall>n. P n (S n)) \<longrightarrow> P_inf (\<Union>n. S n))"
+
+lemma t_closedE:
+  assumes "t_closed P P_inf"
+      and "converges_sets S"
+      and "\<And>n. P n (S n)"
+    shows "P_inf (\<Union>n. S n)"
+  using TotalLogic.t_closed_def assms(1) assms(2) assms(3) by blast
+
+
+subsection \<open>Total version of core rules\<close>
+
+lemma total_skip_rule:
+  "\<Turnstile>TERM {P} Skip {P}"
+  by (meson SemSkip skip_rule total_hyper_triple_def)
+
+lemma total_seq_rule:
+  assumes "\<Turnstile>TERM {P} C1 {R}"
+    and "\<Turnstile>TERM {R} C2 {Q}"
+  shows "\<Turnstile>TERM {P} Seq C1 C2 {Q}"
+proof (rule total_hyper_tripleI)
+  show "\<Turnstile> {P} C1 ;; C2 {Q}"
+    using assms(1) assms(2) seq_rule total_hyper_triple_def by blast
+  fix \<phi> S assume "P S \<and> \<phi> \<in> S"
+  then obtain \<sigma>' where "\<langle>C1, snd \<phi>\<rangle> \<rightarrow> \<sigma>'" "(fst \<phi>, \<sigma>') \<in> sem C1 S"
+    using assms(1) total_hyper_tripleE by blast
+  then obtain \<sigma>'' where "\<langle>C2, \<sigma>'\<rangle> \<rightarrow> \<sigma>''"
+    using assms
+    by (metis (full_types) \<open>P S \<and> \<phi> \<in> S\<close> hyper_hoare_tripleE snd_conv total_hyper_triple_def)
+  then show "\<exists>\<sigma>''. \<langle>C1 ;; C2, snd \<phi>\<rangle> \<rightarrow> \<sigma>''"
+    using SemSeq \<open>\<langle>C1, snd \<phi>\<rangle> \<rightarrow> \<sigma>'\<close> by blast
+qed
+
+lemma total_if_rule:
+  assumes "\<Turnstile>TERM {P} C1 {Q1}"
+      and "\<Turnstile>TERM {P} C2 {Q2}"
+    shows "\<Turnstile>TERM {P} If C1 C2 {join Q1 Q2}"
+proof (rule total_hyper_tripleI)
+  show "\<Turnstile> {P} stmt.If C1 C2 {join Q1 Q2}"
+    using assms(1) assms(2) if_rule total_hyper_triple_equiv by blast
+  fix \<phi> S assume "P S \<and> \<phi> \<in> S"
+  then show "\<exists>\<sigma>'. \<langle>stmt.If C1 C2, snd \<phi>\<rangle> \<rightarrow> \<sigma>'"
+    using SemIf1 assms(1) total_hyper_tripleE by blast
+qed
+
+
+lemma total_rule_exists:
+  assumes "\<And>x. \<Turnstile>TERM {P x} C {Q x}"
+  shows "\<Turnstile>TERM {exists P} C {exists Q}"
+  using total_hyper_tripleI[of "exists P" C "exists Q"]
+  by (metis (mono_tags, lifting) Loops.exists_def assms hyper_hoare_triple_def total_hyper_triple_def)
+
+
+lemma total_assign_rule:
+  "\<Turnstile>TERM { (\<lambda>S. P { (l, \<sigma>(x := e \<sigma>)) |l \<sigma>. (l, \<sigma>) \<in> S }) } (Assign x e) {P}"
+  using total_hyper_tripleI[of _ "Assign x e" P]
+  using SemAssign assign_rule by fastforce
+
+lemma total_havoc_rule:
+  "\<Turnstile>TERM { (\<lambda>S. P { (l, \<sigma>(x := v)) |l \<sigma> v. (l, \<sigma>) \<in> S }) } (Havoc x) {P}"
+  using total_hyper_tripleI[of _ "Havoc x" P]
+  using SemHavoc havoc_rule by fastforce
+
+lemma in_semI:
+  assumes "\<phi> \<in> S"
+      and "fst \<phi> = fst \<phi>'"
+      and "single_sem C (snd \<phi>) (snd \<phi>')"
+    shows "\<phi>' \<in> sem C S"
+  using assms
+  by (metis (no_types, lifting) prod.collapse single_step_then_in_sem)
+
+
+theorem normal_while_tot_stronger:
+  fixes P :: "nat \<Rightarrow> ('lvar, 'lval, 'pvar, 'pval) state set \<Rightarrow> bool"
+
+  assumes "\<And>n. \<Turnstile> {P n} Assume b {Q n}"
+      and "\<And>n. \<Turnstile>TERM {conj (Q n) (e_recorded_in_t e t)} C {conj (P (Suc n)) (e_smaller_than_t_weaker e t u lt)}"
+      and "\<Turnstile> {natural_partition P} Assume (lnot b) {R}"
+
+      and "wfP lt"
+      and "\<And>n. not_fv_hyper t (P n)"
+      and "\<And>n. not_fv_hyper t (Q n)"
+
+      and "\<And>n. not_fv_hyper u (P n)"
+      and "\<And>n. not_fv_hyper u (Q n)"
+
+      and "(tr :: 'lval) \<noteq> fa"
+      and "u \<noteq> t"
+
+    shows "\<Turnstile>TERM {P 0} while_cond b C {R}"
+proof (rule total_hyper_triple_altI)
+  fix S :: "('lvar, 'lval, 'pvar, 'pval) state set"
+  assume asm0: "P 0 S"
+  have "\<And>n. P n (iterate_sem n (Assume b;; C) S)"
+  proof (rule indexed_invariant_then_power)
+    fix n
+    have "\<Turnstile> {Q n} C {P (Suc n)}"
+    proof (rule hyper_hoare_tripleI)
+      fix S assume asm1: "Q n S"
+      let ?S = "assign_exp_to_lvar_set e t S"
+      have "conj (Q n) (e_recorded_in_t e t) ?S"
+        by (metis asm1 assms(6) conj_def e_recorded_in_t_if_assigned not_fv_hyper_assign_exp)
+      then have "conj (P (Suc n)) (e_smaller_than_t_weaker e t u lt) (sem C ?S)"
+        using assms(2) hyper_hoare_tripleE total_hyper_triple_def by blast
+      then show "P (Suc n) (sem C S)"
+        using assign_exp_to_lvar_set_same_mod_updates[of t] assms(5) conj_def not_fv_hyperE[of t "P (Suc n)"] same_mod_updates_sym[of "{t}"] sem_update_commute[of "{t}"]
+        by metis
+    qed
+    then show " \<Turnstile> {P n} Assume b ;; C {P (Suc n)}"
+      using assms(1) seq_rule total_hyper_triple_def by blast
+  qed (simp add: asm0)
+  then have "natural_partition P (\<Union>n. iterate_sem n (Assume b;; C) S)"
+    by (simp add: natural_partitionI)
+  then show "R (sem (while_cond b C) S)"
+    using SUP_cong assms(3) hyper_hoare_triple_def[of "natural_partition P" "Assume (lnot b)" R] sem_seq sem_while while_cond_def
+    by metis
+
+
+  show "terminates_in (while_cond b C) S"
+  proof (rule terminates_in_while_loop)
+    show "wfP lt"
+      by (simp add: assms(4))
+    fix \<phi> n
+    assume asm1: "\<phi> \<in> iterate_sem n (Assume b ;; C) S \<and> b (snd \<phi>)"
+
+    let ?S = "assign_exp_to_lvar_set e t (iterate_sem n (Assume b;; C) S)"
+    let ?\<phi> = "assign_exp_to_lvar e t \<phi>"
+
+    let ?SS = "update_lvar_set u (\<lambda>\<phi>'. if \<phi>' = ?\<phi> then tr else fa) ?S" 
+
+    have SS_def: "?SS = { ((fst \<phi>')(u := if \<phi>' = ?\<phi> then tr else fa), snd \<phi>') |\<phi>'. \<phi>' \<in> ?S}"
+      by (simp add: update_lvar_set_def)
+
+    have same: "same_mod_updates {u} ?S ?SS"
+      by (meson same_update_lvar_set)
+
+
+    let ?\<phi>' = "((fst ?\<phi>)(u := tr), snd ?\<phi>)"
+
+    have "conj (P n) (e_recorded_in_t e t) ?S"
+      by (metis \<open>\<And>n. P n (iterate_sem n (Assume b ;; C) S)\<close> assms(5) conj_def e_recorded_in_t_if_assigned not_fv_hyper_assign_exp)
+    moreover have "e_recorded_in_t e t ?SS"
+    proof (rule e_recorded_in_tI)
+      fix \<phi>' assume "\<phi>' \<in> ?SS"
+      then show "fst \<phi>' t = e (snd \<phi>')" unfolding SS_def
+        using assms(10) e_recorded_in_t_def e_recorded_in_t_if_assigned by fastforce
+    qed
+
+    then have "conj (P n) (e_recorded_in_t e t) ?SS"
+      using assms(7) calculation conj_def not_fv_hyperE[of u "P n"] same
+      by metis
+    then have "conj (Q n) (e_recorded_in_t e t) (sem (Assume b) ?SS)"
+      using assms(1) assume_sem[of b] conj_def e_recorded_in_t_def[of e t] hyper_hoare_tripleE[of "P n" "Assume b" "Q n"
+          "update_lvar_set u (\<lambda>\<phi>'. if \<phi>' = assign_exp_to_lvar e t \<phi> then tr else fa) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))"] member_filter[of _ "b \<circ> snd"]
+      by metis
+    then have "conj (P (Suc n)) (e_smaller_than_t_weaker e t u lt) (sem C (sem (Assume b) ?SS))"
+      using assms(2) hyper_hoare_tripleE total_hyper_triple_def by blast
+    moreover have "?\<phi> \<in> (sem (Assume b) ?S)"
+      by (metis asm1 assign_exp_to_lvar_set_def assume_sem comp_apply image_eqI member_filter same_outside_set_lvar_assign_exp)
+    moreover have "?\<phi>' \<in> (sem (Assume b) ?SS)"
+      unfolding SS_def
+    proof (rule in_semI)
+      show "((fst ?\<phi>)(u := if ?\<phi> = assign_exp_to_lvar e t \<phi> then tr else fa), snd ?\<phi>) \<in> {((fst \<phi>')(u := if \<phi>' = assign_exp_to_lvar e t \<phi> then tr else fa), snd \<phi>') |\<phi>'. \<phi>' \<in> assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S)}"        
+        using asm1 assign_exp_to_lvar_set_def by fastforce
+      show "fst ((fst (assign_exp_to_lvar e t \<phi>))(u := if assign_exp_to_lvar e t \<phi> = assign_exp_to_lvar e t \<phi> then tr else fa), snd (assign_exp_to_lvar e t \<phi>)) =
+    fst ((fst (assign_exp_to_lvar e t \<phi>))(u := tr), snd (assign_exp_to_lvar e t \<phi>))"
+        by presburger
+      show "\<langle>Assume
+      b, snd ((fst (assign_exp_to_lvar e t \<phi>))(u := if assign_exp_to_lvar e t \<phi> = assign_exp_to_lvar e t \<phi> then tr else fa),
+              snd (assign_exp_to_lvar e t \<phi>))\<rangle> \<rightarrow> snd ((fst (assign_exp_to_lvar e t \<phi>))(u := tr), snd (assign_exp_to_lvar e t \<phi>))"
+        by (metis SemAssume asm1 same_outside_set_lvar_assign_exp snd_conv)
+    qed
+    then obtain \<sigma>' where "(fst ?\<phi>', \<sigma>') \<in> sem C (sem (Assume b) ?SS) \<and> \<langle>C, snd ?\<phi>'\<rangle> \<rightarrow> \<sigma>'"
+      using total_hyper_tripleE assms(2)[of n]
+      using \<open>Logic.conj (Q n) (e_recorded_in_t e t) (sem (Assume b) (update_lvar_set u (\<lambda>\<phi>'. if \<phi>' = assign_exp_to_lvar e t \<phi> then tr else fa) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))))\<close> by blast
+    moreover obtain \<phi>' where "\<phi>' \<in> sem C (sem (Assume b) ?SS)" "fst (fst ?\<phi>', \<sigma>') u = fst \<phi>' u \<and> lt (e (snd (fst ?\<phi>', \<sigma>'))) (fst \<phi>' t)"
+      using calculation conj_def[of "P (Suc n)" "e_smaller_than_t_weaker e t u lt"] e_smaller_than_t_weaker_def[of e t u lt]
+      by meson
+    then have "fst \<phi>' u = tr"
+      by simp
+    moreover have "fst ?\<phi> t = fst \<phi>' t \<and> single_sem C (snd \<phi>) (snd \<phi>')"
+    proof -
+      obtain \<phi>0 where "\<phi>0 \<in> sem (Assume b) ?SS" "fst \<phi>0 = fst \<phi>'" "single_sem C (snd \<phi>0) (snd \<phi>')"
+        by (metis (no_types, lifting) \<open>\<phi>' \<in> sem C (sem (Assume b) (update_lvar_set u (\<lambda>\<phi>'. if \<phi>' = assign_exp_to_lvar e t \<phi> then tr else fa) (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))))\<close> fst_conv in_sem snd_conv)
+      then have "\<phi>0 \<in> ?SS"
+        by (metis (no_types, lifting) assume_sem member_filter)
+      then obtain \<phi>0' where 
+        "\<phi>0' \<in> (assign_exp_to_lvar_set e t (iterate_sem n (Assume b ;; C) S))"
+        "\<phi>0 = ((fst \<phi>0')(u := if \<phi>0' = assign_exp_to_lvar e t \<phi> then tr else fa), snd \<phi>0')"
+        using SS_def by auto
+      then have "\<phi>0 = ((fst ?\<phi>)(u := tr), snd ?\<phi>)"
+        by (metis (full_types) \<open>fst \<phi>0 = fst \<phi>'\<close> assms(9) calculation(5) fst_conv fun_upd_same)
+      then show ?thesis
+        by (metis \<open>\<langle>C, snd \<phi>0\<rangle> \<rightarrow> snd \<phi>'\<close> \<open>fst \<phi>0 = fst \<phi>'\<close> assms(10) fst_conv fun_upd_other same_outside_set_lvar_assign_exp snd_conv)
+    qed
+    ultimately show "\<exists>\<sigma>'. (\<langle>C, snd \<phi>\<rangle> \<rightarrow> \<sigma>') \<and> (\<not> b \<sigma>' \<or> lt (e \<sigma>') (e (snd \<phi>)))"
+      by (metis (no_types, lifting) \<open>fst (fst ((fst (assign_exp_to_lvar e t \<phi>))(u := tr), snd (assign_exp_to_lvar e t \<phi>)), \<sigma>') u = fst \<phi>' u \<and> lt (e (snd (fst ((fst (assign_exp_to_lvar e t \<phi>))(u := tr), snd (assign_exp_to_lvar e t \<phi>)), \<sigma>'))) (fst \<phi>' t)\<close> assign_exp_to_lvar_def fst_conv fun_upd_same snd_conv)
+  qed
+qed
+
+
+
+
+end
\ No newline at end of file
diff --git a/thys/HyperHoareLogic/document/root.bib b/thys/HyperHoareLogic/document/root.bib
--- a/thys/HyperHoareLogic/document/root.bib
+++ b/thys/HyperHoareLogic/document/root.bib
@@ -1,684 +1,704 @@
 @article{FloydLogic,
 author={Floyd, Robert W.},
 title={Assigning Meanings to Programs},
 journal={Proceedings of Symposium in Applied Mathematics},
 editor={Schwartz, J. T.},
 year={1967},
 pages={19--32}
 }
 
 @article{HoareLogic,
 author = {Hoare, C. A. R.},
 title = {An Axiomatic Basis for Computer Programming},
 year = {1969},
 issue_date = {Oct. 1969},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {12},
 number = {10},
 issn = {0001-0782},
 doi = {10.1145/363235.363259},
 abstract = {In this paper an attempt is made to explore the logical foundations of computer programming by use of techniques which were first applied in the study of geometry and have later been extended to other branches of mathematics. This involves the elucidation of sets of axioms and rules of inference which can be used in proofs of the properties of computer programs. Examples are given of such axioms and rules, and a formal proof of a simple theorem is displayed. Finally, it is argued that important advantage, both theoretical and practical, may follow from a pursuance of these topics.},
 journal = {Commun. ACM},
 month = {oct},
 pages = {576–580},
 numpages = {5},
 keywords = {machine-independent programming, program documentation, axiomatic method, theory of programming' proofs of programs, programming language design, formal language definition}
 }
 
 @INPROCEEDINGS{hyperproperties,
 author={Clarkson, Michael R. and Schneider, Fred B.},
 booktitle={21st IEEE Computer Security Foundations Symposium}, 
 title={Hyperproperties}, 
 year={2008},
 volume={},
 number={},
 pages={51-65},
 doi={10.1109/CSF.2008.7}}
 
 @book{Isabelle,
 author = {Nipkow, Tobias and Wenzel, Markus and Paulson, Lawrence C.},
 title = {Isabelle/HOL: A Proof Assistant for Higher-Order Logic},
 year = {2002},
 isbn = {3540433767},
 publisher = {Springer-Verlag},
 address = {Berlin, Heidelberg}
 }
 
 @inproceedings{Benton04,
 author = {Benton, Nick},
 title = {Simple Relational Correctness Proofs for Static Analyses and Program Transformations},
 year = {2004},
 isbn = {158113729X},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 doi = {10.1145/964001.964003},
 abstract = {We show how some classical static analyses for imperative programs, and the optimizing transformations which they enable, may be expressed and proved correct using elementary logical and denotationaltechniques. The key ingredients are an interpretation of program properties as relations, rather than predicates, and a realization that although many program analyses are traditionally formulated in very intensional terms, the associated transformations are actually enabled by more liberal extensional properties.We illustrate our approach with formal systems for analysing and transforming while-programs. The first is a simple type system which tracks constancy and dependency information and can be used to perform dead-code elimination, constant propagation and program slicing as well as capturing a form of secure information flow. The second is a relational version of Hoare logic, which significantly generalizes our first type system and can also justify optimizations including hoisting loop invariants. Finally we show how a simple available expression analysis and redundancy elimination transformation may be justified by translation into relational Hoare logic.},
 booktitle = {Proceedings of the 31st ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages},
 pages = {14–25},
 numpages = {12},
 keywords = {dependency, partial equivalence relations, security, optimizing compilation, program analysis, denotational semantics, information flow, Hoare logic, types},
 location = {Venice, Italy},
 series = {POPL '04}
 }
 
 
 @inproceedings{CHL16,
 author = {Sousa, Marcelo and Dillig, Isil},
 title = {Cartesian {H}oare {L}ogic for Verifying K-Safety Properties},
 year = {2016},
 isbn = {9781450342612},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 doi = {10.1145/2908080.2908092},
 abstract = {Unlike safety properties which require the absence of a “bad” program trace, k-safety properties stipulate the absence of a “bad” interaction between k traces. Examples of k-safety properties include transitivity, associativity, anti-symmetry, and monotonicity. This paper presents a sound and relatively complete calculus, called Cartesian Hoare Logic (CHL), for verifying k-safety properties. We also present an automated verification algorithm based on CHL and implement it in a tool called DESCARTES. We use DESCARTES to analyze user-defined relational operators in Java and demonstrate that DESCARTES is effective at verifying (or finding violations of) multiple k-safety properties.},
 booktitle = {Proceedings of the 37th ACM SIGPLAN Conference on Programming Language Design and Implementation},
 pages = {57–69},
 numpages = {13},
 location = {Santa Barbara, CA, USA},
 series = {PLDI '16}
 }
 
 @article{IncorrectnessLogic,
 author = {O'Hearn, Peter W.},
 title = {Incorrectness {L}ogic},
 year = {2019},
 issue_date = {January 2020},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {4},
 number = {POPL},
 doi = {10.1145/3371078},
 journal = {Proc. ACM Program. Lang.},
 month = {dec},
 articleno = {10},
 numpages = {32},
 keywords = {none}
 }
 
   
 @InProceedings{ReverseHL,
 author="de Vries, Edsko
 and Koutavas, Vasileios",
 editor="Barthe, Gilles
 and Pardo, Alberto
 and Schneider, Gerardo",
 title="Reverse {H}oare {L}ogic",
 booktitle="Software Engineering and Formal Methods",
 year="2011",
 pages="155--171",
 isbn="978-3-642-24690-6"
 }
 
 @article{InsecurityLogic,
   doi = {10.48550/ARXIV.2003.04791},
   url = {https://arxiv.org/abs/2003.04791},
   author = {Murray, Toby},
   keywords = {Logic in Computer Science (cs.LO), FOS: Computer and information sciences, FOS: Computer and information sciences},
   title = {An Under-Approximate Relational Logic: Heralding Logics of Insecurity, Incorrect Implementation and More},
   publisher = {arXiv},
   year = {2020},
   journal={arXiv preprint arXiv:2003.04791},
   copyright = {arXiv.org perpetual, non-exclusive license}
 }
 
 @article{OutcomeLogic,
 author = {Zilberstein, Noam and Dreyer, Derek and Silva, Alexandra},
 title = {Outcome {L}ogic: A Unifying Foundation for Correctness and Incorrectness Reasoning},
 year = {2023},
 issue_date = {April 2023},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {7},
 number = {OOPSLA1},
 doi = {10.1145/3586045},
 journal = {Proc. ACM Program. Lang.},
 month = {april},
 articleno = {93}
 }
 
 
 @inproceedings{RHLE,
 author = {Dickerson, Robert and Ye, Qianchuan and Zhang, Michael K. and Delaware, Benjamin},
 title = {{RHLE}: Modular Deductive Verification of Relational $\forall{}\exists{}$ Properties},
 year = {2022},
 isbn = {978-3-031-21036-5},
 doi = {10.1007/978-3-031-21037-2\_4},
 booktitle = {Programming Languages and Systems: 20th Asian Symposium, APLAS 2022, Auckland, New Zealand, December 5, 2022, Proceedings},
 pages = {67–87},
 numpages = {21},
 location = {Auckland, New Zealand}
 }
 
 @article{refinement,
 title = {The existence of refinement mappings},
 journal = {Theoretical Computer Science},
 volume = {82},
 number = {2},
 pages = {253-284},
 year = {1991},
 issn = {0304-3975},
 doi = {https://doi.org/10.1016/0304-3975(91)90224-P},
 author = {Martín Abadi and Leslie Lamport}
 }
 
 @unpublished{Boogie,
 author = {Leino, K. Rustan M.},
 title = {This is {B}oogie 2},
 year = {2008},
 month = {June},
 url = {https://www.microsoft.com/en-us/research/publication/this-is-boogie-2-2/},
 }
 
 @InProceedings{Z3,
 author="de Moura, Leonardo
 and Bj{\o}rner, Nikolaj",
 editor="Ramakrishnan, C. R.
 and Rehof, Jakob",
 title="Z3: An Efficient SMT Solver",
 booktitle="Tools and Algorithms for the Construction and Analysis of Systems",
 year="2008",
 pages="337--340",
 isbn="978-3-540-78800-3"
 }
 
 @INPROCEEDINGS{SeparationLogic,
   author={Reynolds, J.C.},
   booktitle={Proceedings 17th Annual IEEE Symposium on Logic in Computer Science},
   title={Separation logic: a logic for shared mutable data structures},
   year={2002},
   volume={},
   number={},
   pages={55-74},
   doi={10.1109/LICS.2002.1029817}
 }
 
 @INPROCEEDINGS{SIF,
   author={Gray, J.W.},
   booktitle={Proceedings. 1991 IEEE Computer Society Symposium on Research in Security and Privacy},
   title={Toward a mathematical foundation for information flow security},
   year={1991},
   volume={},
   number={},
   pages={21-34},
   keywords={},
   doi={10.1109/RISP.1991.130769},
   ISSN={},
   month={May}
 }
 
 @article{CSL,
 title = {Resources, concurrency, and local reasoning},
 journal = {Theoretical Computer Science},
 volume = {375},
 number = {1},
 pages = {271-307},
 year = {2007},
 issn = {0304-3975},
 doi = {https://doi.org/10.1016/j.tcs.2006.12.035},
 author = {Peter W. O’Hearn},
 keywords = {Concurrency, Logics of programs, Separation logic}
 }
 
 @article{Dijkstra75,
 author = {Dijkstra, Edsger W.},
 title = {Guarded Commands, Nondeterminacy and Formal Derivation of Programs},
 year = {1975},
 issue_date = {Aug. 1975},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {18},
 number = {8},
 issn = {0001-0782},
 doi = {10.1145/360933.360975},
 journal = {Commun. ACM},
 month = {aug},
 pages = {453–457},
 numpages = {5},
 keywords = {program semantics, programming methodology, case-construction, correctness proof, termination, nondeterminancy, programming languages, sequencing primitives, repetition, derivation of programs, programming language semantics}
 }
 
 @article{HypersafetyCompositionally,
 author = {D’Osualdo, Emanuele and Farzan, Azadeh and Dreyer, Derek},
 title = {Proving Hypersafety Compositionally},
 year = {2022},
 issue_date = {October 2022},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {6},
 number = {OOPSLA2},
 doi = {10.1145/3563298},
 journal = {Proc. ACM Program. Lang.},
 month = {oct},
 articleno = {135},
 numpages = {26},
 keywords = {Modularity, Compositionality, Weakest Precondition, Hyperproperties}
 }
 
 @article{RelationalSL,
 title = {Relational separation logic},
 journal = {Theoretical Computer Science},
 volume = {375},
 number = {1},
 pages = {308-334},
 year = {2007},
 issn = {0304-3975},
 doi = {https://doi.org/10.1016/j.tcs.2006.12.036},
 author = {Hongseok Yang},
 keywords = {Separation logic, Program verification, Relational reasoning, Schorr–Waite graph marking algorithm},
 }
 
 @InProceedings{SecCSL,
 author="Ernst, Gidon
 and Murray, Toby",
 editor="Dillig, Isil
 and Tasiran, Serdar",
 title="{SecCSL}: Security Concurrent Separation Logic",
 booktitle="Computer Aided Verification",
 year="2019",
 address="Cham",
 pages="208--230",
 isbn="978-3-030-25543-5"
 }
 
 @misc{CommCSL,
   doi = {10.48550/ARXIV.2211.08459},
   url = {https://arxiv.org/abs/2211.08459},
   author = {Eilers, Marco and Dardinier, Thibault and Müller, Peter},
   keywords = {Cryptography and Security (cs.CR), Programming Languages (cs.PL), FOS: Computer and information sciences, FOS: Computer and information sciences},
   title = {{CommCSL}: Proving Information Flow Security for Concurrent Programs using Abstract Commutativity},
   publisher = {arXiv},
   year = {2022},
   copyright = {arXiv.org perpetual, non-exclusive license}
 }
 
 @InProceedings{ISL,
 author="Raad, Azalea
 and Berdine, Josh
 and Dang, Hoang-Hai
 and Dreyer, Derek
 and O'Hearn, Peter
 and Villard, Jules",
 title="Local Reasoning About the Presence of Bugs:  {I}ncorrectness {S}eparation {L}ogic",
 booktitle="Computer Aided Verification",
 year="2020",
 address="Cham",
 pages="225--252",
 isbn="978-3-030-53291-8"
 }
 
 
 @article{CISL,
 author = {Raad, Azalea and Berdine, Josh and Dreyer, Derek and O'Hearn, Peter W.},
 title = {Concurrent {I}ncorrectness {S}eparation {L}ogic},
 year = {2022},
 issue_date = {January 2022},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {6},
 number = {POPL},
 doi = {10.1145/3498695},
 abstract = {Incorrectness separation logic (ISL) was recently introduced as a theory of under-approximate reasoning, with the goal of proving that compositional bug catchers find actual bugs. However, ISL only considers sequential programs. Here, we develop concurrent incorrectness separation logic (CISL), which extends ISL to account for bug catching in concurrent programs. Inspired by the work on Views, we design CISL as a parametric framework, which can be instantiated for a number of bug catching scenarios, including race detection, deadlock detection, and memory safety error detection. For each instance, the CISL meta-theory ensures the soundness of incorrectness reasoning for free, thereby guaranteeing that the bugs detected are true positives.},
 journal = {Proc. ACM Program. Lang.},
 month = {jan},
 articleno = {34},
 numpages = {29},
 keywords = {bug catching, Concurrency, program logics, separation logic}
 }
 
 @InProceedings{SurveyRHL,
 author="Naumann, David A.",
 editor="Margaria, Tiziana
 and Steffen, Bernhard",
 title="Thirty-Seven Years of {R}elational {H}oare {L}ogic: Remarks on Its Principles and History",
 booktitle="Leveraging Applications of Formal Methods, Verification and Validation: Engineering Principles",
 year="2020",
 address="Cham",
 pages="93--116",
 abstract="Relational Hoare logics extend the applicability of modular, deductive verification to encompass important 2-run properties including dependency requirements such as confidentiality and program relations such as equivalence or similarity between program versions. A considerable number of recent works introduce different relational Hoare logics without yet converging on a core set of proof rules. This paper looks backwards to little known early work. This brings to light some principles that clarify and organize the rules as well as suggesting a new rule and a new notion of completeness.",
 isbn="978-3-030-61470-6"
 }
 
 @article{auxVariables,
 author = {Kleymann, Thomas},
 title = {Hoare Logic and Auxiliary Variables},
 year = {1999},
 issue_date = {Dec 1999},
 volume = {11},
 number = {5},
 issn = {0934-5043},
 doi = {10.1007/s001650050057},
 abstract = {Auxiliary variables are essential for specifying programs in Hoare Logic. They are required to relate the value of variables in different states. However, the axioms and rules of Hoare Logic turn a blind eye to the role of auxiliary variables. We stipulate a new structural rule for adjusting auxiliary variables when strengthening preconditions and weakening postconditions. Courtesy of this new rule, Hoare Logic is adaptation complete, which benefits software re-use. This property is responsible for a number of improvements. Relative completeness follows uniformly from the Most General Formula property. Moreover, one can show that Hoare Logic subsumes Vienna Development Method's (VDM) operation decomposition rules in that every derivation in VDM can be naturally embedded in Hoare Logic. Furthermore, the new treatment leads to a significant simplification in the presentation for verification calculi dealing with more interesting features such as recursion.},
 journal = {Form. Asp. Comput.},
 month = {dec},
 pages = {541–566},
 numpages = {26},
 keywords = {Keywords: Hoare Logic; Auxiliary variables; Adaptation Completeness; Most General Formula; VDM}
 }
 
 @article{francez1983product,
   title={Product properties and their direct verification},
   author={Francez, Nissim},
   journal={Acta informatica},
   volume={20},
   number={4},
   pages={329--344},
   year={1983}
 }
 
 @article{aguirre2017relational,
   title={A relational logic for higher-order programs},
   author={Aguirre, Alejandro and Barthe, Gilles and Gaboardi, Marco and Garg, Deepak and Strub, Pierre-Yves},
   journal={Proceedings of the ACM on Programming Languages},
   volume={1},
   number={ICFP},
   pages={1--29},
   year={2017},
   publisher={ACM New York, NY, USA}
 }
 
 @article{next700RHL,
 author = {Maillard, Kenji and Hri\c{t}cu, C\u{a}t\u{a}lin and Rivas, Exequiel and Van Muylder, Antoine},
 title = {The next 700 Relational Program Logics},
 year = {2019},
 issue_date = {January 2020},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {4},
 number = {POPL},
 doi = {10.1145/3371072},
 abstract = {We propose the first framework for defining relational program logics for arbitrary monadic effects. The framework is embedded within a relational dependent type theory and is highly expressive. At the semantic level, we provide an algebraic presentation of relational specifications as a class of relative monads, and link computations and specifications by introducing relational effect observations, which map pairs of monadic computations to relational specifications in a way that respects the algebraic structure. For an arbitrary relational effect observation, we generically define the core of a sound relational program logic, and explain how to complete it to a full-fledged logic for the monadic effect at hand. We show that this generic framework can be used to define relational program logics for effects as diverse as state, input-output, nondeterminism, and discrete probabilities. We, moreover, show that by instantiating our framework with state and unbounded iteration we can embed a variant of Benton's Relational Hoare Logic, and also sketch how to reconstruct Relational Hoare Type Theory. Finally, we identify and overcome conceptual challenges that prevented previous relational program logics from properly dealing with control effects, and are the first to provide a relational program logic for exceptions.},
 journal = {Proc. ACM Program. Lang.},
 month = {dec},
 articleno = {4},
 numpages = {33},
 keywords = {side-effects, monads, program verification, dependent types, foundations}
 }
 
 @article{AmtoftSIF,
 author = {Amtoft, Torben and Bandhakavi, Sruthi and Banerjee, Anindya},
 title = {A Logic for Information Flow in Object-Oriented Programs},
 year = {2006},
 issue_date = {January 2006},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {41},
 number = {1},
 issn = {0362-1340},
 doi = {10.1145/1111320.1111046},
 abstract = {This paper specifies, via a Hoare-like logic, an interprocedural and flow sensitive (but termination insensitive) information flow analysis for object-oriented programs. Pointer aliasing is ubiquitous in such programs, and can potentially leak confidential information. Thus the logic employs independence assertions to describe the noninterference property that formalizes confidentiality, and employs region assertions to describe possible aliasing. Programmer assertions, in the style of JML, are also allowed, thereby permitting a more fine-grained specification of information flow policy.The logic supports local reasoning about state in the style of separation logic. Small specifications are used; they mention only the variables and addresses relevant to a command. Specifications are combined using a frame rule. An algorithm for the computation of postconditions is described: under certain assumptions, there exists a strongest postcondition which the algorithm computes.},
 journal = {SIGPLAN Not.},
 month = {jan},
 pages = {91–102},
 numpages = {12},
 keywords = {confidentiality, aliasing, information flow}
 }
 
 @InProceedings{Costanzo2014,
 author="Costanzo, David
 and Shao, Zhong",
 editor="Abadi, Mart{\'i}n
 and Kremer, Steve",
 title="A Separation Logic for Enforcing Declarative Information Flow Control Policies",
 booktitle="Principles of Security and Trust",
 year="2014",
 pages="179--198",
 abstract="In this paper, we present a program logic for proving that a program does not release information about sensitive data in an unintended way. The most important feature of the logic is that it provides a formal security guarantee while supporting ``declassification policies'' that describe precise conditions under which a piece of sensitive data can be released. We leverage the power of Hoare Logic to express the policies and security guarantee in terms of state predicates. This allows our system to be far more specific regarding declassification conditions than most other information flow systems.",
 isbn="978-3-642-54792-8"
 }
 
 @article{volpano1996nonInterference,
   title={A sound type system for secure flow analysis},
   author={Volpano, Dennis and Irvine, Cynthia and Smith, Geoffrey},
   journal={Journal of computer security},
   volume={4},
   number={2-3},
   pages={167--187},
   year={1996},
   publisher={IOS Press}
 }
 
 @InProceedings{UnifyingHLandIL,
 author="M{\"o}ller, Bernhard
 and O'Hearn, Peter
 and Hoare, Tony",
 editor="Fahrenberg, Uli
 and Gehrke, Mai
 and Santocanale, Luigi
 and Winter, Michael",
 title="On Algebra of Program Correctness and Incorrectness",
 booktitle="Relational and Algebraic Methods in Computer Science",
 year="2021",
 address="Cham",
 pages="325--343",
 abstract="Variants of Kleene algebra have been used to provide foundations of reasoning about programs, for instance by representing Hoare Logic (HL) in algebra. That work has generally emphasised program correctness, i.e., proving the absence of bugs. Recently, Incorrectness Logic (IL) has been advanced as a formalism for the dual problem: proving the presence of bugs. IL is intended to underpin the use of logic in program testing and static bug finding. Here, we use a Kleene algebra with diamond operators and countable joins of tests, which embeds IL, and which also is complete for reasoning about the image of the embedding. Next to embedding IL, the algebra is able to embed HL, and allows making connections between IL and HL specifications. In this sense, it unifies correctness and incorrectness reasoning in one formalism.",
 isbn="978-3-030-88701-8"
 }
 
 @article{maksimovic2022exact,
   title={Exact Separation Logic},
   author={Maksimovi{\'c}, Petar and Cronj{\"a}ger, Caroline and Sutherland, Julian and L{\"o}{\"o}w, Andreas and Ayoun, Sacha-{\'E}lie and Gardner, Philippa},
   journal={arXiv preprint arXiv:2208.07200},
   year={2022}
 }
 
 @INBOOK{DynamicLogic,
   author={Harel, David and Kozen, Dexter and Tiuryn, Jerzy},
   booktitle={Dynamic Logic}, 
   title={First-Order Dynamic Logic}, 
   year={2000},
   volume={},
   number={},
   pages={283-299},
   doi={}}
 
 
 @book{harel1979first,
   title={First-order dynamic logic},
   author={Harel, David},
   year={1979},
   publisher={Springer}
 }
 
 @article{hyperpropertiesDL,
   title={Propositional dynamic logic for hyperproperties},
   author={Gutsfeld, Jens Oliver and M{\"u}ller-Olm, Markus and Ohrem, Christoph},
   journal={arXiv preprint arXiv:1910.10546},
   year={2019}
 }
 
 @article{probaHL,
   title={Verifying probabilistic programs using a {H}oare like logic},
   author={Den Hartog, JI and de Vink, Erik P},
   journal={International journal of foundations of computer science},
   volume={13},
   number={03},
   pages={315--340},
   year={2002},
   publisher={World Scientific}
 }
 
 @inproceedings{corin2006probabilistic,
   title={A probabilistic {H}oare-style logic for game-based cryptographic proofs},
   author={Corin, Ricardo and Den Hartog, Jerry},
   booktitle={International Colloquium on Automata, Languages, and Programming},
   pages={252--263},
   year={2006}
 }
 
 @inproceedings{barthe2009formal,
   title={Formal certification of code-based cryptographic proofs},
   author={Barthe, Gilles and Gr{\'e}goire, Benjamin and Zanella B{\'e}guelin, Santiago},
   booktitle={Proceedings of the 36th annual ACM SIGPLAN-SIGACT symposium on Principles of programming languages},
   pages={90--101},
   year={2009}
 }
 
 @inproceedings{terauchi2005secure,
   title={Secure information flow as a safety problem},
   author={Terauchi, Tachio and Aiken, Alex},
   booktitle={International Static Analysis Symposium},
   pages={352--367},
   year={2005}
 }
 
 @article{selfComposition,
   title={Secure information flow by self-composition},
   author={Barthe, Gilles and D'argenio, Pedro R and Rezk, Tamara},
   journal={Mathematical Structures in Computer Science},
   volume={21},
   number={6},
   pages={1207--1252},
   year={2011},
   publisher={Cambridge University Press}
 }
 
 @inproceedings{productPrograms,
   title={Relational verification using product programs},
   author={Barthe, Gilles and Crespo, Juan Manuel and Kunz, C{\'e}sar},
   booktitle={International Symposium on Formal Methods},
   pages={200--214},
   year={2011}
 }
 
 @article{eilers2019modular,
   title={Modular product programs},
   author={Eilers, Marco and M{\"u}ller, Peter and Hitz, Samuel},
   journal={ACM Transactions on Programming Languages and Systems (TOPLAS)},
   volume={42},
   number={1},
   pages={1--37},
   year={2019},
   publisher={ACM New York, NY, USA}
 }
 
 @inproceedings{barthe2013beyond,
   title={Beyond 2-safety: Asymmetric product programs for relational program verification},
   author={Barthe, Gilles and Crespo, Juan Manuel and Kunz, C{\'e}sar},
   booktitle={International Symposium on Logical Foundations of Computer Science},
   pages={29--43},
   year={2013}
 }
 
 @inproceedings{clarkson2014temporal,
   title={Temporal logics for hyperproperties},
   author={Clarkson, Michael R and Finkbeiner, Bernd and Koleini, Masoud and Micinski, Kristopher K and Rabe, Markus N and S{\'a}nchez, C{\'e}sar},
   booktitle={International Conference on Principles of Security and Trust},
   pages={265--284},
   year={2014}
 }
 
 @inproceedings{coenen2019verifying,
   title={Verifying hyperliveness},
   author={Coenen, Norine and Finkbeiner, Bernd and S{\'a}nchez, C{\'e}sar and Tentrup, Leander},
   booktitle={International Conference on Computer Aided Verification},
   pages={121--139},
   year={2019}
 }
 
 @InProceedings{beyondkSafety,
 author="Beutner, Raven
 and Finkbeiner, Bernd",
 editor="Shoham, Sharon
 and Vizel, Yakir",
 title="Software Verification of Hyperproperties Beyond k-Safety",
 booktitle="Computer Aided Verification",
 year="2022",
 address="Cham",
 pages="341--362",
 abstract="Temporal hyperproperties are system properties that relate multiple execution traces. For (finite-state) hardware, temporal hyperproperties are supported by model checking algorithms, and tools for general temporal logics like HyperLTL exist. For (infinite-state) software, the analysis of temporal hyperproperties has, so far, been limited to k-safety properties, i.e., properties that stipulate the absence of a bad interaction between any k traces. In this paper, we present an automated method for the verification of {\$}{\$}{\backslash}forall ^k{\backslash}exists ^l{\$}{\$}∀k∃l-safety properties in infinite-state systems. A {\$}{\$}{\backslash}forall ^k{\backslash}exists ^l{\$}{\$}∀k∃l-safety property stipulates that for any k traces, there exist l traces such that the resulting {\$}{\$}k+l{\$}{\$}k+ltraces do not interact badly. This combination of universal and existential quantification enables us to express many properties beyond k-safety, including, for example, generalized non-interference or program refinement. Our method is based on a strategy-based instantiation of existential trace quantification combined with a program reduction, both in the context of a fixed predicate abstraction. Notably, our framework allows for mutual dependence of strategy and reduction.",
 isbn="978-3-031-13185-1"
 }
 
 @article{assaf2017hypercollecting,
   title={Hypercollecting semantics and its application to static analysis of information flow},
   author={Assaf, Mounir and Naumann, David A and Signoles, Julien and Totel, Eric and Tronel, Fr{\'e}d{\'e}ric},
   journal={ACM SIGPLAN Notices},
   volume={52},
   number={1},
   pages={874--887},
   year={2017},
   publisher={ACM New York, NY, USA}
 }
 
 @inproceedings{cousot1977abstract,
   title={Abstract interpretation: a unified lattice model for static analysis of programs by construction or approximation of fixpoints},
   author={Cousot, Patrick and Cousot, Radhia},
   booktitle={Proceedings of the 4th ACM SIGACT-SIGPLAN symposium on Principles of programming languages},
   pages={238--252},
   year={1977}
 }
 
 @inproceedings{relationalUsingTraceLogic,
   title={Verifying relational properties using trace logic},
   author={Barthe, Gilles and Eilers, Renate and Georgiou, Pamina and Gleiss, Bernhard and Kov{\'a}cs, Laura and Maffei, Matteo},
   booktitle={2019 Formal Methods in Computer Aided Design (FMCAD)},
   pages={170--178},
   year={2019},
   organization={IEEE}
 }
 
 
 @inproceedings{mccullough1987GNI,
   title={Specifications for multi-level security and a hook-up},
   author={McCullough, Daryl},
   booktitle={1987 IEEE Symposium on Security and Privacy},
   pages={161--161},
   year={1987},
   organization={IEEE}
 }
 
 @article{mclean1996formalGNI,
   title={A general theory of composition for a class of" possibilistic" properties},
   author={McLean, John},
   journal={IEEE Transactions on Software Engineering},
   volume={22},
   number={1},
   pages={53--67},
   year={1996},
   publisher={IEEE}
 }
 
 @inproceedings{diffPrivacyHL,
   title={Proving differential privacy in Hoare logic},
   author={Barthe, Gilles and Gaboardi, Marco and Arias, Emilio Jes{\'u}s Gallego and Hsu, Justin and Kunz, C{\'e}sar and Strub, Pierre-Yves},
   booktitle={2014 IEEE 27th Computer Security Foundations Symposium},
   pages={411--424},
   year={2014},
   organization={IEEE}
 }
 
 @inproceedings{Ellora,
   title={An assertion-based program logic for probabilistic programs},
   author={Barthe, Gilles and Espitau, Thomas and Gaboardi, Marco and Gr{\'e}goire, Benjamin and Hsu, Justin and Strub, Pierre-Yves},
   booktitle={European Symposium on Programming},
   pages={117--144},
   year={2018}
 }
 
 @article{probabilisticSL,
 author = {Barthe, Gilles and Hsu, Justin and Liao, Kevin},
 title = {A Probabilistic Separation Logic},
 year = {2019},
 issue_date = {January 2020},
 publisher = {Association for Computing Machinery},
 address = {New York, NY, USA},
 volume = {4},
 number = {POPL},
 doi = {10.1145/3371123},
 abstract = {Probabilistic independence is a useful concept for describing the result of random sampling—a basic operation in all probabilistic languages—and for reasoning about groups of random variables. Nevertheless, existing verification methods handle independence poorly, if at all. We propose a probabili stic separation logic PSL, where separation models probabilistic independence. We first give a new, probabilistic model of the logic of bunched implications (BI). We then build a program logic based on these assertions, and prove soundness of the proof system. We demonstrate our logic by verifying information-theoretic security of cryptographic constructions for several well-known tasks, including private information retrieval, oblivious transfer, secure multi-party addition, and simple oblivious RAM. Our proofs reason purely in terms of high-level properties, like independence and uniformity.},
 journal = {Proc. ACM Program. Lang.},
 month = {dec},
 articleno = {55},
 numpages = {30},
 keywords = {probabilistic independence, verified cryptography, separation logic}
 }
 
 @article{HyperHoareLogic,
   title={Hyper {H}oare {L}ogic: (Dis-)Proving Program Hyperproperties (extended version)},
   author={Dardinier, Thibault and M{\"u}ller, Peter},
   journal={arXiv preprint arXiv:2301.10037},
   year={2023},
   doi = {10.48550/arXiv.2301.10037},
   url = {https://doi.org/10.48550/arXiv.2301.10037}
 }
+
+@article{HyperHoareLogicPLDI,
+author = {Dardinier, Thibault and M\"{u}ller, Peter},
+title = {{Hyper Hoare Logic: (Dis-)Proving Program Hyperproperties}},
+year = {2024},
+issue_date = {June 2024},
+publisher = {Association for Computing Machinery},
+address = {New York, NY, USA},
+volume = {8},
+number = {PLDI},
+url = {https://doi.org/10.1145/3656437},
+doi = {10.1145/3656437},
+journal = {Proc. ACM Program. Lang.},
+month = {jun},
+articleno = {207},
+numpages = {25},
+keywords = {Hyperproperties, Program Logic, Incorrectness Logic, Non-Interference}
+}
+
+
diff --git a/thys/HyperHoareLogic/document/root.tex b/thys/HyperHoareLogic/document/root.tex
--- a/thys/HyperHoareLogic/document/root.tex
+++ b/thys/HyperHoareLogic/document/root.tex
@@ -1,78 +1,80 @@
 \documentclass[11pt,a4paper]{article}
 \usepackage[T1]{fontenc}
 \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,bigparallel,fatsemi,interleave,sslash]{stmaryrd}
   %for \<Sqinter>, \<Parallel>, \<Zsemi>, \<Parallel>, \<sslash>
 
 %\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{Formalization of Hyper Hoare Logic:\\A Logic to (Dis-)Prove Program Hyperproperties}
 \author{Thibault Dardinier\\
 Department of Computer Science\\ETH Zurich, Switzerland}
 
 \maketitle
 
 \begin{abstract}
 	Hoare logics~\cite{FloydLogic, HoareLogic} are proof systems that allow one to formally establish properties of computer programs.
-	Traditional Hoare logics prove properties of individual program executions (so-called trace properties, such as functional correctness).
+	Traditional Hoare logics prove properties of individual program executions (such as functional correctness).
 	On the one hand, Hoare logic has been generalized to prove properties of multiple executions of a program (so-called hyperproperties~\cite{hyperproperties}, such as determinism or non-interference).
 	These program logics prove the absence of (bad combinations of) executions.
 	On the other hand, program logics similar to Hoare logic have been proposed to disprove program properties (e.g., Incorrectness Logic~\cite{IncorrectnessLogic}), by proving the existence of (bad combinations of) executions.
 	All of these logics have in common that they specify program properties using assertions over a fixed number of states, for instance, a single pre- and post-state for functional properties or pairs of pre- and post-states for non-interference.
 
-	In this entry, we formalize Hyper Hoare Logic~\cite{HyperHoareLogic}, a generalization of Hoare logic that lifts assertions to properties of arbitrary sets of states.
-	The resulting logic is simple yet expressive: its judgments can express arbitrary trace- and hyperproperties over the terminating executions of a program.
-	By allowing assertions to reason about sets of states, Hyper Hoare Logic can reason about both the absence and the existence of (combinations of) executions, and, thereby, supports both proving and disproving program (hyper-)properties within the same logic.
-	In fact, we prove that Hyper Hoare Logic subsumes the properties handled by numerous existing correctness and incorrectness logics, and can express hyperproperties that no existing Hoare logic can.
-	We also prove that Hyper Hoare Logic is sound and complete.
+	In this entry, we formalize Hyper Hoare Logic~\cite{HyperHoareLogic,HyperHoareLogicPLDI}, a generalization of Hoare logic that lifts assertions to properties of arbitrary sets of states.
+	The resulting logic is simple yet expressive: its judgments can express arbitrary program hyperproperties, a particular class of hyperproperties over the set of terminating executions of a program (including properties of individual program executions).
+	By allowing assertions to reason about sets of states, Hyper Hoare Logic can reason about both the absence and the existence of (combinations of) executions, and, thereby, supports both proving and disproving program (hyper-)properties within the same logic, including hyperproperties that no existing Hoare logic can express.
+	We prove that Hyper Hoare Logic is sound and complete, and demonstrate that it captures important proof principles naturally.
 \end{abstract}
 
 \clearpage
 
 \tableofcontents
 
 % sane default for proof documents
 \parindent 0pt\parskip 0.5ex
 
 % generated text of all theories
 \input{session}
 
 % optional bibliography
-\bibliographystyle{plain}
+\bibliographystyle{plainurl}
+%\citestyle{alphabetic}
+%\bibliographystyle{acm}
+%\bibliographystyle{plain}
 \bibliography{root}
 
 \end{document}
 
 %%% Local Variables:
 %%% mode: latex
 %%% TeX-master: t
 %%% End: