(*  Title:       A Definitional Encoding of TLA in Isabelle/HOL
    Authors:     Gudmund Grov <ggrov at inf.ed.ac.uk>
                 Stephan Merz <Stephan.Merz at loria.fr>
    Year:        2011
    Maintainer:  Gudmund Grov <ggrov at inf.ed.ac.uk>
*)

section \<open>(Infinite) Sequences\<close>

theory Sequence
imports Main
begin

text \<open>
  Lamport's Temporal Logic of Actions (TLA) is a linear-time temporal logic,
  and its semantics is defined over infinite sequence of states, which we
  simply represent by the type \<open>'a seq\<close>, defined as an abbreviation
  for the type \<open>nat \<Rightarrow> 'a\<close>, where \<open>'a\<close> is the type of sequence
  elements.

  This theory defines some useful notions about such sequences, and in particular
  concepts related to stuttering (finite repetitions of states), which are
  important for the semantics of TLA. We identify a finite sequence with an
  infinite sequence that ends in infinite stuttering. In this way, we avoid the
  complications of having to handle both finite and infinite sequences of states:
  see e.g. Devillers et al \cite{Devillers97} who discuss several variants of
  representing possibly infinite sequences in HOL, Isabelle and PVS.
\<close>

type_synonym 'a seq = "nat \<Rightarrow> 'a"

subsection "Some operators on sequences"

text \<open>Some general functions on sequences are provided\<close>

definition first :: "'a seq \<Rightarrow> 'a"
where "first s \<equiv> s 0"

definition second :: "('a seq) \<Rightarrow> 'a"
where "second s \<equiv> s 1"

definition suffix :: "'a seq \<Rightarrow> nat \<Rightarrow> 'a seq" (infixl "|\<^sub>s" 60)
where "s |\<^sub>s i \<equiv> \<lambda> n. s (n+i)"

definition tail :: "'a seq \<Rightarrow> 'a seq"
where "tail s \<equiv> s |\<^sub>s 1"

definition
 app :: "'a \<Rightarrow> ('a seq) \<Rightarrow> ('a seq)" (infixl "##" 60)
where
 "s ## \<sigma>  \<equiv> \<lambda> n. if n=0 then s else \<sigma> (n - 1)"

text \<open>
  \<open>s |\<^sub>s i\<close> returns the suffix of sequence @{term s} from
  index @{term i}.  @{term first} returns the first element of a sequence
  while  @{term second} returns the second element. @{term tail} returns the
  sequence starting at the second element. @{term "s ## \<sigma>"} prefixes the
  sequence @{term \<sigma>} by element @{term s}.
\<close>

subsubsection "Properties of @{term first} and @{term second}"

lemma first_tail_second: "first(tail s) = second s"
  by (simp add: first_def second_def tail_def suffix_def)

subsubsection "Properties of @{term suffix}"

lemma suffix_first: "first (s |\<^sub>s n) = s n"
  by (auto simp add: suffix_def first_def)

lemma suffix_second: "second (s |\<^sub>s n) = s (Suc n)"
  by (auto simp add: suffix_def second_def)

lemma suffix_plus: "s |\<^sub>s n |\<^sub>s m = s |\<^sub>s (m + n)"
  by (simp add: suffix_def add.assoc)

lemma suffix_commute: "((s |\<^sub>s n) |\<^sub>s m) = ((s |\<^sub>s m) |\<^sub>s n)"
  by (simp add: suffix_plus add.commute)

lemma suffix_plus_com: "s |\<^sub>s m |\<^sub>s n = s |\<^sub>s (m + n)"
proof -
  have "s |\<^sub>s n |\<^sub>s m = s |\<^sub>s (m + n)" by (rule suffix_plus)
  thus "s |\<^sub>s m |\<^sub>s n = s |\<^sub>s (m + n)" by (simp add: suffix_commute)
qed

lemma suffix_zero[simp]: "s |\<^sub>s 0 = s"
  by (simp add: suffix_def)

lemma suffix_tail: "s |\<^sub>s 1 = tail s"
  by (simp add: tail_def)

lemma tail_suffix_suc: "s |\<^sub>s (Suc n) = tail (s |\<^sub>s n)"
  by (simp add: suffix_def tail_def)

subsubsection "Properties of  @{term app}"

lemma seq_app_second: "(s ## \<sigma>) 1 = \<sigma> 0"
  by (simp add: app_def)

lemma seq_app_first: "(s ## \<sigma>) 0 = s"
  by (simp add: app_def)

lemma seq_app_first_tail: "(first s) ## (tail s) = s"
proof (rule ext)
  fix x
  show "(first s ## tail s) x = s x"
    by (simp add: first_def app_def suffix_def tail_def)
qed

lemma seq_app_greater_than_zero: "n > 0 \<Longrightarrow> (s ## \<sigma>) n = \<sigma> (n - 1)"
  by (simp add: app_def)

subsection "Finite and Empty Sequences"

text\<open>
  We identify finite and empty sequences and prove lemmas about them.
\<close>

definition fin :: "('a seq) \<Rightarrow> bool"
where "fin s \<equiv> \<exists> i. \<forall> j \<ge> i. s j = s i"

abbreviation inf :: "('a seq) \<Rightarrow> bool"
where "inf s \<equiv> \<not>(fin s)"

definition last :: "('a seq) \<Rightarrow> nat"
where "last s \<equiv> LEAST i. (\<forall> j \<ge> i. s j = s i)"

definition laststate :: "('a seq) \<Rightarrow> 'a"
where "laststate s \<equiv> s (last s)"

definition emptyseq :: "('a seq) \<Rightarrow> bool"
where "emptyseq \<equiv> \<lambda> s. \<forall> i. s i = s 0"

abbreviation notemptyseq :: "('a seq) \<Rightarrow> bool"
where "notemptyseq s \<equiv> \<not>(emptyseq s)"

text \<open>
  Predicate @{term fin} holds if there is an element
  in the sequence such that all subsequent elements are identical,
  i.e. the sequence is finite. @{term "last s"} returns the smallest index
  from which on all elements of a finite sequence @{term s} are identical. Note that
  if \<open>s\<close> is not finite then an arbitrary number is returned.
  @{term laststate} returns the last element of a finite sequence. We assume
  that the sequence is finite when using  @{term last} and  @{term laststate}.
  Predicate @{term emptyseq} identifies empty sequences -- i.e. all states in
  the sequence are identical to the initial one, while @{term notemptyseq} holds
  if the given sequence is not empty.
\<close>

subsubsection "Properties of @{term emptyseq}"

lemma empty_is_finite: assumes "emptyseq s" shows "fin s"
  using assms by (auto simp: fin_def emptyseq_def)

lemma empty_suffix_is_empty: assumes H: "emptyseq s" shows "emptyseq (s |\<^sub>s n)"
proof (clarsimp simp: emptyseq_def)
 fix i
 from H have "(s |\<^sub>s n) i = s 0" by (simp add: emptyseq_def suffix_def)
 moreover
 from H have "(s |\<^sub>s n) 0 = s 0" by (simp add: emptyseq_def suffix_def)
 ultimately
 show "(s |\<^sub>s n) i = (s |\<^sub>s n) 0" by simp
qed

lemma suc_empty: assumes H1: "emptyseq (s |\<^sub>s m)" shows "emptyseq (s |\<^sub>s (Suc m))"
proof -
  from H1 have "emptyseq ((s |\<^sub>s m) |\<^sub>s 1)" by (rule empty_suffix_is_empty)
  thus ?thesis by (simp add: suffix_plus)
qed

