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

    Copyright (C) 2005-2020  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>Even more on order relations\<close>

theory Order_ZF_1a imports Order_ZF

begin

text\<open>This theory is a continuation of \<open>Order_ZF\<close> and talks
  about maximuma and minimum of a set, supremum and infimum
  and strict (not reflexive) versions of order relations.\<close>

subsection\<open>Maximum and minimum of a set\<close>

text\<open>In this section we show that maximum and minimum are unique if they
  exist. We also show that union of sets that have maxima (minima) has a
  maximum (minimum). We also show that singletons have maximum and minimum.
  All this allows to show (in \<open>Finite_ZF\<close>) that every finite set has
  well-defined maximum and minimum.\<close>

text\<open>A somewhat technical fact that allows to reduce the number of premises in some
  theorems: the assumption that a set has a maximum implies that it is not empty. \<close>

lemma set_max_not_empty: assumes "HasAmaximum(r,A)" shows "A\<noteq>0"
  using assms unfolding HasAmaximum_def by auto

text\<open>If a set has a maximum implies that it is not empty. \<close>

lemma set_min_not_empty: assumes "HasAminimum(r,A)" shows "A\<noteq>0"
  using assms unfolding HasAminimum_def by auto

text\<open>If a set has a supremum then it cannot be empty. We are probably using the fact that
  $\bigcap  \emptyset = \emptyset $, which makes me a bit anxious
  as this I think is just a convention. \<close>

lemma set_sup_not_empty: assumes "HasAsupremum(r,A)" shows "A\<noteq>0"
proof -
  from assms have "HasAminimum(r,\<Inter>a\<in>A. r``{a})" unfolding HasAsupremum_def
    by simp
  then have "(\<Inter>a\<in>A. r``{a}) \<noteq> 0" using set_min_not_empty by simp
  then obtain x where "x \<in> (\<Inter>y\<in>A. r``{y})" by blast
  thus ?thesis by auto
qed

text\<open>If a set has an infimum then it cannot be empty.  \<close>

lemma set_inf_not_empty: assumes "HasAnInfimum(r,A)" shows "A\<noteq>0"
proof -
  from assms have "HasAmaximum(r,\<Inter>a\<in>A. r-``{a})" unfolding HasAnInfimum_def
    by simp
  then have "(\<Inter>a\<in>A. r-``{a}) \<noteq> 0" using set_max_not_empty by simp
  then obtain x where "x \<in> (\<Inter>y\<in>A. r-``{y})" by blast
  thus ?thesis by auto
qed

text\<open>For antisymmetric relations maximum of a set is unique if it exists.\<close>

lemma Order_ZF_4_L1: assumes A1: "antisym(r)" and A2: "HasAmaximum(r,A)"
  shows "\<exists>!M. M\<in>A \<and> (\<forall>x\<in>A. \<langle> x,M\<rangle> \<in> r)"
proof
  from A2 show "\<exists>M. M \<in> A \<and> (\<forall>x\<in>A. \<langle>x, M\<rangle> \<in> r)"
    using HasAmaximum_def by auto
  fix M1 M2 assume
    A2: "M1 \<in> A \<and> (\<forall>x\<in>A. \<langle>x, M1\<rangle> \<in> r)" "M2 \<in> A \<and> (\<forall>x\<in>A. \<langle>x, M2\<rangle> \<in> r)"
    then have "\<langle>M1,M2\<rangle> \<in> r" "\<langle>M2,M1\<rangle> \<in> r" by auto
    with A1 show "M1=M2" by (rule Fol1_L4)
qed

text\<open>For antisymmetric relations minimum of a set is unique if it exists.\<close>

lemma Order_ZF_4_L2: assumes A1: "antisym(r)" and A2: "HasAminimum(r,A)"
  shows "\<exists>!m. m\<in>A \<and> (\<forall>x\<in>A. \<langle> m,x\<rangle> \<in> r)"
proof
  from A2 show "\<exists>m. m \<in> A \<and> (\<forall>x\<in>A. \<langle>m, x\<rangle> \<in> r)"
    using HasAminimum_def by auto
  fix m1 m2 assume
    A2: "m1 \<in> A \<and> (\<forall>x\<in>A. \<langle>m1, x\<rangle> \<in> r)" "m2 \<in> A \<and> (\<forall>x\<in>A. \<langle>m2, x\<rangle> \<in> r)"
    then have "\<langle>m1,m2\<rangle> \<in> r" "\<langle>m2,m1\<rangle> \<in> r" by auto
    with A1 show "m1=m2" by (rule Fol1_L4)
qed

text\<open>Maximum of a set has desired properties.\<close>

lemma Order_ZF_4_L3: assumes A1: "antisym(r)" and A2: "HasAmaximum(r,A)"
  shows "Maximum(r,A) \<in> A" "\<forall>x\<in>A. \<langle>x,Maximum(r,A)\<rangle> \<in> r"
proof -
  let ?Max = "THE M. M\<in>A \<and> (\<forall>x\<in>A. \<langle> x,M\<rangle> \<in> r)"
  from A1 A2 have "\<exists>!M. M\<in>A \<and> (\<forall>x\<in>A. \<langle> x,M\<rangle> \<in> r)"
    by (rule Order_ZF_4_L1)
  then have "?Max \<in> A \<and> (\<forall>x\<in>A. \<langle> x,?Max\<rangle> \<in> r)"
    by (rule theI)
  then show "Maximum(r,A) \<in> A" "\<forall>x\<in>A. \<langle>x,Maximum(r,A)\<rangle> \<in> r"
    using Maximum_def by auto
qed

text\<open>Minimum of a set has desired properties.\<close>

lemma Order_ZF_4_L4: assumes A1: "antisym(r)" and A2: "HasAminimum(r,A)"
  shows "Minimum(r,A) \<in> A" "\<forall>x\<in>A. \<langle>Minimum(r,A),x\<rangle> \<in> r"
proof -
  let ?Min = "THE m. m\<in>A \<and> (\<forall>x\<in>A. \<langle> m,x\<rangle> \<in> r)"
  from A1 A2 have "\<exists>!m. m\<in>A \<and> (\<forall>x\<in>A. \<langle> m,x\<rangle> \<in> r)"
    by (rule Order_ZF_4_L2)
  then have "?Min \<in> A \<and> (\<forall>x\<in>A. \<langle> ?Min,x\<rangle> \<in> r)"
    by (rule theI)
  then show "Minimum(r,A) \<in> A" "\<forall>x\<in>A. \<langle>Minimum(r,A),x\<rangle> \<in> r"
    using Minimum_def by auto
qed

text\<open>For total and transitive relations a union a of two sets that have
  maxima has a maximum.\<close>

lemma Order_ZF_4_L5:
  assumes A1: "r {is total on} (A\<union>B)" and A2: "trans(r)"
  and A3: "HasAmaximum(r,A)" "HasAmaximum(r,B)"
  shows "HasAmaximum(r,A\<union>B)"
proof -
  from A3 obtain M K where
    D1: "M\<in>A \<and> (\<forall>x\<in>A. \<langle> x,M\<rangle> \<in> r)" "K\<in>B \<and> (\<forall>x\<in>B. \<langle> x,K\<rangle> \<in> r)"
    using HasAmaximum_def by auto
  let ?L = "GreaterOf(r,M,K)"
  from D1 have T1: "M \<in> A\<union>B" "K \<in> A\<union>B"
    "\<forall>x\<in>A. \<langle> x,M\<rangle> \<in> r" "\<forall>x\<in>B. \<langle> x,K\<rangle> \<in> r"
    by auto
  with A1 A2 have "\<forall>x\<in>A\<union>B.\<langle> x,?L\<rangle> \<in> r" by (rule Order_ZF_3_L2B)
  moreover from T1 have "?L \<in> A\<union>B" using GreaterOf_def IsTotal_def
    by simp
  ultimately show "HasAmaximum(r,A\<union>B)" using HasAmaximum_def by auto
qed

text\<open>For total and transitive relations A union a of two sets that have
  minima has a minimum.\<close>

lemma Order_ZF_4_L6:
  assumes A1: "r {is total on} (A\<union>B)" and A2: "trans(r)"
  and A3: "HasAminimum(r,A)" "HasAminimum(r,B)"
  shows "HasAminimum(r,A\<union>B)"
proof -
  from A3 obtain m k where
    D1: "m\<in>A \<and> (\<forall>x\<in>A. \<langle> m,x\<rangle> \<in> r)" "k\<in>B \<and> (\<forall>x\<in>B. \<langle> k,x\<rangle> \<in> r)"
    using HasAminimum_def by auto
  let ?l = "SmallerOf(r,m,k)"
  from D1 have T1: "m \<in> A\<union>B" "k \<in> A\<union>B"
    "\<forall>x\<in>A. \<langle> m,x\<rangle> \<in> r" "\<forall>x\<in>B. \<langle> k,x\<rangle> \<in> r"
    by auto
  with A1 A2 have "\<forall>x\<in>A\<union>B.\<langle> ?l,x\<rangle> \<in> r" by (rule Order_ZF_3_L5B)
  moreover from T1 have "?l \<in> A\<union>B" using SmallerOf_def IsTotal_def
    by simp
  ultimately show "HasAminimum(r,A\<union>B)" using HasAminimum_def by auto
qed

text\<open>Set that has a maximum is bounded above.\<close>

lemma Order_ZF_4_L7:
  assumes "HasAmaximum(r,A)"
  shows "IsBoundedAbove(A,r)"
  using assms HasAmaximum_def IsBoundedAbove_def by auto

text\<open>Set that has a minimum is bounded below.\<close>

lemma Order_ZF_4_L8A:
  assumes "HasAminimum(r,A)"
  shows "IsBoundedBelow(A,r)"
  using assms HasAminimum_def IsBoundedBelow_def by auto

text\<open>For reflexive relations singletons have a minimum and maximum.\<close>

lemma Order_ZF_4_L8: assumes "refl(X,r)" and "a\<in>X"
  shows "HasAmaximum(r,{a})" "HasAminimum(r,{a})"
  using assms refl_def HasAmaximum_def HasAminimum_def by auto

text\<open>For total and transitive relations if we add an element to a set
  that has a maximum, the set still has a maximum.\<close>

lemma Order_ZF_4_L9:
  assumes A1: "r {is total on} X" and A2: "trans(r)"
  and A3: "A\<subseteq>X" and A4: "a\<in>X" and A5: "HasAmaximum(r,A)"
  shows "HasAmaximum(r,A\<union>{a})"
proof -
  from A3 A4 have "A\<union>{a} \<subseteq> X" by auto
  with A1 have "r {is total on} (A\<union>{a})"
    using Order_ZF_1_L4 by blast
  moreover from A1 A2 A4 A5 have
    "trans(r)" "HasAmaximum(r,A)" by auto
  moreover from A1 A4 have "HasAmaximum(r,{a})"
    using total_is_refl Order_ZF_4_L8 by blast
  ultimately show "HasAmaximum(r,A\<union>{a})" by (rule Order_ZF_4_L5)
qed

text\<open>For total and transitive relations if we add an element to a set
  that has a minimum, the set still has a minimum.\<close>

lemma Order_ZF_4_L10:
  assumes A1: "r {is total on} X" and A2: "trans(r)"
  and A3: "A\<subseteq>X" and A4: "a\<in>X" and A5: "HasAminimum(r,A)"
  shows "HasAminimum(r,A\<union>{a})"
proof -
  from A3 A4 have "A\<union>{a} \<subseteq> X" by auto
  with A1 have "r {is total on} (A\<union>{a})"
    using Order_ZF_1_L4 by blast
  moreover from A1 A2 A4 A5 have
    "trans(r)" "HasAminimum(r,A)" by auto
  moreover from A1 A4 have "HasAminimum(r,{a})"
    using total_is_refl Order_ZF_4_L8 by blast
  ultimately show "HasAminimum(r,A\<union>{a})" by (rule Order_ZF_4_L6)
qed

text\<open>If the order relation has a property that every nonempty bounded set
  attains a minimum (for example integers are like that),
  then every nonempty set bounded below attains a minimum.\<close>

lemma Order_ZF_4_L11:
  assumes A1: "r {is total on} X" and
  A2: "trans(r)" and
  A3: "r \<subseteq> X\<times>X" and
  A4: "\<forall>A. IsBounded(A,r) \<and> A\<noteq>0 \<longrightarrow> HasAminimum(r,A)" and
  A5: "B\<noteq>0" and A6: "IsBoundedBelow(B,r)"
  shows "HasAminimum(r,B)"
proof -
  from A5 obtain b where T: "b\<in>B" by auto
  let ?L = "{x\<in>B. \<langle>x,b\<rangle> \<in> r}"
  from A3 A6 T have T1: "b\<in>X" using Order_ZF_3_L1B by blast
  with A1 T have T2: "b \<in> ?L"
    using total_is_refl refl_def by simp
  then have "?L \<noteq> 0" by auto
  moreover have "IsBounded(?L,r)"
  proof -
    have "?L \<subseteq> B" by auto
    with A6 have "IsBoundedBelow(?L,r)"
      using Order_ZF_3_L12 by simp
    moreover have "IsBoundedAbove(?L,r)"
      by (rule Order_ZF_3_L15)
    ultimately have "IsBoundedAbove(?L,r) \<and> IsBoundedBelow(?L,r)"
      by blast
    then show "IsBounded(?L,r)" using IsBounded_def
      by simp
  qed
  ultimately have "IsBounded(?L,r) \<and> ?L \<noteq> 0" by blast
  with A4 have "HasAminimum(r,?L)" by simp
  then obtain m where I: "m\<in>?L" and II: "\<forall>x\<in>?L. \<langle> m,x\<rangle> \<in> r"
    using HasAminimum_def by auto
  then have III: "\<langle>m,b\<rangle> \<in> r" by simp
  from I have "m\<in>B" by simp
  moreover have "\<forall>x\<in>B. \<langle>m,x\<rangle> \<in> r"
  proof
    fix x assume A7: "x\<in>B"
    from A3 A6 have "B\<subseteq>X" using Order_ZF_3_L1B by blast
    with A1 A7 T1 have "x \<in>  ?L \<union> {x\<in>B. \<langle>b,x\<rangle> \<in> r}"
      using Order_ZF_1_L5 by simp
    then have "x\<in>?L \<or> \<langle>b,x\<rangle> \<in> r" by auto
    moreover
    { assume "x\<in>?L"
      with II have "\<langle>m,x\<rangle> \<in> r" by simp }
    moreover
    { assume "\<langle>b,x\<rangle> \<in> r"
      with A2 III have "trans(r)" and "\<langle>m,b\<rangle> \<in> r \<and> \<langle>b,x\<rangle> \<in> r"
	by auto
      then have  "\<langle>m,x\<rangle> \<in> r" by (rule Fol1_L3) }
    ultimately show "\<langle>m,x\<rangle> \<in> r" by auto
  qed
  ultimately show "HasAminimum(r,B)" using HasAminimum_def
    by auto
qed

text\<open>A dual to \<open>Order_ZF_4_L11\<close>:
  If the order relation has a property that every nonempty bounded set
  attains a maximum (for example integers are like that),
  then every nonempty set bounded above attains a maximum.\<close>

lemma Order_ZF_4_L11A:
  assumes A1: "r {is total on} X" and
  A2: "trans(r)" and
  A3: "r \<subseteq> X\<times>X" and
  A4: "\<forall>A. IsBounded(A,r) \<and> A\<noteq>0 \<longrightarrow> HasAmaximum(r,A)" and
  A5: "B\<noteq>0" and A6: "IsBoundedAbove(B,r)"
  shows "HasAmaximum(r,B)"
