(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics for Isabelle/Isar.

    Copyright (C) 2005, 2006  Slawomir Kolodynski

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Ordered rings\<close>

theory OrderedRing_ZF imports Ring_ZF OrderedGroup_ZF_1

begin

text\<open>In this theory file we consider ordered rings.\<close>

subsection\<open>Definition and notation\<close>

text\<open>This section defines ordered rings and sets up appriopriate notation.\<close>

text\<open>We define ordered ring as a commutative ring with linear order
  that is preserved by
  translations and such that the set of nonnegative elements is closed
  under multiplication. Note that this definition does not guarantee
  that there are no zero divisors in the ring.\<close>

definition
  "IsAnOrdRing(R,A,M,r) \<equiv>
  ( IsAring(R,A,M) \<and> (M {is commutative on} R) \<and>
  r\<subseteq>R\<times>R \<and> IsLinOrder(R,r) \<and>
  (\<forall>a b. \<forall> c\<in>R. \<langle> a,b\<rangle> \<in> r \<longrightarrow> \<langle>A`\<langle> a,c\<rangle>,A`\<langle> b,c\<rangle>\<rangle> \<in> r) \<and>
  (Nonnegative(R,A,r) {is closed under} M))"

text\<open>The next context (locale) defines notation used for ordered rings.
  We do that by extending the notation defined in the
  \<open>ring0\<close> locale and adding some assumptions to make sure we are
  talking about ordered rings in this context.\<close>

locale ring1 = ring0 +

  assumes mult_commut: "M {is commutative on} R"

  fixes r

  assumes ordincl: "r \<subseteq> R\<times>R"

  assumes linord: "IsLinOrder(R,r)"

  fixes lesseq (infix "\<lsq>" 68)
  defines lesseq_def [simp]: "a \<lsq> b \<equiv> \<langle> a,b\<rangle> \<in> r"

  fixes sless (infix "\<ls>" 68)
  defines sless_def [simp]: "a \<ls> b \<equiv> a\<lsq>b \<and> a\<noteq>b"

  assumes ordgroup: "\<forall>a b. \<forall> c\<in>R. a\<lsq>b \<longrightarrow> a\<ra>c \<lsq> b\<ra>c"

  assumes pos_mult_closed: "Nonnegative(R,A,r) {is closed under} M"

  fixes abs ("| _ |")
  defines abs_def [simp]: "|a| \<equiv> AbsoluteValue(R,A,r)`(a)"

  fixes positiveset ("R\<^sub>+")
  defines positiveset_def [simp]: "R\<^sub>+ \<equiv> PositiveSet(R,A,r)"

text\<open>The next lemma assures us that we are talking about ordered rings
  in the \<open>ring1\<close> context.\<close>

lemma (in ring1) OrdRing_ZF_1_L1: shows "IsAnOrdRing(R,A,M,r)"
  using ring0_def ringAssum mult_commut ordincl linord ordgroup
    pos_mult_closed IsAnOrdRing_def by simp

text\<open>We can use theorems proven in the \<open>ring1\<close> context whenever we
  talk about an ordered ring.\<close>

lemma OrdRing_ZF_1_L2: assumes "IsAnOrdRing(R,A,M,r)"
  shows "ring1(R,A,M,r)"
  using assms IsAnOrdRing_def ring1_axioms.intro ring0_def ring1_def
  by simp

text\<open>In the \<open>ring1\<close> context $a\leq b$ implies that $a,b$ are
  elements of the ring.\<close>

lemma (in  ring1) OrdRing_ZF_1_L3: assumes "a\<lsq>b"
  shows "a\<in>R"  "b\<in>R"
  using assms ordincl by auto

text\<open>Ordered ring is an ordered group, hence we can use theorems
  proven in the \<open>group3\<close> context.\<close>

lemma (in  ring1) OrdRing_ZF_1_L4: shows
  "IsAnOrdGroup(R,A,r)"
  "r {is total on} R"
  "A {is commutative on} R"
  "group3(R,A,r)"
proof -
  { fix a b g assume A1: "g\<in>R" and A2: "a\<lsq>b"
    with ordgroup have "a\<ra>g \<lsq> b\<ra>g"
      by simp
    moreover from ringAssum A1 A2 have
      "a\<ra>g = g\<ra>a"  "b\<ra>g = g\<ra>b"
      using OrdRing_ZF_1_L3 IsAring_def IsCommutative_def by auto
    ultimately have
      "a\<ra>g \<lsq> b\<ra>g"  "g\<ra>a \<lsq> g\<ra>b"
      by auto
  } hence
    "\<forall>g\<in>R. \<forall>a b. a\<lsq>b \<longrightarrow> a\<ra>g \<lsq> b\<ra>g \<and> g\<ra>a \<lsq> g\<ra>b"
    by simp
  with ringAssum ordincl linord show
    "IsAnOrdGroup(R,A,r)"
    "group3(R,A,r)"
    "r {is total on} R"
    "A {is commutative on} R"
    using IsAring_def Order_ZF_1_L2 IsAnOrdGroup_def group3_def IsLinOrder_def
    by auto
qed

text\<open>The order relation in rings is transitive.\<close>

lemma (in ring1) ring_ord_transitive: assumes A1: "a\<lsq>b"  "b\<lsq>c"
  shows "a\<lsq>c"
proof -
  from A1 have
    "group3(R,A,r)"  "\<langle>a,b\<rangle> \<in> r"   "\<langle>b,c\<rangle> \<in> r"
    using OrdRing_ZF_1_L4 by auto
  then have "\<langle>a,c\<rangle> \<in> r" by (rule group3.Group_order_transitive)
  then show  "a\<lsq>c" by simp
qed

text\<open>Transitivity for the strict order: if $a<b$ and $b\leq c$, then $a<c$.
  Property of ordered groups.\<close>

lemma (in ring1) ring_strict_ord_trans:
  assumes A1: "a\<ls>b" and A2: "b\<lsq>c"
  shows "a\<ls>c"
proof -
  from A1 A2 have
    "group3(R,A,r)"
    "\<langle>a,b\<rangle> \<in> r \<and> a\<noteq>b"  "\<langle>b,c\<rangle> \<in> r"
    using OrdRing_ZF_1_L4 by auto
    then have "\<langle>a,c\<rangle> \<in> r \<and> a\<noteq>c" by (rule group3.OrderedGroup_ZF_1_L4A)
    then show "a\<ls>c" by simp
qed

text\<open>Another version of transitivity for the strict order:
  if $a\leq b$ and $b<c$, then $a<c$. Property of ordered groups.\<close>

lemma (in ring1) ring_strict_ord_transit:
  assumes A1: "a\<lsq>b" and A2: "b\<ls>c"
  shows "a\<ls>c"
proof -
  from A1 A2 have
    "group3(R,A,r)"
    "\<langle>a,b\<rangle> \<in> r"  "\<langle>b,c\<rangle> \<in> r \<and> b\<noteq>c"
    using OrdRing_ZF_1_L4 by auto
  then have "\<langle>a,c\<rangle> \<in> r \<and> a\<noteq>c" by (rule group3.group_strict_ord_transit)
  then show "a\<ls>c" by simp
qed

text\<open>The next lemma shows what happens when one element of an ordered
  ring is not greater or equal than another.\<close>

lemma (in ring1) OrdRing_ZF_1_L4A: assumes A1: "a\<in>R"  "b\<in>R"
  and A2: "\<not>(a\<lsq>b)"
  shows "b \<lsq> a"  "(\<rm>a) \<lsq> (\<rm>b)"  "a\<noteq>b"
proof -
  from A1 A2 have I:
    "group3(R,A,r)"
    "r {is total on} R"
    "a \<in> R"  "b \<in> R"  "\<langle>a, b\<rangle> \<notin> r"
    using OrdRing_ZF_1_L4 by auto
  then have "\<langle>b,a\<rangle> \<in> r" by (rule group3.OrderedGroup_ZF_1_L8)
  then show "b \<lsq> a" by simp
  from I have "\<langle>GroupInv(R,A)`(a),GroupInv(R,A)`(b)\<rangle> \<in> r"
    by (rule group3.OrderedGroup_ZF_1_L8)
  then show  "(\<rm>a) \<lsq> (\<rm>b)" by simp
  from I show "a\<noteq>b" by (rule group3.OrderedGroup_ZF_1_L8)
qed

text\<open>A special case of \<open>OrdRing_ZF_1_L4A\<close> when one of the
  constants is $0$. This is useful for many proofs by cases.\<close>

corollary (in ring1) ord_ring_split2: assumes A1: "a\<in>R"
  shows "a\<lsq>\<zero> \<or> (\<zero>\<lsq>a \<and> a\<noteq>\<zero>)"
proof -
  { from A1 have  I: "a\<in>R"  "\<zero>\<in>R"
      using Ring_ZF_1_L2 by auto
    moreover assume A2: "\<not>(a\<lsq>\<zero>)"
    ultimately have "\<zero>\<lsq>a" by (rule OrdRing_ZF_1_L4A)
    moreover from I A2 have "a\<noteq>\<zero>" by (rule OrdRing_ZF_1_L4A)
    ultimately have "\<zero>\<lsq>a \<and> a\<noteq>\<zero>" by simp}
  then show ?thesis by auto
qed

text\<open>Taking minus on both sides reverses an inequality.\<close>

lemma (in ring1) OrdRing_ZF_1_L4B: assumes "a\<lsq>b"
  shows "(\<rm>b) \<lsq> (\<rm>a)"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L5
  by simp

text\<open>The next lemma just expands the condition that requires the set
  of nonnegative elements to be closed with respect to multiplication.
  These are properties of totally ordered groups.\<close>

lemma (in  ring1) OrdRing_ZF_1_L5:
  assumes "\<zero>\<lsq>a"  "\<zero>\<lsq>b"
  shows "\<zero> \<lsq> a\<cdot>b"
  using pos_mult_closed assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L2
  IsOpClosed_def by simp

text\<open>Double nonnegative is nonnegative.\<close>

lemma (in  ring1) OrdRing_ZF_1_L5A: assumes A1: "\<zero>\<lsq>a"
  shows "\<zero>\<lsq>\<two>\<cdot>a"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L5G
  OrdRing_ZF_1_L3 Ring_ZF_1_L3 by simp

text\<open>A sufficient (somewhat redundant) condition for a structure to be an
  ordered ring. It says that a commutative ring that is a totally ordered
  group with respect to the additive operation such that set of nonnegative
  elements is closed under multiplication, is an ordered ring.\<close>

lemma OrdRing_ZF_1_L6:
  assumes
  "IsAring(R,A,M)"
  "M {is commutative on} R"
  "Nonnegative(R,A,r) {is closed under} M"
  "IsAnOrdGroup(R,A,r)"
  "r {is total on} R"
  shows "IsAnOrdRing(R,A,M,r)"
  using assms IsAnOrdGroup_def Order_ZF_1_L3 IsAnOrdRing_def
  by simp

text\<open> $a\leq b$ iff $a-b\leq 0$. This is a fact from
  \<open>OrderedGroup.thy\<close>, where it is stated in multiplicative notation.\<close>

lemma (in ring1) OrdRing_ZF_1_L7:
  assumes "a\<in>R"  "b\<in>R"
  shows "a\<lsq>b \<longleftrightarrow> a\<rs>b \<lsq> \<zero>"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L9
  by simp

text\<open>Negative times positive is negative.\<close>

lemma (in ring1) OrdRing_ZF_1_L8:
  assumes A1: "a\<lsq>\<zero>"  and A2: "\<zero>\<lsq>b"
  shows "a\<cdot>b \<lsq> \<zero>"
proof -
  from A1 A2 have T1: "a\<in>R"  "b\<in>R"  "a\<cdot>b \<in> R"
    using OrdRing_ZF_1_L3 Ring_ZF_1_L4 by auto
  from A1 A2 have "\<zero>\<lsq>(\<rm>a)\<cdot>b"
    using OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L5A OrdRing_ZF_1_L5
    by simp
  with T1 show "a\<cdot>b \<lsq> \<zero>"
    using Ring_ZF_1_L7 OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L5AA
    by simp
qed

text\<open>We can multiply both sides of an inequality by a nonnegative ring
  element. This property is sometimes (not here) used to define
  ordered rings.\<close>

lemma (in ring1) OrdRing_ZF_1_L9:
  assumes A1: "a\<lsq>b" and A2: "\<zero>\<lsq>c"
  shows
  "a\<cdot>c \<lsq> b\<cdot>c"
  "c\<cdot>a \<lsq> c\<cdot>b"
proof -
  from A1 A2 have T1:
    "a\<in>R"  "b\<in>R"  "c\<in>R"  "a\<cdot>c \<in> R"  "b\<cdot>c \<in> R"
    using OrdRing_ZF_1_L3 Ring_ZF_1_L4 by auto
  with A1 A2 have "(a\<rs>b)\<cdot>c \<lsq> \<zero>"
    using OrdRing_ZF_1_L7 OrdRing_ZF_1_L8 by simp
  with T1 show "a\<cdot>c \<lsq> b\<cdot>c"
    using Ring_ZF_1_L8 OrdRing_ZF_1_L7 by simp
  with mult_commut T1 show "c\<cdot>a \<lsq> c\<cdot>b"
    using IsCommutative_def by simp
qed

text\<open>A special case of \<open>OrdRing_ZF_1_L9\<close>: we can multiply
  an inequality by a positive ring element.\<close>

lemma (in ring1) OrdRing_ZF_1_L9A:
  assumes A1: "a\<lsq>b" and A2: "c\<in>R\<^sub>+"
  shows
  "a\<cdot>c \<lsq> b\<cdot>c"
  "c\<cdot>a \<lsq> c\<cdot>b"
proof -
  from A2 have "\<zero> \<lsq> c" using PositiveSet_def
    by simp
  with A1 show "a\<cdot>c \<lsq> b\<cdot>c"  "c\<cdot>a \<lsq> c\<cdot>b"
    using OrdRing_ZF_1_L9 by auto
qed

text\<open>A square is nonnegative.\<close>

lemma (in ring1) OrdRing_ZF_1_L10:
  assumes A1: "a\<in>R" shows "\<zero>\<lsq>(a\<^sup>2)"
proof -
  { assume "\<zero>\<lsq>a"
    then have "\<zero>\<lsq>(a\<^sup>2)" using OrdRing_ZF_1_L5 by simp}
  moreover
  { assume "\<not>(\<zero>\<lsq>a)"
    with A1 have "\<zero>\<lsq>((\<rm>a)\<^sup>2)"
      using OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L8A
	OrdRing_ZF_1_L5 by simp
    with A1 have "\<zero>\<lsq>(a\<^sup>2)" using Ring_ZF_1_L14 by simp }
  ultimately show ?thesis by blast
qed

text\<open>$1$ is nonnegative.\<close>

corollary (in ring1) ordring_one_is_nonneg: shows "\<zero> \<lsq> \<one>"
proof -
  have "\<zero> \<lsq> (\<one>\<^sup>2)" using Ring_ZF_1_L2 OrdRing_ZF_1_L10
    by simp
  then show "\<zero> \<lsq> \<one>" using Ring_ZF_1_L2 Ring_ZF_1_L3
    by simp
qed

text\<open>In nontrivial rings one is positive.\<close>

lemma (in ring1) ordring_one_is_pos: assumes "\<zero>\<noteq>\<one>"
  shows "\<one> \<in> R\<^sub>+"
  using assms Ring_ZF_1_L2 ordring_one_is_nonneg PositiveSet_def
  by auto

text\<open>Nonnegative is not negative. Property of ordered groups.\<close>

lemma (in ring1) OrdRing_ZF_1_L11: assumes "\<zero>\<lsq>a"
  shows "\<not>(a\<lsq>\<zero> \<and> a\<noteq>\<zero>)"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L5AB
  by simp

text\<open>A negative element cannot be a square.\<close>

lemma (in ring1) OrdRing_ZF_1_L12:
  assumes A1: "a\<lsq>\<zero>"  "a\<noteq>\<zero>"
  shows "\<not>(\<exists>b\<in>R. a = (b\<^sup>2))"
proof -
  { assume "\<exists>b\<in>R. a = (b\<^sup>2)"
    with A1 have False using OrdRing_ZF_1_L10 OrdRing_ZF_1_L11
      by auto
  } then show ?thesis by auto
qed

text\<open>If $a\leq b$, then $0\leq b-a$.\<close>

lemma (in ring1) OrdRing_ZF_1_L13: assumes "a\<lsq>b"
  shows "\<zero> \<lsq> b\<rs>a"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L9D
  by simp

text\<open>If $a<b$, then $0 < b-a$.\<close>

lemma (in ring1) OrdRing_ZF_1_L14: assumes "a\<lsq>b"  "a\<noteq>b"
  shows
  "\<zero> \<lsq> b\<rs>a"  "\<zero> \<noteq> b\<rs>a"
  "b\<rs>a \<in> R\<^sub>+"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L9E
  by auto

text\<open>If the difference is nonnegative, then $a\leq b$.\<close>

lemma (in ring1) OrdRing_ZF_1_L15:
  assumes "a\<in>R" "b\<in>R" and "\<zero> \<lsq> b\<rs>a"
  shows "a\<lsq>b"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L9F
  by simp

text\<open>A nonnegative number is does not decrease when multiplied by
  a number greater or equal $1$.\<close>

lemma (in ring1) OrdRing_ZF_1_L16:
  assumes A1: "\<zero>\<lsq>a" and A2: "\<one>\<lsq>b"
  shows "a\<lsq>a\<cdot>b"
proof -
  from A1 A2 have T: "a\<in>R"  "b\<in>R"  "a\<cdot>b \<in> R"
    using OrdRing_ZF_1_L3 Ring_ZF_1_L4 by auto
  from A1 A2 have "\<zero> \<lsq> a\<cdot>(b\<rs>\<one>)"
    using OrdRing_ZF_1_L13 OrdRing_ZF_1_L5 by simp
  with T show "a\<lsq>a\<cdot>b"
    using Ring_ZF_1_L8 Ring_ZF_1_L2 Ring_ZF_1_L3 OrdRing_ZF_1_L15
    by simp
qed

text\<open>We can multiply the right hand side of an inequality between
  nonnegative ring elements by an element greater or equal $1$.\<close>

lemma (in ring1) OrdRing_ZF_1_L17:
  assumes A1: "\<zero>\<lsq>a" and A2: "a\<lsq>b" and A3: "\<one>\<lsq>c"
  shows "a\<lsq>b\<cdot>c"
proof -
  from A1 A2 have "\<zero>\<lsq>b" by (rule ring_ord_transitive)
  with A3 have "b\<lsq>b\<cdot>c" using OrdRing_ZF_1_L16
    by simp
  with A2 show "a\<lsq>b\<cdot>c" by (rule ring_ord_transitive)
qed

text\<open>Strict order is preserved by translations.\<close>

lemma (in ring1) ring_strict_ord_trans_inv:
  assumes "a\<ls>b" and "c\<in>R"
  shows
  "a\<ra>c \<ls> b\<ra>c"
  "c\<ra>a \<ls> c\<ra>b"
  using assms OrdRing_ZF_1_L4 group3.group_strict_ord_transl_inv
  by auto

text\<open>We can put an element on the other side of a strict inequality,
  changing its sign.\<close>

lemma (in ring1) OrdRing_ZF_1_L18:
  assumes "a\<in>R"  "b\<in>R" and  "a\<rs>b \<ls> c"
  shows "a \<ls> c\<ra>b"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L12B
  by simp

text\<open>We can add the sides of two inequalities,
  the first of them strict, and we get a strict inequality.
  Property of ordered groups.\<close>

lemma (in ring1) OrdRing_ZF_1_L19:
  assumes "a\<ls>b" and "c\<lsq>d"
  shows "a\<ra>c \<ls> b\<ra>d"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L12C
  by simp

text\<open>We can add the sides of two inequalities,
  the second of them strict and we get a strict inequality.
  Property of ordered groups.\<close>

lemma (in ring1) OrdRing_ZF_1_L20:
  assumes "a\<lsq>b" and "c\<ls>d"
  shows "a\<ra>c \<ls> b\<ra>d"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L12D
  by simp

subsection\<open>Absolute value for ordered rings\<close>

text\<open>Absolute value is defined for ordered groups as a function
  that is the identity on the nonnegative set and the negative of the element
  (the inverse in the multiplicative notation) on the rest. In this section
  we consider properties of absolute value related to multiplication in
  ordered rings.\<close>

text\<open>Absolute value of a product is the product of absolute values:
  the case when both elements of the ring are nonnegative.\<close>

lemma (in ring1) OrdRing_ZF_2_L1:
  assumes "\<zero>\<lsq>a" "\<zero>\<lsq>b"
  shows "|a\<cdot>b| = |a|\<cdot>|b|"
  using assms OrdRing_ZF_1_L5 OrdRing_ZF_1_L4
    group3.OrderedGroup_ZF_1_L2 group3.OrderedGroup_ZF_3_L2
  by simp

text\<open>The absolue value of an element and its negative are the same.\<close>

lemma (in ring1) OrdRing_ZF_2_L2: assumes "a\<in>R"
  shows "|\<rm>a| = |a|"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_3_L7A by simp

text\<open>The next lemma states that
  $|a\cdot (-b)| = |(-a)\cdot b| = |(-a)\cdot (-b)| = |a\cdot b|$.\<close>

lemma (in ring1) OrdRing_ZF_2_L3:
  assumes "a\<in>R"  "b\<in>R"
  shows
  "|(\<rm>a)\<cdot>b| = |a\<cdot>b|"
  "|a\<cdot>(\<rm>b)| = |a\<cdot>b|"
  "|(\<rm>a)\<cdot>(\<rm>b)| = |a\<cdot>b|"
  using assms Ring_ZF_1_L4 Ring_ZF_1_L7 Ring_ZF_1_L7A
   OrdRing_ZF_2_L2 by auto

text\<open>This lemma allows to prove theorems for the case of positive and
  negative elements of the ring separately.\<close>

lemma (in ring1) OrdRing_ZF_2_L4: assumes "a\<in>R" and "\<not>(\<zero>\<lsq>a)"
  shows "\<zero> \<lsq> (\<rm>a)"  "\<zero>\<noteq>a"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L8A
  by auto

text\<open>Absolute value of a product is the product of absolute values.\<close>

lemma (in ring1) OrdRing_ZF_2_L5:
  assumes A1: "a\<in>R" "b\<in>R"
  shows "|a\<cdot>b| = |a|\<cdot>|b|"
proof -
  { assume A2: "\<zero>\<lsq>a" have "|a\<cdot>b| = |a|\<cdot>|b|"
    proof -
      { assume "\<zero>\<lsq>b"
	with A2 have "|a\<cdot>b| = |a|\<cdot>|b|"
	  using OrdRing_ZF_2_L1 by simp }
      moreover
      { assume "\<not>(\<zero>\<lsq>b)"
	with A1 A2 have "|a\<cdot>(\<rm>b)| = |a|\<cdot>|\<rm>b|"
	  using OrdRing_ZF_2_L4 OrdRing_ZF_2_L1 by simp
	with A1 have "|a\<cdot>b| = |a|\<cdot>|b|"
	  using OrdRing_ZF_2_L2 OrdRing_ZF_2_L3 by simp }
      ultimately show ?thesis by blast
    qed }
  moreover
  { assume "\<not>(\<zero>\<lsq>a)"
    with A1 have A3: "\<zero> \<lsq> (\<rm>a)"
      using OrdRing_ZF_2_L4 by simp
    have "|a\<cdot>b| = |a|\<cdot>|b|"
    proof -
      { assume "\<zero>\<lsq>b"
	with A3 have "|(\<rm>a)\<cdot>b| = |\<rm>a|\<cdot>|b|"
	  using OrdRing_ZF_2_L1 by simp
	with A1 have "|a\<cdot>b| = |a|\<cdot>|b|"
	  using OrdRing_ZF_2_L2 OrdRing_ZF_2_L3 by simp }
      moreover
      { assume "\<not>(\<zero>\<lsq>b)"
	with A1 A3 have "|(\<rm>a)\<cdot>(\<rm>b)| = |\<rm>a|\<cdot>|\<rm>b|"
	  using OrdRing_ZF_2_L4 OrdRing_ZF_2_L1 by simp
	with A1 have "|a\<cdot>b| = |a|\<cdot>|b|"
	  using OrdRing_ZF_2_L2 OrdRing_ZF_2_L3 by simp }
      ultimately show ?thesis by blast
    qed }
  ultimately show ?thesis by blast
qed

text\<open>Triangle inequality. Property of linearly ordered abelian groups.\<close>

lemma (in ring1) ord_ring_triangle_ineq:  assumes "a\<in>R" "b\<in>R"
  shows "|a\<ra>b| \<lsq> |a|\<ra>|b|"
  using assms OrdRing_ZF_1_L4 group3.OrdGroup_triangle_ineq
  by simp

text\<open>If $a\leq c$ and $b\leq c$, then $a+b\leq 2\cdot c$.\<close>

lemma (in ring1) OrdRing_ZF_2_L6:
  assumes "a\<lsq>c"  "b\<lsq>c" shows "a\<ra>b \<lsq> \<two>\<cdot>c"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L5B
    OrdRing_ZF_1_L3 Ring_ZF_1_L3 by simp

subsection\<open>Positivity in ordered rings\<close>

text\<open>This section is about properties of the set of positive
  elements \<open>R\<^sub>+\<close>.\<close>

text\<open>The set of positive elements is closed under ring addition.
  This is a property of ordered groups, we just reference a theorem
  from \<open>OrderedGroup_ZF\<close> theory in the proof.\<close>

lemma (in ring1) OrdRing_ZF_3_L1: shows "R\<^sub>+ {is closed under} A"
  using OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L13
  by simp

text\<open>Every element of a ring can be either in the postitive set, equal to
  zero or its opposite (the additive inverse) is in the positive set.
  This is a property of ordered groups, we just reference a theorem
  from \<open>OrderedGroup_ZF\<close> theory.\<close>

lemma (in ring1) OrdRing_ZF_3_L2: assumes "a\<in>R"
  shows "Exactly_1_of_3_holds (a=\<zero>, a\<in>R\<^sub>+, (\<rm>a) \<in> R\<^sub>+)"
  using assms OrdRing_ZF_1_L4 group3.OrdGroup_decomp
  by simp

text\<open>If a ring element $a\neq 0$, and it is not positive, then
  $-a$ is positive.\<close>

lemma (in ring1) OrdRing_ZF_3_L2A: assumes "a\<in>R"  "a\<noteq>\<zero>"  "a \<notin> R\<^sub>+"
  shows "(\<rm>a) \<in>  R\<^sub>+"
  using assms OrdRing_ZF_1_L4 group3.OrdGroup_cases
  by simp

text\<open>\<open>R\<^sub>+\<close> is closed under
  multiplication iff the ring has no zero divisors.\<close>

lemma (in ring1) OrdRing_ZF_3_L3:
  shows "(R\<^sub>+ {is closed under} M)\<longleftrightarrow> HasNoZeroDivs(R,A,M)"
proof
  assume A1: "HasNoZeroDivs(R,A,M)"
  { fix a b assume "a\<in>R\<^sub>+"  "b\<in>R\<^sub>+"
    then have "\<zero>\<lsq>a"  "a\<noteq>\<zero>"  "\<zero>\<lsq>b"  "b\<noteq>\<zero>"
      using PositiveSet_def by auto
    with A1 have "a\<cdot>b \<in> R\<^sub>+"
      using OrdRing_ZF_1_L5 Ring_ZF_1_L2 OrdRing_ZF_1_L3 Ring_ZF_1_L12
	OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L2A
      by simp
  } then show  "R\<^sub>+ {is closed under} M" using IsOpClosed_def
    by simp
next assume A2: "R\<^sub>+ {is closed under} M"
  { fix a b assume A3: "a\<in>R"  "b\<in>R"  and "a\<noteq>\<zero>"  "b\<noteq>\<zero>"
    with A2 have "|a\<cdot>b| \<in> R\<^sub>+"
      using OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_3_L12 IsOpClosed_def
        OrdRing_ZF_2_L5 by simp
    with A3 have "a\<cdot>b \<noteq> \<zero>"
      using PositiveSet_def Ring_ZF_1_L4
	OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_3_L2A
      by auto
  } then show "HasNoZeroDivs(R,A,M)" using HasNoZeroDivs_def
    by auto
qed

text\<open>Another (in addition to \<open>OrdRing_ZF_1_L6\<close> sufficient condition
  that defines order in an ordered ring starting from the positive set.\<close>

theorem (in ring0) ring_ord_by_positive_set:
  assumes
  A1: "M {is commutative on} R" and
  A2: "P\<subseteq>R"  "P {is closed under} A"  "\<zero> \<notin> P" and
  A3: "\<forall>a\<in>R. a\<noteq>\<zero> \<longrightarrow> (a\<in>P) Xor ((\<rm>a) \<in> P)" and
  A4: "P {is closed under} M" and
  A5: "r = OrderFromPosSet(R,A,P)"
  shows
  "IsAnOrdGroup(R,A,r)"
  "IsAnOrdRing(R,A,M,r)"
  "r {is total on} R"
  "PositiveSet(R,A,r) = P"
  "Nonnegative(R,A,r) = P \<union> {\<zero>}"
  "HasNoZeroDivs(R,A,M)"
proof -
  from A2 A3 A5 show
    I: "IsAnOrdGroup(R,A,r)"  "r {is total on} R" and
    II: "PositiveSet(R,A,r) = P" and
    III: "Nonnegative(R,A,r) = P \<union> {\<zero>}"
    using Ring_ZF_1_L1 group0.Group_ord_by_positive_set
    by auto
  from A2 A4 III have "Nonnegative(R,A,r) {is closed under} M"
    using Ring_ZF_1_L16 by simp
  with ringAssum A1 I show "IsAnOrdRing(R,A,M,r)"
    using OrdRing_ZF_1_L6 by simp
  with A4 II show "HasNoZeroDivs(R,A,M)"
    using OrdRing_ZF_1_L2 ring1.OrdRing_ZF_3_L3
    by auto
qed

text\<open>Nontrivial ordered rings are infinite. More precisely we assume
  that the neutral
  element of the additive operation is not equal to the multiplicative neutral
  element and show that the the set of positive elements of the ring is not a
  finite subset of the ring and the ring is not a finite subset of itself.\<close>

theorem (in ring1) ord_ring_infinite: assumes "\<zero>\<noteq>\<one>"
  shows
  "R\<^sub>+ \<notin> Fin(R)"
  "R \<notin> Fin(R)"
  using assms Ring_ZF_1_L17 OrdRing_ZF_1_L4 group3.Linord_group_infinite
  by auto

text\<open>If every element of a nontrivial ordered ring can be dominated
  by an element from $B$, then we $B$ is not bounded and not finite.\<close>

lemma (in ring1) OrdRing_ZF_3_L4:
  assumes "\<zero>\<noteq>\<one>" and "\<forall>a\<in>R. \<exists>b\<in>B. a\<lsq>b"
  shows
  "\<not>IsBoundedAbove(B,r)"
  "B \<notin> Fin(R)"
  using assms Ring_ZF_1_L17 OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_2_L2A
  by auto

text\<open>If $m$ is greater or equal the multiplicative unit, then the set
  $\{m\cdot n: n\in R\}$ is infinite (unless the ring is trivial).\<close>

lemma (in ring1) OrdRing_ZF_3_L5: assumes A1: "\<zero>\<noteq>\<one>" and A2: "\<one>\<lsq>m"
  shows
  "{m\<cdot>x. x\<in>R\<^sub>+} \<notin> Fin(R)"
  "{m\<cdot>x. x\<in>R} \<notin> Fin(R)"
  "{(\<rm>m)\<cdot>x. x\<in>R} \<notin> Fin(R)"
proof -
  from A2 have T: "m\<in>R" using OrdRing_ZF_1_L3 by simp
  from A2 have "\<zero>\<lsq>\<one>"  "\<one>\<lsq>m"
    using ordring_one_is_nonneg by auto
  then have I: "\<zero>\<lsq>m" by (rule ring_ord_transitive)
  let ?B = "{m\<cdot>x. x\<in>R\<^sub>+}"
  { fix a assume A3: "a\<in>R"
    then have "a\<lsq>\<zero> \<or> (\<zero>\<lsq>a \<and> a\<noteq>\<zero>)"
      using ord_ring_split2 by simp
    moreover
    { assume A4: "a\<lsq>\<zero>"
      from A1 have "m\<cdot>\<one> \<in> ?B" using ordring_one_is_pos
	by auto
      with T have "m\<in>?B" using Ring_ZF_1_L3 by simp
      moreover from A4 I have "a\<lsq>m" by (rule ring_ord_transitive)
      ultimately have "\<exists>b\<in>?B. a\<lsq>b" by blast }
    moreover
    { assume A4: "\<zero>\<lsq>a \<and> a\<noteq>\<zero>"
      with A3 have "m\<cdot>a \<in> ?B" using PositiveSet_def
	by auto
      moreover
      from A2 A4 have "\<one>\<cdot>a \<lsq> m\<cdot>a" using OrdRing_ZF_1_L9
	by simp
      with A3 have "a \<lsq> m\<cdot>a" using Ring_ZF_1_L3
	by simp
      ultimately have "\<exists>b\<in>?B. a\<lsq>b" by auto }
    ultimately have "\<exists>b\<in>?B. a\<lsq>b" by auto
  } then have "\<forall>a\<in>R. \<exists>b\<in>?B. a\<lsq>b"
    by simp
  with A1 show "?B \<notin> Fin(R)" using OrdRing_ZF_3_L4
    by simp
  moreover have "?B \<subseteq> {m\<cdot>x. x\<in>R}"
    using PositiveSet_def by auto
  ultimately show "{m\<cdot>x. x\<in>R} \<notin> Fin(R)" using Fin_subset
    by auto
  with T show "{(\<rm>m)\<cdot>x. x\<in>R} \<notin> Fin(R)" using Ring_ZF_1_L18
    by simp
qed

text\<open>If $m$ is less or equal than the negative of
  multiplicative unit, then the set
  $\{m\cdot n: n\in R\}$ is infinite (unless the ring is trivial).\<close>

lemma (in ring1) OrdRing_ZF_3_L6: assumes A1: "\<zero>\<noteq>\<one>" and A2: "m \<lsq> \<rm>\<one>"
  shows "{m\<cdot>x. x\<in>R} \<notin> Fin(R)"
proof -
  from A2 have "(\<rm>(\<rm>\<one>)) \<lsq> \<rm>m"
    using OrdRing_ZF_1_L4B by simp
  with A1 have "{(\<rm>m)\<cdot>x. x\<in>R} \<notin> Fin(R)"
    using Ring_ZF_1_L2 Ring_ZF_1_L3 OrdRing_ZF_3_L5
    by simp
  with A2 show "{m\<cdot>x. x\<in>R} \<notin> Fin(R)"
    using OrdRing_ZF_1_L3 Ring_ZF_1_L18 by simp
qed

text\<open>All elements greater or equal than an element of \<open>R\<^sub>+\<close>
  belong to \<open>R\<^sub>+\<close>. Property of ordered groups.\<close>

lemma (in ring1) OrdRing_ZF_3_L7: assumes A1: "a \<in> R\<^sub>+" and A2: "a\<lsq>b"
  shows "b \<in> R\<^sub>+"
proof -
  from A1 A2 have
    "group3(R,A,r)"
    "a \<in> PositiveSet(R,A,r)"
    "\<langle>a,b\<rangle> \<in> r"
    using OrdRing_ZF_1_L4 by auto
  then have "b \<in> PositiveSet(R,A,r)"
    by (rule group3.OrderedGroup_ZF_1_L19)
  then show "b \<in> R\<^sub>+" by simp
qed

text\<open>A special case of \<open>OrdRing_ZF_3_L7\<close>: a ring element greater
  or equal than $1$ is positive.\<close>

corollary (in ring1) OrdRing_ZF_3_L8: assumes A1: "\<zero>\<noteq>\<one>" and A2: "\<one>\<lsq>a"
  shows "a \<in> R\<^sub>+"
proof -
  from A1 A2 have "\<one> \<in> R\<^sub>+"  "\<one>\<lsq>a"
    using ordring_one_is_pos by auto
  then show "a \<in> R\<^sub>+" by (rule OrdRing_ZF_3_L7)
qed

text\<open>Adding a positive element to $a$ strictly increases $a$.
  Property of ordered groups.\<close>

lemma (in ring1) OrdRing_ZF_3_L9: assumes A1: "a\<in>R"  "b\<in>R\<^sub>+"
  shows "a \<lsq> a\<ra>b"  "a \<noteq> a\<ra>b"
  using assms OrdRing_ZF_1_L4 group3.OrderedGroup_ZF_1_L22
  by auto

text\<open>A special case of \<open> OrdRing_ZF_3_L9\<close>: in nontrivial
  rings adding one to $a$ increases $a$.\<close>

corollary (in ring1) OrdRing_ZF_3_L10: assumes A1: "\<zero>\<noteq>\<one>" and A2: "a\<in>R"
  shows "a \<lsq> a\<ra>\<one>"  "a \<noteq> a\<ra>\<one>"
  using assms ordring_one_is_pos OrdRing_ZF_3_L9
  by auto

text\<open>If $a$ is not greater than $b$, then it is strictly less than
  $b+1$.\<close>

lemma (in ring1) OrdRing_ZF_3_L11: assumes A1: "\<zero>\<noteq>\<one>" and A2: "a\<lsq>b"
  shows "a\<ls> b\<ra>\<one>"
proof -
  from A1 A2 have I: "b \<ls> b\<ra>\<one>"
    using OrdRing_ZF_1_L3 OrdRing_ZF_3_L10 by auto
  with A2 show "a\<ls> b\<ra>\<one>" by (rule ring_strict_ord_transit)
qed

text\<open>For any ring element $a$ the greater of $a$ and $1$ is a positive
  element that is greater or equal than $m$. If we add $1$ to it we
  get a positive element that is strictly greater than $m$. This holds
  in nontrivial rings.\<close>

lemma (in ring1) OrdRing_ZF_3_L12: assumes A1: "\<zero>\<noteq>\<one>" and A2: "a\<in>R"
  shows
  "a \<lsq> GreaterOf(r,\<one>,a)"
  "GreaterOf(r,\<one>,a) \<in> R\<^sub>+"
  "GreaterOf(r,\<one>,a) \<ra> \<one> \<in> R\<^sub>+"
  "a \<lsq> GreaterOf(r,\<one>,a) \<ra> \<one>"  "a \<noteq> GreaterOf(r,\<one>,a) \<ra> \<one>"
proof -
  from linord have "r {is total on} R" using IsLinOrder_def
    by simp
  moreover from A2 have "\<one> \<in> R"  "a\<in>R"
    using Ring_ZF_1_L2 by auto
  ultimately have
    "\<one> \<lsq> GreaterOf(r,\<one>,a)" and
    I: "a \<lsq> GreaterOf(r,\<one>,a)"
    using Order_ZF_3_L2 by auto
  with A1 show
    "a \<lsq> GreaterOf(r,\<one>,a)" and
    "GreaterOf(r,\<one>,a) \<in> R\<^sub>+"
    using OrdRing_ZF_3_L8 by auto
  with A1 show "GreaterOf(r,\<one>,a) \<ra> \<one> \<in> R\<^sub>+"
    using ordring_one_is_pos OrdRing_ZF_3_L1 IsOpClosed_def
    by simp
  from A1 I show
    "a \<lsq> GreaterOf(r,\<one>,a) \<ra> \<one>"  "a \<noteq> GreaterOf(r,\<one>,a) \<ra> \<one>"
    using OrdRing_ZF_3_L11 by auto
qed

text\<open>We can multiply strict inequality by a positive element.\<close>

lemma (in ring1) OrdRing_ZF_3_L13:
  assumes A1: "HasNoZeroDivs(R,A,M)" and
  A2: "a\<ls>b" and A3: "c\<in>R\<^sub>+"
  shows
  "a\<cdot>c \<ls> b\<cdot>c"
  "c\<cdot>a \<ls> c\<cdot>b"
proof -
  from A2 A3 have T: "a\<in>R"  "b\<in>R"  "c\<in>R"  "c\<noteq>\<zero>"
    using OrdRing_ZF_1_L3 PositiveSet_def by auto
  from A2 A3 have "a\<cdot>c \<lsq> b\<cdot>c" using OrdRing_ZF_1_L9A
    by simp
  moreover from A1 A2 T have "a\<cdot>c \<noteq> b\<cdot>c"
    using Ring_ZF_1_L12A by auto
  ultimately show "a\<cdot>c \<ls> b\<cdot>c" by simp
  moreover from mult_commut T have "a\<cdot>c = c\<cdot>a" and "b\<cdot>c = c\<cdot>b"
    using IsCommutative_def by auto
  ultimately show "c\<cdot>a \<ls> c\<cdot>b" by simp
qed

text\<open>A sufficient condition for an element to be in the set
  of positive ring elements.\<close>

lemma (in ring1) OrdRing_ZF_3_L14: assumes "\<zero>\<lsq>a" and "a\<noteq>\<zero>"
  shows "a \<in> R\<^sub>+"
  using assms OrdRing_ZF_1_L3 PositiveSet_def
  by auto

text\<open>If a ring has no zero divisors, the square of a nonzero
  element is positive.\<close>

lemma (in ring1) OrdRing_ZF_3_L15:
  assumes "HasNoZeroDivs(R,A,M)" and "a\<in>R"  "a\<noteq>\<zero>"
  shows "\<zero> \<lsq> a\<^sup>2"  "a\<^sup>2 \<noteq> \<zero>"  "a\<^sup>2 \<in> R\<^sub>+"
  using assms OrdRing_ZF_1_L10 Ring_ZF_1_L12 OrdRing_ZF_3_L14
  by auto

text\<open>In rings with no zero divisors we can (strictly) increase a
  positive element by  multiplying it by an element that is greater than $1$.\<close>

lemma (in ring1) OrdRing_ZF_3_L16:
  assumes "HasNoZeroDivs(R,A,M)" and "a \<in> R\<^sub>+" and "\<one>\<lsq>b"  "\<one>\<noteq>b"
  shows "a\<lsq>a\<cdot>b"  "a \<noteq> a\<cdot>b"
  using assms PositiveSet_def OrdRing_ZF_1_L16 OrdRing_ZF_1_L3
    Ring_ZF_1_L12C by auto

text\<open>If the right hand side of an inequality is positive we can multiply it
  by a number that is greater than one.\<close>

lemma (in ring1) OrdRing_ZF_3_L17:
   assumes A1: "HasNoZeroDivs(R,A,M)" and A2: "b\<in>R\<^sub>+" and
  A3: "a\<lsq>b"  and A4: "\<one>\<ls>c"
  shows "a\<ls>b\<cdot>c"
proof -
  from A1 A2 A4 have "b \<ls> b\<cdot>c"
    using OrdRing_ZF_3_L16 by auto
  with A3 show "a\<ls>b\<cdot>c" by (rule ring_strict_ord_transit)
qed

text\<open>We can multiply a right hand side of an inequality between
  positive numbers by a number that is greater than one.\<close>

lemma (in ring1) OrdRing_ZF_3_L18:
  assumes A1: "HasNoZeroDivs(R,A,M)" and A2: "a \<in> R\<^sub>+" and
  A3: "a\<lsq>b" and A4: "\<one>\<ls>c"
  shows "a\<ls>b\<cdot>c"
proof -
  from A2 A3 have "b \<in> R\<^sub>+" using OrdRing_ZF_3_L7
    by blast
  with A1 A3 A4 show "a\<ls>b\<cdot>c"
    using OrdRing_ZF_3_L17 by simp
qed

text\<open>In ordered rings with no zero divisors if at
  least one of $a,b$ is not zero, then
  $0 < a^2+b^2$, in particular $a^2+b^2\neq 0$.\<close>

lemma (in ring1) OrdRing_ZF_3_L19:
  assumes A1: "HasNoZeroDivs(R,A,M)" and A2: "a\<in>R"  "b\<in>R" and
  A3: "a \<noteq> \<zero> \<or> b \<noteq> \<zero>"
  shows "\<zero> \<ls> a\<^sup>2 \<ra> b\<^sup>2"
proof -
  { assume "a \<noteq> \<zero>"
    with A1 A2 have "\<zero> \<lsq> a\<^sup>2"  "a\<^sup>2 \<noteq> \<zero>"
      using OrdRing_ZF_3_L15 by auto
    then have "\<zero> \<ls> a\<^sup>2" by auto
    moreover from A2 have "\<zero> \<lsq> b\<^sup>2"
      using OrdRing_ZF_1_L10 by simp
    ultimately have "\<zero> \<ra> \<zero> \<ls> a\<^sup>2 \<ra> b\<^sup>2"
      using OrdRing_ZF_1_L19 by simp
    then have "\<zero> \<ls> a\<^sup>2 \<ra> b\<^sup>2"
      using Ring_ZF_1_L2 Ring_ZF_1_L3 by simp }
  moreover
  { assume A4: "a = \<zero>"
    then have "a\<^sup>2 \<ra> b\<^sup>2 = \<zero> \<ra> b\<^sup>2"
      using  Ring_ZF_1_L2 Ring_ZF_1_L6 by simp
    also from A2 have "\<dots> = b\<^sup>2"
      using Ring_ZF_1_L4 Ring_ZF_1_L3 by simp
    finally have "a\<^sup>2 \<ra> b\<^sup>2 = b\<^sup>2" by simp
    moreover
    from A3 A4 have "b \<noteq> \<zero>" by simp
    with A1 A2 have "\<zero> \<lsq> b\<^sup>2" and "b\<^sup>2 \<noteq> \<zero>"
      using OrdRing_ZF_3_L15 by auto
    hence "\<zero> \<ls> b\<^sup>2" by auto
    ultimately have "\<zero> \<ls> a\<^sup>2 \<ra> b\<^sup>2" by simp }
  ultimately show "\<zero> \<ls> a\<^sup>2 \<ra> b\<^sup>2"
    by auto
qed

end


theory ReoAutomata
  imports Main
begin

section "Guarded strings"

type_synonym '\<Sigma> guard = "'\<Sigma> set"
type_synonym '\<Sigma> firings = "'\<Sigma> set"
type_synonym '\<Sigma> guarded_string = "('\<Sigma> guard \<times> '\<Sigma> firings) list"

section "Guarded automata"

record ('\<Sigma>,'Q) transition =
  source :: 'Q
  guard :: "'\<Sigma> guard"
  firings :: "'\<Sigma> firings"
  target :: 'Q

abbreviation step :: "'Q \<Rightarrow> '\<Sigma> guard \<Rightarrow> '\<Sigma> firings \<Rightarrow> 'Q \<Rightarrow> ('\<Sigma>, 'Q) transition" ("_ _\<rightarrow>_ _" [100, 100, 100, 100]) where
  "q g\<rightarrow>f q' \<equiv> \<lparr> source = q, guard = g, firings = f, target = q' \<rparr>"

record ('\<Sigma>, 'Q) guarded_automaton =
  ports :: "'\<Sigma> set"
  states :: "'Q set"
  transitions :: "('\<Sigma>,'Q) transition set"

definition wf_guarded_automaton :: "('\<Sigma>,'Q) guarded_automaton \<Rightarrow> bool" where
  "wf_guarded_automaton \ = (finite (ports \) \<and> finite (states \) \<and> source ` transitions \ \<subseteq> states \
    \<and> \<Union>(guard ` transitions \<A>) \<subseteq> ports \<A> \<and> \<Union>(firings ` transitions \) \<subseteq> ports \
    \<and> target ` transitions \ \<subseteq> states \ \<and> states \ \<noteq> {})"

lemma wf_guarded_automatonI [intro!]:
  "\<lbrakk> finite (ports \); finite (states \); source ` transitions \ \<subseteq> states \;
     \<Union>(guard ` transitions \<A>) \<subseteq> ports \<A>; \<Union>(firings ` transitions \) \<subseteq> ports \;
     target ` transitions \ \<subseteq> states \; states \ \<noteq> {} \<rbrakk> \<Longrightarrow> wf_guarded_automaton \"
  by (auto simp add: wf_guarded_automaton_def)

abbreviation neutral_automaton :: "'Q \<Rightarrow> ('\<Sigma>,'Q) guarded_automaton" ("1\<^sub>\") where
  "1\<^sub>\ x \<equiv> \<lparr>ports = {}, states = {x}, transitions = {}\<rparr>"

lemma wf_guarded_automaton_has_model:
  "wf_guarded_automaton (neutral_automaton x)"
  by auto

lemma wf_implies_wf_transitions [intro, dest, consumes 2]:
  assumes
    "wf_guarded_automaton \" and
    "q g\<rightarrow>f q' \<in> transitions \"
  shows
    "q \<in> states \"
    "g \<subseteq> ports \"
    "f \<subseteq> ports \"
    "q' \<in> states \"
  using assms wf_guarded_automaton_def by fastforce+

inductive accepts :: "('\<Sigma>, 'Q) guarded_automaton \<Rightarrow> 'Q \<Rightarrow> '\<Sigma> guarded_string \<Rightarrow> bool" where
  empty: "q \<in> states \ \<Longrightarrow> accepts \ q []"
| step: "\<lbrakk> q \<in> states \; q g\<rightarrow>f q' \<in> transitions \; accepts \ q' tail \<rbrakk> \<Longrightarrow> accepts \ q ((g, f) # tail)"

abbreviation sync :: "'\<Sigma> \<Rightarrow> '\<Sigma> \<Rightarrow> 'Q \<Rightarrow> ('\<Sigma>, 'Q) guarded_automaton" where
  "sync a b q \<equiv> \<lparr> ports = {a, b}, states = {q}, transitions = { q {a,b}\<rightarrow>{a,b} q } \<rparr>"

lemma "accepts (sync a b q) q ([({a,b}, {a,b}), ({a,b}, {a,b})])"
  by (auto intro!: accepts.intros)

lemma "a \<noteq> b \<Longrightarrow> \<not> (accepts (sync a b q) q ([({a,b}, {a,b}), ({a}, {a,b})]))"
  by (auto elim!: accepts.cases)

definition language :: "('\<Sigma>, 'Q) guarded_automaton \<Rightarrow> 'Q \<Rightarrow> '\<Sigma> guarded_string set" where
  "language \ q = { s |s.  accepts \ q s }"

lemma language_nonempty: "q \<in> states \ \<Longrightarrow> language \ q \<noteq> {}"
  using empty language_def by fastforce

definition prefix_closed :: "'a list set \<Rightarrow> bool" where
  "prefix_closed L = (\<forall>v w. (v @ w) \<in> L \<longrightarrow> v \<in> L)"

lemma accepts_butlast:
  assumes
    q_in_\: "q \<in> states \" and
    accepts_tail: "accepts \ q xs"
  shows "accepts \ q (butlast xs)"
proof (use assms in \<open>induct xs arbitrary: q\<close>)
  case Nil
  thus ?case by simp
next
  case (Cons rqs_fs tl)
  obtain rqs fs where hd: "rqs_fs = (rqs, fs)" by (cases rqs_fs) simp
  obtain q' where "q' \<in> states \" and "q rqs\<rightarrow>fs q' \<in> transitions \" and "accepts \ q' tl"
    by (use Cons.prems(2) in cases) (metis Pair_inject accepts.cases hd)
  thus ?case using hd by (auto simp add: Cons.prems(1) empty accepts.step Cons.hyps)
qed

lemma language_prefix_closed: "prefix_closed (language \ q)"
proof -
  have "\<And>v w. accepts \ q (v @ w) \<Longrightarrow> accepts \ q v"
  proof -
    fix v w
    assume accepts: "accepts \ q (v @ w)"
    obtain n where len: "length (v @ w) = n" by simp
    show "accepts \ q v"
    proof (use accepts len in \<open>induct n arbitrary: w\<close>)
      case 0
      then show ?case by simp
    next
      case Suc: (Suc n)
      have "accepts \ q (butlast (v @ w))" by (meson Suc.prems(1) accepts.cases accepts_butlast)
      hence "accepts \ q (v @ butlast w)" by (metis Suc.prems(1) butlast.simps(1) butlast_append)
      then show ?case
        by (metis (mono_tags) One_nat_def Suc.hyps Suc.prems(1-2) append_Nil2 butlast_append diff_Suc_Suc diff_zero length_butlast)
    qed
  qed
  thus ?thesis by (simp add: language_def prefix_closed_def)
qed

definition simulating where
  "simulating R \\<^sub>1 \\<^sub>2 = (\<forall>q\<^sub>1 q\<^sub>2. (q\<^sub>1,q\<^sub>2) \<in> R \<longrightarrow>
    (\<forall>g f q\<^sub>1'. q\<^sub>1 g\<rightarrow>f q\<^sub>1' \<in> transitions \\<^sub>1 \<longrightarrow> (\<exists>q\<^sub>2'. q\<^sub>2 g\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2 \<and> (q\<^sub>1',q\<^sub>2') \<in> R))
  \<and> (\<forall>g f q\<^sub>2'. q\<^sub>2 g\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2 \<longrightarrow> (\<exists>q\<^sub>1'. q\<^sub>1 g\<rightarrow>f q\<^sub>1' \<in> transitions \\<^sub>1 \<and> (q\<^sub>1',q\<^sub>2') \<in> R)))"

lemma simulatingI [intro]:
"(\<And>q\<^sub>1 q\<^sub>2 g f q\<^sub>1' q\<^sub>2'. (q\<^sub>1,q\<^sub>2) \<in> R \<Longrightarrow> ((q\<^sub>1 g\<rightarrow>f q\<^sub>1' \<in> transitions \\<^sub>1 \<longrightarrow> (\<exists>q\<^sub>2'. q\<^sub>2 g\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2 \<and> (q\<^sub>1',q\<^sub>2') \<in> R))
  \<and> (q\<^sub>2 g\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2 \<longrightarrow> (\<exists>q\<^sub>1'. q\<^sub>1 g\<rightarrow>f q\<^sub>1' \<in> transitions \\<^sub>1 \<and> (q\<^sub>1',q\<^sub>2') \<in> R)))) \<Longrightarrow> simulating R \\<^sub>1 \\<^sub>2"
  by (auto simp add: simulating_def)

definition bisimulates :: "('Q\<^sub>1 \<times> 'Q\<^sub>2) set \<Rightarrow> ('\<Sigma>, 'Q\<^sub>1) guarded_automaton \<Rightarrow> ('\<Sigma>, 'Q\<^sub>2) guarded_automaton \<Rightarrow> bool" where
  "bisimulates R \\<^sub>1 \\<^sub>2 = (ports \\<^sub>1 = ports \\<^sub>2 \<and> R \<subseteq> states \\<^sub>1 \<times> states \\<^sub>2 \<and> states \\<^sub>1 \<subseteq> fst ` R \<and> states \<A>\<^sub>2 \<subseteq> snd ` R \<and> simulating R \\<^sub>1 \\<^sub>2)"

lemma bisimulatesI [intro!]:
  "\<lbrakk> ports \\<^sub>1 = ports \\<^sub>2; R \<subseteq> states \\<^sub>1 \<times> states \\<^sub>2; states \\<^sub>1 \<subseteq> fst ` R; states \<A>\<^sub>2 \<subseteq> snd ` R; simulating R \\<^sub>1 \\<^sub>2 \<rbrakk>
  \<Longrightarrow> bisimulates R \\<^sub>1 \\<^sub>2"
  by (auto simp add: bisimulates_def)

definition bisimilar :: "('\<Sigma>, 'Q\<^sub>1) guarded_automaton \<Rightarrow> ('\<Sigma>, 'Q\<^sub>2) guarded_automaton \<Rightarrow> bool" ("_ \<sim> _" [100,100]) where
  "bisimilar \\<^sub>1 \\<^sub>2 = (\<exists>R. bisimulates R \\<^sub>1 \\<^sub>2)"

lemma bisim_refl: "wf_guarded_automaton \ \<Longrightarrow> \ \<sim> \"
proof -
  assume wf: "wf_guarded_automaton \"
  let ?R = "{ (q,q) |q. q \<in> states \ }"
  have "bisimulates ?R \ \" using wf by (auto simp add: image_iff)
  thus ?thesis using bisimilar_def by blast
qed

lemma fst_conv_R_snd_R [simp]: "fst ` R\<inverse> = snd ` R" by (simp add: Range_snd fst_eq_Domain)
lemma snd_conv_R_fst_R [simp]: "snd ` R\<inverse> = fst ` R" by (simp add: Domain_fst snd_eq_Range)

lemma bisim_sym [intro]: "\\<^sub>1 \<sim> \\<^sub>2 \<Longrightarrow> \\<^sub>2 \<sim> \\<^sub>1"
proof -
  assume "\\<^sub>1 \<sim> \\<^sub>2"
  then obtain R where R_bisim: "bisimulates R \\<^sub>1 \\<^sub>2" using bisimilar_def by blast
  have "bisimulates (R\<inverse>) \\<^sub>2 \\<^sub>1" using R_bisim by (auto simp add: simulating_def bisimulates_def)
  thus ?thesis using bisimilar_def by blast
qed

lemma simulating_trans: "simulating R \\<^sub>1 \\<^sub>2 \<Longrightarrow> simulating R' \\<^sub>2 \\<^sub>3 \<Longrightarrow> simulating (R O R') \\<^sub>1 \\<^sub>3"
  by (auto simp add: simulating_def, (meson relcomp.relcompI)+)

lemma boo1 [simp]: "snd ` R = fst ` R' \<Longrightarrow> fst ` (R O R') = fst ` R"
  by (auto simp add: image_iff, force+)
lemma boo2 [simp]: "snd ` R = fst ` R' \<Longrightarrow> snd ` (R O R') = snd ` R'"
  by (auto simp add: image_iff, force+)

lemma bisim_trans [intro]: "\\<^sub>1 \<sim> \\<^sub>2 \<Longrightarrow> \\<^sub>2 \<sim> \\<^sub>3 \<Longrightarrow> \\<^sub>1 \<sim> \\<^sub>3"
proof -
  assume sim1: "\\<^sub>1 \<sim> \\<^sub>2" and sim2: "\\<^sub>2 \<sim> \\<^sub>3"
  from sim1 obtain R where R_bisim: "bisimulates R \\<^sub>1 \\<^sub>2" using bisimilar_def by blast
  from sim2 obtain R' where R'_bisim: "bisimulates R' \\<^sub>2 \\<^sub>3" using bisimilar_def by blast
  have snd_eq_fst: "snd ` R = fst ` R'" using R_bisim R'_bisim by (auto 5 3 simp add: bisimilar_def bisimulates_def)
  have "bisimulates (R O R') \\<^sub>1 \\<^sub>3" using R_bisim R'_bisim snd_eq_fst by (auto simp add: bisimulates_def simulating_trans)
  thus ?thesis using bisimilar_def by auto
qed

abbreviation verbose_sync :: "'\<Sigma> \<Rightarrow> '\<Sigma> \<Rightarrow> 'Q \<Rightarrow> 'Q \<Rightarrow> ('\<Sigma>, 'Q) guarded_automaton" where
  "verbose_sync a b q\<^sub>1 q\<^sub>2 \<equiv> \<lparr> ports = {a,b}, states = {q\<^sub>1,q\<^sub>2}, transitions = { q\<^sub>1 {a,b}\<rightarrow>{a,b} q\<^sub>1, q\<^sub>1 {a,b}\<rightarrow>{a,b} q\<^sub>2, q\<^sub>2 {a,b}\<rightarrow>{a,b} q\<^sub>2 } \<rparr>"

abbreviation lossy_sync :: "'\<Sigma> \<Rightarrow> '\<Sigma> \<Rightarrow> 'Q \<Rightarrow> ('\<Sigma>, 'Q) guarded_automaton" where
  "lossy_sync a b q \<equiv> \<lparr> ports = {a,b}, states = {q}, transitions = { q {a,b}\<rightarrow>{a,b} q, q {a,b}\<rightarrow>{a} q, q {a}\<rightarrow>{a} q } \<rparr>"

proposition sync_and_verbose_sync_bisim: "(sync a b q) \<sim> (verbose_sync a b q\<^sub>1 q\<^sub>2)"
proof -
  have "bisimulates {(q,q\<^sub>1), (q,q\<^sub>2)} (sync a b q) (verbose_sync a b q\<^sub>1 q\<^sub>2)"
    by (auto simp add: simulating_def)
  thus ?thesis by (auto simp add: bisimilar_def)
qed

lemma in_left_iff_in_right [intro]:
  assumes
    "bisimulates R \\<^sub>1 \\<^sub>2" and
    "R = {(q,q')}"
  shows
    "q' {a}\<rightarrow>{a} q' \<in> transitions \\<^sub>2 \<Longrightarrow> q {a}\<rightarrow>{a} q \<in> transitions \\<^sub>1"
    "q {a}\<rightarrow>{a} q \<in> transitions \\<^sub>1 \<Longrightarrow> q' {a}\<rightarrow>{a} q' \<in> transitions \\<^sub>2"
  using assms by(auto simp add: bisimulates_def simulating_def)

proposition sync_and_lossy_sync_not_bisim: "a \<noteq> b \<Longrightarrow> \<not> (sync a b q) \<sim> (lossy_sync a b q')"
proof (rule notI)
  assume neq: "a \<noteq> b" and bisim: "(sync a b q) \<sim> (lossy_sync a b q')"
  from bisim obtain R where R_bisim: "bisimulates R (sync a b q) (lossy_sync a b q')"
    using bisimilar_def by blast
  hence R_eq: "R = {(q,q')}" by (auto simp add: bisimulates_def)
  have "q {a}\<rightarrow>{a} q \<in> transitions (sync a b q)"
    by (rule in_left_iff_in_right(1)[where R=R and \\<^sub>2="lossy_sync a b q'" and q'=q']) (use R_bisim R_eq in auto)
  thus False using neq by auto
qed

theorem bisim_implies_language_equivalence:
  fixes
    \\<^sub>1 :: "('\<Sigma>,'Q) guarded_automaton"
  assumes
    R_bisim: "bisimulates R \\<^sub>1 \\<^sub>2" and
    states_bisim: "(q\<^sub>1,q\<^sub>2) \<in> R"
  shows "language \\<^sub>1 q\<^sub>1 = language \\<^sub>2 q\<^sub>2"
proof -
  have q\<^sub>1\\<^sub>1: "q\<^sub>1 \<in> states \\<^sub>1" using states_bisim R_bisim by (auto simp add: bisimulates_def)
  have q\<^sub>2\\<^sub>2: "q\<^sub>2 \<in> states \\<^sub>2" using states_bisim R_bisim by (auto simp add: bisimulates_def)
  have "\<And>w. (w \<in> language \\<^sub>1 q\<^sub>1) = (w \<in> language \\<^sub>2 q\<^sub>2)"
  proof -
    fix w :: "'\<Sigma> guarded_string"
    obtain n where len: "length w = n" by simp
    show "(w \<in> language \\<^sub>1 q\<^sub>1) = (w \<in> language \\<^sub>2 q\<^sub>2)"
    proof (use R_bisim states_bisim len q\<^sub>1\\<^sub>1 q\<^sub>2\\<^sub>2 in \<open>induct n arbitrary: w q\<^sub>1 q\<^sub>2\<close>)
      case zero: 0
      have w_empty: "w = []" using zero.prems by blast
      show ?case by (auto simp add: empty language_def q\<^sub>1\\<^sub>1 q\<^sub>2\\<^sub>2 w_empty zero.prems(4-5))
    next
      case suc: (Suc nat)
      obtain g f v where w_nonempty: "w = (g,f) # v" by (metis length_Suc_conv prod.collapse suc.prems(3))
      have len_v: "length v = nat" using w_nonempty suc.prems by auto
      show ?case
      proof (rule iffI)
        assume "w \<in> language \\<^sub>1 q\<^sub>1"
        hence "accepts \\<^sub>1 q\<^sub>1 w" by (simp add: language_def)
        then obtain q\<^sub>1' where
          left_trans: "q\<^sub>1 g\<rightarrow>f q\<^sub>1' \<in> transitions \\<^sub>1" and
          accepts_tail: "accepts \\<^sub>1 q\<^sub>1' v"
          by cases (use w_nonempty in blast)+
        have "v \<in> language \\<^sub>1 q\<^sub>1'" by (simp add: accepts_tail language_def)
        have "\<exists>q\<^sub>2'. q\<^sub>2 g\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2 \<and> (q\<^sub>1', q\<^sub>2') \<in> R"
          using states_bisim R_bisim left_trans suc.prems(2) by (auto simp add: bisimulates_def simulating_def)
        then obtain q\<^sub>2' where "q\<^sub>2 g\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2" and q\<^sub>1'q\<^sub>2': "(q\<^sub>1', q\<^sub>2') \<in> R" by blast
        have "accepts \\<^sub>2 q\<^sub>2' v"
        proof -
          have q\<^sub>1'_in: "q\<^sub>1' \<in> states \\<^sub>1" using accepts.cases accepts_tail by fastforce
          have q\<^sub>2'_in: "q\<^sub>2' \<in> states \\<^sub>2" using R_bisim q\<^sub>1'q\<^sub>2' by (auto simp add: bisimulates_def)
          thus ?thesis using R_bisim language_def len_v q\<^sub>1'_in q\<^sub>1'q\<^sub>2' suc.hyps \<open>v \<in> language \\<^sub>1 q\<^sub>1'\<close> q\<^sub>2'_in by force
        qed
        have "accepts \\<^sub>2 q\<^sub>2 w"
          using \<open>accepts \\<^sub>2 q\<^sub>2' v\<close> \<open>q\<^sub>2 g\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2\<close> accepts.step suc.prems(5) w_nonempty by fastforce
        thus "w \<in> language \\<^sub>2 q\<^sub>2"  by (simp add: language_def)
      next
        show "w \<in> language \\<^sub>2 q\<^sub>2 \<Longrightarrow> w \<in> language \\<^sub>1 q\<^sub>1" sorry (* symmetric, but clean up first *)
      qed
    qed
  qed
  thus ?thesis by blast
qed

subsection Product

definition nonenabling :: "('\<Sigma>,'Q) guarded_automaton \<Rightarrow> 'Q \<Rightarrow> '\<Sigma> guard set" ("_ _\<^sup>#") where
  "\ q\<^sup># = Pow (ports \) - {g |g. \<exists>f q'. q g\<rightarrow>f q' \<in> transitions \}"

(*
definition nonenabling :: "('\<Sigma>,'Q) guarded_automaton \<Rightarrow> 'Q \<Rightarrow> '\<Sigma> guard set" ("_ _\<^sup>#") where
  "\ q\<^sup># = Pow (ports \) - (guard ` transitions \)"

lemma transition_iff_not_nonenabling:
  "wf_guarded_automaton \ \<Longrightarrow> (g \<subseteq> ports \ \<and> g \<notin> (\ q\<^sup>#)) = (\<exists>t. t \<in> transitions \ \<and> guard t = g)"
  apply (auto simp add: nonenabling_def) sledgehammer
  by (metis old.unit.exhaust subsetCE transition.surjective wf_implies_wf_transitions(2))

lemma transition_if_not_nonenabling [intro]:
  assumes
    "g \<subseteq> ports \" and
    "g \<notin> (\ q\<^sup>#)"
  shows "\<exists>q' f. q g\<rightarrow>f q' \<in> transitions \"
  using assms transition_iff_not_nonenabling by (auto simp add: nonenabling_def)
*)

lemma transition_iff_not_nonenabling:
  "wf_guarded_automaton \ \<Longrightarrow> (g \<subseteq> ports \ \<and> g \<notin> (\ q\<^sup>#)) = (\<exists>q' f. q g\<rightarrow>f q' \<in> transitions \)"
  by (auto simp add: nonenabling_def)

lemma transition_if_not_nonenabling [intro]:
  assumes
    "g \<subseteq> ports \" and
    "g \<notin> (\ q\<^sup>#)"
  shows "\<exists>q' f. q g\<rightarrow>f q' \<in> transitions \"
  using assms transition_iff_not_nonenabling by (auto simp add: nonenabling_def)

proposition "a \<noteq> b \<Longrightarrow> (sync a b q) q\<^sup># = {{},{a},{b}}" by (auto simp add: nonenabling_def)
proposition "a \<noteq> b \<Longrightarrow> (lossy_sync a b q) q\<^sup># = {{},{b}}" by (auto simp add: nonenabling_def)

abbreviation left_async where
  "left_async \\<^sub>1 \\<^sub>2 \<equiv> { (q,p) (g \<union> g')\<rightarrow>f (q',p) |q g f q' p g'.
  q g\<rightarrow>f q' \<in> transitions \\<^sub>1 \<and> p \<in> states \\<^sub>2 \<and> g' \<in> (\\<^sub>2 p\<^sup>#) }"

abbreviation right_async where
  "right_async \\<^sub>1 \\<^sub>2 \<equiv> { (q,p) (g \<union> g')\<rightarrow>f (q,p') |p g f p' q g'.
  p g\<rightarrow>f p' \<in> transitions \\<^sub>2 \<and> q \<in> states \\<^sub>1 \<and> g' \<in> (\\<^sub>1 q\<^sup>#) }"

abbreviation both_sync where
  "both_sync \\<^sub>1 \\<^sub>2 \<equiv> { (q,p) (g \<union> g')\<rightarrow>(f \<union> f') (q',p') |q g f q' p g' f' p'.
   q g\<rightarrow>f q' \<in> transitions \\<^sub>1 \<and> p g'\<rightarrow>f' p' \<in> transitions \\<^sub>2 }"

(* the product operation is defined under the assumption ports \\<^sub>1 \<inter> ports \\<^sub>2 = {} *)
fun product :: "('\<Sigma>,'Q\<^sub>1) guarded_automaton \<Rightarrow> ('\<Sigma>,'Q\<^sub>2) guarded_automaton \<Rightarrow> ('\<Sigma>,'Q\<^sub>1\<times>'Q\<^sub>2) guarded_automaton" ("_ \<times>\<^sub>\ _")  where
  "product \\<^sub>1 \\<^sub>2 = \<lparr> ports = ports \\<^sub>1 \<union> ports \\<^sub>2, states = states \\<^sub>1 \<times> states \\<^sub>2,
    transitions = left_async \\<^sub>1 \\<^sub>2 \<union> right_async \\<^sub>1 \\<^sub>2 \<union> both_sync \\<^sub>1 \\<^sub>2 \<rparr>"

lemma prod_transitionE [elim, consumes 1, case_names left_async right_async both_sync]:
  assumes
    prod_trans: "(q\<^sub>1,q\<^sub>2) g\<rightarrow>f (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)" and
    left: "\<And>g\<^sub>1 g\<^sub>2. q\<^sub>2 = q\<^sub>2' \<Longrightarrow> g = g\<^sub>1 \<union> g\<^sub>2 \<Longrightarrow> q\<^sub>1 g\<^sub>1\<rightarrow>f q\<^sub>1' \<in> transitions \\<^sub>1 \<Longrightarrow> g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#) \<Longrightarrow> P" and
    right: "\<And>g\<^sub>1 g\<^sub>2. q\<^sub>1 = q\<^sub>1' \<Longrightarrow> g = g\<^sub>1 \<union> g\<^sub>2 \<Longrightarrow> q\<^sub>2 g\<^sub>2\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2 \<Longrightarrow> g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#) \<Longrightarrow> P" and
    both: "\<And>g\<^sub>1 g\<^sub>2 f\<^sub>1 f\<^sub>2. g = g\<^sub>1 \<union> g\<^sub>2 \<Longrightarrow> f = f\<^sub>1 \<union> f\<^sub>2 \<Longrightarrow> q\<^sub>1 g\<^sub>1\<rightarrow>f\<^sub>1 q\<^sub>1' \<in> transitions \\<^sub>1 \<Longrightarrow> q\<^sub>2 g\<^sub>2\<rightarrow>f\<^sub>2 q\<^sub>2' \<in> transitions \\<^sub>2 \<Longrightarrow> P"
  shows "P"
  using assms by (auto 4 0)

lemma wf_invariant_product [intro]:
  assumes
    \\<^sub>1_GA: "wf_guarded_automaton \\<^sub>1" and
    \\<^sub>2_GA: "wf_guarded_automaton \\<^sub>2"
  shows "wf_guarded_automaton (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
    using assms by (auto 0 0 simp add: wf_guarded_automaton_def, auto simp add: nonenabling_def)

lemma product_neutral_element:
  "wf_guarded_automaton \ \<Longrightarrow> \ \<sim> (\ \<times>\<^sub>\ (1\<^sub>\ x))" (is "_ \<Longrightarrow> _ \<sim> ?\
")
proof -
  assume wf_\: "wf_guarded_automaton \"
  let ?R = "{ (q,(q,x)) |q. q \<in> states \}"
  have "bisimulates ?R \ ?\
"
  proof (rule bisimulatesI)
    show "simulating {(q,q,x) |q. q \<in> states \} \ ?\
"
      by (rule simulatingI) (use wf_\ in \<open>auto simp add: nonenabling_def\<close>)
  qed (auto simp add: image_iff)
  thus ?thesis using bisimilar_def by blast
qed

lemma product_commutative:
  assumes
    \\<^sub>1_GA: "wf_guarded_automaton \\<^sub>1" and
    \\<^sub>2_GA: "wf_guarded_automaton \\<^sub>2"
  shows "(\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) \<sim> (\\<^sub>2 \<times>\<^sub>\ \\<^sub>1)" (is "?l \<sim> ?r")
proof -
  let ?R = "{ ((q\<^sub>1,q\<^sub>2), (q\<^sub>2,q\<^sub>1)) |q\<^sub>1 q\<^sub>2. (q\<^sub>1,q\<^sub>2) \<in> states ?l }"
  have "bisimulates ?R ?l ?r"
  proof (rule bisimulatesI)
    show "simulating ?R ?l ?r" by (rule simulatingI) (use assms in \<open>auto 0 3 simp add: sup_commute\<close>)
  qed (auto simp add: image_iff)
  thus ?thesis using bisimilar_def by blast
qed

lemma nonenabling_components_nonenabling_product:
  assumes
    wf_\\<^sub>1: "wf_guarded_automaton \\<^sub>1" and
    wf_\\<^sub>2: "wf_guarded_automaton \\<^sub>2" and
    g\<^sub>1_blocks: "g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#)" and
    g\<^sub>2_blocks: "g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)" and
    disjoint: "ports \\<^sub>1 \<inter> ports \\<^sub>2 = {}"
  shows "g\<^sub>1 \<union> g\<^sub>2 \<in> ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) (q\<^sub>1,q\<^sub>2)\<^sup>#)"
proof (rule ccontr)
  assume ass: "g\<^sub>1 \<union> g\<^sub>2 \<notin> ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) (q\<^sub>1, q\<^sub>2)\<^sup>#)"
  have "\<exists>q' f. (q\<^sub>1,q\<^sub>2) (g\<^sub>1 \<union> g\<^sub>2)\<rightarrow>f q' \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
    by (rule transition_if_not_nonenabling, use g\<^sub>1_blocks g\<^sub>2_blocks ass in \<open>auto simp add: nonenabling_def\<close>)
  then obtain q\<^sub>1' q\<^sub>2' f where "(q\<^sub>1,q\<^sub>2) (g\<^sub>1 \<union> g\<^sub>2)\<rightarrow>f (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)" by force
  thus False
  proof (cases rule: prod_transitionE)
    case (left_async g\<^sub>1' g\<^sub>2')
    hence g\<^sub>1'_blocks: "g\<^sub>1' \<notin> (\\<^sub>1 q\<^sub>1\<^sup>#)" by (auto simp add: nonenabling_def)
    have "g\<^sub>1 = g\<^sub>1'"
    proof (rule set_eqI, rule iffI)
      fix x
      assume "x \<in> g\<^sub>1"
      thus "x \<in> g\<^sub>1'"
        by (metis (no_types, lifting) DiffE IntI Pow_iff Un_iff disjoint emptyE g\<^sub>1_blocks left_async(2) left_async(4) nonenabling_def subsetCE)
    next
      fix x
      assume "x \<in> g\<^sub>1'"
      thus "x \<in> g\<^sub>1"
        using disjoint g\<^sub>2_blocks left_async(2) left_async(3) nonenabling_def wf_\\<^sub>1 wf_implies_wf_transitions(2) by fastforce
    qed
    thus ?thesis using g\<^sub>1_blocks g\<^sub>1'_blocks by blast
  next
    case (right_async g\<^sub>1' g\<^sub>2')
    hence g\<^sub>2'_blocks: "g\<^sub>2' \<notin> (\\<^sub>2 q\<^sub>2\<^sup>#)" by (auto simp add: nonenabling_def)
    have "g\<^sub>2 = g\<^sub>2'"
    proof (rule set_eqI, rule iffI)
      fix x
      assume "x \<in> g\<^sub>2"
      thus "x \<in> g\<^sub>2'"
        by (metis (no_types, lifting) DiffE IntI Pow_iff Un_iff disjoint emptyE g\<^sub>2_blocks insert_subset mk_disjoint_insert nonenabling_def right_async(2) right_async(4))
    next
      fix x
      assume "x \<in> g\<^sub>2'"
      thus "x \<in> g\<^sub>2"
        by (metis (no_types, lifting) DiffE Pow_iff UnE disjoint disjoint_iff_not_equal g\<^sub>1_blocks nonenabling_def right_async(2) right_async(3) subsetCE sup_commute sup_ge1 wf_\\<^sub>2 wf_implies_wf_transitions(2))
    qed
    thus ?thesis using g\<^sub>2_blocks g\<^sub>2'_blocks by blast
  next
    case (both_sync g\<^sub>1' g\<^sub>2' f\<^sub>1' f\<^sub>2')
    have g\<^sub>1_eq_g\<^sub>1': "g\<^sub>1 = g\<^sub>1'"
    proof (rule set_eqI, rule iffI)
      fix x
      assume "x \<in> g\<^sub>1"
      thus "x \<in> g\<^sub>1'"
        using both_sync(1) both_sync(4) disjoint g\<^sub>1_blocks wf_\\<^sub>2 wf_implies_wf_transitions(2) nonenabling_def by fastforce
    next
      fix x
      assume "x \<in> g\<^sub>1'"
      thus "x \<in> g\<^sub>1"
        by (metis (no_types, lifting) DiffE Pow_iff UnE both_sync(1) both_sync(3) disjoint disjoint_iff_not_equal g\<^sub>2_blocks nonenabling_def subset_iff sup_ge1 wf_\\<^sub>1 wf_implies_wf_transitions(2))
    qed
    have g\<^sub>2_eq_g\<^sub>2': "g\<^sub>2 = g\<^sub>2'" using both_sync(3) g\<^sub>1_blocks g\<^sub>1_eq_g\<^sub>1' by (auto simp add: nonenabling_def)
    show ?thesis using both_sync(4) g\<^sub>2_blocks g\<^sub>2_eq_g\<^sub>2' by (auto simp add: nonenabling_def)
  qed
qed

lemma prod_trans_leftI [intro]:
  assumes
    "g = left_guard \<union> right_guard" and
    "q\<^sub>1 left_guard\<rightarrow>f q\<^sub>1' \<in> transitions \\<^sub>1" and
    "q\<^sub>2 \<in> states \\<^sub>2" and
    "right_guard \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)" and
    "q\<^sub>2 = q\<^sub>2'"
  shows "(q\<^sub>1,q\<^sub>2) g\<rightarrow>f (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
  using assms by (auto simp add: nonenabling_def)

lemma prod_trans_rightI [intro]:
  assumes
    "g = left_guard \<union> right_guard" and
    "q\<^sub>2 right_guard\<rightarrow>f q\<^sub>2' \<in> transitions \\<^sub>2" and
    "q\<^sub>1 \<in> states \\<^sub>1" and
    "left_guard \<in> (\\<^sub>1 q\<^sub>1\<^sup>#)" and
    "q\<^sub>1 = q\<^sub>1'"
  shows "(q\<^sub>1,q\<^sub>2) g\<rightarrow>f (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
  using assms by auto

lemma prod_trans_bothI [intro]:
  assumes
    "g = left_guard \<union> right_guard" and
    "f = left_firing \<union> right_firing" and
    "q\<^sub>1 left_guard\<rightarrow>left_firing q\<^sub>1' \<in> transitions \\<^sub>1" and
    "q\<^sub>2 right_guard\<rightarrow>right_firing q\<^sub>2' \<in> transitions \\<^sub>2"
  shows "(q\<^sub>1,q\<^sub>2) g\<rightarrow>f (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
  using assms by (auto 0 5)

lemma tup_in_states [intro!]: "q\<^sub>1 \<in> states \\<^sub>1 \<Longrightarrow> q\<^sub>2 \<in> states \\<^sub>2 \<Longrightarrow> (q\<^sub>1, q\<^sub>2) \<in> states (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
  by auto

lemma nonenabling_product_simp [simp]:
  assumes
    wf_\\<^sub>1: "wf_guarded_automaton \\<^sub>1" and
    wf_\\<^sub>2: "wf_guarded_automaton \\<^sub>2" and
    q\<^sub>1_in: "q\<^sub>1 \<in> states \\<^sub>1" and
    q\<^sub>2_in: "q\<^sub>2 \<in> states \\<^sub>2" and
    disjoint: "ports \\<^sub>1 \<inter> ports \\<^sub>2 = {}"
  shows "((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) (q\<^sub>1,q\<^sub>2)\<^sup>#) = { g\<^sub>1 \<union> g\<^sub>2 |g\<^sub>1 g\<^sub>2. g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#) \<and> g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#) }" (is "?l = ?r")
proof (rule set_eqI, rule iffI)
  fix g
  assume g_in: "g \<in> ?l"
  have "g \<subseteq> ports (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)" using g_in by (simp add: nonenabling_def)
  then obtain g\<^sub>1 g\<^sub>2 where g\<^sub>1_sub: "g\<^sub>1 \<subseteq> ports \\<^sub>1" and g\<^sub>2_sub: "g\<^sub>2 \<subseteq> ports \\<^sub>2" and g_eq: "g = g\<^sub>1 \<union> g\<^sub>2"
    using g_in apply auto
    by (metis inf.absorb_iff1 inf.cobounded2 inf_sup_distrib1)
  have g\<^sub>1_in: "g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#)"
  proof (rule ccontr)
    assume "g\<^sub>1 \<notin> (\\<^sub>1 q\<^sub>1\<^sup>#)"
    then obtain f\<^sub>1 q\<^sub>1' where left_fires: "q\<^sub>1 g\<^sub>1\<rightarrow>f\<^sub>1 q\<^sub>1' \<in> transitions \\<^sub>1" by (auto simp add: g\<^sub>1_sub nonenabling_def)
    show False
    proof (cases "g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)")
      case True
      have "(q\<^sub>1,q\<^sub>2) (g\<^sub>1 \<union> g\<^sub>2)\<rightarrow>f\<^sub>1 (q\<^sub>1',q\<^sub>2) \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
        using left_fires q\<^sub>2_in g\<^sub>2_sub True by auto
      hence "g\<^sub>1 \<union> g\<^sub>2 \<notin> ?l" by (meson transition_iff_not_nonenabling wf_\\<^sub>1 wf_\\<^sub>2 wf_invariant_product)
      thus ?thesis using g_eq g_in by blast
    next
      case False
      then obtain f\<^sub>2 q\<^sub>2' where right_fires: "q\<^sub>2 g\<^sub>2\<rightarrow>f\<^sub>2 q\<^sub>2' \<in> transitions \\<^sub>2" by (auto simp add: g\<^sub>2_sub nonenabling_def)
      hence "(q\<^sub>1,q\<^sub>2) (g\<^sub>1 \<union> g\<^sub>2)\<rightarrow>(f\<^sub>1 \<union> f\<^sub>2) (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
        using left_fires by blast
      hence "g\<^sub>1 \<union> g\<^sub>2 \<notin> ?l" by (meson transition_iff_not_nonenabling wf_\\<^sub>1 wf_\\<^sub>2 wf_invariant_product)
      thus ?thesis using g_eq g_in by blast
    qed
  qed
  have g\<^sub>2_in: "g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)"
  proof (rule ccontr)
    assume "g\<^sub>2 \<notin> (\\<^sub>2 q\<^sub>2\<^sup>#)"
    then obtain f\<^sub>2 q\<^sub>2' where right_fires: "q\<^sub>2 g\<^sub>2\<rightarrow>f\<^sub>2 q\<^sub>2' \<in> transitions \\<^sub>2" by (auto simp add: g\<^sub>2_sub nonenabling_def)
    hence "(q\<^sub>1,q\<^sub>2) (g\<^sub>1 \<union> g\<^sub>2)\<rightarrow>f\<^sub>2 (q\<^sub>1,q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)" using g\<^sub>1_in q\<^sub>1_in by blast
    hence "g\<^sub>1 \<union> g\<^sub>2 \<notin> ?l" by (meson transition_iff_not_nonenabling wf_\\<^sub>1 wf_\\<^sub>2 wf_invariant_product)
    thus False using g_eq g_in by blast
  qed
  show "g \<in> ?r" using g\<^sub>1_in g\<^sub>2_in g_eq by blast
next
  fix g
  assume "g \<in> ?r"
  then obtain g\<^sub>1 g\<^sub>2 where g\<^sub>1_in: "g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#)" and g\<^sub>2_in: "g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)" and g_eq: "g = g\<^sub>1 \<union> g\<^sub>2"
    by blast
  thus "g \<in> ?l" by (meson disjoint nonenabling_components_nonenabling_product wf_\\<^sub>1 wf_\\<^sub>2)
qed

(*
lemma in_component_in_product [intro]:
  assumes
    \\<^sub>1_step: "q\<^sub>1 g\<^sub>1\<rightarrow>f\<^sub>1 q\<^sub>1' \<in> transitions \\<^sub>1" and
    wf_\\<^sub>2: "wf_guarded_automaton \\<^sub>2"
  shows "\<exists>q\<^sub>2 g\<^sub>2 f\<^sub>2 q\<^sub>2'. (q\<^sub>1,q\<^sub>2) (g\<^sub>1 \<union> g\<^sub>2)\<rightarrow>(f\<^sub>1 \<union> f\<^sub>2) (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
proof (cases "(transitions \\<^sub>2) = {}")
  case True
  obtain q\<^sub>2 where q\<^sub>2_in: "q\<^sub>2 \<in> states \\<^sub>2" by (meson ex_in_conv wf_\\<^sub>2 wf_guarded_automaton_def)
  have "{} \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)" by (simp add: True nonenabling_def)
  hence "(q\<^sub>1,q\<^sub>2) (g\<^sub>1 \<union> {})\<rightarrow>(f\<^sub>1 \<union> {}) (q\<^sub>1',q\<^sub>2) \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
    using q\<^sub>2_in \\<^sub>1_step by (auto simp add: nonenabling_def)
  then show ?thesis by blast
next
  case False
  obtain q\<^sub>2 g\<^sub>2 f\<^sub>2 q\<^sub>2' where "q\<^sub>2 g\<^sub>2\<rightarrow>f\<^sub>2 q\<^sub>2' \<in> transitions \\<^sub>2" by (metis False equals0I transition.cases)
  then show ?thesis by (meson \\<^sub>1_step prod_trans_bothI)
qed
*)

lemma nonenabling_product_components [intro]:
  assumes
    wf_\\<^sub>1: "wf_guarded_automaton \\<^sub>1" and
    wf_\\<^sub>2: "wf_guarded_automaton \\<^sub>2" and
    q\<^sub>1_in: "q\<^sub>1 \<in> states \\<^sub>1" and
    q\<^sub>2_in: "q\<^sub>2 \<in> states \\<^sub>2" and
    g_in: "g \<in> ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) (q\<^sub>1,q\<^sub>2)\<^sup>#)" and
    disjoint: "ports \\<^sub>1 \<inter> ports \\<^sub>2 = {}"
  shows
    "\<exists>g\<^sub>1 g\<^sub>2. g = g\<^sub>1 \<union> g\<^sub>2 \<and> g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#) \<and> g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)"
proof -
  have "((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) (q\<^sub>1,q\<^sub>2)\<^sup>#) = { g\<^sub>1 \<union> g\<^sub>2 |g\<^sub>1 g\<^sub>2. g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#) \<and> g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#) }"
    by (rule nonenabling_product_simp[OF wf_\\<^sub>1 wf_\\<^sub>2 q\<^sub>1_in q\<^sub>2_in disjoint])
  thus ?thesis using g_in by blast
qed

lemma product_associative:
  assumes
    \\<^sub>1_GA: "wf_guarded_automaton \\<^sub>1" and
    \\<^sub>2_GA: "wf_guarded_automaton \\<^sub>2" and
    \\<^sub>3_GA: "wf_guarded_automaton \\<^sub>3" and
    \\<^sub>1_\\<^sub>2_disjoint: "ports \\<^sub>1 \<inter> ports \\<^sub>2 = {}" and
    \\<^sub>2_\\<^sub>3_disjoint: "ports \\<^sub>2 \<inter> ports \\<^sub>3 = {}" and
    \\<^sub>1_\\<^sub>3_disjoint: "ports \\<^sub>1 \<inter> ports \\<^sub>3 = {}"
  shows "((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) \<times>\<^sub>\ \\<^sub>3) \<sim> (\\<^sub>1 \<times>\<^sub>\ (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3))" (is "?l \<sim> ?r")
proof -
  let ?R = "{ (((q\<^sub>1,q\<^sub>2),q\<^sub>3), (q\<^sub>1,(q\<^sub>2,q\<^sub>3))) |q\<^sub>1 q\<^sub>2 q\<^sub>3. ((q\<^sub>1,q\<^sub>2),q\<^sub>3) \<in> states ?l }"
  have R_bisim: "bisimulates ?R ?l ?r"
  proof (rule bisimulatesI)
    show "ports ?l = ports ?r" by auto
    show "?R \<subseteq> states ?l \<times> states ?r" by auto
    show "states ?l \<subseteq> fst ` ?R" by (auto simp add: image_iff)
    show "states ?r \<subseteq> snd ` ?R" by (auto simp add: image_iff)
    show "simulating ?R ?l ?r"
    proof (rule simulatingI, rule conjI; rule impI)
      fix left_triple right_triple g f
      assume in_R: "(left_triple, right_triple) \<in> ?R"
      from in_R obtain q\<^sub>1 q\<^sub>2 q\<^sub>3 where
        l_def: "left_triple = ((q\<^sub>1,q\<^sub>2),q\<^sub>3)" and
        r_def: "right_triple = (q\<^sub>1,(q\<^sub>2,q\<^sub>3))" by blast
      {
      fix left_triple'
      assume left_trans: "left_triple g\<rightarrow>f left_triple' \<in> transitions ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) \<times>\<^sub>\ \\<^sub>3)"
      from left_trans obtain q\<^sub>1' q\<^sub>2' q\<^sub>3' where
        l'_def: "left_triple'= ((q\<^sub>1',q\<^sub>2'),q\<^sub>3')" by auto
      from left_trans have
        left_trans_unfolded: "((q\<^sub>1,q\<^sub>2),q\<^sub>3) g\<rightarrow>f ((q\<^sub>1',q\<^sub>2'),q\<^sub>3') \<in> transitions ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) \<times>\<^sub>\ \\<^sub>3)"
        by (simp add: l_def l'_def)
      have q\<^sub>1_in: "q\<^sub>1 \<in> states \\<^sub>1" using \\<^sub>1_GA left_trans_unfolded by auto
      have q\<^sub>2_in: "q\<^sub>2 \<in> states \\<^sub>2" using \\<^sub>2_GA \\<^sub>3_GA left_trans_unfolded by auto
      have q\<^sub>3_in: "q\<^sub>3 \<in> states \\<^sub>3" using \\<^sub>2_GA \\<^sub>3_GA left_trans_unfolded by auto
      have targets_in_R: "(left_triple', (q\<^sub>1',(q\<^sub>2',q\<^sub>3'))) \<in> ?R"
        using \\<^sub>1_GA \\<^sub>2_GA \\<^sub>3_GA l'_def left_trans by auto
      have right_trans: "(q\<^sub>1,(q\<^sub>2,q\<^sub>3)) g\<rightarrow>f (q\<^sub>1',(q\<^sub>2',q\<^sub>3')) \<in> transitions (\\<^sub>1 \<times>\<^sub>\ (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3))"
      proof (use left_trans_unfolded in \<open>cases rule: prod_transitionE\<close>)
        case (left_async g\<^sub>1g\<^sub>2 g\<^sub>3)
        then show ?thesis
        proof (use left_async(3) in \<open>cases rule: prod_transitionE\<close>)
          case \\<^sub>1_only: (left_async g\<^sub>1 g\<^sub>2)
          show ?thesis
          proof (rule prod_trans_leftI[where left_guard=g\<^sub>1 and right_guard="g\<^sub>2 \<union> g\<^sub>3"])
            show "g\<^sub>2 \<union> g\<^sub>3 \<in> ((\\<^sub>2 \<times>\<^sub>\ \\<^sub>3) (q\<^sub>2, q\<^sub>3)\<^sup>#)"
              by (meson \\<^sub>1_only(4) \\<^sub>2_GA \\<^sub>3_GA \\<^sub>2_\\<^sub>3_disjoint left_async(4) nonenabling_components_nonenabling_product)
          qed (use q\<^sub>2_in q\<^sub>3_in \\<^sub>1_only left_async in auto)
        next
          case (right_async g\<^sub>1 g\<^sub>2)
          show ?thesis
          proof (rule prod_trans_rightI[where left_guard=g\<^sub>1 and right_guard="g\<^sub>2 \<union> g\<^sub>3"])
            show "(q\<^sub>2, q\<^sub>3) (g\<^sub>2 \<union> g\<^sub>3)\<rightarrow>f (q\<^sub>2', q\<^sub>3') \<in> transitions (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3)"
              by (rule prod_trans_leftI[where left_guard=g\<^sub>2 and right_guard=g\<^sub>3], use right_async left_async q\<^sub>3_in in auto)
          qed (use q\<^sub>1_in right_async left_async in auto)
        next
          case (both_sync g\<^sub>1 g\<^sub>2 f\<^sub>1 f\<^sub>2)
          show ?thesis
          proof (rule prod_trans_bothI[where left_guard=g\<^sub>1 and right_guard="g\<^sub>2 \<union> g\<^sub>3" and left_firing=f\<^sub>1 and right_firing=f\<^sub>2])
            show "(q\<^sub>2, q\<^sub>3) (g\<^sub>2 \<union> g\<^sub>3)\<rightarrow>f\<^sub>2 (q\<^sub>2', q\<^sub>3') \<in> transitions (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3)"
              by (rule prod_trans_leftI[where left_guard=g\<^sub>2 and right_guard=g\<^sub>3], use both_sync left_async q\<^sub>3_in in auto)
          qed (use both_sync left_async in auto)
        qed
      next
        case (right_async g\<^sub>1g\<^sub>2 g\<^sub>3)
        obtain g\<^sub>1 g\<^sub>2 where
          g\<^sub>1g\<^sub>2_eq: "g\<^sub>1g\<^sub>2 = g\<^sub>1 \<union> g\<^sub>2" and
          g\<^sub>1_nonenabling: "g\<^sub>1 \<in> (\\<^sub>1 q\<^sub>1\<^sup>#)" and
          g\<^sub>2_nonenabling: "g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)"
          by (meson \\<^sub>1_GA \\<^sub>1_\\<^sub>2_disjoint \\<^sub>2_GA nonenabling_product_components q\<^sub>1_in q\<^sub>2_in right_async(4))
        show ?thesis
        proof (rule prod_trans_rightI[where left_guard=g\<^sub>1 and right_guard="g\<^sub>2 \<union> g\<^sub>3"])
          show "(q\<^sub>2,q\<^sub>3) (g\<^sub>2 \<union> g\<^sub>3)\<rightarrow>f (q\<^sub>2',q\<^sub>3') \<in> transitions (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3)"
            by (rule prod_trans_rightI[where left_guard=g\<^sub>2 and right_guard=g\<^sub>3],
              use g\<^sub>1g\<^sub>2_eq right_async q\<^sub>2_in g\<^sub>2_nonenabling in auto)
        qed (use g\<^sub>1g\<^sub>2_eq right_async q\<^sub>1_in g\<^sub>1_nonenabling in auto)
      next
        case (both_sync g\<^sub>1g\<^sub>2 g\<^sub>3 f\<^sub>1f\<^sub>2 f\<^sub>3)
        then show ?thesis
        proof (use both_sync(3) in \<open>cases rule: prod_transitionE\<close>)
          case (left_async g\<^sub>1 g\<^sub>2)
          show ?thesis
            by (rule prod_trans_bothI[where left_guard=g\<^sub>1 and right_guard="g\<^sub>3 \<union> g\<^sub>2" and left_firing=f\<^sub>1f\<^sub>2 and right_firing=f\<^sub>3],
            use both_sync left_async q\<^sub>2_in in auto)
        next
          case (right_async g\<^sub>1 g\<^sub>2)
           show ?thesis
             by (rule prod_trans_rightI[where left_guard=g\<^sub>1 and right_guard="g\<^sub>2 \<union> g\<^sub>3"],
             use both_sync right_async q\<^sub>1_in sup_assoc in auto)
        next
          case both_sync': (both_sync g\<^sub>1 g\<^sub>2 f\<^sub>1 f\<^sub>2)
          show ?thesis
            by (rule prod_trans_bothI[where left_guard="g\<^sub>1" and right_guard="g\<^sub>2 \<union> g\<^sub>3" and left_firing="f\<^sub>1" and right_firing="f\<^sub>2 \<union> f\<^sub>3"],
            use both_sync both_sync'  sup_assoc in auto)
        qed
      qed
      show "\<exists>right_triple'. right_triple g\<rightarrow>f right_triple' \<in> transitions (\\<^sub>1 \<times>\<^sub>\ (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3)) \<and>
          (left_triple', right_triple') \<in> ?R"
        using r_def right_trans targets_in_R by blast
      }
      fix right_triple'
      assume right_trans: "right_triple g\<rightarrow>f right_triple' \<in> transitions (\\<^sub>1 \<times>\<^sub>\ (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3))"
      from right_trans obtain q\<^sub>1' q\<^sub>2' q\<^sub>3' where
          r'_def: "right_triple'= (q\<^sub>1',q\<^sub>2',q\<^sub>3')" by auto
      from right_trans have
        right_trans_unfolded: "(q\<^sub>1,q\<^sub>2,q\<^sub>3) g\<rightarrow>f (q\<^sub>1',q\<^sub>2',q\<^sub>3') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ (\\<^sub>2 \<times>\<^sub>\ \\<^sub>3))"
        by (simp add: r_def r'_def)
      have q\<^sub>1_in: "q\<^sub>1 \<in> states \\<^sub>1" using \\<^sub>1_GA right_trans_unfolded by auto
      have q\<^sub>2_in: "q\<^sub>2 \<in> states \\<^sub>2" using \\<^sub>2_GA \\<^sub>3_GA right_trans_unfolded by auto
      have q\<^sub>3_in: "q\<^sub>3 \<in> states \\<^sub>3" using \\<^sub>2_GA \\<^sub>3_GA right_trans_unfolded by auto
      have targets_in_R: "(((q\<^sub>1',q\<^sub>2'),q\<^sub>3'), (q\<^sub>1',(q\<^sub>2',q\<^sub>3'))) \<in> ?R"
        using \\<^sub>1_GA \\<^sub>2_GA \\<^sub>3_GA r'_def right_trans by auto
      have left_trans: "((q\<^sub>1,q\<^sub>2),q\<^sub>3) g\<rightarrow>f ((q\<^sub>1',q\<^sub>2'), q\<^sub>3') \<in> transitions ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) \<times>\<^sub>\ \\<^sub>3)"
      proof (use right_trans_unfolded in \<open>cases rule: prod_transitionE\<close>)
        case (left_async g\<^sub>1 g\<^sub>2g\<^sub>3)
        obtain g\<^sub>2 g\<^sub>3 where
            g\<^sub>2g\<^sub>3_eq: "g\<^sub>2g\<^sub>3 = g\<^sub>2 \<union> g\<^sub>3" and
            g\<^sub>2_nonenabling: "g\<^sub>2 \<in> (\\<^sub>2 q\<^sub>2\<^sup>#)" and
            g\<^sub>3_nonenabling: "g\<^sub>3 \<in> (\\<^sub>3 q\<^sub>3\<^sup>#)"
          by (meson \\<^sub>2_GA \\<^sub>2_\\<^sub>3_disjoint \\<^sub>3_GA left_async(4) nonenabling_product_components q\<^sub>2_in q\<^sub>3_in)
        show ?thesis
        proof (rule prod_trans_leftI[where left_guard="g\<^sub>1 \<union> g\<^sub>2" and right_guard="g\<^sub>3"])
          show "(q\<^sub>1, q\<^sub>2) (g\<^sub>1 \<union> g\<^sub>2)\<rightarrow>f (q\<^sub>1', q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
            by (rule prod_trans_leftI[where left_guard=g\<^sub>1 and right_guard=g\<^sub>2],
              use left_async q\<^sub>2_in g\<^sub>2_nonenabling in auto)
        qed (use g\<^sub>2g\<^sub>3_eq left_async q\<^sub>3_in g\<^sub>3_nonenabling in auto)
      next
        case (right_async g\<^sub>1 g\<^sub>2g\<^sub>3)
        show ?thesis
        proof (use right_async(3) in \<open>cases rule: prod_transitionE\<close>)
          case (left_async g\<^sub>2 g\<^sub>3)
          show ?thesis
            by (rule prod_trans_leftI[where left_guard="g\<^sub>1 \<union> g\<^sub>2" and right_guard="g\<^sub>3"],
              use left_async right_async q\<^sub>1_in q\<^sub>3_in in auto)
      next
        case right_async': (right_async g\<^sub>2 g\<^sub>3)
        have g\<^sub>1g\<^sub>2_in: "g\<^sub>1 \<union> g\<^sub>2 \<in> ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) (q\<^sub>1, q\<^sub>2)\<^sup>#)"
          by (meson \\<^sub>1_GA \\<^sub>1_\\<^sub>2_disjoint \\<^sub>2_GA nonenabling_components_nonenabling_product right_async'(4) right_async(4))
        show ?thesis
          by (rule prod_trans_rightI[where left_guard="g\<^sub>1 \<union> g\<^sub>2" and right_guard="g\<^sub>3"],
            use q\<^sub>1_in q\<^sub>2_in g\<^sub>1g\<^sub>2_in right_async right_async' sup_assoc in auto)
      next
        case (both_sync g\<^sub>2 g\<^sub>3 f\<^sub>2 f\<^sub>3)
        show ?thesis
          by (rule prod_trans_bothI[where left_guard="g\<^sub>1 \<union> g\<^sub>2" and right_guard=g\<^sub>3 and left_firing=f\<^sub>2 and right_firing=f\<^sub>3],
          use both_sync right_async sup_assoc q\<^sub>1_in in auto)
      qed
    next
      case (both_sync g\<^sub>1 g\<^sub>2g\<^sub>3 f\<^sub>1 f\<^sub>2f\<^sub>3)
      then show ?thesis
      proof (use both_sync(4) in \<open>cases rule: prod_transitionE\<close>)
        case (left_async g\<^sub>2 g\<^sub>3)
        show ?thesis
          by (rule prod_trans_leftI[where left_guard="g\<^sub>1 \<union> g\<^sub>2" and right_guard=g\<^sub>3],
            use both_sync left_async sup_assoc q\<^sub>3_in in auto)
      next
        case (right_async g\<^sub>2 g\<^sub>3)
        show ?thesis
          by (rule prod_trans_bothI[where left_guard="g\<^sub>1 \<union> g\<^sub>2" and right_guard=g\<^sub>3 and left_firing=f\<^sub>1 and right_firing=f\<^sub>2f\<^sub>3],
            use both_sync right_async sup_assoc q\<^sub>2_in in auto)
      next
        case both_sync': (both_sync g\<^sub>2 g\<^sub>3 f\<^sub>2 f\<^sub>3)
        show ?thesis
          by (rule prod_trans_bothI[where left_guard="g\<^sub>1 \<union> g\<^sub>2" and right_guard=g\<^sub>3 and left_firing="f\<^sub>1 \<union> f\<^sub>2" and right_firing=f\<^sub>3],
            use both_sync both_sync' sup_assoc in auto)
        qed
      qed
      show "\<exists>left_triple'. left_triple g\<rightarrow>f left_triple' \<in> transitions ((\\<^sub>1 \<times>\<^sub>\ \\<^sub>2) \<times>\<^sub>\ \\<^sub>3) \<and>
          (left_triple', right_triple') \<in> ?R"
        using l_def left_trans r'_def targets_in_R by blast
    qed
  qed
  show ?thesis using R_bisim bisimilar_def by blast
qed

subsection ReoAutomata

definition reactive :: "('\<Sigma>, 'Q) guarded_automaton \<Rightarrow> bool" where
  "reactive \ = (\<forall>t. t \<in> transitions \ \<longrightarrow> firings t \<subseteq> guard t)"

lemma reactiveI [intro]: "(\<And>t. t \<in> transitions \ \<Longrightarrow> firings t \<subseteq> guard t) \<Longrightarrow> reactive \"
  by (simp add: reactive_def)

(* removing unfired requests does not LOSE firing behaviour ? *)

definition uniform :: "('\<Sigma>, 'Q) guarded_automaton \<Rightarrow> bool" where
  "uniform \ = True"

lemma uniformI [intro, simp]: "uniform \"
  by (simp add: uniform_def)
(*

definition uniform :: "('\<Sigma>, 'Q) guarded_automaton \<Rightarrow> bool" where
  "uniform \ = (\<forall>q q' g f g'. q g\<rightarrow>f q' \<in> transitions \ \<and> f \<subseteq> g' \<and> g' \<subseteq> g \<longrightarrow> q g'\<rightarrow>f q' \<in> transitions \)"

lemma uniformI [intro]:
  "(\<And>q g f q' g'. q g\<rightarrow>f q' \<in> transitions \ \<Longrightarrow> f \<subseteq> g' \<Longrightarrow> g' \<subseteq> g \<Longrightarrow> q g'\<rightarrow>f q' \<in> transitions \) \<Longrightarrow> uniform \"
  using uniform_def by force

lemma trans_by_uniformity [intro]:
  "uniform \ \<Longrightarrow> q g\<rightarrow>f q' \<in> transitions \ \<Longrightarrow> f \<subseteq> g' \<Longrightarrow> g' \<subseteq> g \<Longrightarrow> q g'\<rightarrow>f q' \<in> transitions \"
  by (auto simp add: uniform_def)
*)

definition reo_automaton :: "('\<Sigma>, 'Q) guarded_automaton \<Rightarrow> bool"  where
  "reo_automaton \ = (wf_guarded_automaton \ \<and> reactive \ \<and> uniform \)"

lemma reo_automatonE1 [intro]: "reo_automaton \ \<Longrightarrow> q g\<rightarrow>f q' \<in> transitions \ \<Longrightarrow> f \<subseteq> g"
  using reactive_def reo_automaton_def by fastforce

lemma reo_automatonI [intro]: "wf_guarded_automaton \ \<Longrightarrow> reactive \ \<Longrightarrow> uniform \ \<Longrightarrow> reo_automaton \"
  by (simp add: reo_automaton_def)

lemma reo_automatonD [dest]:
  assumes "reo_automaton \"
  shows "wf_guarded_automaton \" "reactive \" "uniform \"
  using assms by (auto simp add: reo_automaton_def)

lemma reo_automaton_closed_product:
  assumes
    reo_\\<^sub>1: "reo_automaton \\<^sub>1" and
    reo_\\<^sub>2: "reo_automaton \\<^sub>2" and
    disjoint: "ports \\<^sub>1 \<inter> ports \\<^sub>2 = {}"
  shows "reo_automaton (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
proof (rule reo_automatonI)
  have wf_\\<^sub>1: "wf_guarded_automaton \\<^sub>1" by (meson reo_\\<^sub>1 reo_automaton_def)
  have wf_\\<^sub>2: "wf_guarded_automaton \\<^sub>2" by (meson reo_\\<^sub>2 reo_automaton_def)
  show "wf_guarded_automaton (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)" by (meson wf_\\<^sub>1 wf_\\<^sub>2 wf_invariant_product)
  show "reactive (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
  proof (rule reactiveI)
    fix t
    assume t_in: "t \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)"
    obtain q\<^sub>1 q\<^sub>2 q\<^sub>1' q\<^sub>2' g f where t_def: "t = (q\<^sub>1,q\<^sub>2) g\<rightarrow>f (q\<^sub>1',q\<^sub>2')" by (metis surj_pair transition.cases)
    have t_unfolded: "(q\<^sub>1,q\<^sub>2) g\<rightarrow>f (q\<^sub>1',q\<^sub>2') \<in> transitions (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)" using t_def t_in by blast
    show "firings t \<subseteq> guard t"
    proof (use t_unfolded in \<open>cases rule: prod_transitionE\<close>)
      case (left_async g\<^sub>1 g\<^sub>2)
      have "f \<subseteq> g\<^sub>1" by (meson left_async(3) reo_\\<^sub>1 reo_automatonE1)
      then show ?thesis by (simp add: left_async(2) sup.coboundedI1 t_def)
    next
      case (right_async g\<^sub>1 g\<^sub>2)
      have "f \<subseteq> g\<^sub>2" by (meson right_async(3) reo_\\<^sub>2 reo_automatonE1)
      then show ?thesis by (simp add: right_async(2) sup.coboundedI2 t_def)
    next
      case (both_sync g\<^sub>1 g\<^sub>2 f\<^sub>1 f\<^sub>2)
      then show ?thesis
        by (metis Un_mono reo_\\<^sub>1 reo_\\<^sub>2 reo_automatonE1 t_def transition.select_convs(2) transition.select_convs(3))
    qed
  qed
  show "uniform (\\<^sub>1 \<times>\<^sub>\ \\<^sub>2)" by simp
qed

fun synchronize where
  "synchronize a b \ = \<lparr> ports = ports \ - {a,b}, states = states \,
     transitions = { q (g - {a,b})\<rightarrow>(f - {a,b}) q' |q g f q'. (q g\<rightarrow>f q' \<in> transitions \) \<and> ((a \<in> f) = (b \<in> f)) \<and> (a \<in> g \<or> b \<in> g) } \<rparr>"

lemma "distinct [a,b,c,d] \<Longrightarrow> (synchronize b c ((sync a b q\<^sub>1) \<times>\<^sub>\ (sync c d q\<^sub>2))) = (sync a d (q\<^sub>1,q\<^sub>2))"
  apply auto
  apply (rule exI[where x="{a,b,c,d}"])
  apply (rule conjI)
   apply blast
  apply (rule exI[where x="{a,b,c,d}"])
  apply (rule conjI)
   apply blast
  apply (rule conjI)
  by blast+

lemma reo_automaton_closed_synchronization:
  assumes
    is_reo: "reo_automaton \" and
    a_port: "a \<in> ports \" and
    b_port: "b \<in> ports \"
  shows "reo_automaton (synchronize a b \)"
proof (rule reo_automatonI)
  have \_wf: "wf_guarded_automaton \" by (meson is_reo reo_automaton_def)
  show "wf_guarded_automaton (synchronize a b \)"
  proof (rule wf_guarded_automatonI)
    show "finite (ports (synchronize a b \))" using \_wf wf_guarded_automaton_def by auto
    show "finite (states (synchronize a b \))" using \_wf wf_guarded_automaton_def by auto
    show "source ` transitions (synchronize a b \) \<subseteq> states (synchronize a b \)"
      using \_wf wf_implies_wf_transitions(1) by auto
    show "\<Union>(guard ` transitions (synchronize a b \)) \<subseteq> ports (synchronize a b \)"
      apply auto
      using \_wf by blast+
    show "\<Union> (firings ` transitions (synchronize a b \)) \<subseteq> ports (synchronize a b \)"
      apply auto
      using \_wf by blast+
    show "target ` transitions (synchronize a b \) \<subseteq> states (synchronize a b \)"
      apply auto
      using \_wf by blast+
    show "states (synchronize a b \) \<noteq> {}" using \_wf wf_guarded_automaton_def by auto
  qed
  show "reactive (synchronize a b \)"
    apply (rule reactiveI)
    apply auto
    by (meson is_reo reo_automatonE1 subsetCE)+
  show "uniform (synchronize a b \)" by blast
qed

(*
fun synchronize where
  "synchronize a b \ = \<lparr> ports = ports \ - {a,b}, states = states \,
     transitions = { q (g - {a,b})\<rightarrow>(f - {a,b}) q' |q g f q'. (q g\<rightarrow>f q' \<in> transitions \) \<and> ((a \<in> f) = (b \<in> f)) \<and> (a \<in> g \<or> b \<in> g) } \<rparr>"
*)

lemma wooo:
  assumes
    sync_trans: "q g\<rightarrow>f q' \<in> transitions (synchronize a b \)"
  shows "q (g \<union> {a})\<rightarrow>f q' \<in> transitions \ \<or> q (g \<union> {b})\<rightarrow>f q' \<in> transitions \ \<or> q (g \<union> {a,b})\<rightarrow>f q' \<in> transitions \ \<or>
  q (g \<union> {a})\<rightarrow>(f \<union> {a,b}) q' \<in> transitions \ \<or> q (g \<union> {b})\<rightarrow>(f \<union> {a,b}) q' \<in> transitions \ \<or> q (g \<union> {a,b})\<rightarrow>(f \<union> {a,b}) q' \<in> transitions \"
proof -
  obtain  g' f'  where
    x: "q g'\<rightarrow>f' q' \<in> transitions \" and
    "(a \<in> f') = (b \<in> f')" and
    "a \<in> g' \<or> b \<in> g'" and
    "f = f' - {a,b}" and
    "g = g' - {a,b}"
    using sync_trans by auto
  have y: "f' = f \<or> f' = f \<union> {a,b}"
    using \<open>(a \<in> f') = (b \<in> f')\<close> \<open>f = f' - {a, b}\<close> by auto
  have z: "g' = g \<union> {a} \<or> g' = g \<union> {b} \<or> g' = g \<union> {a,b}"
    using \<open>a \<in> g' \<or> b \<in> g'\<close> \<open>g = g' - {a, b}\<close> by auto
  show ?thesis using x y z by blast
qed

lemma sync_trans_elim [elim, consumes 1]:
  assumes
    "q g\<rightarrow>f q' \<in> transitions (synchronize a b \)" and
    "q (g \<union> {a})\<rightarrow>f q' \<in> transitions \ \<Longrightarrow> P" and
    "q (g \<union> {b})\<rightarrow>f q' \<in> transitions \ \<Longrightarrow> P" and
    "q (g \<union> {a,b})\<rightarrow>f q' \<in> transitions \ \<Longrightarrow> P" and
    "q (g \<union> {a})\<rightarrow>(f \<union> {a,b}) q' \<in> transitions \ \<Longrightarrow> P" and
    "q (g \<union> {b})\<rightarrow>(f \<union> {a,b}) q' \<in> transitions \ \<Longrightarrow> P" and
    "q (g \<union> {a,b})\<rightarrow>(f \<union> {a,b}) q' \<in> transitions \ \<Longrightarrow> P"
  shows P
  by (meson assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) wooo)

(*
fun synchronize where
  "synchronize a b \ = \<lparr> ports = ports \ - {a,b}, states = states \,
     transitions = { q (g - {a,b})\<rightarrow>(f - {a,b}) q' |q g f q'. (q g\<rightarrow>f q' \<in> transitions \) \<and> ((a \<in> f) = (b \<in> f)) \<and> (a \<in> g \<or> b \<in> g) } \<rparr>"
*)

lemma synchronization_commutative:
  assumes
    "reo_automaton \" and
    "a \<in> ports \" and
    "b \<in> ports \" and
    "c \<in> ports \" and
    "d \<in> ports \" and
    "distinct [a,b,c,d]"
  shows "synchronize a b (synchronize c d \) = synchronize c d (synchronize a b \)" (is "?l = ?r")
proof -
  have "states ?l = states ?r" by auto
  have "ports ?l = ports ?r" by auto
  have "transitions ?l = transitions ?r"
  proof -
    have "transitions (synchronize a b (synchronize c d \)) =
  { q (g - {a,b})\<rightarrow>(f - {a,b}) q' |q g f q'. (q g\<rightarrow>f q' \<in> transitions (synchronize c d \)) \<and> ((a \<in> f) = (b \<in> f)) \<and> (a \<in> g \<or> b \<in> g) }"
      by simp
    have "transitions (synchronize c d \) =
 { q (g - {c,d})\<rightarrow>(f - {c,d}) q' |q g f q'. (q g\<rightarrow>f q' \<in> transitions \) \<and> ((c \<in> f) = (d \<in> f)) \<and> (c \<in> g \<or> d \<in> g) }"
      by simp
    have "transitions (synchronize a b (synchronize c d \)) =
 { q (g - {a,b,c,d})\<rightarrow>(f - {a,b,c,d}) q' |q g f q'. (q g\<rightarrow>f q' \<in> transitions \) \<and> ((a \<in> f) = (b \<in> f)) \<and> ((c \<in> f) = (d \<in> f)) \<and> (a \<in> g \<or> b \<in> g) \<and> (c \<in> g \<or> d \<in> g) }"

  proof (rule set_eqI, rule iffI)
    fix t
    assume t_in: "t \<in> transitions (synchronize a b (synchronize c d \))"
    obtain q g f q' where t_def: "t = q g\<rightarrow>f q'" using transition.cases by blast
    have t_in': "q g\<rightarrow>f q' \<in> transitions (synchronize a b (synchronize c d \))" using t_in t_def by auto
    have "a \<notin> f" using mem_Collect_eq t_def t_in by auto
    have "b \<notin> f" using mem_Collect_eq t_def t_in by auto
    have "a \<notin> g" using mem_Collect_eq t_def t_in by auto
    have "b \<notin> g" using mem_Collect_eq t_def t_in by auto
    have "q g\<rightarrow>f q' \<in> transitions (synchronize c d (synchronize a b \))"
      apply (rule sync_trans_elim[OF t_in'])
    proof -
      assume ff: "q (g \<union> {a})\<rightarrow>f q' \<in> transitions (synchronize c d \)"
      have "c \<notin> f"
        using ff by auto
      have "d \<notin> f"
        using ff by auto
      show "q g\<rightarrow>f q' \<in> transitions (synchronize c d (synchronize a b \))"
        apply (rule sync_trans_elim[OF ff])
             apply auto[1]
             apply (rule exI[where x="{a,b,c,d}"])
        apply (rule conjI)

(*
section GuardedStrings

datatype '\<Sigma> guard =
    Var '\<Sigma>
  | Top ("\<top>\<^sub>g")
  | Bottom ("\<bottom>\<^sub>g")
  | Or "'\<Sigma> guard" "'\<Sigma> guard" ("_ \<or>\<^sub>g _")
  | And "'\<Sigma> guard" "'\<Sigma> guard" ("_ \<and>\<^sub>g _")
  | Not "'\<Sigma> guard" ("\<not>\<^sub>g")

primrec vars :: "'\<Sigma> guard \<Rightarrow> '\<Sigma> set" where
  "vars (Var \<sigma>) = { \<sigma> }"
| "vars \<top>\<^sub>g = {}"
| "vars \<bottom>\<^sub>g = {}"
| "vars (g\<^sub>1 \<or>\<^sub>g g\<^sub>2) = vars g\<^sub>1 \<union> vars g\<^sub>2"
| "vars (g\<^sub>1 \<and>\<^sub>g g\<^sub>2) = vars g\<^sub>1 \<union> vars g\<^sub>2"
| "vars (\<not>\<^sub>g g) = vars g"

type_synonym 'v valuation = "'v \<Rightarrow> bool"

primrec interpret_guard :: "'\<Sigma> valuation \<Rightarrow> '\<Sigma> guard \<Rightarrow> bool" ("\") where
  "\ v (Var \<sigma>) = v \<sigma>"
| "\ _ \<top>\<^sub>g = True"
| "\ _ \<bottom>\<^sub>g = False"
| "\ v (g\<^sub>1 \<or>\<^sub>g g\<^sub>2) = (\ v g\<^sub>1 \<or> \ v g\<^sub>2)"
| "\ v (g\<^sub>1 \<and>\<^sub>g g\<^sub>2) = (\ v g\<^sub>1 \<and> \ v g\<^sub>2)"
| "\ v (\<not>\<^sub>g g) = (\<not> \ v g)"

definition leq :: "'\<Sigma> guard \<Rightarrow> '\<Sigma> guard \<Rightarrow> bool" where
  "leq g\<^sub>1 g\<^sub>2 = (\<forall>v. (\ v (g\<^sub>1 \<and>\<^sub>g g\<^sub>2) = \ v g\<^sub>1))"

definition eq :: "'\<Sigma> guard \<Rightarrow> '\<Sigma> guard \<Rightarrow> bool" ("_ \<approx> _" [100,100]) where
  "eq g\<^sub>1 g\<^sub>2 = (\<forall>v. \ v g\<^sub>1 = \ v g\<^sub>2)"

fun is_literal :: "'\<Sigma> guard \<Rightarrow> bool" where
  "is_literal (Var _) = True"
| "is_literal (\<not>\<^sub>g (Var _)) = True"
| "is_literal _ = False"

locale signature =
  fixes ports :: "'\<Sigma> list"
  assumes "finite (set ports)"
begin

definition At\<^sub>\<Sigma> :: "'\<Sigma> guard set" where
  "At\<^sub>\<Sigma> = { g . is_atom g}"

fun dnf :: "'\<Sigma> guard \<Rightarrow> bool" where
  "dnf (g\<^sub>1 \<or>\<^sub>g g\<^sub>2) = (dnf g\<^sub>1 \<and> dnf g\<^sub>2)"
| "dnf g = is_atom g"

definition norm :: "'\<Sigma> guard \<Rightarrow> '\<Sigma> guard set" where
  "norm g = { g' . dnf g' \<and> g \<approx> g' }"

(* more todo *)

section GuardedAutomata

record ('\<Sigma>, 'Q) transition =
  source :: 'Q
  guard :: "'\<Sigma> guard"
  firings :: "'\<Sigma> set"
  target :: 'Q

record ('\<Sigma>, 'Q) guarded_automaton =
  ports :: "'\<Sigma> set"
  states :: "'Q set"
  transitions :: "('\<Sigma>, 'Q) transition set"

locale guarded_automaton =
  fixes \ :: "('\<Sigma>, 'Q) guarded_automaton"
  assumes
    "finite (ports \)" and
    "finite (states \)" and
    "source ` transitions \ \<subseteq> states \"
    "\<Union> ((vars \<circ> guard) ` transitions \) \<subseteq> ports \"
    "target ` transitions \ \<subseteq> states \"

definition bisimulates where
  "bisimulates R \\<^sub>1 \\<^sub>2 = (R \<subseteq> states \\<^sub>1 \<times> states \\<^sub>2 \<and> (\<forall> t \<in> transitions \\<^sub>1 . t = t))" (* todo *)

*)


section {*\isaheader{Implementation of Priority Queues by Binomial Heap}*}

theory BinoPrioImpl
imports
  "../../../Binomial-Heaps/BinomialHeap"
  "../spec/PrioSpec"
  "../tools/Record_Intf"
  "../tools/Locale_Code"
begin

(*@impl Prio
  @type ('a,'p::linorder) bino
  @abbrv bino
  Binomial heaps.
*)

type_synonym ('a,'b) bino = "('a,'b) BinomialHeap"

subsection "Definitions"
definition bino_\<alpha> where "bino_\<alpha> q \<equiv> BinomialHeap.to_mset q"
definition bino_insert where "bino_insert \<equiv> BinomialHeap.insert"
abbreviation (input) bino_invar :: "('a,'b) BinomialHeap \<Rightarrow> bool"
  where "bino_invar \<equiv> \<lambda>_. True"
definition bino_find where "bino_find \<equiv> BinomialHeap.findMin"
definition bino_delete where "bino_delete \<equiv> BinomialHeap.deleteMin"
definition bino_meld where "bino_meld \<equiv> BinomialHeap.meld"
definition bino_empty where "bino_empty \<equiv> \<lambda>_::unit. BinomialHeap.empty"
definition bino_isEmpty where "bino_isEmpty = BinomialHeap.isEmpty"

definition [icf_rec_def]: "bino_ops == \<lparr>
  prio_op_\<alpha> = bino_\<alpha>,
  prio_op_invar = bino_invar,
  prio_op_empty = bino_empty,
  prio_op_isEmpty = bino_isEmpty,
  prio_op_insert = bino_insert,
  prio_op_find = bino_find,
  prio_op_delete = bino_delete,
  prio_op_meld = bino_meld
\<rparr>"

lemmas bino_defs =
  bino_\<alpha>_def
  bino_insert_def
  bino_find_def
  bino_delete_def
  bino_meld_def
  bino_empty_def
  bino_isEmpty_def

subsection "Correctness"

theorem bino_empty_impl: "prio_empty bino_\<alpha> bino_invar bino_empty"
  by (unfold_locales, auto simp add: bino_defs)

theorem bino_isEmpty_impl: "prio_isEmpty bino_\<alpha> bino_invar bino_isEmpty"
  by unfold_locales
     (simp add: bino_defs BinomialHeap.isEmpty_correct BinomialHeap.empty_correct)

theorem bino_find_impl: "prio_find bino_\<alpha> bino_invar bino_find"
  apply unfold_locales
  apply (simp add: bino_defs BinomialHeap.empty_correct BinomialHeap.findMin_correct)
  done

lemma bino_insert_impl: "prio_insert bino_\<alpha> bino_invar bino_insert"
  apply(unfold_locales)
  apply(unfold bino_defs)
  apply (simp_all add: BinomialHeap.insert_correct)
  done

lemma bino_meld_impl: "prio_meld bino_\<alpha> bino_invar bino_meld"
  apply(unfold_locales)
  apply(unfold bino_defs)
  apply(simp_all add: BinomialHeap.meld_correct)
  done

lemma bino_delete_impl:
  "prio_delete bino_\<alpha> bino_invar bino_find bino_delete"
  apply intro_locales
  apply (rule bino_find_impl)
  apply(unfold_locales)
  apply(simp_all add: bino_defs BinomialHeap.empty_correct BinomialHeap.deleteMin_correct)
done

setup Locale_Code.open_block
interpretation bino: StdPrio bino_ops
  apply (rule StdPrio.intro)
  apply (simp_all add: icf_rec_unf)
  apply (rule
    bino_empty_impl
    bino_isEmpty_impl
    bino_find_impl
    bino_insert_impl
    bino_meld_impl
    bino_delete_impl
  )+
  done
interpretation bino: StdPrio_no_invar bino_ops
  apply unfold_locales
  apply (simp add: icf_rec_unf)
  done
setup Locale_Code.close_block

setup {* ICF_Tools.revert_abbrevs "bino"*}

definition test_codegen where "test_codegen = (
  bino.empty,
  bino.isEmpty,
  bino.find,
  bino.insert,
  bino.meld,
  bino.delete
)"

export_code test_codegen in SML

end