lemma empty_suffix_exteq: assumes H:"emptyseq s" shows "(s |\<^sub>s n) m = s m"
proof (unfold suffix_def)
  from H have "s (m+n) = s 0" by (simp add: emptyseq_def)
  moreover
  from H have "s m = s 0" by (simp add: emptyseq_def)
  ultimately show "s (m + n) = s m" by simp
qed

lemma empty_suffix_eq: assumes H: "emptyseq s" shows "(s |\<^sub>s n) = s"
proof (rule ext)
  fix m
  from H show "(s |\<^sub>s n) m = s m" by (rule empty_suffix_exteq)
qed

lemma seq_empty_all: assumes H: "emptyseq s" shows "s i = s j"
proof -
  from H have "s i = s 0" by (simp add: emptyseq_def)
  moreover
  from H have "s j = s 0" by (simp add: emptyseq_def)
  ultimately
  show ?thesis by simp
qed

subsubsection "Properties of @{term last} and @{term laststate}"

lemma fin_stut_after_last: assumes H: "fin s" shows "\<forall>j \<ge> last s. s j = s (last s)"
proof (clarify)
  fix j
  assume j: "j \<ge> last s"
  from H obtain i where "\<forall>j \<ge> i. s j = s i" (is "?P i") by (auto simp: fin_def)
  hence "?P (last s)" unfolding last_def by (rule LeastI)
  with j show "s j = s (last s)" by blast
qed

subsection "Stuttering Invariance"

text \<open>
  This subsection provides functions for removing stuttering
  steps of sequences, i.e. we formalise Lamports \<open>\<natural>\<close> operator.
  Our formal definition is close to that of Wahab in the PVS prover.

  The key novelty with the @{term "Sequence"} theory, is the treatment of
  stuttering invariance, which enables verification of stuttering invariance of
  the operators derived using it. Such proofs require comparing sequences
  up to stuttering. Here, Lamport's \cite{Lamport94} method is used to
  mechanise the equality of sequences up to stuttering: he defines
  the \<open>\<natural>\<close> operator, which collapses a sequence by removing
  all stuttering steps, except possibly infinite stuttering at the end of the sequence.
  These are left unchanged.
\<close>

definition nonstutseq :: "('a seq) \<Rightarrow> bool"
where "nonstutseq s \<equiv> \<forall> i. s i = s (Suc i) \<longrightarrow> (\<forall> j > i. s i = s j)"

definition stutstep :: "('a seq) \<Rightarrow> nat \<Rightarrow> bool"
where "stutstep s n \<equiv> (s n = s (Suc n))"

definition nextnat :: "('a seq) \<Rightarrow> nat"
where "nextnat s \<equiv> if emptyseq s then 0 else LEAST i. s i \<noteq> s 0"

definition nextsuffix :: "('a seq) \<Rightarrow> ('a seq)"
where "nextsuffix s \<equiv> s |\<^sub>s (nextnat s)"

fun "next" :: "nat \<Rightarrow> ('a seq) \<Rightarrow> ('a seq)" where
  "next 0 = id"
| "next (Suc n) = nextsuffix o (next n)"

definition collapse :: "('a seq) \<Rightarrow> ('a seq)" ("\<natural>")
where "\<natural> s \<equiv> \<lambda> n. (next n s) 0"

text \<open>
  Predicate @{term nonstutseq} identifies sequences without any
  stuttering steps -- except possibly for infinite stuttering at the end.
  Further, @{term "stutstep s n"} is a predicate which holds if the element
  after @{term "s n"} is equal to @{term "s n"}, i.e. @{term "Suc n"} is
  a stuttering step.
  @{term "collapse s"} formalises Lamports  @{term "\<natural>"}
  operator. It returns the first state of the result of @{term "next n s"}.
  @{term "next n s"} finds suffix of the $n^{th}$ change. Hence the first
  element, which @{term "\<natural> s"} returns, is the state after the $n^{th}$
  change.  @{term "next n s"} is defined by primitive recursion on
  @{term "n"} using function composition of function @{term nextsuffix}. E.g.
  @{term "next 3 s"} equals @{term "nextsuffix (nextsuffix (nextsuffix s))"}.
  @{term "nextsuffix s"} returns the suffix of the sequence starting at the
  next changing state. It uses @{term "nextnat"} to obtain this. All the real
  computation is done in this function. Firstly, an empty sequence will obviously
  not contain any changes, and \<open>0\<close> is therefore returned. In this case
  @{term "nextsuffix"} behaves like the identify function. If the sequence is not
  empty then the smallest number @{term "i"} such that @{term "s i"} is different
  from the initial state is returned. This is achieved by @{term "Least"}.
\<close>

subsubsection "Properties of @{term nonstutseq}"

lemma seq_empty_is_nonstut:
  assumes H: "emptyseq s" shows "nonstutseq s"
  using H by (auto simp: nonstutseq_def seq_empty_all)

lemma notempty_exist_nonstut:
  assumes H: "\<not> emptyseq (s |\<^sub>s m)" shows "\<exists> i. s i \<noteq> s m \<and> i > m"
using H proof (auto simp: emptyseq_def suffix_def)
  fix i
  assume i: "s (i + m) \<noteq> s m"
  hence "i \<noteq> 0" by (intro notI, simp)
  with i show ?thesis by auto
qed

subsubsection "Properties of @{term nextnat}"

lemma nextnat_le_unch: assumes H: "n < nextnat s" shows "s n = s 0"
proof (cases "emptyseq s")
  assume "emptyseq s"
  hence "nextnat s = 0" by (simp add: nextnat_def)
  with H show ?thesis by auto
next
  assume "\<not> emptyseq s"
  hence a1: "nextnat s = (LEAST i. s i \<noteq> s 0)" by (simp add: nextnat_def)
  show ?thesis
  proof (rule ccontr)
    assume a2: "s n \<noteq> s 0" (is "?P n")
    hence "(LEAST i. s i \<noteq> s 0) \<le> n" by (rule Least_le)
    hence "\<not>(n < (LEAST i. s i \<noteq> s 0))" by auto
    also from H a1 have "n < (LEAST i. s i \<noteq> s 0)" by simp
    ultimately show False by auto
  qed
qed

lemma stutnempty:
  assumes H: "\<not> stutstep s n" shows "\<not> emptyseq (s |\<^sub>s n)"
proof (unfold emptyseq_def suffix_def)
  from H have "s (Suc n) \<noteq> s n" by (auto simp add: stutstep_def)
  hence "s (1+n) \<noteq> s (0+n)" by simp
  thus "\<not>(\<forall> i. s (i+n) = s (0+n))" by blast
qed

lemma notstutstep_nexnat1:
  assumes H: "\<not> stutstep s n" shows "nextnat (s |\<^sub>s n) = 1"