proof -
  from A5 obtain b where T: "b\<in>B" by auto
  let ?U = "{x\<in>B. \<langle>b,x\<rangle> \<in> r}"
  from A3 A6 T have T1: "b\<in>X" using Order_ZF_3_L1A by blast
  with A1 T have T2: "b \<in> ?U"
    using total_is_refl refl_def by simp
  then have "?U \<noteq> 0" by auto
  moreover have "IsBounded(?U,r)"
  proof -
    have "?U \<subseteq> B" by auto
    with A6 have "IsBoundedAbove(?U,r)"
      using Order_ZF_3_L13 by blast
    moreover have "IsBoundedBelow(?U,r)"
      using IsBoundedBelow_def by auto
    ultimately have "IsBoundedAbove(?U,r) \<and> IsBoundedBelow(?U,r)"
      by blast
    then show "IsBounded(?U,r)" using IsBounded_def
      by simp
  qed
  ultimately have "IsBounded(?U,r) \<and> ?U \<noteq> 0" by blast
  with A4 have "HasAmaximum(r,?U)" by simp
  then obtain m where I: "m\<in>?U" and II: "\<forall>x\<in>?U. \<langle>x,m\<rangle> \<in> r"
    using HasAmaximum_def by auto
  then have III: "\<langle>b,m\<rangle> \<in> r" by simp
  from I have "m\<in>B" by simp
  moreover have "\<forall>x\<in>B. \<langle>x,m\<rangle> \<in> r"
  proof
    fix x assume A7: "x\<in>B"
    from A3 A6 have "B\<subseteq>X" using Order_ZF_3_L1A by blast
    with A1 A7 T1 have "x \<in> {x\<in>B. \<langle>x,b\<rangle> \<in> r} \<union> ?U"
      using Order_ZF_1_L5 by simp
    then have "x\<in>?U \<or> \<langle>x,b\<rangle> \<in> r" by auto
    moreover
    { assume "x\<in>?U"
      with II have "\<langle>x,m\<rangle> \<in> r" by simp }
    moreover
    { assume "\<langle>x,b\<rangle> \<in> r"
      with A2 III have "trans(r)" and "\<langle>x,b\<rangle> \<in> r \<and> \<langle>b,m\<rangle> \<in> r"
	by auto
      then have  "\<langle>x,m\<rangle> \<in> r" by (rule Fol1_L3) }
    ultimately show "\<langle>x,m\<rangle> \<in> r" by auto
  qed
  ultimately show "HasAmaximum(r,B)" using HasAmaximum_def
    by auto
qed

text\<open>If a set has a minimum and $L$ is less or equal than
  all elements of the set, then $L$ is less or equal than the minimum.\<close>

lemma Order_ZF_4_L12:
  assumes "antisym(r)" and "HasAminimum(r,A)" and "\<forall>a\<in>A. \<langle>L,a\<rangle> \<in> r"
  shows "\<langle>L,Minimum(r,A)\<rangle> \<in> r"
  using assms Order_ZF_4_L4 by simp

text\<open>If a set has a maximum and all its elements are less or equal than
  $M$, then the maximum of the set is less or equal than $M$.\<close>

lemma Order_ZF_4_L13:
  assumes "antisym(r)" and "HasAmaximum(r,A)" and "\<forall>a\<in>A. \<langle>a,M\<rangle> \<in> r"
  shows "\<langle>Maximum(r,A),M\<rangle> \<in> r"
  using assms Order_ZF_4_L3 by simp

text\<open>If an element belongs to a set and is greater or equal
  than all elements of that set, then it is the maximum of that set.\<close>

lemma Order_ZF_4_L14:
  assumes A1: "antisym(r)" and A2: "M \<in> A" and
  A3: "\<forall>a\<in>A. \<langle>a,M\<rangle> \<in> r"
  shows "Maximum(r,A) = M"
proof -
  from A2 A3 have I: "HasAmaximum(r,A)" using HasAmaximum_def
    by auto
  with A1 have "\<exists>!M. M\<in>A \<and> (\<forall>x\<in>A. \<langle>x,M\<rangle> \<in> r)"
    using Order_ZF_4_L1 by simp
  moreover from A2 A3 have "M\<in>A \<and> (\<forall>x\<in>A. \<langle>x,M\<rangle> \<in> r)" by simp
  moreover from A1 I have
    "Maximum(r,A) \<in> A \<and> (\<forall>x\<in>A. \<langle>x,Maximum(r,A)\<rangle> \<in> r)"
    using Order_ZF_4_L3 by simp
  ultimately show "Maximum(r,A) = M" by auto
qed

text\<open>If an element belongs to a set and is less or equal
  than all elements of that set, then it is the minimum of that set.\<close>

lemma Order_ZF_4_L15:
  assumes A1: "antisym(r)" and A2: "m \<in> A" and
  A3: "\<forall>a\<in>A. \<langle>m,a\<rangle> \<in> r"
  shows "Minimum(r,A) = m"
proof -
  from A2 A3 have I: "HasAminimum(r,A)" using HasAminimum_def
    by auto
  with A1 have "\<exists>!m. m\<in>A \<and> (\<forall>x\<in>A. \<langle>m,x\<rangle> \<in> r)"
    using Order_ZF_4_L2 by simp
  moreover from A2 A3 have "m\<in>A \<and> (\<forall>x\<in>A. \<langle>m,x\<rangle> \<in> r)" by simp
  moreover from A1 I have
    "Minimum(r,A) \<in> A \<and> (\<forall>x\<in>A. \<langle>Minimum(r,A),x\<rangle> \<in> r)"
    using Order_ZF_4_L4 by simp
  ultimately show "Minimum(r,A) = m" by auto
qed

text\<open>If a set does not have a maximum, then for any its element we can
  find one that is (strictly) greater.\<close>

lemma Order_ZF_4_L16:
  assumes A1: "antisym(r)" and A2: "r {is total on} X" and
  A3: "A\<subseteq>X" and
  A4: "\<not>HasAmaximum(r,A)" and
  A5: "x\<in>A"
  shows "\<exists>y\<in>A. \<langle>x,y\<rangle> \<in> r \<and> y\<noteq>x"
proof -
  { assume A6: "\<forall>y\<in>A. \<langle>x,y\<rangle> \<notin> r \<or> y=x"
    have "\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> r"
    proof
      fix y assume A7: "y\<in>A"
      with A6 have "\<langle>x,y\<rangle> \<notin> r \<or> y=x" by simp
      with A2 A3 A5 A7 show "\<langle>y,x\<rangle> \<in> r"
	using IsTotal_def Order_ZF_1_L1 by auto
    qed
    with A5 have "\<exists>x\<in>A.\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> r"
      by auto
    with A4 have False using HasAmaximum_def by simp
  } then show "\<exists>y\<in>A. \<langle>x,y\<rangle> \<in> r \<and> y\<noteq>x" by auto
qed

subsection\<open>Supremum and Infimum\<close>

text\<open>In this section we consider the notions of supremum and infimum a set.\<close>

text\<open>Elements of the set of upper bounds are indeed upper bounds.
  Isabelle also thinks it is obvious.\<close>

lemma Order_ZF_5_L1: assumes "u \<in> (\<Inter>a\<in>A. r``{a})" and "a\<in>A"
  shows "\<langle>a,u\<rangle> \<in> r"
  using assms by auto

text\<open>Elements of the set of lower bounds are indeed lower bounds.
  Isabelle also thinks it is obvious.\<close>

lemma Order_ZF_5_L2: assumes "l \<in> (\<Inter>a\<in>A. r-``{a})" and "a\<in>A"
  shows "\<langle>l,a\<rangle> \<in> r"
  using assms by auto

text\<open>If the set of upper bounds has a minimum, then the supremum
  is less or equal than any upper bound. We can probably do away with
  the assumption that $A$ is not empty, (ab)using the fact that
  intersection over an empty family is defined in Isabelle to be empty.
  This lemma is obsolete and will be removed in the future. Use \<open>sup_leq_up_bnd\<close> instead.\<close>

lemma Order_ZF_5_L3: assumes A1: "antisym(r)" and A2: "A\<noteq>0" and
  A3: "HasAminimum(r,\<Inter>a\<in>A. r``{a})" and
  A4: "\<forall>a\<in>A. \<langle>a,u\<rangle> \<in> r"
  shows "\<langle>Supremum(r,A),u\<rangle> \<in> r"
proof -
  let ?U = "\<Inter>a\<in>A. r``{a}"
  from A4 have "\<forall>a\<in>A. u \<in> r``{a}" using image_singleton_iff
    by simp
  with A2 have "u\<in>?U" by auto
  with A1 A3 show "\<langle>Supremum(r,A),u\<rangle> \<in> r"
    using Order_ZF_4_L4 Supremum_def by simp
qed

text\<open>Supremum is less or equal than any upper bound. \<close>

lemma sup_leq_up_bnd: assumes "antisym(r)" "HasAsupremum(r,A)" "\<forall>a\<in>A. \<langle>a,u\<rangle> \<in> r"
  shows "\<langle>Supremum(r,A),u\<rangle> \<in> r"
proof -
  let ?U = "\<Inter>a\<in>A. r``{a}"
  from assms(3) have  "\<forall>a\<in>A. u \<in> r``{a}" using image_singleton_iff by simp
  with assms(2) have "u\<in>?U" using set_sup_not_empty by auto
  with assms(1,2) show "\<langle>Supremum(r,A),u\<rangle> \<in> r"
    unfolding HasAsupremum_def Supremum_def using Order_ZF_4_L4 by simp
qed

text\<open>Infimum is greater or equal than any lower bound.
  This lemma is obsolete and will be removed. Use \<open>inf_geq_lo_bnd\<close> instead.\<close>

lemma Order_ZF_5_L4: assumes A1: "antisym(r)" and A2: "A\<noteq>0" and
  A3: "HasAmaximum(r,\<Inter>a\<in>A. r-``{a})" and
  A4: "\<forall>a\<in>A. \<langle>l,a\<rangle> \<in> r"
  shows "\<langle>l,Infimum(r,A)\<rangle> \<in> r"
proof -
  let ?L = "\<Inter>a\<in>A. r-``{a}"
  from A4 have "\<forall>a\<in>A. l \<in> r-``{a}" using vimage_singleton_iff
    by simp
  with A2 have "l\<in>?L" by auto
  with A1 A3 show "\<langle>l,Infimum(r,A)\<rangle> \<in> r"
    using Order_ZF_4_L3 Infimum_def by simp
qed

text\<open>Infimum is greater or equal than any upper bound. \<close>

lemma inf_geq_lo_bnd: assumes "antisym(r)" "HasAnInfimum(r,A)" "\<forall>a\<in>A. \<langle>u,a\<rangle> \<in> r"
  shows "\<langle>u,Infimum(r,A)\<rangle> \<in> r"
proof -
  let ?U = "\<Inter>a\<in>A. r-``{a}"
  from assms(3) have  "\<forall>a\<in>A. u \<in> r-``{a}" using vimage_singleton_iff by simp
  with assms(2) have "u\<in>?U" using set_inf_not_empty by auto
  with assms(1,2) show  "\<langle>u,Infimum(r,A)\<rangle> \<in> r"
    unfolding HasAnInfimum_def Infimum_def using Order_ZF_4_L3 by simp
qed

text\<open>If $z$ is an upper bound for $A$ and is less or equal than
  any other upper bound, then $z$ is the supremum of $A$.\<close>

lemma Order_ZF_5_L5: assumes A1: "antisym(r)" and A2: "A\<noteq>0" and
  A3: "\<forall>x\<in>A. \<langle>x,z\<rangle> \<in> r" and
  A4: "\<forall>y. (\<forall>x\<in>A. \<langle>x,y\<rangle> \<in> r) \<longrightarrow> \<langle>z,y\<rangle> \<in> r"
  shows
  "HasAminimum(r,\<Inter>a\<in>A. r``{a})"
  "z = Supremum(r,A)"
proof -
  let ?B = "\<Inter>a\<in>A. r``{a}"
  from A2 A3 A4 have I: "z \<in> ?B"   "\<forall>y\<in>?B. \<langle>z,y\<rangle> \<in> r"
    by auto
  then show "HasAminimum(r,\<Inter>a\<in>A. r``{a})"
    using HasAminimum_def by auto
  from A1 I show "z = Supremum(r,A)"
    using Order_ZF_4_L15 Supremum_def by simp
qed

text\<open>The dual theorem to \<open>Order_ZF_5_L5\<close>: if $z$ is an lower bound for $A$ and is
  greater or equal than any other lower bound, then $z$ is the infimum of $A$.\<close>

lemma inf_glb:
  assumes "antisym(r)" "A\<noteq>0" "\<forall>x\<in>A. \<langle>z,x\<rangle> \<in> r" "\<forall>y. (\<forall>x\<in>A. \<langle>y,x\<rangle> \<in> r) \<longrightarrow> \<langle>y,z\<rangle> \<in> r"
  shows
  "HasAmaximum(r,\<Inter>a\<in>A. r-``{a})"
  "z = Infimum(r,A)"
proof -
  let ?B = "\<Inter>a\<in>A. r-``{a}"
  from assms(2,3,4) have I: "z \<in> ?B"   "\<forall>y\<in>?B. \<langle>y,z\<rangle> \<in> r"
    by auto
  then show "HasAmaximum(r,\<Inter>a\<in>A. r-``{a})"
    unfolding HasAmaximum_def by auto
  from assms(1) I show "z = Infimum(r,A)"
    using Order_ZF_4_L14 Infimum_def by simp
qed

text\<open> Supremum and infimum of a singleton is the element. \<close>

lemma sup_inf_singl: assumes "antisym(r)" "refl(X,r)" "z\<in>X"
  shows
    "HasAsupremum(r,{z})" "Supremum(r,{z}) = z" and
    "HasAnInfimum(r,{z})" "Infimum(r,{z}) = z"
proof -
  from assms show "Supremum(r,{z}) = z" and "Infimum(r,{z}) = z"
    using inf_glb Order_ZF_5_L5 unfolding refl_def by auto
  from assms show  "HasAsupremum(r,{z})"
    using Order_ZF_5_L5 unfolding HasAsupremum_def refl_def by blast
  from assms show "HasAnInfimum(r,{z})"
    using inf_glb unfolding HasAnInfimum_def refl_def by blast
qed

text\<open>If a set has a maximum, then the maximum is the supremum. This lemma is obsolete, use
  \<open>max_is_sup\<close> instead.\<close>

lemma Order_ZF_5_L6:
  assumes A1:  "antisym(r)" and A2: "A\<noteq>0" and
  A3: "HasAmaximum(r,A)"
  shows
  "HasAminimum(r,\<Inter>a\<in>A. r``{a})"
  "Maximum(r,A) = Supremum(r,A)"
proof -
  let ?M = "Maximum(r,A)"
  from A1 A3 have I: "?M \<in> A" and II: "\<forall>x\<in>A. \<langle>x,?M\<rangle> \<in> r"
    using Order_ZF_4_L3 by auto
  from I have III: "\<forall>y. (\<forall>x\<in>A. \<langle>x,y\<rangle> \<in> r) \<longrightarrow> \<langle>?M,y\<rangle> \<in> r"
    by simp
  with A1 A2 II show "HasAminimum(r,\<Inter>a\<in>A. r``{a})"
    by (rule Order_ZF_5_L5)
  from A1 A2 II III show "?M = Supremum(r,A)"
    by (rule Order_ZF_5_L5)
qed

text\<open>Another version of \<open>Order_ZF_5_L6\<close> that: if a sat has a maximum then it has a supremum and
  the maximum is the supremum. \<close>

lemma max_is_sup: assumes "antisym(r)" "A\<noteq>0" "HasAmaximum(r,A)"
  shows "HasAsupremum(r,A)" and "Maximum(r,A) = Supremum(r,A)"
proof -
  let ?M = "Maximum(r,A)"
  from assms(1,3) have "?M \<in> A" and I: "\<forall>x\<in>A. \<langle>x,?M\<rangle> \<in> r" using Order_ZF_4_L3
    by auto
  with assms(1,2) have "HasAminimum(r,\<Inter>a\<in>A. r``{a})" using Order_ZF_5_L5(1)
    by blast
  then show "HasAsupremum(r,A)" unfolding HasAsupremum_def by simp
  from assms(1,2) \<open>?M \<in> A\<close> I show "?M = Supremum(r,A)" using Order_ZF_5_L5(2)
    by blast
qed

text\<open> Minimum is the infimum if it exists.\<close>

lemma min_is_inf: assumes "antisym(r)" "A\<noteq>0" "HasAminimum(r,A)"
  shows "HasAnInfimum(r,A)" and "Minimum(r,A) = Infimum(r,A)"
proof -
  let ?M = "Minimum(r,A)"
  from assms(1,3) have "?M\<in>A" and I: "\<forall>x\<in>A. \<langle>?M,x\<rangle> \<in> r" using  Order_ZF_4_L4
    by auto
  with assms(1,2) have "HasAmaximum(r,\<Inter>a\<in>A. r-``{a})" using inf_glb(1) by blast
  then show "HasAnInfimum(r,A)" unfolding HasAnInfimum_def by simp
  from assms(1,2) \<open>?M \<in> A\<close> I show "?M = Infimum(r,A)" using inf_glb(2) by blast
qed

text\<open>For reflexive and total relations two-element set has a minimum and a maximum. \<close>

lemma min_max_two_el: assumes "r {is total on} X" "x\<in>X" "y\<in>X"
  shows "HasAminimum(r,{x,y})" and "HasAmaximum(r,{x,y})"
  using assms unfolding IsTotal_def HasAminimum_def HasAmaximum_def by auto

text\<open>For antisymmetric, reflexive and total relations two-element set has a supremum and infimum. \<close>

lemma inf_sup_two_el:assumes "antisym(r)" "r {is total on} X" "x\<in>X" "y\<in>X"
  shows
    "HasAnInfimum(r,{x,y})"
    "Minimum(r,{x,y}) = Infimum(r,{x,y})"
    "HasAsupremum(r,{x,y})"
    "Maximum(r,{x,y}) = Supremum(r,{x,y})"
  using assms min_max_two_el max_is_sup min_is_inf by auto

text\<open>A sufficient condition for the supremum to be in the space.\<close>

lemma sup_in_space:
  assumes "r \<subseteq> X\<times>X" "antisym(r)" "HasAminimum(r,\<Inter>a\<in>A. r``{a})"
  shows "Supremum(r,A) \<in> X" and "\<forall>x\<in>A. \<langle>x,Supremum(r,A)\<rangle> \<in> r"
proof -
  from assms(3) have "A\<noteq>0" using set_sup_not_empty unfolding HasAsupremum_def by simp
  then obtain a where "a\<in>A" by auto
  with assms(1,2,3) show "Supremum(r,A) \<in> X" unfolding Supremum_def
    using Order_ZF_4_L4 Order_ZF_5_L1 by blast
  from assms(2,3) show "\<forall>x\<in>A. \<langle>x,Supremum(r,A)\<rangle> \<in> r" unfolding Supremum_def
    using Order_ZF_4_L4 by blast
qed

text\<open>A sufficient condition for the infimum to be in the space.\<close>

lemma inf_in_space:
  assumes "r \<subseteq> X\<times>X" "antisym(r)" "HasAmaximum(r,\<Inter>a\<in>A. r-``{a})"
  shows "Infimum(r,A) \<in> X" and "\<forall>x\<in>A. \<langle>Infimum(r,A),x\<rangle> \<in> r"
proof -
  from assms(3) have "A\<noteq>0" using set_inf_not_empty unfolding HasAnInfimum_def by simp
  then obtain a where "a\<in>A" by auto
  with assms(1,2,3) show "Infimum(r,A) \<in> X" unfolding Infimum_def
    using Order_ZF_4_L3 Order_ZF_5_L1 by blast
  from assms(2,3) show "\<forall>x\<in>A. \<langle>Infimum(r,A),x\<rangle> \<in> r" unfolding Infimum_def
    using Order_ZF_4_L3 by blast
qed

text\<open>Properties of supremum of a set for complete relations.\<close>

lemma Order_ZF_5_L7:
  assumes A1: "r \<subseteq> X\<times>X" and A2: "antisym(r)" and
  A3: "r {is complete}" and
  A4: "A\<noteq>0" and A5: "\<exists>x\<in>X. \<forall>y\<in>A. \<langle>y,x\<rangle> \<in> r"
  shows "Supremum(r,A) \<in> X" and "\<forall>x\<in>A. \<langle>x,Supremum(r,A)\<rangle> \<in> r"
proof -
  from A3 A4 A5 have "HasAminimum(r,\<Inter>a\<in>A. r``{a})"
    unfolding IsBoundedAbove_def IsComplete_def by blast
  with A1 A2 show "Supremum(r,A) \<in> X" and "\<forall>x\<in>A. \<langle>x,Supremum(r,A)\<rangle> \<in> r"
    using sup_in_space by auto
qed

text\<open> Infimum of the set of infima of a collection of sets is infimum of the union. \<close>

lemma inf_inf:
  assumes
    "r \<subseteq> X\<times>X" "antisym(r)" "trans(r)"
    "\<forall>T\<in>\<T>. HasAnInfimum(r,T)"
    "HasAnInfimum(r,{Infimum(r,T).T\<in>\<T>})"
  shows
    "HasAnInfimum(r,\<Union>\<T>)" and "Infimum(r,{Infimum(r,T).T\<in>\<T>}) = Infimum(r,\<Union>\<T>)"
proof -
  let ?i = "Infimum(r,{Infimum(r,T).T\<in>\<T>})"
  note assms(2)
  moreover from assms(4,5) have "\<Union>\<T> \<noteq> 0" using set_inf_not_empty by blast
  moreover
  have "\<forall>T\<in>\<T>.\<forall>t\<in>T. \<langle>?i,t\<rangle> \<in> r"
  proof -
    { fix T t assume "T\<in>\<T>" "t\<in>T"
      with assms(1,2,4) have "\<langle>Infimum(r,T),t\<rangle> \<in> r"
        unfolding HasAnInfimum_def using inf_in_space(2) by blast
      moreover from assms(1,2,5) \<open>T\<in>\<T>\<close> have "\<langle>?i,Infimum(r,T)\<rangle> \<in> r"
        unfolding HasAnInfimum_def using inf_in_space(2) by blast
      moreover note assms(3)
      ultimately have "\<langle>?i,t\<rangle> \<in> r" unfolding trans_def by blast
    } thus ?thesis by simp
  qed
  hence I: "\<forall>t\<in>\<Union>\<T>. \<langle>?i,t\<rangle> \<in> r" by auto
  moreover have J: "\<forall>y. (\<forall>x\<in>\<Union>\<T>. \<langle>y,x\<rangle> \<in> r) \<longrightarrow> \<langle>y,?i\<rangle> \<in> r"
  proof -
    { fix y x assume A: "\<forall>x\<in>\<Union>\<T>. \<langle>y,x\<rangle> \<in> r"
      with assms(2,4) have "\<forall>a\<in>{Infimum(r,T).T\<in>\<T>}. \<langle>y,a\<rangle> \<in> r" using inf_geq_lo_bnd
        by simp
      with assms(2,5) have "\<langle>y,?i\<rangle> \<in> r" by (rule inf_geq_lo_bnd)
    } thus ?thesis by simp
  qed
  ultimately have "HasAmaximum(r,\<Inter>a\<in>\<Union>\<T>. r-``{a})" by (rule inf_glb)
  then show "HasAnInfimum(r,\<Union>\<T>)" unfolding HasAnInfimum_def by simp
  from assms(2) \<open>\<Union>\<T> \<noteq> 0\<close> I J show "?i = Infimum(r,\<Union>\<T>)" by (rule inf_glb)
qed

text\<open> Supremum of the set of suprema of a collection of sets is supremum of the union. \<close>

lemma sup_sup:
  assumes
    "r \<subseteq> X\<times>X" "antisym(r)" "trans(r)"
    "\<forall>T\<in>\<T>. HasAsupremum(r,T)"
    "HasAsupremum(r,{Supremum(r,T).T\<in>\<T>})"
  shows
    "HasAsupremum(r,\<Union>\<T>)" and "Supremum(r,{Supremum(r,T).T\<in>\<T>}) = Supremum(r,\<Union>\<T>)"
proof -
  let ?s = "Supremum(r,{Supremum(r,T).T\<in>\<T>})"
  note assms(2)
  moreover from assms(4,5) have "\<Union>\<T> \<noteq> 0" using set_sup_not_empty by blast
  moreover
  have "\<forall>T\<in>\<T>.\<forall>t\<in>T. \<langle>t,?s\<rangle> \<in> r"
  proof -
    { fix T t assume "T\<in>\<T>" "t\<in>T"
      with assms(1,2,4) have "\<langle>t,Supremum(r,T)\<rangle> \<in> r"
        unfolding HasAsupremum_def using sup_in_space(2) by blast
      moreover from assms(1,2,5) \<open>T\<in>\<T>\<close> have "\<langle>Supremum(r,T),?s\<rangle> \<in> r"
        unfolding HasAsupremum_def using sup_in_space(2) by blast
      moreover note assms(3)
      ultimately have "\<langle>t,?s\<rangle> \<in> r" unfolding trans_def by blast
    } thus ?thesis by simp
  qed
  hence I: "\<forall>t\<in>\<Union>\<T>. \<langle>t,?s\<rangle> \<in> r" by auto
  moreover have J: "\<forall>y. (\<forall>x\<in>\<Union>\<T>. \<langle>x,y\<rangle> \<in> r) \<longrightarrow> \<langle>?s,y\<rangle> \<in> r"
  proof -
    { fix y x assume A: "\<forall>x\<in>\<Union>\<T>. \<langle>x,y\<rangle> \<in> r"
      with assms(2,4) have "\<forall>a\<in>{Supremum(r,T).T\<in>\<T>}. \<langle>a,y\<rangle> \<in> r" using sup_leq_up_bnd
        by simp
      with assms(2,5) have "\<langle>?s,y\<rangle> \<in> r" by (rule sup_leq_up_bnd)
    } thus ?thesis by simp
  qed
  ultimately have "HasAminimum(r,\<Inter>a\<in>\<Union>\<T>. r``{a})" by (rule Order_ZF_5_L5)
  then show "HasAsupremum(r,\<Union>\<T>)" unfolding HasAsupremum_def by simp
  from assms(2) \<open>\<Union>\<T> \<noteq> 0\<close> I J show "?s = Supremum(r,\<Union>\<T>)" by (rule Order_ZF_5_L5)
qed

text\<open>If the relation is a linear order then for any
  element $y$ smaller than the supremum of a set we can
  find one element of the set that is greater than $y$.\<close>

lemma Order_ZF_5_L8:
  assumes A1: "r \<subseteq> X\<times>X"  and A2: "IsLinOrder(X,r)" and
  A3: "r {is complete}" and
  A4: "A\<subseteq>X"  "A\<noteq>0" and A5: "\<exists>x\<in>X. \<forall>y\<in>A. \<langle>y,x\<rangle> \<in> r" and
  A6: "\<langle>y,Supremum(r,A)\<rangle> \<in> r"   "y \<noteq> Supremum(r,A)"
  shows "\<exists>z\<in>A. \<langle>y,z\<rangle> \<in> r \<and> y \<noteq> z"
proof -
  from A2 have
    I: "antisym(r)" and
    II: "trans(r)" and
    III: "r {is total on} X"
    using IsLinOrder_def by auto
  from A1 A6 have T1: "y\<in>X" by auto
  { assume A7: "\<forall>z \<in> A. \<langle>y,z\<rangle> \<notin> r \<or> y=z"
    from A4 I have "antisym(r)" and "A\<noteq>0" by auto
    moreover have "\<forall>x\<in>A. \<langle>x,y\<rangle> \<in> r"
    proof
      fix x assume A8: "x\<in>A"
      with A4 have T2: "x\<in>X" by auto
      from A7 A8 have "\<langle>y,x\<rangle> \<notin> r \<or> y=x" by simp
      with III T1 T2 show "\<langle>x,y\<rangle> \<in> r"
	using IsTotal_def total_is_refl refl_def by auto
    qed
    moreover have "\<forall>u. (\<forall>x\<in>A. \<langle>x,u\<rangle> \<in> r) \<longrightarrow> \<langle>y,u\<rangle> \<in> r"
    proof-
      { fix u assume A9: "\<forall>x\<in>A. \<langle>x,u\<rangle> \<in> r"
	from A4 A5 have "IsBoundedAbove(A,r)" and "A\<noteq>0"
	  using IsBoundedAbove_def by auto
	with  A3 A4 A6 I A9  have
	  "\<langle>y,Supremum(r,A)\<rangle> \<in> r \<and> \<langle>Supremum(r,A),u\<rangle> \<in> r"
	  using IsComplete_def Order_ZF_5_L3 by simp
	with II have "\<langle>y,u\<rangle> \<in> r" by (rule Fol1_L3)
      } then show "\<forall>u. (\<forall>x\<in>A. \<langle>x,u\<rangle> \<in> r) \<longrightarrow> \<langle>y,u\<rangle> \<in> r"
	by simp
    qed
    ultimately have "y = Supremum(r,A)"
      by (rule Order_ZF_5_L5)
    with A6 have False by simp
  } then show "\<exists>z\<in>A. \<langle>y,z\<rangle> \<in> r \<and> y \<noteq> z" by auto
qed

subsection\<open>Strict versions of order relations\<close>

text\<open>One of the problems with translating formalized mathematics from
  Metamath to IsarMathLib is that Metamath uses strict orders (of the $<$
  type) while in IsarMathLib we mostly use nonstrict orders (of the
  $\leq$ type).
  This doesn't really make any difference, but is annoying as we
  have to prove many theorems twice. In this section we prove some theorems
  to make it easier to translate the statements about strict orders to
  statements about the corresponding non-strict order and vice versa.\<close>

text\<open>We define a strict version of a relation by removing the $y=x$ line
  from the relation.\<close>

definition
  "StrictVersion(r) \<equiv> r - {\<langle>x,x\<rangle>. x \<in> domain(r)}"

text\<open>A reformulation of the definition of a strict version of an order.
\<close>

lemma def_of_strict_ver: shows
  "\<langle>x,y\<rangle> \<in> StrictVersion(r) \<longleftrightarrow> \<langle>x,y\<rangle> \<in> r \<and> x\<noteq>y"
  using StrictVersion_def domain_def by auto

text\<open>The next lemma is about the strict version of an antisymmetric
  relation.\<close>

lemma strict_of_antisym:
  assumes A1: "antisym(r)" and A2: "\<langle>a,b\<rangle> \<in> StrictVersion(r)"
  shows "\<langle>b,a\<rangle> \<notin> StrictVersion(r)"