proof -
  from H have h': "nextnat (s |\<^sub>s n) = (LEAST i. (s |\<^sub>s n) i \<noteq> (s |\<^sub>s n) 0)"
    by (auto simp add: nextnat_def stutnempty)
  from H have "s (Suc n) \<noteq> s n" by (auto simp add: stutstep_def)
  hence "(s |\<^sub>s n) 1 \<noteq> (s |\<^sub>s n) 0" (is "?P 1") by (auto simp add: suffix_def)
  hence "Least ?P \<le> 1" by (rule Least_le)
  hence g1: "Least ?P = 0 \<or> Least ?P = 1" by auto
  with h' have g1': "nextnat (s |\<^sub>s n) = 0 \<or> nextnat (s |\<^sub>s n) = 1" by auto
  also have "nextnat (s |\<^sub>s n) \<noteq> 0"
  proof -
    from H have "\<not> emptyseq (s |\<^sub>s n)" by (rule stutnempty)
    then obtain i where "(s |\<^sub>s n) i \<noteq>  (s |\<^sub>s n) 0" by (auto simp add: emptyseq_def)
    hence "(s |\<^sub>s n) (LEAST i. (s |\<^sub>s n) i \<noteq> (s |\<^sub>s n) 0) \<noteq> (s |\<^sub>s n) 0" by (rule LeastI)
    with h' have g2: "(s |\<^sub>s n) (nextnat (s |\<^sub>s n)) \<noteq> (s |\<^sub>s n) 0" by auto
    show "(nextnat (s |\<^sub>s n)) \<noteq> 0"
    proof
      assume "(nextnat (s |\<^sub>s n)) = 0"
      with g2 show "False" by simp
    qed
  qed
  ultimately show  "nextnat (s |\<^sub>s n) = 1" by auto
qed

lemma stutstep_notempty_notempty:
  assumes h1: "emptyseq (s |\<^sub>s Suc n)" (is "emptyseq ?sn")
      and h2: "stutstep s n"
  shows "emptyseq (s |\<^sub>s n)" (is "emptyseq ?s")
proof (auto simp: emptyseq_def)
  fix k
  show "?s k = ?s 0"
  proof (cases k)
    assume "k = 0" thus ?thesis by simp
  next
    fix m
    assume k: "k = Suc m"
    hence "?s k = ?sn m" by (simp add: suffix_def)
    also from h1 have "... = ?sn 0" by (simp add: emptyseq_def)
    also from h2 have "... = s n" by (simp add: suffix_def stutstep_def)
    finally show ?thesis by (simp add: suffix_def)
  qed
qed

lemma stutstep_empty_suc:
  assumes "stutstep s n"
  shows "emptyseq (s |\<^sub>s Suc n) = emptyseq (s |\<^sub>s n)"
using assms by (auto elim: stutstep_notempty_notempty suc_empty)

lemma nextnat_empty_neq: assumes H: "\<not> emptyseq s" shows "s (nextnat s) \<noteq> s 0"
proof -
  from H have a1: "nextnat s =  (LEAST i. s i \<noteq> s 0)" by (simp add: nextnat_def)
  from H obtain i where "s i \<noteq> s 0" by (auto simp: emptyseq_def)
  hence "s (LEAST i. s i \<noteq> s 0) \<noteq> s 0" by (rule LeastI)
  with a1 show ?thesis by auto
qed

lemma nextnat_empty_gzero: assumes H: "\<not> emptyseq s" shows "nextnat s > 0"
proof -
  from H have a1: "s (nextnat s) \<noteq> s 0" by (rule nextnat_empty_neq)
  have "nextnat s \<noteq> 0"
  proof
    assume "nextnat s = 0"
    with a1 show "False" by simp
  qed
  thus "nextnat s > 0" by simp
qed

subsubsection "Properties of @{term nextsuffix}"

lemma empty_nextsuffix:
  assumes H: "emptyseq s" shows "nextsuffix s = s"
  using H by (simp add: nextsuffix_def nextnat_def)

lemma empty_nextsuffix_id:
  assumes H: "emptyseq s" shows "nextsuffix s = id s"
  using H by (simp add: empty_nextsuffix)

lemma notstutstep_nextsuffix1:
  assumes H: "\<not> stutstep s n" shows "nextsuffix (s |\<^sub>s n) = s |\<^sub>s (Suc n)"
proof (unfold nextsuffix_def)
  show "(s |\<^sub>s n |\<^sub>s (nextnat (s |\<^sub>s n))) =  s |\<^sub>s (Suc n)"
  proof -
    from H have  "nextnat (s |\<^sub>s n) = 1" by (rule notstutstep_nexnat1)
    hence "(s |\<^sub>s n |\<^sub>s (nextnat (s |\<^sub>s n))) = s |\<^sub>s n |\<^sub>s 1" by auto
    thus ?thesis by (simp add: suffix_def)
  qed
qed

subsubsection "Properties of @{term next}"

lemma next_suc_suffix: "next (Suc n) s = nextsuffix (next n s)"
  by simp

lemma next_suffix_com: "nextsuffix (next n s) = (next n (nextsuffix s))"
  by (induct n, auto)

lemma next_plus: "next (m+n) s = next m (next n s)"
  by (induct m, auto)

lemma next_empty: assumes H: "emptyseq s" shows "next n s = s"
proof (induct n)
  from H show "next 0 s = s" by auto
next
  fix n
  assume a1: "next n s = s"
  have "next (Suc n) s = nextsuffix (next n s)" by auto
  with a1 have "next (Suc n) s = nextsuffix s" by simp
  with H show "next (Suc n) s = s"
    by (simp add: nextsuffix_def nextnat_def)
qed

lemma notempty_nextnotzero:
  assumes H: "\<not>emptyseq s" shows "(next (Suc 0) s) 0 \<noteq> s 0"
proof -
  from H have g1: "s (nextnat s) \<noteq> s 0" by (rule nextnat_empty_neq)
  have "next (Suc 0) s = nextsuffix s" by auto
  hence "(next (Suc 0) s) 0 =  s (nextnat s)" by (simp add: nextsuffix_def suffix_def)
  with g1 show ?thesis by simp
qed

lemma next_ex_id: "\<exists> i. s i = (next m s) 0"
proof -
  have "\<exists> i. (s |\<^sub>s i) = (next m s)"
  proof (induct m)
    have "s |\<^sub>s 0 = next 0 s" by simp
    thus "\<exists> i. (s |\<^sub>s i) = (next 0 s)" ..
  next
    fix m
    assume a1: "\<exists> i. (s |\<^sub>s i) = (next m s)"
    then obtain i where a1': "(s |\<^sub>s i) = (next m s)" ..
    have "next (Suc m) s = nextsuffix (next m s)" by auto
    hence "next (Suc m) s = (next m s) |\<^sub>s (nextnat (next m s))" by (simp add: nextsuffix_def)
    hence "\<exists> i. next (Suc m) s = (next m s) |\<^sub>s i" ..
    then obtain j where "next (Suc m) s = (next m s) |\<^sub>s j" ..
    with a1' have "next (Suc m) s = (s |\<^sub>s i) |\<^sub>s j" by simp
    hence "next (Suc m) s = (s |\<^sub>s (j+i))" by (simp add: suffix_plus)
    hence "(s |\<^sub>s (j+i)) = next (Suc m) s" by simp
    thus "\<exists> i. (s |\<^sub>s i) = (next (Suc m) s)" ..
  qed
  then obtain i where "(s |\<^sub>s i) = (next m s)" ..
  hence "(s |\<^sub>s i) 0 = (next m s) 0" by auto
  hence "s i = (next m s) 0" by (auto simp add: suffix_def)
  thus ?thesis ..
qed

subsubsection "Properties of @{term collapse}"

lemma emptyseq_collapse_eq: assumes A1: "emptyseq s" shows "\<natural> s = s"
proof (unfold collapse_def, rule ext)
  fix n
  from A1 have "next n s = s" by (rule next_empty)
  moreover
  from A1 have "s n = s 0" by (simp add: emptyseq_def)
  ultimately
  show "(next n s) 0 = s n" by simp
qed

lemma empty_collapse_empty:
  assumes H: "emptyseq s" shows "emptyseq (\<natural> s)"
  using H by (simp add: emptyseq_collapse_eq)

lemma collapse_empty_empty:
  assumes H: "emptyseq (\<natural> s)" shows "emptyseq s"