proof -
  { assume A3: "\<langle>b,a\<rangle> \<in> StrictVersion(r)"
    with A2 have "\<langle>a,b\<rangle> \<in> r"  and "\<langle>b,a\<rangle> \<in> r"
      using def_of_strict_ver by auto
    with A1 have "a=b" by (rule Fol1_L4)
    with A2 have False using def_of_strict_ver
      by simp
  } then show "\<langle>b,a\<rangle> \<notin> StrictVersion(r)" by auto
qed

text\<open>The strict version of totality.\<close>

lemma strict_of_tot:
  assumes "r {is total on} X" and "a\<in>X"  "b\<in>X"  "a\<noteq>b"
  shows "\<langle>a,b\<rangle> \<in> StrictVersion(r) \<or> \<langle>b,a\<rangle> \<in> StrictVersion(r)"
  using assms IsTotal_def def_of_strict_ver by auto

text\<open>A trichotomy law for the strict version of a total
  and antisymmetric
  relation. It is kind of interesting that one does not need
  the full linear order for this.\<close>

lemma strict_ans_tot_trich:
  assumes A1: "antisym(r)" and A2: "r {is total on} X"
  and A3: "a\<in>X"  "b\<in>X"
  and A4: "s = StrictVersion(r)"
  shows "Exactly_1_of_3_holds(\<langle>a,b\<rangle> \<in> s, a=b,\<langle>b,a\<rangle> \<in> s)"
proof -
  let ?p = "\<langle>a,b\<rangle> \<in> s"
  let ?q = "a=b"
  let ?r = "\<langle>b,a\<rangle> \<in> s"
  from A2 A3 A4 have "?p \<or> ?q \<or> ?r"
    using strict_of_tot by auto
  moreover from A1 A4 have "?p \<longrightarrow> \<not>?q \<and> \<not>?r"
    using def_of_strict_ver strict_of_antisym by simp
  moreover from A4 have "?q \<longrightarrow> \<not>?p \<and> \<not>?r"
    using def_of_strict_ver by simp
  moreover from A1 A4 have "?r \<longrightarrow> \<not>?p \<and> \<not>?q"
    using def_of_strict_ver strict_of_antisym by auto
  ultimately show "Exactly_1_of_3_holds(?p, ?q, ?r)"
    by (rule Fol1_L5)
qed

text\<open>A trichotomy law for linear order. This is a special
  case of \<open>strict_ans_tot_trich\<close>.\<close>

corollary strict_lin_trich: assumes A1: "IsLinOrder(X,r)" and
  A2: "a\<in>X"  "b\<in>X" and
  A3: "s = StrictVersion(r)"
  shows "Exactly_1_of_3_holds(\<langle>a,b\<rangle> \<in> s, a=b,\<langle>b,a\<rangle> \<in> s)"
  using assms IsLinOrder_def strict_ans_tot_trich by auto

text\<open>For an antisymmetric relation if a pair is in relation then
  the reversed pair is not in the strict version of the relation.
\<close>

lemma geq_impl_not_less:
  assumes A1: "antisym(r)" and A2: "\<langle>a,b\<rangle> \<in> r"
  shows "\<langle>b,a\<rangle> \<notin> StrictVersion(r)"
proof -
  { assume A3: "\<langle>b,a\<rangle> \<in>  StrictVersion(r)"
    with A2 have "\<langle>a,b\<rangle> \<in> StrictVersion(r)"
      using def_of_strict_ver by auto
    with A1 A3 have False using strict_of_antisym
      by blast
  } then show "\<langle>b,a\<rangle> \<notin> StrictVersion(r)" by auto
qed

text\<open>If an antisymmetric relation is transitive,
  then the strict version is also transitive, an explicit
  version \<open>strict_of_transB\<close> below.\<close>

lemma strict_of_transA:
  assumes A1: "trans(r)" and A2: "antisym(r)" and
  A3: "s= StrictVersion(r)" and  A4: "\<langle>a,b\<rangle> \<in> s"  "\<langle>b,c\<rangle> \<in> s"
  shows "\<langle>a,c\<rangle> \<in> s"
proof -
  from A3 A4 have I: "\<langle>a,b\<rangle> \<in> r \<and> \<langle>b,c\<rangle> \<in> r"
    using def_of_strict_ver by simp
  with A1 have "\<langle>a,c\<rangle> \<in> r" by (rule Fol1_L3)
  moreover
  { assume "a=c"
    with I have "\<langle>a,b\<rangle> \<in> r" and "\<langle>b,a\<rangle> \<in> r" by auto
    with A2 have "a=b" by (rule Fol1_L4)
    with A3 A4 have False using def_of_strict_ver by simp
  } then have "a\<noteq>c" by auto
  ultimately have  "\<langle>a,c\<rangle> \<in> StrictVersion(r)"
    using def_of_strict_ver by simp
  with A3 show ?thesis by simp
qed

text\<open>If an antisymmetric relation is transitive,
  then the strict version is also transitive.\<close>

lemma strict_of_transB:
  assumes A1: "trans(r)" and A2: "antisym(r)"
  shows "trans(StrictVersion(r))"
proof -
  let ?s = "StrictVersion(r)"
  from A1 A2 have
    "\<forall> x y z. \<langle>x, y\<rangle> \<in> ?s \<and> \<langle>y, z\<rangle> \<in> ?s \<longrightarrow> \<langle>x, z\<rangle> \<in> ?s"
    using strict_of_transA by blast
  then show "trans(StrictVersion(r))" by (rule Fol1_L2)
qed

text\<open>The next lemma provides a condition that is satisfied by
  the strict version of a relation if the original relation
  is a complete linear order.\<close>

lemma strict_of_compl:
  assumes A1: "r \<subseteq> X\<times>X" and A2: "IsLinOrder(X,r)" and
  A3: "r {is complete}" and
  A4: "A\<subseteq>X"  "A\<noteq>0" and A5: "s = StrictVersion(r)" and
  A6: "\<exists>u\<in>X. \<forall>y\<in>A. \<langle>y,u\<rangle> \<in> s"
  shows
  "\<exists>x\<in>X. ( \<forall>y\<in>A. \<langle>x,y\<rangle> \<notin> s ) \<and> (\<forall>y\<in>X. \<langle>y,x\<rangle> \<in> s \<longrightarrow> (\<exists>z\<in>A. \<langle>y,z\<rangle> \<in> s))"
proof -
  let ?x = "Supremum(r,A)"
  from A2 have I: "antisym(r)" using IsLinOrder_def
    by simp
  moreover from A5 A6 have "\<exists>u\<in>X. \<forall>y\<in>A. \<langle>y,u\<rangle> \<in> r"
    using def_of_strict_ver by auto
  moreover note A1 A3 A4
  ultimately have II: "?x \<in> X"   "\<forall>y\<in>A. \<langle>y,?x\<rangle> \<in> r"
    using Order_ZF_5_L7 by auto
  then have III: "\<exists>x\<in>X. \<forall>y\<in>A. \<langle>y,x\<rangle> \<in> r" by auto
  from A5 I II have "?x \<in> X"   "\<forall>y\<in>A. \<langle>?x,y\<rangle> \<notin> s"
    using geq_impl_not_less by auto
  moreover from A1 A2 A3 A4 A5 III have
    "\<forall>y\<in>X. \<langle>y,?x\<rangle> \<in> s \<longrightarrow> (\<exists>z\<in>A. \<langle>y,z\<rangle> \<in> s)"
    using def_of_strict_ver Order_ZF_5_L8 by simp
  ultimately show
    "\<exists>x\<in>X. ( \<forall>y\<in>A. \<langle>x,y\<rangle> \<notin> s ) \<and> (\<forall>y\<in>X. \<langle>y,x\<rangle> \<in> s \<longrightarrow> (\<exists>z\<in>A. \<langle>y,z\<rangle> \<in> s))"
    by auto
qed

text\<open>Strict version of a relation on a set is a relation on that
  set.\<close>

lemma strict_ver_rel: assumes A1: "r \<subseteq> A\<times>A"
  shows "StrictVersion(r) \<subseteq> A\<times>A"
  using assms StrictVersion_def by auto

end


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2004         |
            |               December 2004               |
            |                   June 2005  (modified)   |
            |              September 2005  (modified)   |
            |                                           |
            |        CSP-Prover on Isabelle2005         |
            |               November 2005  (modified)   |
            |                  March 2007  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_F_law_ref
imports CSP_F_law_basic CSP_T.CSP_T_law_ref
begin

(*****************************************************************

         1. rules for refinement

 *****************************************************************)

(*-------------------------------------------------------*
 |            refinement and equality                    |
 *-------------------------------------------------------*)

lemma cspF_ref_eq_iff: "(P <=F[M,M] Q) = (P =F[M,M] Q |~| P)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_ref_eq_iff)
apply (rule)

(* <= *)
 apply (simp)
 apply (rule order_antisym)
 apply (simp add: subsetF_iff)
 apply (simp add: in_failures)
 apply (simp add: subsetF_iff)
 apply (simp add: in_failures)

(* => *)
 apply (simp)
 apply (erule conjE)
 apply (erule order_antisymE)
 apply (rule)
 apply (rotate_tac 2)
 apply (erule subsetFE_ALL)
 apply (drule_tac x="s" in spec)
 apply (drule_tac x="X" in spec)
 apply (simp add: in_failures)
done

(*-------------------------------------------------------*
 |              decompose Internal choice                |
 *-------------------------------------------------------*)

(*** or <= ***)                                         (* unsafe *)

lemma cspF_Int_choice_left1:
  "P1 <=F[M1,M2] Q ==> P1 |~| P2 <=F[M1,M2] Q"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_left1)
apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Int_choice_left2:
  "P2 <=F[M1,M2] Q ==> P1 |~| P2 <=F[M1,M2] Q"
apply (rule cspF_rw_left)
apply (rule cspF_commut)
by (simp add: cspF_Int_choice_left1)

(*** <= and ***)                                          (* safe *)

lemma cspF_Int_choice_right:
  "[| P <=F[M1,M2] Q1 ; P <=F[M1,M2] Q2 |]
      ==> P <=F[M1,M2] Q1 |~| Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_choice_right)
apply (rule, simp add: in_failures)
apply (force)
done

(*-------------------------------------------------------*
 |        decompose Replicated internal choice           |
 *-------------------------------------------------------*)

(*** EX <= ***)                                           (* unsafe *)

lemma cspF_Rep_int_choice_nat_left:
  "(EX n. n:N & Pf n <=F[M1,M2] Q)
      ==> !nat :N .. Pf <=F[M1,M2] Q"
apply (simp add: cspF_cspT_semantics)
apply (rule conjI)

apply (rule cspT_Rep_int_choice_left)
apply (fast)

apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_nat_left_x:
  "[| n:N ; Pf n <=F[M1,M2] Q |]
  ==> !nat :N .. Pf <=F[M1,M2] Q"
apply (rule cspF_Rep_int_choice_nat_left)
by (fast)

lemma cspF_Rep_int_choice_set_left:
  "(EX X. X:Xs & Pf X <=F[M1,M2] Q)
      ==> !set :Xs .. Pf <=F[M1,M2] Q"
apply (simp add: cspF_cspT_semantics)
apply (rule conjI)

apply (rule cspT_Rep_int_choice_left)
apply (fast)

apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_set_left_x:
  "[| X:Xs ; Pf X <=F[M1,M2] Q |]
  ==> !set :Xs .. Pf <=F[M1,M2] Q"
apply (rule cspF_Rep_int_choice_set_left)
by (fast)

lemma cspF_Rep_int_choice_com_left:
  "(EX a. a:X & Pf a <=F[M1,M2] Q)
      ==> ! :X .. Pf <=F[M1,M2] Q"
apply (simp add: Rep_int_choice_com_def)
apply (rule cspF_Rep_int_choice_set_left)
apply (erule exE)
apply (rule_tac x="{a}" in exI)
apply (auto)
done

lemma cspF_Rep_int_choice_com_left_x:
  "[| a:X ; Pf a <=F[M1,M2] Q |]
  ==> ! :X .. Pf <=F[M1,M2] Q"
apply (rule cspF_Rep_int_choice_com_left)
by (fast)

lemma cspF_Rep_int_choice_f_left:
  "[| inj f ; (EX a. a:X & Pf a <=F[M1,M2] Q) |]
      ==> !<f> :X .. Pf <=F[M1,M2] Q"
apply (simp add: Rep_int_choice_f_def)
apply (rule cspF_Rep_int_choice_com_left)
apply (erule exE)
apply (rule_tac x="f a" in exI)
apply (auto)
done

lemma cspF_Rep_int_choice_f_left_x:
  "[| inj f ; a:X ; Pf a <=F[M1,M2] Q |]
  ==> !<f> :X .. Pf <=F[M1,M2] Q"
apply (rule cspF_Rep_int_choice_f_left)
apply (simp)
by (fast)

lemmas cspF_Rep_int_choice_left = cspF_Rep_int_choice_nat_left
                                  cspF_Rep_int_choice_set_left
                                  cspF_Rep_int_choice_com_left
                                  cspF_Rep_int_choice_f_left

lemmas cspF_Rep_int_choice_left_x = cspF_Rep_int_choice_nat_left_x
                                  cspF_Rep_int_choice_set_left_x
                                  cspF_Rep_int_choice_com_left_x
                                  cspF_Rep_int_choice_f_left_x

(*** <= ALL ***)                                         (* safe *)

lemma cspF_Rep_int_choice_nat_right:
  "[| !!n. n:N ==> P <=F[M1,M2] Qf n |]
               ==> P <=F[M1,M2] !nat :N .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_right)
apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_set_right:
  "[| !!X. X:Xs ==> P <=F[M1,M2] Qf X |]
               ==> P <=F[M1,M2] !set :Xs .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_right)
apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_com_right:
  "[| !!a. a:X ==> P <=F[M1,M2] Qf a |]
               ==> P <=F[M1,M2] ! :X .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_right)
apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_f_right:
  "[| inj f ; !!a. a:X ==> P <=F[M1,M2] Qf a |]
               ==> P <=F[M1,M2] !<f> :X .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_right)
apply (rule, simp add: in_failures)
apply (force)
done

lemmas cspF_Rep_int_choice_right
     = cspF_Rep_int_choice_nat_right
       cspF_Rep_int_choice_set_right
       cspF_Rep_int_choice_com_right
       cspF_Rep_int_choice_f_right

(* 1,2,3,f E *)

lemma cspF_Rep_int_choice_nat_rightE:
  "[| P <=F[M1,M2] !nat :N .. Qf ;
      ALL n:N. P <=F[M1,M2] Qf n ==> R
   |] ==> R"
apply (simp add: cspF_cspT_semantics)
apply (elim conjE exE)
apply (erule cspT_Rep_int_choice_rightE)

apply (simp add: subsetF_iff)
apply (simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_set_rightE:
  "[| P <=F[M1,M2] !set :Xs .. Qf ;
      ALL X:Xs. P <=F[M1,M2] Qf X ==> R
   |] ==> R"
apply (simp add: cspF_cspT_semantics)
apply (elim conjE exE)
apply (erule cspT_Rep_int_choice_rightE)

apply (simp add: subsetF_iff)
apply (simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_com_rightE:
  "[| P <=F[M1,M2] ! :X .. Qf ;
      ALL a:X. P <=F[M1,M2] Qf a ==> R
   |] ==> R"
apply (simp add: cspF_cspT_semantics)
apply (elim conjE exE)
apply (erule cspT_Rep_int_choice_rightE)