proof (rule ccontr)
  assume a1: "\<not>emptyseq s"
  from H have "\<forall> i. (next i s) 0 = s 0" by (simp add: collapse_def emptyseq_def)
  moreover
  from a1 have "(next (Suc 0) s) 0 \<noteq> s 0" by (rule notempty_nextnotzero)
  ultimately show "False" by blast
qed

lemma collapse_empty_iff_empty [simp]: "emptyseq (\<natural> s) = emptyseq s"
  by (auto elim: empty_collapse_empty collapse_empty_empty)

subsection "Similarity of Sequences"

text\<open>
  Since adding or removing stuttering steps does not change the validity
  of a stuttering-invarant formula, equality is often too strong,
  and the weaker equality \emph{up to stuttering} is sufficient.
  This is often called \emph{similarity} ($\approx$)
  of sequences in the literature, and is required to
  show that logical operators are stuttering invariant. This
  is mechanised as:
\<close>

definition seqsimilar :: "('a seq) \<Rightarrow> ('a seq) \<Rightarrow> bool" (infixl "\<approx>" 50)
where "\<sigma> \<approx> \<tau> \<equiv> (\<natural> \<sigma>) = (\<natural> \<tau>)"

subsubsection "Properties of @{term seqsimilar}"

lemma seqsim_refl [iff]: "s \<approx> s"
  by (simp add: seqsimilar_def)

lemma seqsim_sym: assumes H: "s \<approx> t" shows "t \<approx> s"
  using H by (simp add: seqsimilar_def)

lemma seqeq_imp_sim: assumes H: "s = t" shows "s \<approx> t"
  using H by simp

lemma seqsim_trans [trans]: assumes h1: "s \<approx> t" and h2: "t \<approx> z" shows "s \<approx> z"
  using assms by (simp add: seqsimilar_def)

theorem sim_first: assumes H: "s \<approx> t" shows "first s = first t"
proof -
  from H have "(\<natural> s) 0 = (\<natural> t) 0" by (simp add: seqsimilar_def)
  thus ?thesis by (simp add: collapse_def first_def)
qed

lemmas sim_first2 = sim_first[unfolded first_def]

lemma tail_sim_second: assumes H: "tail s \<approx> tail t" shows "second s = second t"
proof -
  from H have "first (tail s) = first (tail t)" by (simp add: sim_first)
  thus "second s = second t" by (simp add: first_tail_second)
qed

lemma seqsimilarI:
  assumes 1: "first s = first t" and 2: "nextsuffix s \<approx> nextsuffix t"
  shows "s \<approx> t"
  unfolding seqsimilar_def collapse_def
proof
  fix n
  show "next n s 0 = next n t 0"
  proof (cases n)
    assume "n = 0"
    with 1 show ?thesis by (simp add: first_def)
  next
    fix m
    assume m: "n = Suc m"
    from 2 have "next m (nextsuffix s) 0 =  next m (nextsuffix t) 0"
      unfolding seqsimilar_def collapse_def by (rule fun_cong)
    with m show ?thesis by (simp add: next_suffix_com)
  qed
qed

lemma seqsim_empty_empty:
  assumes H1: "s \<approx> t" and H2: "emptyseq s" shows "emptyseq t"
proof -
  from H2 have "emptyseq (\<natural> s)" by simp
  with H1 have "emptyseq (\<natural> t)" by (simp add: seqsimilar_def)
  thus ?thesis by simp
qed

lemma seqsim_empty_iff_empty:
  assumes H: "s \<approx> t" shows "emptyseq s = emptyseq t"
proof
  assume "emptyseq s" with H show "emptyseq t" by (rule seqsim_empty_empty)
next
  assume t: "emptyseq t"
  from H have "t \<approx> s" by (rule seqsim_sym)
  from this t show "emptyseq s" by (rule seqsim_empty_empty)
qed

lemma seq_empty_eq:
  assumes H1: "s 0 = t 0" and H2: "emptyseq s" and H3: "emptyseq t"
  shows "s = t"
proof (rule ext)
  fix n
  from assms have "t n = s n" by (auto simp: emptyseq_def)
  thus "s n = t n" by simp
qed

lemma seqsim_notstutstep:
  assumes H: "\<not> (stutstep s n)" shows "(s |\<^sub>s (Suc n)) \<approx> nextsuffix (s |\<^sub>s n)"
  using H by (simp add: notstutstep_nextsuffix1)

lemma stut_nextsuf_suc:
  assumes H: "stutstep s n" shows "nextsuffix (s |\<^sub>s n) = nextsuffix (s |\<^sub>s (Suc n))"
proof (cases "emptyseq (s |\<^sub>s n)")
  case True
  hence g1: "nextsuffix (s |\<^sub>s n) = (s |\<^sub>s n)" by (simp add: nextsuffix_def nextnat_def)
  from True have g2: "nextsuffix (s |\<^sub>s Suc n) = (s |\<^sub>s Suc n)"
    by (simp add: suc_empty nextsuffix_def nextnat_def)
  have "(s |\<^sub>s n) = (s |\<^sub>s Suc n)"
  proof
    fix x
    from True have "s (x + n) = s (0 + n)" "s (Suc x + n) = s (0 + n)"
      unfolding emptyseq_def suffix_def by (blast+)
    thus "(s |\<^sub>s n) x = (s |\<^sub>s Suc n) x" by (simp add: suffix_def)
  qed
  with g1 g2 show ?thesis by auto
next
  case False
  with H have "(nextnat (s |\<^sub>s n)) = Suc (nextnat (s |\<^sub>s Suc n))"
    by (simp add: stutstep_notempty_sucnextnat)
  thus ?thesis
    by (simp add: nextsuffix_def suffix_plus)
qed

lemma seqsim_stutstep:
  assumes H: "stutstep s n" shows "(s |\<^sub>s (Suc n)) \<approx> (s |\<^sub>s n)" (is "?sn \<approx> ?s")
  unfolding seqsimilar_def collapse_def
proof
  fix m
  show "next m (s |\<^sub>s Suc n) 0 = next m (s |\<^sub>s n) 0"
  proof (cases m)
    assume "m=0"
    with H show ?thesis by (simp add: suffix_def stutstep_def)
  next
    fix k
    assume m: "m = Suc k"
    with H  have "next m (s |\<^sub>s Suc n) = next k (nextsuffix  (s |\<^sub>s n))"
      by (simp add: stut_nextsuf_suc next_suffix_com)
    moreover from m have "next m (s |\<^sub>s n) = next k (nextsuffix  (s |\<^sub>s n))"
      by (simp add: next_suffix_com)
    ultimately show "next m (s |\<^sub>s Suc n) 0 = next m (s |\<^sub>s n) 0" by simp
  qed
qed

lemma addfeqstut: "stutstep ((first t) ## t) 0"
  by (simp add: first_def stutstep_def app_def suffix_def)

lemma addfeqsim: "((first t) ## t) \<approx> t"
proof -
  have "stutstep ((first t) ## t) 0" by (rule addfeqstut)
  hence "(((first t) ## t) |\<^sub>s (Suc 0)) \<approx> (((first t) ## t) |\<^sub>s 0)" by (rule seqsim_stutstep)
  hence "tail ((first t) ## t) \<approx> ((first t) ## t)" by (simp add: suffix_def tail_def)
  hence "t \<approx> ((first t) ## t)" by (simp add: tail_def app_def suffix_def)
  thus ?thesis by (rule seqsim_sym)
qed

lemma addfirststut:
  assumes H: "first s = second s" shows "s \<approx> tail s"