apply (simp add: subsetF_iff)
apply (simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_f_rightE:
  "[| P <=F[M1,M2] !<f> :X .. Qf ; inj f ;
      [| ALL a:X. P <=F[M1,M2] Qf a |] ==> R
   |] ==> R"
apply (simp add: cspF_cspT_semantics)
apply (elim conjE exE)
apply (erule cspT_Rep_int_choice_rightE)
apply (simp)

apply (simp add: subsetF_iff)
apply (simp add: in_failures)
apply (force)
done

lemmas cspF_Rep_int_choice_rightE =
       cspF_Rep_int_choice_nat_rightE
       cspF_Rep_int_choice_set_rightE
       cspF_Rep_int_choice_com_rightE
       cspF_Rep_int_choice_f_rightE

(*-------------------------------------------------------*
 |             decomposition with subset                 |
 *-------------------------------------------------------*)

lemma cspF_Rep_int_choice_nat_subset:
  "[| N2 <= N1  ; !!n. n:N2 ==> Pf n <=F[M1,M2] Qf n |]
                    ==> !nat :N1 .. Pf <=F[M1,M2] !nat :N2 .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_subset)
apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_set_subset:
  "[| Ys <= Xs  ; !!X. X:Ys ==> Pf X <=F[M1,M2] Qf X |]
                    ==> !set :Xs .. Pf <=F[M1,M2] !set :Ys .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_subset)
apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_com_subset:
  "[| Y <= X  ; !!a. a:Y ==> Pf a <=F[M1,M2] Qf a |]
                    ==> ! :X .. Pf <=F[M1,M2] ! :Y .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_subset)
apply (rule, simp add: in_failures)
apply (force)
done

lemma cspF_Rep_int_choice_f_subset:
  "[| inj f ; Y <= X  ; !!a. a:Y ==> Pf a <=F[M1,M2] Qf a |]
                    ==> !<f> :X .. Pf <=F[M1,M2] !<f> :Y .. Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Rep_int_choice_subset)
apply (rule, simp add: in_failures)
apply (force)
done

lemmas cspF_Rep_int_choice_subset
     = cspF_Rep_int_choice_nat_subset
       cspF_Rep_int_choice_set_subset
       cspF_Rep_int_choice_com_subset
       cspF_Rep_int_choice_f_subset

(*** ! x:X .. and ? -> ***)

lemma cspF_Int_Ext_pre_choice_subset:
  "[| Y ~={} ; Y <= X ; !!a. a:Y ==> Pf a <=F[M1,M2] Qf a |]
        ==> ! x:X .. (x -> Pf x) <=F[M1,M2]
            ? :Y -> Qf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Int_Ext_pre_choice_subset)
apply (rule, simp add: in_failures)
apply (force)
done

lemmas cspF_decompo_subset = cspF_Rep_int_choice_subset
                             cspF_Int_Ext_pre_choice_subset

(*-------------------------------------------------------*
 |               decompose external choice               |
 *-------------------------------------------------------*)

lemma cspF_Ext_choice_right:
  "[| P <=F[M1,M2] Q1 ;
      P <=F[M1,M2] Q2 |]
      ==> P <=F[M1,M2] Q1 [+] Q2"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_right)
apply (rule)

 apply (simp add: in_failures)
 apply (elim disjE conjE exE, simp)
 apply (force, force, force)
 apply (simp_all)

 apply (subgoal_tac "(<>, X) :f failures(Q1) M2")
 apply (force)
 apply (rule proc_F2_F4)
 apply (simp_all)
 apply (rule proc_F2_F4)
 apply (simp_all)
 apply (simp add: cspT_semantics)
 apply (auto)
done

end


(*  Title:       AWN_SOS.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke
*)

section "Semantics of the Algebra of Wireless Networks"

theory AWN_SOS
imports TransitionSystems AWN
begin

subsection "Table 1: Structural operational semantics for sequential process expressions "

inductive_set
  seqp_sos
  :: "('s, 'm, 'p, 'l) seqp_env \<Rightarrow> ('s \<times> ('s, 'm, 'p, 'l) seqp, 'm seq_action) transition set"
  for \<Gamma> :: "('s, 'm, 'p, 'l) seqp_env"
where
    broadcastT: "((\<xi>, {l}broadcast(s\<^sub>m\<^sub>s\<^sub>g).p),          broadcast (s\<^sub>m\<^sub>s\<^sub>g \<xi>),         (\<xi>, p)) \<in> seqp_sos \<Gamma>"
  | groupcastT: "((\<xi>, {l}groupcast(s\<^sub>i\<^sub>p\<^sub>s, s\<^sub>m\<^sub>s\<^sub>g).p),    groupcast (s\<^sub>i\<^sub>p\<^sub>s \<xi>) (s\<^sub>m\<^sub>s\<^sub>g \<xi>), (\<xi>, p)) \<in> seqp_sos \<Gamma>"
  | unicastT:   "((\<xi>, {l}unicast(s\<^sub>i\<^sub>p, s\<^sub>m\<^sub>s\<^sub>g).p \<triangleright> q),   unicast (s\<^sub>i\<^sub>p \<xi>) (s\<^sub>m\<^sub>s\<^sub>g \<xi>),    (\<xi>, p)) \<in> seqp_sos \<Gamma>"
  | notunicastT:"((\<xi>, {l}unicast(s\<^sub>i\<^sub>p, s\<^sub>m\<^sub>s\<^sub>g).p \<triangleright> q),    \<not>unicast (s\<^sub>i\<^sub>p \<xi>),          (\<xi>, q)) \<in> seqp_sos \<Gamma>"
  | sendT:      "((\<xi>, {l}send(s\<^sub>m\<^sub>s\<^sub>g).p),               send (s\<^sub>m\<^sub>s\<^sub>g \<xi>),              (\<xi>, p)) \<in> seqp_sos \<Gamma>"
  | deliverT:   "((\<xi>, {l}deliver(s\<^sub>d\<^sub>a\<^sub>t\<^sub>a).p),           deliver (s\<^sub>d\<^sub>a\<^sub>t\<^sub>a \<xi>),          (\<xi>, p)) \<in> seqp_sos \<Gamma>"
  | receiveT:   "((\<xi>, {l}receive(u\<^sub>m\<^sub>s\<^sub>g).p),            receive msg,       (u\<^sub>m\<^sub>s\<^sub>g msg \<xi>, p)) \<in> seqp_sos \<Gamma>"
  | assignT:    "((\<xi>, {l}\<lbrakk>u\<rbrakk> p),                      \<tau>,                        (u \<xi>, p)) \<in> seqp_sos \<Gamma>"

  | callT:      "\<lbrakk> ((\<xi>, \<Gamma> pn), a, (\<xi>', p')) \<in> seqp_sos \<Gamma> \<rbrakk> \<Longrightarrow>
                 ((\<xi>, call(pn)), a, (\<xi>', p')) \<in> seqp_sos \<Gamma>" (* TPB: quite different to Table 1 *)

  | choiceT1:   "((\<xi>, p), a, (\<xi>', p')) \<in> seqp_sos \<Gamma>  \<Longrightarrow> ((\<xi>, p \<oplus> q), a, (\<xi>', p')) \<in> seqp_sos \<Gamma>"
  | choiceT2:   "((\<xi>, q), a, (\<xi>', q')) \<in> seqp_sos \<Gamma>  \<Longrightarrow> ((\<xi>, p \<oplus> q), a, (\<xi>', q')) \<in> seqp_sos \<Gamma>"

  | guardT:     "\<xi>' \<in> g \<xi> \<Longrightarrow> ((\<xi>, {l}\<langle>g\<rangle> p), \<tau>, (\<xi>', p)) \<in> seqp_sos \<Gamma>"

inductive_cases
      seqp_callTE [elim]:      "((\<xi>, call(pn)), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>"
  and seqp_choiceTE [elim]:    "((\<xi>, p1 \<oplus> p2), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>"

lemma seqp_broadcastTE [elim]:
  "\<lbrakk>((\<xi>, {l}broadcast(s\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>;
    \<lbrakk>a = broadcast (s\<^sub>m\<^sub>s\<^sub>g \<xi>); \<xi>' = \<xi>; q = p\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((\<xi>, {l}broadcast(s\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>") simp

lemma seqp_groupcastTE [elim]:
  "\<lbrakk>((\<xi>, {l}groupcast(s\<^sub>i\<^sub>p\<^sub>s, s\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>;
    \<lbrakk>a = groupcast (s\<^sub>i\<^sub>p\<^sub>s \<xi>) (s\<^sub>m\<^sub>s\<^sub>g \<xi>); \<xi>' = \<xi>; q = p\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((\<xi>, {l}groupcast(s\<^sub>i\<^sub>p\<^sub>s, s\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>") simp