proof -
  have g1: "(first s) ## (tail s) = s" by (rule seq_app_first_tail)
  from H have "(first s) = first (tail s)"
    by (simp add: first_def second_def tail_def suffix_def)
  hence "(first s) ## (tail s) \<approx> (tail s)" by (simp add: addfeqsim)
  with g1 show ?thesis by simp
qed

lemma app_seqsimilar:
  assumes h1: "s \<approx> t" shows "(x ## s) \<approx> (x ## t)"
proof (cases "stutstep (x ## s) 0")
  case True
  from h1 have "first s = first t" by (rule sim_first)
  with True have a2: "stutstep (x ## t) 0"
    by (simp add: stutstep_def first_def app_def)
  from True have "((x ## s) |\<^sub>s (Suc 0)) \<approx> ((x ## s) |\<^sub>s 0)" by (rule seqsim_stutstep)
  hence "tail (x ## s) \<approx> (x ## s)" by (simp add: tail_def suffix_def)
  hence g1: "s \<approx> (x ## s)" by (simp add: app_def tail_def suffix_def)
  from a2 have "((x ## t) |\<^sub>s (Suc 0)) \<approx> ((x ## t) |\<^sub>s 0)" by (rule seqsim_stutstep)
  hence "tail (x ## t) \<approx> (x ## t)" by (simp add: tail_def suffix_def)
  hence g2: "t \<approx> (x ## t)" by (simp add: app_def tail_def suffix_def)
  from h1 g2 have "s \<approx> (x ## t)" by (rule seqsim_trans)
  from this[THEN seqsim_sym] g1 show "(x ## s) \<approx> (x ## t)"
    by (rule seqsim_sym[OF seqsim_trans])
next
  case False
  from h1 have "first s = first t" by (rule sim_first)
  with False have a2: "\<not> stutstep (x ## t) 0"
    by (simp add: stutstep_def first_def app_def)
  from False have "((x ## s) |\<^sub>s (Suc 0)) \<approx> nextsuffix ((x ## s) |\<^sub>s 0)"
    by (rule seqsim_notstutstep)
  hence "(tail (x ## s)) \<approx> nextsuffix (x ## s)"
    by (simp add: tail_def)
  hence g1: "s \<approx> nextsuffix (x ## s)" by (simp add: seq_app_tail)
  from a2 have "((x ## t) |\<^sub>s (Suc 0)) \<approx> nextsuffix ((x ## t) |\<^sub>s 0)"
    by (rule seqsim_notstutstep)
  hence "(tail (x ## t)) \<approx> nextsuffix (x ## t)" by (simp add: tail_def)
  hence g2: "t \<approx> nextsuffix (x ## t)" by (simp add: seq_app_tail)
  with h1 have "s \<approx> nextsuffix (x ## t)" by (rule seqsim_trans)
  from this[THEN seqsim_sym] g1 have g3: "nextsuffix (x ## s) \<approx> nextsuffix (x ## t)"
    by (rule seqsim_sym[OF seqsim_trans])
  have "first (x ## s) = first (x ## t)" by (simp add: first_def app_def)
  from this g3 show ?thesis by (rule seqsimilarI)
qed

text \<open>
  If two sequences are similar then for any suffix of one of them there
  exists a similar suffix of the other one. We will prove a stronger
  result below.
\<close>

lemma simstep_disj1: assumes H: "s \<approx> t" shows "\<exists> m. ((s |\<^sub>s n) \<approx> (t |\<^sub>s m))"
proof (induct n)
  from H have "((s |\<^sub>s 0) \<approx> (t |\<^sub>s 0))" by auto
  thus "\<exists> m. ((s |\<^sub>s 0) \<approx> (t |\<^sub>s m))" ..
next
  fix n
  assume "\<exists> m. ((s |\<^sub>s n) \<approx> (t |\<^sub>s m))"
  then obtain m where a1': "(s |\<^sub>s n) \<approx> (t |\<^sub>s m)" ..
  show "\<exists> m. ((s |\<^sub>s (Suc n)) \<approx> (t |\<^sub>s m))"
  proof (cases "stutstep s n")
    case True
    hence "(s |\<^sub>s (Suc n)) \<approx> (s |\<^sub>s n)" by (rule seqsim_stutstep)
    from this a1' have "((s |\<^sub>s (Suc n)) \<approx> (t |\<^sub>s m))" by (rule seqsim_trans)
    thus ?thesis ..
  next
    case False
    hence "(s |\<^sub>s (Suc n)) \<approx> nextsuffix (s |\<^sub>s n)" by (rule seqsim_notstutstep)
    moreover
    from a1' have "nextsuffix (s |\<^sub>s n) \<approx> nextsuffix (t |\<^sub>s m)"
      by (simp add: seqsim_suffix_seqsim)
    ultimately have "(s |\<^sub>s (Suc n)) \<approx> nextsuffix (t |\<^sub>s m)" by (rule seqsim_trans)
    hence "(s |\<^sub>s (Suc n)) \<approx> t |\<^sub>s (m + (nextnat (t |\<^sub>s m)))"
      by (simp add: nextsuffix_def suffix_plus_com)
    thus "\<exists> m. (s |\<^sub>s (Suc n)) \<approx> t |\<^sub>s m" ..
  qed
qed

lemma nextnat_le_seqsim:
  assumes n: "n < nextnat s" shows "s \<approx> (s |\<^sub>s n)"
proof (cases "emptyseq s")
  case True   \<comment> \<open>case impossible\<close>
  with n show ?thesis by (simp add: nextnat_def)
next
  case False
  from n show ?thesis
  proof (induct n)
    show "s \<approx> (s |\<^sub>s 0)" by simp
  next
    fix n
    assume a2: "n < nextnat s \<Longrightarrow> s \<approx> (s |\<^sub>s n)" and a3: "Suc n < nextnat s"
    from a3 have g1: "s (Suc n) = s 0" by (rule nextnat_le_unch)
    from a3 have a3': "n < nextnat s" by simp
    hence "s n = s 0" by (rule nextnat_le_unch)
    with g1 have "stutstep s n" by (simp add: stutstep_def)
    hence g2: "(s |\<^sub>s n) \<approx> (s |\<^sub>s (Suc n))" by (rule seqsim_stutstep[THEN seqsim_sym])
    with a3' a2 show "s \<approx> (s |\<^sub>s (Suc n))" by (auto elim: seqsim_trans)
  qed
qed

lemma seqsim_prev_nextnat: "s \<approx> s |\<^sub>s ((nextnat s) - 1)"
proof (cases "emptyseq s")
  case True
  hence "s |\<^sub>s ((nextnat s)-(1::nat)) = s |\<^sub>s 0" by (simp add: nextnat_def)
  thus ?thesis by simp
next
  case False
  hence "nextnat s > 0" by (rule nextnat_empty_gzero)
  thus ?thesis by (simp add: nextnat_le_seqsim)
qed