lemma seqp_unicastTE [elim]:
  "\<lbrakk>((\<xi>, {l}unicast(s\<^sub>i\<^sub>p, s\<^sub>m\<^sub>s\<^sub>g). p \<triangleright> q), a, (\<xi>', r)) \<in> seqp_sos \<Gamma>;
    \<lbrakk>a = unicast (s\<^sub>i\<^sub>p \<xi>) (s\<^sub>m\<^sub>s\<^sub>g \<xi>); \<xi>' = \<xi>; r = p\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>a = \<not>unicast (s\<^sub>i\<^sub>p \<xi>); \<xi>' = \<xi>; r = q\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((\<xi>, {l}unicast(s\<^sub>i\<^sub>p, s\<^sub>m\<^sub>s\<^sub>g). p \<triangleright> q), a, (\<xi>', r)) \<in> seqp_sos \<Gamma>") simp_all

lemma seqp_sendTE [elim]:
  "\<lbrakk>((\<xi>, {l}send(s\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>;
    \<lbrakk>a = send (s\<^sub>m\<^sub>s\<^sub>g \<xi>); \<xi>' = \<xi>; q = p\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((\<xi>, {l}send(s\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>") simp

lemma seqp_deliverTE [elim]:
  "\<lbrakk>((\<xi>, {l}deliver(s\<^sub>d\<^sub>a\<^sub>t\<^sub>a). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>;
    \<lbrakk>a = deliver (s\<^sub>d\<^sub>a\<^sub>t\<^sub>a \<xi>); \<xi>' = \<xi>; q = p\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((\<xi>, {l}deliver(s\<^sub>d\<^sub>a\<^sub>t\<^sub>a). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>") simp

lemma seqp_receiveTE [elim]:
  "\<lbrakk>((\<xi>, {l}receive(u\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>;
    \<And>msg. \<lbrakk>a = receive msg; \<xi>' = u\<^sub>m\<^sub>s\<^sub>g msg \<xi>; q = p\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((\<xi>, {l}receive(u\<^sub>m\<^sub>s\<^sub>g). p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>") simp

lemma seqp_assignTE [elim]:
  "\<lbrakk>((\<xi>, {l}\<lbrakk>u\<rbrakk> p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>; \<lbrakk>a = \<tau>; \<xi>' = u \<xi>; q = p\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((\<xi>, {l}\<lbrakk>u\<rbrakk> p), a, (\<xi>', q)) \<in> seqp_sos \<Gamma>") simp

lemmas seqpTEs =
  seqp_broadcastTE
  seqp_groupcastTE
  seqp_unicastTE
  seqp_sendTE
  seqp_deliverTE
  seqp_receiveTE
  seqp_assignTE
  seqp_callTE
  seqp_choiceTE
  seqp_guardTE

declare seqp_sos.intros [intro]

subsection "Table 2: Structural operational semantics for parallel process expressions "

inductive_set
  parp_sos :: "('s1, 'm seq_action) transition set
                    \<Rightarrow> ('s2, 'm seq_action) transition set
                    \<Rightarrow> ('s1 \<times> 's2, 'm seq_action) transition set"
  for S :: "('s1, 'm seq_action) transition set"
  and T :: "('s2, 'm seq_action) transition set"
where
    parleft:  "\<lbrakk> (s, a, s') \<in> S; \<And>m. a \<noteq> receive m \<rbrakk> \<Longrightarrow> ((s, t), a, (s', t)) \<in> parp_sos S T"
  | parright: "\<lbrakk> (t, a, t') \<in> T; \<And>m. a \<noteq> send m \<rbrakk> \<Longrightarrow> ((s, t), a, (s, t')) \<in> parp_sos S T"
  | parboth:  "\<lbrakk> (s, receive m, s') \<in> S; (t, send m, t') \<in> T \<rbrakk>
               \<Longrightarrow>((s, t), \<tau>, (s', t')) \<in> parp_sos S T"

lemma par_broadcastTE [elim]:
  "\<lbrakk>((s, t), broadcast m, (s', t')) \<in> parp_sos S T;
    \<lbrakk>(s, broadcast m, s') \<in> S; t' = t\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>(t, broadcast m, t') \<in> T; s' = s\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((s, t), broadcast m, (s', t')) \<in> parp_sos S T") simp_all

lemma par_groupcastTE [elim]:
  "\<lbrakk>((s, t), groupcast ips m, (s', t')) \<in> parp_sos S T;
    \<lbrakk>(s, groupcast ips m, s') \<in> S; t' = t\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>(t, groupcast ips m, t') \<in> T; s' = s\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((s, t), groupcast ips m, (s', t')) \<in> parp_sos S T") simp_all

lemma par_unicastTE [elim]:
  "\<lbrakk>((s, t), unicast i m, (s', t')) \<in> parp_sos S T;
    \<lbrakk>(s, unicast i m, s') \<in> S; t' = t\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>(t, unicast i m, t') \<in> T; s' = s\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((s, t), unicast i m, (s', t')) \<in> parp_sos S T") simp_all

lemma par_notunicastTE [elim]:
  "\<lbrakk>((s, t), notunicast i, (s', t')) \<in> parp_sos S T;
    \<lbrakk>(s, notunicast i, s') \<in> S; t' = t\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>(t, notunicast i, t') \<in> T; s' = s\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((s, t), notunicast i, (s', t')) \<in> parp_sos S T") simp_all

lemma par_sendTE [elim]:
  "\<lbrakk>((s, t), send m, (s', t')) \<in> parp_sos S T;
    \<lbrakk>(s, send m, s') \<in> S; t' = t\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((s, t), send m, (s', t')) \<in> parp_sos S T") auto

lemma par_deliverTE [elim]:
  "\<lbrakk>((s, t), deliver d, (s', t')) \<in> parp_sos S T;
    \<lbrakk>(s, deliver d, s') \<in> S; t' = t\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>(t, deliver d, t') \<in> T; s' = s\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((s, t), deliver d, (s', t')) \<in> parp_sos S T") simp_all

lemma par_receiveTE [elim]:
  "\<lbrakk>((s, t), receive m, (s', t')) \<in> parp_sos S T;
    \<lbrakk>(t, receive m, t') \<in> T; s' = s\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (ind_cases "((s, t), receive m, (s', t')) \<in> parp_sos S T") auto

inductive_cases par_tauTE: "((s, t), \<tau>, (s', t')) \<in> parp_sos S T"

lemmas parpTEs =
  par_broadcastTE
  par_groupcastTE
  par_unicastTE
  par_notunicastTE
  par_sendTE
  par_deliverTE
  par_receiveTE

lemma parp_sos_cases [elim]:
  assumes "((s, t), a, (s', t')) \<in> parp_sos S T"
      and "\<lbrakk> (s, a, s') \<in> S; \<And>m. a \<noteq> receive m; t' = t \<rbrakk> \<Longrightarrow> P"
      and "\<lbrakk> (t, a, t') \<in> T; \<And>m. a \<noteq> send m; s' = s \<rbrakk> \<Longrightarrow> P"
      and "\<And>m. \<lbrakk> (s, receive m, s') \<in> S; (t, send m, t') \<in> T \<rbrakk> \<Longrightarrow> P"
    shows "P"
  using assms by cases auto

definition
  par_comp :: "('s1, 'm seq_action) automaton
              \<Rightarrow> ('s2, 'm seq_action) automaton
              \<Rightarrow> ('s1 \<times> 's2, 'm seq_action) automaton"
  ("(_ \<langle>\<langle> _)" [102, 103] 102)
where
  "s \<langle>\<langle> t \<equiv> \<lparr> init = init s \<times> init t, trans = parp_sos (trans s) (trans t) \<rparr>"

lemma trans_par_comp [simp]:
  "trans (s \<langle>\<langle> t) = parp_sos (trans s) (trans t)"
  unfolding par_comp_def by simp

lemma init_par_comp [simp]:
  "init (s \<langle>\<langle> t) = init s \<times> init t"
  unfolding par_comp_def by simp

subsection "Table 3: Structural operational semantics for node expressions "

inductive_set
  node_sos :: "('s, 'm seq_action) transition set \<Rightarrow> ('s net_state, 'm node_action) transition set"
  for S :: "('s, 'm seq_action) transition set"
where
    node_bcast:
    "(s, broadcast m, s') \<in> S \<Longrightarrow> (NodeS i s R, R:*cast(m), NodeS i s' R) \<in> node_sos S"
  | node_gcast:
    "(s, groupcast D m, s') \<in> S \<Longrightarrow> (NodeS i s R, (R\<inter>D):*cast(m), NodeS i s' R) \<in> node_sos S"
  | node_ucast:
    "\<lbrakk> (s, unicast d m, s') \<in> S; d\<in>R \<rbrakk> \<Longrightarrow> (NodeS i s R, {d}:*cast(m), NodeS i s' R) \<in> node_sos S"
  | node_notucast:
    "\<lbrakk> (s, \<not>unicast d, s') \<in> S; d\<notin>R \<rbrakk> \<Longrightarrow> (NodeS i s R, \<tau>, NodeS i s' R) \<in> node_sos S"
  | node_deliver:
    "(s, deliver d, s') \<in> S \<Longrightarrow> (NodeS i s R, i:deliver(d), NodeS i s' R) \<in> node_sos S"
  | node_receive:
    "(s, receive m, s') \<in> S \<Longrightarrow> (NodeS i s R, {i}\<not>{}:arrive(m), NodeS i s' R) \<in> node_sos S"
  | node_tau:
    "(s, \<tau>, s') \<in> S         \<Longrightarrow> (NodeS i s R, \<tau>, NodeS i s' R) \<in> node_sos S"
  | node_arrive:
    "(NodeS i s R, {}\<not>{i}:arrive(m),  NodeS i s R) \<in> node_sos S"
  | node_connect1:
    "(NodeS i s R, connect(i, i'),    NodeS i s (R \<union> {i'})) \<in> node_sos S"
  | node_connect2:
    "(NodeS i s R, connect(i', i),    NodeS i s (R \<union> {i'})) \<in> node_sos S"
  | node_disconnect1:
    "(NodeS i s R, disconnect(i, i'), NodeS i s (R - {i'})) \<in> node_sos S"
  | node_disconnect2:
    "(NodeS i s R, disconnect(i', i), NodeS i s (R - {i'})) \<in> node_sos S"
  | node_connect_other:
    "\<lbrakk> i \<noteq> i'; i \<noteq> i'' \<rbrakk> \<Longrightarrow> (NodeS i s R, connect(i', i''), NodeS i s R) \<in> node_sos S"
  | node_disconnect_other:
    "\<lbrakk> i \<noteq> i'; i \<noteq> i'' \<rbrakk> \<Longrightarrow> (NodeS i s R, disconnect(i', i''), NodeS i s R) \<in> node_sos S"

inductive_cases node_arriveTE:  "(NodeS i s R, ii\<not>ni:arrive(m), NodeS i s' R) \<in> node_sos S"
            and node_arriveTE': "(NodeS i s R, H\<not>K:arrive(m), s') \<in> node_sos S"
            and node_castTE:    "(NodeS i s R, RM:*cast(m), NodeS i s' R') \<in> node_sos S"
            and node_castTE':   "(NodeS i s R, RM:*cast(m), s') \<in> node_sos S"
            and node_deliverTE: "(NodeS i s R, i:deliver(d), NodeS i s' R) \<in> node_sos S"
            and node_deliverTE': "(s, i:deliver(d), s') \<in> node_sos S"
            and node_deliverTE'': "(NodeS ii s R, i:deliver(d), s') \<in> node_sos S"
            and node_tauTE:     "(NodeS i s R, \<tau>, NodeS i s' R) \<in> node_sos S"
            and node_tauTE':    "(NodeS i s R, \<tau>, s') \<in> node_sos S"
            and node_connectTE: "(NodeS ii s R, connect(i, i'), NodeS ii s' R') \<in> node_sos S"
            and node_connectTE': "(NodeS ii s R, connect(i, i'), s') \<in> node_sos S"
            and node_disconnectTE: "(NodeS ii s R, disconnect(i, i'), NodeS ii s' R') \<in> node_sos S"
            and node_disconnectTE': "(NodeS ii s R, disconnect(i, i'), s') \<in> node_sos S"

lemma node_sos_never_newpkt [simp]:
  assumes "(s, a, s') \<in> node_sos S"
    shows "a \<noteq> i:newpkt(d, di)"
  using assms by cases auto

lemma arrives_or_not:
  assumes "(NodeS i s R, ii\<not>ni:arrive(m), NodeS i' s' R') \<in> node_sos S"
    shows "(ii = {i} \<and> ni = {}) \<or> (ii = {} \<and> ni = {i})"
  using assms by rule simp_all

definition
  node_comp :: "ip \<Rightarrow> ('s, 'm seq_action) automaton \<Rightarrow> ip set
                   \<Rightarrow> ('s net_state, 'm node_action) automaton"
    ("(\<langle>_ : (_) : _\<rangle>)" [0, 0, 0] 104)
where
  "\<langle>i : np : R\<^sub>i\<rangle> \<equiv> \<lparr> init = {NodeS i s R\<^sub>i|s. s \<in> init np}, trans = node_sos (trans np) \<rparr>"

lemma trans_node_comp:
  "trans (\<langle>i : np : R\<^sub>i\<rangle>) = node_sos (trans np)"
  unfolding node_comp_def by simp

lemma init_node_comp:
  "init (\<langle>i : np : R\<^sub>i\<rangle>) = {NodeS i s R\<^sub>i|s. s \<in> init np}"
  unfolding node_comp_def by simp

lemmas node_comps = trans_node_comp init_node_comp

lemma trans_par_node_comp [simp]:
  "trans (\<langle>i : s \<langle>\<langle> t : R\<rangle>) = node_sos (parp_sos (trans s) (trans t))"
  unfolding node_comp_def by simp

lemma snd_par_node_comp [simp]:
  "init (\<langle>i : s \<langle>\<langle> t : R\<rangle>) = {NodeS i st R|st. st \<in> init s \<times> init t}"
  unfolding node_comp_def by simp

lemma node_sos_dest_is_net_state:
  assumes "(s, a, s') \<in> node_sos S"
    shows "\<exists>i' P' R'. s' = NodeS i' P' R'"
  using assms by induct auto

lemma node_sos_dest:
  assumes "(NodeS i p R, a, s') \<in> node_sos S"
    shows "\<exists>P' R'. s' = NodeS i P' R'"
  using assms assms [THEN node_sos_dest_is_net_state]
  by - (erule node_sos.cases, auto)

lemma node_sos_states [elim]:
  assumes "(ns, a, ns') \<in> node_sos S"
  obtains i s R s' R' where "ns  = NodeS i s  R"
                        and "ns' = NodeS i s' R'"
  proof -
    assume [intro!]: "\<And>i s R s' R'. ns = NodeS i s R \<Longrightarrow> ns' = NodeS i s' R' \<Longrightarrow> thesis"
    from assms(1) obtain i s R where "ns = NodeS i s R"
      by (cases ns) auto
    moreover with assms(1) obtain s' R' where "ns' = NodeS i s' R'"
      by (metis node_sos_dest)
    ultimately show thesis ..
  qed

lemma node_sos_cases [elim]:
  "(NodeS i p R, a, NodeS i p' R') \<in> node_sos S \<Longrightarrow>
  (\<And>m .       \<lbrakk> a = R:*cast(m);          R' = R; (p, broadcast m, p') \<in> S \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>m D.      \<lbrakk> a = (R \<inter> D):*cast(m);    R' = R; (p, groupcast D m, p') \<in> S \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>d m.      \<lbrakk> a = {d}:*cast(m);        R' = R; (p, unicast d m, p') \<in> S; d \<in> R \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>d.        \<lbrakk> a = \<tau>;                   R' = R; (p, \<not>unicast d, p') \<in> S; d \<notin> R \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>d.        \<lbrakk> a = i:deliver(d);        R' = R; (p, deliver d, p') \<in> S \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>m.        \<lbrakk> a = {i}\<not>{}:arrive(m);    R' = R; (p, receive m, p') \<in> S \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (            \<lbrakk> a = \<tau>;                   R' = R; (p, \<tau>, p') \<in> S \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>m.        \<lbrakk> a = {}\<not>{i}:arrive(m);    R' = R; p = p' \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>i i'.     \<lbrakk> a = connect(i, i');      R' = R \<union> {i'}; p = p' \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>i i'.     \<lbrakk> a = connect(i', i);      R' = R \<union> {i'}; p = p' \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>i i'.     \<lbrakk> a = disconnect(i, i');   R' = R - {i'}; p = p' \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>i i'.     \<lbrakk> a = disconnect(i', i);   R' = R - {i'}; p = p' \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>i i' i''. \<lbrakk> a = connect(i', i'');    R' = R; p = p'; i \<noteq> i'; i \<noteq> i'' \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  (\<And>i i' i''. \<lbrakk> a = disconnect(i', i''); R' = R; p = p'; i \<noteq> i'; i \<noteq> i'' \<rbrakk> \<Longrightarrow> P) \<Longrightarrow>
  P"
  by (erule node_sos.cases) simp_all

subsection "Table 4: Structural operational semantics for partial network expressions "

inductive_set
  pnet_sos :: "('s net_state, 'm node_action) transition set
                    \<Rightarrow> ('s net_state, 'm node_action) transition set
                    \<Rightarrow> ('s net_state, 'm node_action) transition set"
  for S :: "('s net_state, 'm node_action) transition set"
  and T :: "('s net_state, 'm node_action) transition set"
where
    pnet_cast1: "\<lbrakk> (s, R:*cast(m), s') \<in> S; (t, H\<not>K:arrive(m), t') \<in> T; H \<subseteq> R; K \<inter> R = {} \<rbrakk>
      \<Longrightarrow> (SubnetS s t, R:*cast(m), SubnetS s' t') \<in> pnet_sos S T"

  | pnet_cast2: "\<lbrakk> (s, H\<not>K:arrive(m), s') \<in> S; (t, R:*cast(m), t') \<in> T;  H \<subseteq> R; K \<inter> R = {} \<rbrakk>
      \<Longrightarrow> (SubnetS s t, R:*cast(m), SubnetS s' t') \<in> pnet_sos S T"

  | pnet_arrive: "\<lbrakk> (s, H\<not>K:arrive(m), s') \<in> S; (t, H'\<not>K':arrive(m), t') \<in> T \<rbrakk>
      \<Longrightarrow> (SubnetS s t,  (H \<union> H')\<not>(K \<union> K'):arrive(m), SubnetS s' t') \<in> pnet_sos S T"

  | pnet_deliver1: "(s, i:deliver(d), s') \<in> S
      \<Longrightarrow> (SubnetS s t, i:deliver(d), SubnetS s' t) \<in> pnet_sos S T"
  | pnet_deliver2: "\<lbrakk> (t, i:deliver(d), t') \<in> T \<rbrakk>
      \<Longrightarrow> (SubnetS s t, i:deliver(d), SubnetS s t') \<in> pnet_sos S T"

  | pnet_tau1: "(s, \<tau>, s') \<in> S \<Longrightarrow> (SubnetS s t, \<tau>, SubnetS s' t) \<in> pnet_sos S T"
  | pnet_tau2: "(t, \<tau>, t') \<in> T \<Longrightarrow> (SubnetS s t, \<tau>, SubnetS s t') \<in> pnet_sos S T"

  | pnet_connect: "\<lbrakk> (s, connect(i, i'), s') \<in> S; (t, connect(i, i'), t') \<in> T \<rbrakk>
      \<Longrightarrow> (SubnetS s t, connect(i, i'), SubnetS s' t') \<in> pnet_sos S T"

  | pnet_disconnect: "\<lbrakk> (s, disconnect(i, i'), s') \<in> S; (t, disconnect(i, i'), t') \<in> T \<rbrakk>
      \<Longrightarrow> (SubnetS s t, disconnect(i, i'), SubnetS s' t') \<in> pnet_sos S T"

inductive_cases partial_castTE [elim]:       "(s, R:*cast(m), s') \<in> pnet_sos S T"
            and partial_arriveTE [elim]:     "(s, H\<not>K:arrive(m), s') \<in> pnet_sos S T"
            and partial_deliverTE [elim]:    "(s, i:deliver(d), s') \<in> pnet_sos S T"
            and partial_tauTE [elim]:        "(s, \<tau>, s') \<in> pnet_sos S T"
            and partial_connectTE [elim]:    "(s, connect(i, i'), s') \<in> pnet_sos S T"
            and partial_disconnectTE [elim]: "(s, disconnect(i, i'), s') \<in> pnet_sos S T"

lemma pnet_sos_never_newpkt:
  assumes "(st, a, st') \<in> pnet_sos S T"
      and "\<And>i d di a s s'. (s, a, s') \<in> S \<Longrightarrow> a \<noteq> i:newpkt(d, di)"
      and "\<And>i d di a t t'. (t, a, t') \<in> T \<Longrightarrow> a \<noteq> i:newpkt(d, di)"
    shows "a \<noteq> i:newpkt(d, di)"
  using assms(1) by cases (auto dest!: assms(2-3))

fun pnet :: "(ip \<Rightarrow> ('s, 'm seq_action) automaton)
              \<Rightarrow> net_tree \<Rightarrow> ('s net_state, 'm node_action) automaton"
where
    "pnet np (\<langle>i; R\<^sub>i\<rangle>)  =  \<langle>i : np i : R\<^sub>i\<rangle>"
  | "pnet np (p\<^sub>1 \<parallel> p\<^sub>2) = \<lparr> init = {SubnetS s\<^sub>1 s\<^sub>2 |s\<^sub>1 s\<^sub>2. s\<^sub>1 \<in> init (pnet np p\<^sub>1)
                                                      \<and> s\<^sub>2 \<in> init (pnet np p\<^sub>2)},
                           trans = pnet_sos (trans (pnet np p\<^sub>1)) (trans (pnet np p\<^sub>2)) \<rparr>"

lemma pnet_node_init [elim, simp]:
  assumes "s \<in> init (pnet np \<langle>i; R\<rangle>)"
    shows "s \<in> { NodeS i s R |s. s \<in> init (np i)}"
  using assms by (simp add: node_comp_def)

lemma pnet_node_init' [elim]:
 assumes "s \<in> init (pnet np \<langle>i; R\<rangle>)"
 obtains ns where "s = NodeS i ns R"
             and "ns \<in> init (np i)"
   using assms by (auto simp add: node_comp_def)

lemma pnet_node_trans [elim, simp]:
  assumes "(s, a, s') \<in> trans (pnet np \<langle>i; R\<rangle>)"
    shows "(s, a, s') \<in> node_sos (trans (np i))"
  using assms by (simp add: trans_node_comp)

lemma pnet_never_newpkt':
  assumes "(s, a, s') \<in> trans (pnet np n)"
    shows "\<forall>i d di. a \<noteq> i:newpkt(d, di)"
  using assms proof (induction n arbitrary: s a s')
    fix n1 n2 s a s'
    assume IH1: "\<And>s a s'. (s, a, s') \<in> trans (pnet np n1) \<Longrightarrow> \<forall>i d di. a \<noteq> i:newpkt(d, di)"
       and IH2: "\<And>s a s'. (s, a, s') \<in> trans (pnet np n2) \<Longrightarrow> \<forall>i d di. a \<noteq> i:newpkt(d, di)"
       and "(s, a, s') \<in> trans (pnet np (n1 \<parallel> n2))"
    show "\<forall>i d di. a \<noteq> i:newpkt(d, di)"
    proof (intro allI)
      fix i d di
      from \<open>(s, a, s') \<in> trans (pnet np (n1 \<parallel> n2))\<close>
        have "(s, a, s') \<in> pnet_sos (trans (pnet np n1)) (trans (pnet np n2))"
          by simp
      thus "a \<noteq> i:newpkt(d, di)"
        by (rule pnet_sos_never_newpkt) (auto dest!: IH1 IH2)
    qed
  qed (simp add: node_comps)

lemma pnet_never_newpkt:
  assumes "(s, a, s') \<in> trans (pnet np n)"
    shows "a \<noteq> i:newpkt(d, di)"
  proof -
    from assms have "\<forall>i d di. a \<noteq> i:newpkt(d, di)"
      by (rule pnet_never_newpkt')
    thus ?thesis by clarsimp
  qed

subsection "Table 5: Structural operational semantics for complete network expressions "

inductive_set
  cnet_sos :: "('s, ('m::msg) node_action) transition set
                    \<Rightarrow> ('s, 'm node_action) transition set"
  for S :: "('s, 'm node_action) transition set"
where
    cnet_connect: "(s, connect(i, i'), s') \<in> S  \<Longrightarrow> (s, connect(i, i'), s') \<in> cnet_sos S"
  | cnet_disconnect: "(s, disconnect(i, i'), s') \<in> S  \<Longrightarrow> (s, disconnect(i, i'), s') \<in> cnet_sos S"
  | cnet_cast: "(s, R:*cast(m), s') \<in> S  \<Longrightarrow> (s, \<tau>, s') \<in> cnet_sos S"
  | cnet_tau: "(s, \<tau>, s') \<in> S  \<Longrightarrow> (s, \<tau>, s') \<in> cnet_sos S"
  | cnet_deliver: "(s, i:deliver(d), s') \<in> S  \<Longrightarrow> (s, i:deliver(d), s') \<in> cnet_sos S"
  | cnet_newpkt: "(s, {i}\<not>K:arrive(newpkt(d, di)), s') \<in> S  \<Longrightarrow> (s, i:newpkt(d, di), s') \<in> cnet_sos S"

inductive_cases connect_completeTE: "(s, connect(i, i'), s') \<in> cnet_sos S"
            and disconnect_completeTE: "(s, disconnect(i, i'), s') \<in> cnet_sos S"
            and tau_completeTE: "(s, \<tau>, s') \<in> cnet_sos S"
            and deliver_completeTE: "(s, i:deliver(d), s') \<in> cnet_sos S"
            and newpkt_completeTE: "(s, i:newpkt(d, di), s') \<in> cnet_sos S"

lemmas completeTEs = connect_completeTE
                     disconnect_completeTE
                     tau_completeTE
                     deliver_completeTE
                     newpkt_completeTE

lemma complete_no_cast [simp]:
  "(s, R:*cast(m), s') \<notin> cnet_sos T"
  proof
    assume "(s, R:*cast(m), s') \<in> cnet_sos T"
    hence "R:*cast(m) \<noteq> R:*cast(m)"
     by (rule cnet_sos.cases) auto
    thus False by simp
  qed

lemma complete_no_arrive [simp]:
  "(s, ii\<not>ni:arrive(m), s') \<notin> cnet_sos T"
  proof
    assume "(s, ii\<not>ni:arrive(m), s') \<in> cnet_sos T"
    hence "ii\<not>ni:arrive(m) \<noteq> ii\<not>ni:arrive(m)"
     by (rule cnet_sos.cases) auto
    thus False by simp
  qed

abbreviation
  closed :: "('s net_state, ('m::msg) node_action) automaton \<Rightarrow> ('s net_state, 'm node_action) automaton"
where
  "closed \<equiv> (\<lambda>A. A \<lparr> trans := cnet_sos (trans A) \<rparr>)"

end


theory Proofs2
  imports Requirements VCTheoryLemmas
begin

definition inv2 where "inv2 s \<equiv> R2 s \<and> extraInv s"

theorem proof_2_1: "VC1 inv2 s0"
  apply(unfold VC1_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_338: "VC338 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC338_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_339: "VC339 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC339_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_340: "VC340 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC340_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_341: "VC341 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC341_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_342: "VC342 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC342_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_343: "VC343 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC343_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_344: "VC344 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC344_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_345: "VC345 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC345_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_346: "VC346 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC346_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_347: "VC347 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC347_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_348: "VC348 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC348_def inv2_def R2_def extraInv_def)
  by auto

theorem proof_2_362: "VC362 R2 env s0 PdOut_value paid_value opened_value"
  apply(unfold VC362_def inv2_def R2_def extraInv_def)
  apply(rule impI)
  apply(rule conjI)
   apply simp
  apply((rule allI)+)
  apply(rule impI)
  apply(simp split: if_splits)
  using substate_toEnvNum_id apply blast
  by auto

end


(*  Title:      HOL/Extraction.thy
    Author:     Stefan Berghofer, TU Muenchen
*)

section {* Program extraction for HOL *}

theory Extraction
imports Option
begin

ML_file "Tools/rewrite_hol_proof.ML"

subsection {* Setup *}

setup {*
  Extraction.add_types
      [("bool", ([], NONE))] #>
  Extraction.set_preprocessor (fn thy =>
      Proofterm.rewrite_proof_notypes
        ([], RewriteHOLProof.elim_cong :: ProofRewriteRules.rprocs true) o
      Proofterm.rewrite_proof thy
        (RewriteHOLProof.rews,
         ProofRewriteRules.rprocs true @ [ProofRewriteRules.expand_of_class thy]) o
      ProofRewriteRules.elim_vars (curry Const @{const_name default}))
*}

lemmas [extraction_expand] =
  meta_spec atomize_eq atomize_all atomize_imp atomize_conj
  allE rev_mp conjE Eq_TrueI Eq_FalseI eqTrueI eqTrueE eq_cong2
  notE' impE' impE iffE imp_cong simp_thms eq_True eq_False
  induct_forall_eq induct_implies_eq induct_equal_eq induct_conj_eq
  induct_atomize induct_atomize' induct_rulify induct_rulify'
  induct_rulify_fallback induct_trueI
  True_implies_equals TrueE

lemmas [extraction_expand_def] =
  induct_forall_def induct_implies_def induct_equal_def induct_conj_def
  induct_true_def induct_false_def

datatype (plugins only: code extraction) sumbool = Left | Right

subsection {* Type of extracted program *}

extract_type
  "typeof (Trueprop P) \<equiv> typeof P"

  "typeof P \<equiv> Type (TYPE(Null)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE('Q)) \<Longrightarrow>
     typeof (P \<longrightarrow> Q) \<equiv> Type (TYPE('Q))"

  "typeof Q \<equiv> Type (TYPE(Null)) \<Longrightarrow> typeof (P \<longrightarrow> Q) \<equiv> Type (TYPE(Null))"

  "typeof P \<equiv> Type (TYPE('P)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE('Q)) \<Longrightarrow>
     typeof (P \<longrightarrow> Q) \<equiv> Type (TYPE('P \<Rightarrow> 'Q))"

  "(\<lambda>x. typeof (P x)) \<equiv> (\<lambda>x. Type (TYPE(Null))) \<Longrightarrow>
     typeof (\<forall>x. P x) \<equiv> Type (TYPE(Null))"

  "(\<lambda>x. typeof (P x)) \<equiv> (\<lambda>x. Type (TYPE('P))) \<Longrightarrow>
     typeof (\<forall>x::'a. P x) \<equiv> Type (TYPE('a \<Rightarrow> 'P))"

  "(\<lambda>x. typeof (P x)) \<equiv> (\<lambda>x. Type (TYPE(Null))) \<Longrightarrow>
     typeof (\<exists>x::'a. P x) \<equiv> Type (TYPE('a))"

  "(\<lambda>x. typeof (P x)) \<equiv> (\<lambda>x. Type (TYPE('P))) \<Longrightarrow>
     typeof (\<exists>x::'a. P x) \<equiv> Type (TYPE('a \<times> 'P))"

  "typeof P \<equiv> Type (TYPE(Null)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE(Null)) \<Longrightarrow>
     typeof (P \<or> Q) \<equiv> Type (TYPE(sumbool))"

  "typeof P \<equiv> Type (TYPE(Null)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE('Q)) \<Longrightarrow>
     typeof (P \<or> Q) \<equiv> Type (TYPE('Q option))"

  "typeof P \<equiv> Type (TYPE('P)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE(Null)) \<Longrightarrow>
     typeof (P \<or> Q) \<equiv> Type (TYPE('P option))"

  "typeof P \<equiv> Type (TYPE('P)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE('Q)) \<Longrightarrow>
     typeof (P \<or> Q) \<equiv> Type (TYPE('P + 'Q))"

  "typeof P \<equiv> Type (TYPE(Null)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE('Q)) \<Longrightarrow>
     typeof (P \<and> Q) \<equiv> Type (TYPE('Q))"

  "typeof P \<equiv> Type (TYPE('P)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE(Null)) \<Longrightarrow>
     typeof (P \<and> Q) \<equiv> Type (TYPE('P))"

  "typeof P \<equiv> Type (TYPE('P)) \<Longrightarrow> typeof Q \<equiv> Type (TYPE('Q)) \<Longrightarrow>
     typeof (P \<and> Q) \<equiv> Type (TYPE('P \<times> 'Q))"

  "typeof (P = Q) \<equiv> typeof ((P \<longrightarrow> Q) \<and> (Q \<longrightarrow> P))"

  "typeof (x \<in> P) \<equiv> typeof P"

subsection {* Realizability *}

realizability
  "(realizes t (Trueprop P)) \<equiv> (Trueprop (realizes t P))"

  "(typeof P) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (P \<longrightarrow> Q)) \<equiv> (realizes Null P \<longrightarrow> realizes t Q)"

  "(typeof P) \<equiv> (Type (TYPE('P))) \<Longrightarrow>
   (typeof Q) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (P \<longrightarrow> Q)) \<equiv> (\<forall>x::'P. realizes x P \<longrightarrow> realizes Null Q)"

  "(realizes t (P \<longrightarrow> Q)) \<equiv> (\<forall>x. realizes x P \<longrightarrow> realizes (t x) Q)"

  "(\<lambda>x. typeof (P x)) \<equiv> (\<lambda>x. Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (\<forall>x. P x)) \<equiv> (\<forall>x. realizes Null (P x))"

  "(realizes t (\<forall>x. P x)) \<equiv> (\<forall>x. realizes (t x) (P x))"

  "(\<lambda>x. typeof (P x)) \<equiv> (\<lambda>x. Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (\<exists>x. P x)) \<equiv> (realizes Null (P t))"

  "(realizes t (\<exists>x. P x)) \<equiv> (realizes (snd t) (P (fst t)))"

  "(typeof P) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
   (typeof Q) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (P \<or> Q)) \<equiv>
     (case t of Left \<Rightarrow> realizes Null P | Right \<Rightarrow> realizes Null Q)"

  "(typeof P) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (P \<or> Q)) \<equiv>
     (case t of None \<Rightarrow> realizes Null P | Some q \<Rightarrow> realizes q Q)"

  "(typeof Q) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (P \<or> Q)) \<equiv>
     (case t of None \<Rightarrow> realizes Null Q | Some p \<Rightarrow> realizes p P)"

  "(realizes t (P \<or> Q)) \<equiv>
   (case t of Inl p \<Rightarrow> realizes p P | Inr q \<Rightarrow> realizes q Q)"

  "(typeof P) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (P \<and> Q)) \<equiv> (realizes Null P \<and> realizes t Q)"

  "(typeof Q) \<equiv> (Type (TYPE(Null))) \<Longrightarrow>
     (realizes t (P \<and> Q)) \<equiv> (realizes t P \<and> realizes Null Q)"

  "(realizes t (P \<and> Q)) \<equiv> (realizes (fst t) P \<and> realizes (snd t) Q)"

  "typeof P \<equiv> Type (TYPE(Null)) \<Longrightarrow>
     realizes t (\<not> P) \<equiv> \<not> realizes Null P"

  "typeof P \<equiv> Type (TYPE('P)) \<Longrightarrow>
     realizes t (\<not> P) \<equiv> (\<forall>x::'P. \<not> realizes x P)"

  "typeof (P::bool) \<equiv> Type (TYPE(Null)) \<Longrightarrow>
   typeof Q \<equiv> Type (TYPE(Null)) \<Longrightarrow>
     realizes t (P = Q) \<equiv> realizes Null P = realizes Null Q"

  "(realizes t (P = Q)) \<equiv> (realizes t ((P \<longrightarrow> Q) \<and> (Q \<longrightarrow> P)))"

subsection {* Computational content of basic inference rules *}

theorem disjE_realizer:
  assumes r: "case x of Inl p \<Rightarrow> P p | Inr q \<Rightarrow> Q q"
  and r1: "\<And>p. P p \<Longrightarrow> R (f p)" and r2: "\<And>q. Q q \<Longrightarrow> R (g q)"
  shows "R (case x of Inl p \<Rightarrow> f p | Inr q \<Rightarrow> g q)"
proof (cases x)
  case Inl
  with r show ?thesis by simp (rule r1)
next
  case Inr
  with r show ?thesis by simp (rule r2)
qed

theorem disjE_realizer2:
  assumes r: "case x of None \<Rightarrow> P | Some q \<Rightarrow> Q q"
  and r1: "P \<Longrightarrow> R f" and r2: "\<And>q. Q q \<Longrightarrow> R (g q)"
  shows "R (case x of None \<Rightarrow> f | Some q \<Rightarrow> g q)"
proof (cases x)
  case None
  with r show ?thesis by simp (rule r1)
next
  case Some
  with r show ?thesis by simp (rule r2)
qed

theorem disjE_realizer3:
  assumes r: "case x of Left \<Rightarrow> P | Right \<Rightarrow> Q"
  and r1: "P \<Longrightarrow> R f" and r2: "Q \<Longrightarrow> R g"
  shows "R (case x of Left \<Rightarrow> f | Right \<Rightarrow> g)"
proof (cases x)
  case Left
  with r show ?thesis by simp (rule r1)
next
  case Right
  with r show ?thesis by simp (rule r2)
qed

theorem conjI_realizer:
  "P p \<Longrightarrow> Q q \<Longrightarrow> P (fst (p, q)) \<and> Q (snd (p, q))"
  by simp

theorem exI_realizer:
  "P y x \<Longrightarrow> P (snd (x, y)) (fst (x, y))" by simp

theorem exE_realizer: "P (snd p) (fst p) \<Longrightarrow>
  (\<And>x y. P y x \<Longrightarrow> Q (f x y)) \<Longrightarrow> Q (let (x, y) = p in f x y)"
  by (cases p) (simp add: Let_def)

theorem exE_realizer': "P (snd p) (fst p) \<Longrightarrow>
  (\<And>x y. P y x \<Longrightarrow> Q) \<Longrightarrow> Q" by (cases p) simp

realizers
  impI (P, Q): "\<lambda>pq. pq"
    "\<^bold>\<lambda>(c: _) (d: _) P Q pq (h: _). allI \<cdot> _ \<bullet> c \<bullet> (\<^bold>\<lambda>x. impI \<cdot> _ \<cdot> _ \<bullet> (h \<cdot> x))"

  impI (P): "Null"
    "\<^bold>\<lambda>(c: _) P Q (h: _). allI \<cdot> _ \<bullet> c \<bullet> (\<^bold>\<lambda>x. impI \<cdot> _ \<cdot> _ \<bullet> (h \<cdot> x))"

  impI (Q): "\<lambda>q. q" "\<^bold>\<lambda>(c: _) P Q q. impI \<cdot> _ \<cdot> _"

  impI: "Null" "impI"

  mp (P, Q): "\<lambda>pq. pq"
    "\<^bold>\<lambda>(c: _) (d: _) P Q pq (h: _) p. mp \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> p \<bullet> c \<bullet> h)"

  mp (P): "Null"
    "\<^bold>\<lambda>(c: _) P Q (h: _) p. mp \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> p \<bullet> c \<bullet> h)"

  mp (Q): "\<lambda>q. q" "\<^bold>\<lambda>(c: _) P Q q. mp \<cdot> _ \<cdot> _"

  mp: "Null" "mp"

  allI (P): "\<lambda>p. p" "\<^bold>\<lambda>(c: _) P (d: _) p. allI \<cdot> _ \<bullet> d"

  allI: "Null" "allI"

  spec (P): "\<lambda>x p. p x" "\<^bold>\<lambda>(c: _) P x (d: _) p. spec \<cdot> _ \<cdot> x \<bullet> d"

  spec: "Null" "spec"

  exI (P): "\<lambda>x p. (x, p)" "\<^bold>\<lambda>(c: _) P x (d: _) p. exI_realizer \<cdot> P \<cdot> p \<cdot> x \<bullet> c \<bullet> d"

  exI: "\<lambda>x. x" "\<^bold>\<lambda>P x (c: _) (h: _). h"

  exE (P, Q): "\<lambda>p pq. let (x, y) = p in pq x y"
    "\<^bold>\<lambda>(c: _) (d: _) P Q (e: _) p (h: _) pq. exE_realizer \<cdot> P \<cdot> p \<cdot> Q \<cdot> pq \<bullet> c \<bullet> e \<bullet> d \<bullet> h"

  exE (P): "Null"
    "\<^bold>\<lambda>(c: _) P Q (d: _) p. exE_realizer' \<cdot> _ \<cdot> _ \<cdot> _ \<bullet> c \<bullet> d"

  exE (Q): "\<lambda>x pq. pq x"
    "\<^bold>\<lambda>(c: _) P Q (d: _) x (h1: _) pq (h2: _). h2 \<cdot> x \<bullet> h1"

  exE: "Null"
    "\<^bold>\<lambda>P Q (c: _) x (h1: _) (h2: _). h2 \<cdot> x \<bullet> h1"

  conjI (P, Q): "Pair"
    "\<^bold>\<lambda>(c: _) (d: _) P Q p (h: _) q. conjI_realizer \<cdot> P \<cdot> p \<cdot> Q \<cdot> q \<bullet> c \<bullet> d \<bullet> h"

  conjI (P): "\<lambda>p. p"
    "\<^bold>\<lambda>(c: _) P Q p. conjI \<cdot> _ \<cdot> _"

  conjI (Q): "\<lambda>q. q"
    "\<^bold>\<lambda>(c: _) P Q (h: _) q. conjI \<cdot> _ \<cdot> _ \<bullet> h"

  conjI: "Null" "conjI"

  conjunct1 (P, Q): "fst"
    "\<^bold>\<lambda>(c: _) (d: _) P Q pq. conjunct1 \<cdot> _ \<cdot> _"

  conjunct1 (P): "\<lambda>p. p"
    "\<^bold>\<lambda>(c: _) P Q p. conjunct1 \<cdot> _ \<cdot> _"

  conjunct1 (Q): "Null"
    "\<^bold>\<lambda>(c: _) P Q q. conjunct1 \<cdot> _ \<cdot> _"

  conjunct1: "Null" "conjunct1"

  conjunct2 (P, Q): "snd"
    "\<^bold>\<lambda>(c: _) (d: _) P Q pq. conjunct2 \<cdot> _ \<cdot> _"

  conjunct2 (P): "Null"
    "\<^bold>\<lambda>(c: _) P Q p. conjunct2 \<cdot> _ \<cdot> _"

  conjunct2 (Q): "\<lambda>p. p"
    "\<^bold>\<lambda>(c: _) P Q p. conjunct2 \<cdot> _ \<cdot> _"

  conjunct2: "Null" "conjunct2"

  disjI1 (P, Q): "Inl"
    "\<^bold>\<lambda>(c: _) (d: _) P Q p. iffD2 \<cdot> _ \<cdot> _ \<bullet> (sum.case_1 \<cdot> P \<cdot> _ \<cdot> p \<bullet> arity_type_bool \<bullet> c \<bullet> d)"

  disjI1 (P): "Some"
    "\<^bold>\<lambda>(c: _) P Q p. iffD2 \<cdot> _ \<cdot> _ \<bullet> (option.case_2 \<cdot> _ \<cdot> P \<cdot> p \<bullet> arity_type_bool \<bullet> c)"

  disjI1 (Q): "None"
    "\<^bold>\<lambda>(c: _) P Q. iffD2 \<cdot> _ \<cdot> _ \<bullet> (option.case_1 \<cdot> _ \<cdot> _ \<bullet> arity_type_bool \<bullet> c)"

  disjI1: "Left"
    "\<^bold>\<lambda>P Q. iffD2 \<cdot> _ \<cdot> _ \<bullet> (sumbool.case_1 \<cdot> _ \<cdot> _ \<bullet> arity_type_bool)"

  disjI2 (P, Q): "Inr"
    "\<^bold>\<lambda>(d: _) (c: _) Q P q. iffD2 \<cdot> _ \<cdot> _ \<bullet> (sum.case_2 \<cdot> _ \<cdot> Q \<cdot> q \<bullet> arity_type_bool \<bullet> c \<bullet> d)"

  disjI2 (P): "None"
    "\<^bold>\<lambda>(c: _) Q P. iffD2 \<cdot> _ \<cdot> _ \<bullet> (option.case_1 \<cdot> _ \<cdot> _ \<bullet> arity_type_bool \<bullet> c)"

  disjI2 (Q): "Some"
    "\<^bold>\<lambda>(c: _) Q P q. iffD2 \<cdot> _ \<cdot> _ \<bullet> (option.case_2 \<cdot> _ \<cdot> Q \<cdot> q \<bullet> arity_type_bool \<bullet> c)"

  disjI2: "Right"
    "\<^bold>\<lambda>Q P. iffD2 \<cdot> _ \<cdot> _ \<bullet> (sumbool.case_2 \<cdot> _ \<cdot> _ \<bullet> arity_type_bool)"

  disjE (P, Q, R): "\<lambda>pq pr qr.
     (case pq of Inl p \<Rightarrow> pr p | Inr q \<Rightarrow> qr q)"
    "\<^bold>\<lambda>(c: _) (d: _) (e: _) P Q R pq (h1: _) pr (h2: _) qr.
       disjE_realizer \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> R \<cdot> pr \<cdot> qr \<bullet> c \<bullet> d \<bullet> e \<bullet> h1 \<bullet> h2"

  disjE (Q, R): "\<lambda>pq pr qr.
     (case pq of None \<Rightarrow> pr | Some q \<Rightarrow> qr q)"
    "\<^bold>\<lambda>(c: _) (d: _) P Q R pq (h1: _) pr (h2: _) qr.
       disjE_realizer2 \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> R \<cdot> pr \<cdot> qr \<bullet> c \<bullet> d \<bullet> h1 \<bullet> h2"

  disjE (P, R): "\<lambda>pq pr qr.
     (case pq of None \<Rightarrow> qr | Some p \<Rightarrow> pr p)"
    "\<^bold>\<lambda>(c: _) (d: _) P Q R pq (h1: _) pr (h2: _) qr (h3: _).
       disjE_realizer2 \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> R \<cdot> qr \<cdot> pr \<bullet> c \<bullet> d \<bullet> h1 \<bullet> h3 \<bullet> h2"

  disjE (R): "\<lambda>pq pr qr.
     (case pq of Left \<Rightarrow> pr | Right \<Rightarrow> qr)"
    "\<^bold>\<lambda>(c: _) P Q R pq (h1: _) pr (h2: _) qr.
       disjE_realizer3 \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> R \<cdot> pr \<cdot> qr \<bullet> c \<bullet> h1 \<bullet> h2"

  disjE (P, Q): "Null"
    "\<^bold>\<lambda>(c: _) (d: _) P Q R pq. disjE_realizer \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> (\<lambda>x. R) \<cdot> _ \<cdot> _ \<bullet> c \<bullet> d \<bullet> arity_type_bool"

  disjE (Q): "Null"
    "\<^bold>\<lambda>(c: _) P Q R pq. disjE_realizer2 \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> (\<lambda>x. R) \<cdot> _ \<cdot> _ \<bullet> c \<bullet> arity_type_bool"

  disjE (P): "Null"
    "\<^bold>\<lambda>(c: _) P Q R pq (h1: _) (h2: _) (h3: _).
       disjE_realizer2 \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> (\<lambda>x. R) \<cdot> _ \<cdot> _ \<bullet> c \<bullet> arity_type_bool \<bullet> h1 \<bullet> h3 \<bullet> h2"

  disjE: "Null"
    "\<^bold>\<lambda>P Q R pq. disjE_realizer3 \<cdot> _ \<cdot> _ \<cdot> pq \<cdot> (\<lambda>x. R) \<cdot> _ \<cdot> _ \<bullet> arity_type_bool"

  FalseE (P): "default"
    "\<^bold>\<lambda>(c: _) P. FalseE \<cdot> _"

  FalseE: "Null" "FalseE"

  notI (P): "Null"
    "\<^bold>\<lambda>(c: _) P (h: _). allI \<cdot> _ \<bullet> c \<bullet> (\<^bold>\<lambda>x. notI \<cdot> _ \<bullet> (h \<cdot> x))"

  notI: "Null" "notI"

  notE (P, R): "\<lambda>p. default"
    "\<^bold>\<lambda>(c: _) (d: _) P R (h: _) p. notE \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> p \<bullet> c \<bullet> h)"

  notE (P): "Null"
    "\<^bold>\<lambda>(c: _) P R (h: _) p. notE \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> p \<bullet> c \<bullet> h)"

  notE (R): "default"
    "\<^bold>\<lambda>(c: _) P R. notE \<cdot> _ \<cdot> _"

  notE: "Null" "notE"

  subst (P): "\<lambda>s t ps. ps"
    "\<^bold>\<lambda>(c: _) s t P (d: _) (h: _) ps. subst \<cdot> s \<cdot> t \<cdot> P ps \<bullet> d \<bullet> h"

  subst: "Null" "subst"

  iffD1 (P, Q): "fst"
    "\<^bold>\<lambda>(d: _) (c: _) Q P pq (h: _) p.
       mp \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> p \<bullet> d \<bullet> (conjunct1 \<cdot> _ \<cdot> _ \<bullet> h))"

  iffD1 (P): "\<lambda>p. p"
    "\<^bold>\<lambda>(c: _) Q P p (h: _). mp \<cdot> _ \<cdot> _ \<bullet> (conjunct1 \<cdot> _ \<cdot> _ \<bullet> h)"

  iffD1 (Q): "Null"
    "\<^bold>\<lambda>(c: _) Q P q1 (h: _) q2.
       mp \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> q2 \<bullet> c \<bullet> (conjunct1 \<cdot> _ \<cdot> _ \<bullet> h))"

  iffD1: "Null" "iffD1"

  iffD2 (P, Q): "snd"
    "\<^bold>\<lambda>(c: _) (d: _) P Q pq (h: _) q.
       mp \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> q \<bullet> d \<bullet> (conjunct2 \<cdot> _ \<cdot> _ \<bullet> h))"

  iffD2 (P): "\<lambda>p. p"
    "\<^bold>\<lambda>(c: _) P Q p (h: _). mp \<cdot> _ \<cdot> _ \<bullet> (conjunct2 \<cdot> _ \<cdot> _ \<bullet> h)"

  iffD2 (Q): "Null"
    "\<^bold>\<lambda>(c: _) P Q q1 (h: _) q2.
       mp \<cdot> _ \<cdot> _ \<bullet> (spec \<cdot> _ \<cdot> q2 \<bullet> c \<bullet> (conjunct2 \<cdot> _ \<cdot> _ \<bullet> h))"

  iffD2: "Null" "iffD2"

  iffI (P, Q): "Pair"
    "\<^bold>\<lambda>(c: _) (d: _) P Q pq (h1 : _) qp (h2 : _). conjI_realizer \<cdot>
       (\<lambda>pq. \<forall>x. P x \<longrightarrow> Q (pq x)) \<cdot> pq \<cdot>
       (\<lambda>qp. \<forall>x. Q x \<longrightarrow> P (qp x)) \<cdot> qp \<bullet>
       (arity_type_fun \<bullet> c \<bullet> d) \<bullet>
       (arity_type_fun \<bullet> d \<bullet> c) \<bullet>
       (allI \<cdot> _ \<bullet> c \<bullet> (\<^bold>\<lambda>x. impI \<cdot> _ \<cdot> _ \<bullet> (h1 \<cdot> x))) \<bullet>
       (allI \<cdot> _ \<bullet> d \<bullet> (\<^bold>\<lambda>x. impI \<cdot> _ \<cdot> _ \<bullet> (h2 \<cdot> x)))"

  iffI (P): "\<lambda>p. p"
    "\<^bold>\<lambda>(c: _) P Q (h1 : _) p (h2 : _). conjI \<cdot> _ \<cdot> _ \<bullet>
       (allI \<cdot> _ \<bullet> c \<bullet> (\<^bold>\<lambda>x. impI \<cdot> _ \<cdot> _ \<bullet> (h1 \<cdot> x))) \<bullet>
       (impI \<cdot> _ \<cdot> _ \<bullet> h2)"

  iffI (Q): "\<lambda>q. q"
    "\<^bold>\<lambda>(c: _) P Q q (h1 : _) (h2 : _). conjI \<cdot> _ \<cdot> _ \<bullet>
       (impI \<cdot> _ \<cdot> _ \<bullet> h1) \<bullet>
       (allI \<cdot> _ \<bullet> c \<bullet> (\<^bold>\<lambda>x. impI \<cdot> _ \<cdot> _ \<bullet> (h2 \<cdot> x)))"

  iffI: "Null" "iffI"

end