text \<open>
  Given a suffix \<open>s |\<^sub>s n\<close> of some sequence \<open>s\<close> that is
  similar to some suffix \<open>t |\<^sub>s m\<close> of sequence \<open>t\<close>, there
  exists some suffix \<open>t |\<^sub>s m'\<close> of \<open>t\<close> such that
  \<open>s |\<^sub>s n\<close> and \<open>t |\<^sub>s m'\<close> are similar and also
  \<open>s |\<^sub>s (n+1)\<close> is similar to either \<open>t |\<^sub>s m'\<close> or to
  \<open>t |\<^sub>s (m'+1)\<close>.
\<close>

lemma seqsim_suffix_suc:
  assumes H: "s |\<^sub>s n \<approx> t |\<^sub>s m"
  shows "\<exists>m'. s |\<^sub>s n \<approx> t |\<^sub>s m' \<and> ((s |\<^sub>s Suc n \<approx> t |\<^sub>s Suc m') \<or> (s |\<^sub>s Suc n \<approx> t |\<^sub>s m'))"
proof (cases "stutstep s n")
  case True
  hence "s |\<^sub>s Suc n \<approx> s |\<^sub>s n" by (rule seqsim_stutstep)
  from this H have "s |\<^sub>s Suc n \<approx> t |\<^sub>s m" by (rule seqsim_trans)
  with H show ?thesis by blast
next
  case False
  hence "\<not> emptyseq (s |\<^sub>s n)" by (rule stutnempty)
  with H have a2: "\<not> emptyseq (t |\<^sub>s m)" by (simp add: seqsim_empty_iff_empty)
  hence g4: "nextsuffix (t |\<^sub>s m) = (t |\<^sub>s m) |\<^sub>s Suc (nextnat (t |\<^sub>s m) - 1)"
    by (simp add: nextnat_empty_gzero nextsuffix_def)
  have g3: "(t |\<^sub>s m) \<approx> (t |\<^sub>s m) |\<^sub>s (nextnat (t |\<^sub>s m) - 1)"
    by (rule seqsim_prev_nextnat)
  with H have G1: "s |\<^sub>s n \<approx> (t |\<^sub>s m) |\<^sub>s (nextnat (t |\<^sub>s m) - 1)"
    by (rule seqsim_trans)
  from False have G1': "(s |\<^sub>s Suc n) = nextsuffix (s |\<^sub>s n)"
    by (rule notstutstep_nextsuffix1[THEN sym])
  from H have "nextsuffix (s |\<^sub>s n) \<approx> nextsuffix (t |\<^sub>s m)"
    by (rule seqsim_suffix_seqsim)
  with G1 G1' g4
  have "s |\<^sub>s n \<approx> t |\<^sub>s (m + (nextnat (t |\<^sub>s m) - 1))
      \<and> s |\<^sub>s (Suc n) \<approx> t |\<^sub>s Suc (m + (nextnat (t |\<^sub>s m) - 1))"
    by (simp add: suffix_plus_com)
  thus ?thesis by blast
qed

text \<open>
  The following main result about similar sequences shows that if
  \<open>s \<approx> t\<close> holds then for any suffix \<open>s |\<^sub>s n\<close> of \<open>s\<close>
  there exists a suffix \<open>t |\<^sub>s m\<close> such that
  \begin{itemize}
  \item \<open>s |\<^sub>s n\<close> and \<open>t |\<^sub>s m\<close> are similar, and
  \item \<open>s |\<^sub>s (n+1)\<close> is similar to either \<open>t |\<^sub>s (m+1)\<close>
    or \<open>t |\<^sub>s m\<close>.
  \end{itemize}
  The idea is to pick the largest \<open>m\<close> such that \<open>s |\<^sub>s n \<approx> t |\<^sub>s m\<close>
  (or some such \<open>m\<close> if \<open>s |\<^sub>s n\<close> is empty).
\<close>

theorem sim_step:
  assumes H: "s \<approx> t"
  shows "\<exists> m. s |\<^sub>s n \<approx> t |\<^sub>s m \<and>
              ((s |\<^sub>s Suc n \<approx> t |\<^sub>s Suc m) \<or> (s |\<^sub>s Suc n \<approx> t |\<^sub>s m))"
    (is "\<exists>m. ?Sim n m")
proof (induct n)
  from H have "s |\<^sub>s 0 \<approx> t |\<^sub>s 0" by simp
  thus "\<exists> m. ?Sim 0 m" by (rule seqsim_suffix_suc)
next
  fix n
  assume "\<exists> m. ?Sim n m"
  hence "\<exists>k. s |\<^sub>s Suc n \<approx> t |\<^sub>s k" by blast
  thus "\<exists> m. ?Sim (Suc n) m" by (blast dest: seqsim_suffix_suc)
qed

end


section \<open>Rely Quotient Operator \label{S:rely-quotient}\<close>

text \<open>
  The rely quotient operator is used to generalise a Jones-style rely condition
  to a process \cite{jon83a}.
  It is defined in terms of the parallel operator and a process $i$
  representing interference from the environment.
\<close>

theory Rely_Quotient
imports
  CRA
  Conjunctive_Iteration
begin

subsection \<open>Basic rely quotient\<close>

text \<open>
  The rely quotient of a process $c$ and an interference process $i$
  is the most general process $d$ such that $c$ is refined by $d \parallel i$.
  The following locale introduces the definition of the
  rely quotient $c \quotient i$ as a non-deterministic choice over
  all processes $d$ such that $c$ is refined by $d \parallel i$.
\<close>

locale rely_quotient = par_distrib + conjunction_parallel
begin

definition
  rely_quotient :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "'/'/" 85)
where
  "c // i \<equiv> \<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> i)}"

text \<open>
  Any process $c$ is implemented by itself if the interference is skip.
\<close>
lemma quotient_identity: "c // skip = c"
proof -
  have "c // skip = \<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> skip) }" by (metis rely_quotient_def)
  then have "c // skip = \<Sqinter>{ d. (c \<sqsubseteq> d)  }" by (metis (mono_tags, lifting) Collect_cong par_skip)
  thus ?thesis by (metis Inf_greatest Inf_lower2 dual_order.antisym dual_order.refl mem_Collect_eq)
qed

text \<open>
  Provided the interference process $i$ is non-aborting (i.e. it refines chaos),
  any process $c$ is refined by its rely quotient with $i$ in parallel with $i$.
  If interference $i$ was allowed to be aborting then,
  because $(c \quotient \bot) \parallel \bot$ equals $\bot$,
  it does not refine $c$ in general.
\<close>
theorem rely_quotient:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  shows "c \<sqsubseteq> (c // i) \<parallel> i"
proof -
  define D where "D = { d \<parallel> i | d. (c \<sqsubseteq> d \<parallel> i)}"
  define C where "C = {c}"
  have "(\<forall>d \<in> D. (\<exists> c \<in> C. c \<sqsubseteq> d))" using D_def C_def CollectD singletonI by auto
  then have "\<Sqinter> C \<sqsubseteq> (\<Sqinter> D)" by (simp add: Inf_mono)
  then have "c \<sqsubseteq> \<Sqinter>{ d \<parallel> i | d. (c \<sqsubseteq> d \<parallel> i)}" by (simp add: C_def D_def)
  also have "... = \<Sqinter>{ d \<parallel> i | d. d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}}" by simp
  also have "... = (\<Sqinter>d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}. d \<parallel> i)" by (simp add: INF_Inf)
  also have "... = \<Sqinter>{ d | d. (c \<sqsubseteq> d \<parallel> i)} \<parallel> i"
  proof (cases "{ d | d. (c \<sqsubseteq> d \<parallel> i)} = {}")
    assume "{ d | d. (c \<sqsubseteq> d \<parallel> i)} = {}"
    then show "(\<Sqinter>d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}. d \<parallel> i) = \<Sqinter>{ d | d. (c \<sqsubseteq> d \<parallel> i)} \<parallel> i"
      using nonabort_i Collect_empty_eq top_greatest
            nonabort_par_top par_commute by fastforce
  next
    assume a: "{ d | d. (c \<sqsubseteq> d \<parallel> i)} \<noteq> {}"
    have b: "{d. (c \<sqsubseteq> d \<parallel> i)}  \<noteq> {}" using a by blast
    then have "(\<Sqinter>d \<in> {d. (c \<sqsubseteq> d \<parallel> i)}. d \<parallel> i) = \<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> i)} \<parallel> i"
      using Inf_par_distrib by simp
    then show ?thesis by auto
  qed
  also have "... = (c // i) \<parallel> i" by (metis rely_quotient_def)
  finally show ?thesis .
qed

text \<open>
  The following theorem represents the Galois connection between
  the parallel operator (upper adjoint) and the rely quotient operator
  (lower adjoint). This basic relationship is used to prove the majority
  of the theorems about rely quotient.
\<close>

theorem rely_refinement:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  shows "c // i \<sqsubseteq> d \<longleftrightarrow> c \<sqsubseteq> d \<parallel> i"
proof
  assume a: "c // i \<sqsubseteq> d"
  have "c \<sqsubseteq> (c // i) \<parallel> i" using rely_quotient nonabort_i by simp
  thus "c \<sqsubseteq> d \<parallel> i" using par_mono a
    by (metis inf.absorb_iff2 inf_commute le_infI2 order_refl)
next
  assume b: "c \<sqsubseteq> d \<parallel> i"
  then have "\<Sqinter>{ d. (c \<sqsubseteq> d \<parallel> i)} \<sqsubseteq> d" by (simp add: Inf_lower)
  thus "c // i \<sqsubseteq> d" by (metis rely_quotient_def)
qed

text \<open>
  Refining the ``numerator'' in a quotient, refines the quotient.
\<close>

lemma rely_mono:
  assumes c_refsto_d: "c \<sqsubseteq> d"
  shows "(c // i) \<sqsubseteq> (d // i)"
proof -
  have "\<And> f. ((d \<sqsubseteq> f \<parallel> i) \<Longrightarrow> \<exists> e. (c \<sqsubseteq> e \<parallel> i) \<and> (e \<sqsubseteq> f))"
    using c_refsto_d order.trans by blast
  then have b: "\<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> i)} \<sqsubseteq>  \<Sqinter>{ f. (d \<sqsubseteq> f \<parallel> i)}"
    by (metis Inf_mono mem_Collect_eq)
  show ?thesis using rely_quotient_def b by simp
qed

text \<open>
  Refining the ``denominator'' in a quotient, gives a reverse refinement
  for the quotients. This corresponds to weaken rely condition law of
  Jones \cite{jon83a},
  i.e. assuming less about the environment.
\<close>

lemma weaken_rely:
  assumes i_refsto_j: "i \<sqsubseteq> j"
  shows "(c // j) \<sqsubseteq> (c // i)"
proof -
  have "\<And> f. ((c \<sqsubseteq> f \<parallel> i) \<Longrightarrow> \<exists> e. (c \<sqsubseteq> e \<parallel> j) \<and> (e \<sqsubseteq> f))"
    using i_refsto_j order.trans
    by (metis inf.absorb_iff2 inf_le1 inf_par_distrib inf_sup_ord(2) par_commute)
  then have b: "\<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<sqsubseteq>  \<Sqinter>{ f. (c \<sqsubseteq> f \<parallel> i)}"
    by (metis Inf_mono mem_Collect_eq)
  show ?thesis using rely_quotient_def b by simp
qed

lemma par_nonabort:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes nonabort_j: "chaos \<sqsubseteq> j"
  shows "chaos \<sqsubseteq> i \<parallel> j"
  by (meson chaos_par_chaos nonabort_i nonabort_j order_trans par_mono)

text \<open>
  Nesting rely quotients of $j$ and $i$ means the same as a single quotient
  which is the parallel composition of $i$ and $j$.
\<close>

lemma nested_rely:
  assumes j_nonabort: "chaos \<sqsubseteq> j"
  shows "((c // j) // i) = c // (i \<parallel> j)"
proof (rule antisym)
  show "((c // j) // i) \<sqsubseteq> c // (i \<parallel> j)"
  proof -
    have "\<And> f. ((c \<sqsubseteq> f \<parallel> i \<parallel> j) \<Longrightarrow> \<exists> e. (c \<sqsubseteq> e \<parallel> j) \<and> (e \<sqsubseteq> f \<parallel> i))" by blast
    then have "\<Sqinter>{ d. (\<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<sqsubseteq> d \<parallel> i)} \<sqsubseteq>  \<Sqinter>{ f. (c \<sqsubseteq> f \<parallel> i \<parallel> j)}"
      by (simp add: Collect_mono Inf_lower Inf_superset_mono)
    thus ?thesis using local.rely_quotient_def par_assoc by auto
  qed
next
  show "c // (i \<parallel> j) \<sqsubseteq> ((c // j) // i) "
  proof -
    have "c \<sqsubseteq> \<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<parallel> j"
      using j_nonabort local.rely_quotient_def rely_quotient by auto
    then have "\<And> d. \<Sqinter>{ e. (c \<sqsubseteq> e \<parallel> j)} \<sqsubseteq> d \<parallel> i  \<Longrightarrow> (c \<sqsubseteq> d \<parallel> i \<parallel> j)"
      by (meson j_nonabort order_trans rely_refinement)
    thus ?thesis
      by (simp add: Collect_mono Inf_superset_mono local.rely_quotient_def par_assoc)
  qed
qed

end

subsection \<open>Distributed rely quotient\<close>

locale rely_distrib = rely_quotient + conjunction_sequential
begin

text \<open>
  The following is a fundamental law for introducing a parallel composition
  of process to refine a conjunction of specifications.
  It represents an abstract view of the parallel introduction law of Jones \cite{jon83a}.
\<close>

lemma introduce_parallel:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  assumes nonabort_j: "chaos \<sqsubseteq>  j"
  shows "c \<iinter> d \<sqsubseteq>  (j \<iinter> (c // i)) \<parallel> (i \<iinter> (d // j))"
proof -
  have a: "c \<sqsubseteq> (c // i) \<parallel> i" using nonabort_i nonabort_j rely_quotient by auto
  have b: "d \<sqsubseteq> j \<parallel> (d // j)" using rely_quotient par_commute
    by (simp add: nonabort_j)
  have "c \<iinter> d \<sqsubseteq>  ((c // i) \<parallel> i) \<iinter> ( j \<parallel> (d // j))" using a b by (metis conj_mono)
  also have interchange: "c \<iinter> d \<sqsubseteq>  ((c // i) \<iinter> j) \<parallel> ( i \<iinter> (d // j))"
   using parallel_interchange refine_trans calculation by blast
  show ?thesis using interchange by (simp add: local.conj_commute)
qed

text \<open>
  Rely quotients satisfy a range of distribution properties with respect
  to the other operators.
\<close>

lemma distribute_rely_conjunction:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  shows "(c \<iinter> d) // i  \<sqsubseteq>  (c // i) \<iinter> (d // i)"
proof -
  have "c \<iinter> d \<sqsubseteq> ((c // i) \<parallel> i) \<iinter> ((d // i) \<parallel> i)" using conj_mono rely_quotient
    by (simp add: nonabort_i)
  then have "c \<iinter> d \<sqsubseteq> ((c // i) \<iinter> (d // i)) \<parallel> (i \<iinter> i)"
    by (metis parallel_interchange refine_trans)
  then have "c \<iinter> d \<sqsubseteq> ((c // i) \<iinter> (d // i)) \<parallel> i" by (metis conj_idem)
  thus ?thesis using rely_refinement by (simp add: nonabort_i)
qed

lemma distribute_rely_choice:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  shows "(c \<sqinter> d) // i  \<sqsubseteq>  (c // i) \<sqinter> (d // i)"
proof -
  have "c \<sqinter> d \<sqsubseteq> ((c // i) \<parallel> i) \<sqinter> ((d // i) \<parallel> i)"
    by (metis nonabort_i inf_mono rely_quotient)
  then have "c \<sqinter> d \<sqsubseteq> ((c // i) \<sqinter> (d // i)) \<parallel> i" by (metis inf_par_distrib)
  thus ?thesis by (metis nonabort_i rely_refinement)
qed

lemma distribute_rely_parallel1:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  assumes nonabort_j: "chaos \<sqsubseteq>  j"
  shows "(c \<parallel> d) // (i \<parallel> j)  \<sqsubseteq>  (c // i) \<parallel> (d // j)"
proof -
  have "(c \<parallel> d) \<sqsubseteq> ((c // i) \<parallel> i) \<parallel> ((d // j) \<parallel> j)"
    using par_mono rely_quotient nonabort_i nonabort_j by simp
  then have "(c \<parallel> d) \<sqsubseteq> (c // i) \<parallel> (d // j) \<parallel> j \<parallel> i" by (metis par_assoc par_commute)
  thus ?thesis using par_assoc par_commute rely_refinement
    by (metis nonabort_i nonabort_j par_nonabort)
qed

lemma distribute_rely_parallel2:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes i_par_i: "i \<parallel> i \<sqsubseteq> i"
  shows "(c \<parallel> d) // i  \<sqsubseteq>  (c // i) \<parallel> (d // i)"
proof -
  have "(c \<parallel> d) // i \<sqsubseteq> ((c \<parallel> d) // (i \<parallel> i))" using assms(1) using weaken_rely
    by (simp add: i_par_i par_nonabort)
  thus ?thesis by (metis distribute_rely_parallel1 refine_trans nonabort_i)
qed

lemma distribute_rely_sequential:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes "(\<forall> c. (\<forall> d. ((c \<parallel> i);(d \<parallel> i) \<sqsubseteq> (c;d) \<parallel> i)))"
  shows "(c;d) // i \<sqsubseteq> (c // i);(d // i)"
proof -
  have "c;d \<sqsubseteq> ((c // i) \<parallel> i);((d // i) \<parallel> i)"
    by (metis rely_quotient nonabort_i seq_mono)
  then have "c;d \<sqsubseteq> (c // i) ; (d // i) \<parallel> i" using assms(2) by (metis refine_trans)
  thus ?thesis by (metis rely_refinement nonabort_i)
qed

lemma distribute_rely_sequential_event:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes nonabort_j: "chaos \<sqsubseteq> j"
  assumes nonabort_e: "chaos \<sqsubseteq> e"
  assumes "(\<forall> c. (\<forall> d. ((c \<parallel> i);e;(d \<parallel> j) \<sqsubseteq> (c;e;d) \<parallel> (i;e;j))))"
  shows "(c;e;d) // (i;e;j) \<sqsubseteq> (c // i);e;(d // j)"
proof -
  have "c;e;d \<sqsubseteq> ((c // i) \<parallel> i);e;((d // j) \<parallel> j)"
    by (metis order.refl rely_quotient nonabort_i nonabort_j seq_mono)
  then have "c;e;d \<sqsubseteq> ((c // i);e;(d // j)) \<parallel> (i;e;j)" using assms
    by (metis refine_trans)
  thus ?thesis using rely_refinement nonabort_i nonabort_j nonabort_e
    by (simp add: Inf_lower local.rely_quotient_def)
qed

lemma introduce_parallel_with_rely:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes nonabort_j0: "chaos \<sqsubseteq>  j\<^sub>0"
  assumes nonabort_j1: "chaos \<sqsubseteq>  j\<^sub>1"
  shows "(c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i)))"
proof -
  have "(c \<iinter> d) // i \<sqsubseteq> (c // i) \<iinter> (d // i)"
    by (metis distribute_rely_conjunction nonabort_i)
  then have "(c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<iinter> ((c // i) // j\<^sub>0)) \<parallel> (j\<^sub>0 \<iinter> ((d // i) // j\<^sub>1))"
    by (metis introduce_parallel nonabort_j0 nonabort_j1 inf_assoc inf.absorb_iff1)
  thus ?thesis by (simp add: nested_rely nonabort_i)
qed

lemma introduce_parallel_with_rely_guarantee:
  assumes nonabort_i: "chaos \<sqsubseteq>  i"
  assumes nonabort_j0: "chaos \<sqsubseteq>  j\<^sub>0"
  assumes nonabort_j1: "chaos \<sqsubseteq>  j\<^sub>1"
  shows "(j\<^sub>1 \<parallel> j\<^sub>0) \<iinter> (c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i)))"
proof -
  have "(j\<^sub>1 \<parallel> j\<^sub>0) \<iinter> (c \<iinter> d) // i \<sqsubseteq> (j\<^sub>1 \<parallel> j\<^sub>0) \<iinter> ((j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i))))"
    by (metis introduce_parallel_with_rely nonabort_i nonabort_j0 nonabort_j1
        conj_mono order.refl)
  also have "... \<sqsubseteq> (j\<^sub>1 \<iinter> j\<^sub>1 \<iinter> (c // (j\<^sub>0 \<parallel> i))) \<parallel> (j\<^sub>0 \<iinter> j\<^sub>0 \<iinter> (d // (j\<^sub>1 \<parallel> i)))"
    by (metis conj_assoc parallel_interchange)
  finally show ?thesis by (metis conj_idem)
qed

lemma wrap_rely_guar:
  assumes nonabort_rg: "chaos \<sqsubseteq> rg"
  and skippable: "rg \<sqsubseteq> skip"
  shows "c \<sqsubseteq> rg \<iinter> c // rg"
proof -
  have "c = c // skip" by (simp add: quotient_identity)
  also have "... \<sqsubseteq> c // rg" by (simp add: skippable weaken_rely nonabort_rg)
  also have "... \<sqsubseteq> rg \<iinter> c // rg" using conjoin_non_aborting conj_commute nonabort_rg
    by auto
  finally show "c \<sqsubseteq> rg \<iinter> c // rg" .
qed

end

locale rely_distrib_iteration = rely_distrib + iteration_finite_conjunctive

begin

lemma distribute_rely_iteration:
  assumes nonabort_i: "chaos \<sqsubseteq> i"
  assumes "(\<forall> c. (\<forall> d. ((c \<parallel> i);(d \<parallel> i) \<sqsubseteq> (c;d) \<parallel> i)))"
  shows "(c\<^sup>\<omega>;d) // i \<sqsubseteq> (c // i)\<^sup>\<omega>;(d // i)"
proof -
  have "d \<sqinter> c ; ((c // i)\<^sup>\<omega>;(d // i) \<parallel> i) \<sqsubseteq> ((d // i) \<parallel> i) \<sqinter> ((c // i) \<parallel> i);((c // i)\<^sup>\<omega>;(d // i) \<parallel> i)"
    by (metis inf_mono order.refl rely_quotient nonabort_i seq_mono)
  also have "... \<sqsubseteq> ((d // i) \<parallel> i) \<sqinter> ((c // i);(c // i)\<^sup>\<omega>;(d // i) \<parallel> i )"
    using assms inf_mono_right seq_assoc by fastforce
  also have "... \<sqsubseteq> ((d // i) \<sqinter> (c // i);(c // i)\<^sup>\<omega>;(d // i)) \<parallel> i"
    by (simp add: inf_par_distrib)
  also have "... = ((c // i)\<^sup>\<omega>;(d // i)) \<parallel> i"
    by (metis iter_unfold inf_seq_distrib seq_nil_left)
  finally show ?thesis by (metis rely_refinement nonabort_i iter_induct)
qed

end

end