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

    Copyright (C) 2013 Daniel de la Concepcion

    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>Topological groups 1\<close>

theory TopologicalGroup_ZF_1 imports TopologicalGroup_ZF Topology_ZF_properties_2
begin

text\<open>This theory deals with some topological properties of topological groups.\<close>

subsection\<open>Separation properties of topological groups\<close>
text\<open>The topological groups have very specific properties. For instance, $G$ is \<open>T\<^sub>0\<close>
iff it is \<open>T\<^sub>3\<close>.\<close>

theorem(in topgroup) cl_point:
  assumes "x\<in>G"
  shows "cl({x}) = (\<Inter>H\<in>\<N>\<^sub>0. x\<ltr>H)"
proof-
  {
    have c:"cl({x}) = (\<Inter>H\<in>\<N>\<^sub>0. {x}\<sad>H)" using cl_topgroup assms by auto
    {
      fix H
      assume "H\<in>\<N>\<^sub>0"
      then have "{x}\<sad>H=x\<ltr> H" using interval_add(3) assms
        by auto
      with \<open>H\<in>\<N>\<^sub>0\<close> have "{x}\<sad>H\<in>{x\<ltr>H. H\<in>\<N>\<^sub>0}" by auto
    }
    then have "{{x}\<sad>H. H\<in>\<N>\<^sub>0}\<subseteq>{x\<ltr>H. H\<in>\<N>\<^sub>0}" by auto
    moreover
    {
      fix H
      assume "H\<in>\<N>\<^sub>0"
      then have "{x}\<sad>H=x\<ltr> H" using interval_add(3) assms
        by auto
      with \<open>H\<in>\<N>\<^sub>0\<close> have "x\<ltr> H\<in>{{x}\<sad>H. H\<in>\<N>\<^sub>0}" by auto
    }
    then have "{x\<ltr>H. H\<in>\<N>\<^sub>0}\<subseteq>{{x}\<sad>H. H\<in>\<N>\<^sub>0}" by auto
    ultimately have "{{x}\<sad>H. H\<in>\<N>\<^sub>0}={x\<ltr>H. H\<in>\<N>\<^sub>0}" by auto
    then have "(\<Inter>H\<in>\<N>\<^sub>0. {x}\<sad>H) = (\<Inter>H\<in>\<N>\<^sub>0. x\<ltr>H)" by auto
    with c show "cl({x})=(\<Inter>H\<in>\<N>\<^sub>0. x\<ltr>H)" by auto
  }
qed

text\<open>We prove the equivalence between $T_0$ and $T_1$ first.\<close>

theorem (in topgroup) neu_closed_imp_T1:
  assumes "{\<zero>}{is closed in}T"
  shows "T{is T\<^sub>1}"
proof-
  {
    fix x z assume xG:"x\<in>G" and zG:"z\<in>G" and dis:"x\<noteq>z"
    then have clx:"cl({x})=(\<Inter>H\<in>\<N>\<^sub>0. x\<ltr>H)" using cl_point by auto
    {
      fix y
      assume "y\<in>cl({x})"
      with clx have "y\<in>(\<Inter>H\<in>\<N>\<^sub>0. x\<ltr>H)" by auto
      then have t:"\<forall>H\<in>\<N>\<^sub>0. y\<in>x\<ltr>H" by auto
      from \<open>y\<in>cl({x})\<close> xG have yG:"y\<in>G" using Top_3_L11(1) G_def by auto
      {
        fix H
        assume HNeig:"H\<in>\<N>\<^sub>0"
        with t have "y\<in>x\<ltr>H" by auto
        then obtain n where "y=x\<ra>n" and "n\<in>H" unfolding ltrans_def grop_def LeftTranslation_def by auto
        with HNeig have nG:"n\<in>G" unfolding zerohoods_def by auto
        from \<open>y=x\<ra>n\<close> and \<open>n\<in>H\<close> have "(\<rm>x)\<ra>y\<in>H" using group0.group0_2_L18(2) group0_valid_in_tgroup xG nG yG unfolding grinv_def grop_def
          by auto
      }
      then have el:"(\<rm>x)\<ra>y\<in>(\<Inter>\<N>\<^sub>0)" using zneigh_not_empty by auto
      have "cl({\<zero>})=(\<Inter>H\<in>\<N>\<^sub>0. \<zero>\<ltr>H)" using cl_point zero_in_tgroup by auto
      moreover
      {
        fix H  assume "H\<in>\<N>\<^sub>0"
        then have "H\<subseteq>G" unfolding zerohoods_def by auto
        then have "\<zero>\<ltr>H=H" using image_id_same  group0.trans_neutral(2) group0_valid_in_tgroup unfolding gzero_def ltrans_def
          by auto
        with \<open>H\<in>\<N>\<^sub>0\<close> have "\<zero>\<ltr>H\<in>\<N>\<^sub>0" "H\<in>{\<zero>\<ltr>H. H\<in>\<N>\<^sub>0}" by auto
      }
      then have "{\<zero>\<ltr>H. H\<in>\<N>\<^sub>0}=\<N>\<^sub>0" by blast
      ultimately have "cl({\<zero>})=(\<Inter>\<N>\<^sub>0)" by auto
      with el have "(\<rm>x)\<ra>y\<in>cl({\<zero>})" by auto
      then have "(\<rm>x)\<ra>y\<in>{\<zero>}" using assms Top_3_L8 G_def zero_in_tgroup by auto
      then have "(\<rm>x)\<ra>y=\<zero>" by auto
      then have "y=\<rm>(\<rm>x)" using group0.group0_2_L9(2) group0_valid_in_tgroup neg_in_tgroup xG yG unfolding grop_def grinv_def by auto
      then have "y=x" using group0.group_inv_of_inv group0_valid_in_tgroup xG unfolding grinv_def by auto
    }
    then have "cl({x})\<subseteq>{x}" by auto
    then have "cl({x})={x}" using xG cl_contains_set G_def by blast
    then have "{x}{is closed in}T" using Top_3_L8 xG G_def by auto
    then have "(\<Union>T)-{x}\<in>T" using IsClosed_def by auto moreover
    from dis zG G_def have "z\<in>((\<Union>T)-{x}) \<and> x\<notin>((\<Union>T)-{x})" by auto
    ultimately have "\<exists>V\<in>T. z\<in>V\<and>x\<notin>V" by(safe,auto)
  }
  then show "T{is T\<^sub>1}" using isT1_def by auto
qed

theorem (in topgroup) T0_imp_neu_closed:
  assumes "T{is T\<^sub>0}"
  shows "{\<zero>}{is closed in}T"
proof-
  {
    fix x assume "x\<in>cl({\<zero>})" and "x\<noteq>\<zero>"
    have "cl({\<zero>})=(\<Inter>H\<in>\<N>\<^sub>0. \<zero>\<ltr>H)" using cl_point zero_in_tgroup by auto
    moreover
    {
      fix H  assume "H\<in>\<N>\<^sub>0"
      then have "H\<subseteq>G" unfolding zerohoods_def by auto
      then have "\<zero>\<ltr>H=H" using image_id_same  group0.trans_neutral(2) group0_valid_in_tgroup unfolding gzero_def ltrans_def
        by auto
      with \<open>H\<in>\<N>\<^sub>0\<close> have "\<zero>\<ltr>H\<in>\<N>\<^sub>0" "H\<in>{\<zero>\<ltr>H. H\<in>\<N>\<^sub>0}" by auto
    }
    then have "{\<zero>\<ltr>H. H\<in>\<N>\<^sub>0}=\<N>\<^sub>0" by blast
    ultimately have "cl({\<zero>})=(\<Inter>\<N>\<^sub>0)" by auto
    from \<open>x\<noteq>\<zero>\<close> and \<open>x\<in>cl({\<zero>})\<close> obtain U where "U\<in>T" and "(x\<notin>U\<and>\<zero>\<in>U)\<or>(\<zero>\<notin>U\<and>x\<in>U)" using assms Top_3_L11(1)
      zero_in_tgroup unfolding isT0_def G_def by blast moreover
    {
      assume "\<zero>\<in>U"
      with \<open>U\<in>T\<close> have "U\<in>\<N>\<^sub>0" using zerohoods_def G_def Top_2_L3 by auto
      with \<open>x\<in>cl({\<zero>})\<close> and \<open>cl({\<zero>})=(\<Inter>\<N>\<^sub>0)\<close> have "x\<in>U" by auto
    }
    ultimately have "\<zero>\<notin>U" and "x\<in>U" by auto
    with \<open>U\<in>T\<close> \<open>x\<in>cl({\<zero>})\<close> have "False" using cl_inter_neigh zero_in_tgroup unfolding G_def by blast
  }
  then have "cl({\<zero>})\<subseteq>{\<zero>}" by auto
  then have "cl({\<zero>})={\<zero>}" using zero_in_tgroup cl_contains_set G_def by blast
  then show ?thesis using Top_3_L8 zero_in_tgroup unfolding G_def by auto
qed

subsection\<open>Existence of nice neighbourhoods.\<close>

lemma (in topgroup) exist_basehoods_closed:
  assumes "U\<in>\<N>\<^sub>0"
  shows "\<exists>V\<in>\<N>\<^sub>0. cl(V)\<subseteq>U"
proof-
  from assms obtain V where "V\<in>\<N>\<^sub>0" "V\<subseteq>U" "(V\<sad>V)\<subseteq>U" "(\<sm>V)=V" using exists_procls_zerohood by blast
  have inv_fun:"GroupInv(G,f)\<in>G\<rightarrow>G" using group0_2_T2 Ggroup by auto
  have f_fun:"f\<in>G\<times>G\<rightarrow>G" using group0.group_oper_fun group0_valid_in_tgroup by auto
  {
    fix x assume "x\<in>cl(V)"
    with \<open>V\<in>\<N>\<^sub>0\<close> have "x\<in>\<Union>T" "V\<subseteq>\<Union>T" using Top_3_L11(1) unfolding zerohoods_def G_def by blast+
    with \<open>V\<in>\<N>\<^sub>0\<close> have "x\<in>int(x\<ltr>V)" using elem_in_int_ltrans G_def by auto
    with \<open>V\<subseteq>\<Union>T\<close>\<open>x\<in>cl(V)\<close> have "int(x\<ltr>V)\<inter>V\<noteq>0" using cl_inter_neigh Top_2_L2 by blast
    then have "(x\<ltr>V)\<inter>V\<noteq>0" using Top_2_L1 by blast
    then obtain q where "q\<in>(x\<ltr>V)" and "q\<in>V" by blast
    with \<open>V\<subseteq>\<Union>T\<close>\<open>x\<in>\<Union>T\<close> obtain v where "q=x\<ra>v" "v\<in>V" unfolding ltrans_def grop_def using group0.ltrans_image
      group0_valid_in_tgroup unfolding G_def by auto
    from \<open>V\<subseteq>\<Union>T\<close> \<open>v\<in>V\<close>\<open>q\<in>V\<close> have "v\<in>\<Union>T" "q\<in>\<Union>T" by auto
    with \<open>q=x\<ra>v\<close>\<open>x\<in>\<Union>T\<close> have "q\<rs>v=x" using group0.group0_2_L18(1) group0_valid_in_tgroup unfolding G_def
        unfolding grsub_def grinv_def grop_def by auto moreover
    from \<open>v\<in>V\<close> have "(\<rm>v)\<in>(\<sm>V)" unfolding setninv_def grinv_def using func_imagedef inv_fun \<open>V\<subseteq>\<Union>T\<close> G_def by auto
    then have "(\<rm>v)\<in>V" using \<open>(\<sm>V)=V\<close> by auto
    with \<open>q\<in>V\<close> have "\<langle>q,\<rm>v\<rangle>\<in>V\<times>V" by auto
    then have "f`\<langle>q,\<rm>v\<rangle>\<in>V\<sad>V" using lift_subset_suff f_fun \<open>V\<subseteq>\<Union>T\<close> unfolding setadd_def by auto
    with \<open>V\<sad>V\<subseteq>U\<close> have "q\<rs>v\<in>U" unfolding grsub_def grop_def by auto
    with \<open>q\<rs>v=x\<close> have "x\<in>U" by auto
  }
  then have "cl(V)\<subseteq>U" by auto
  with \<open>V\<in>\<N>\<^sub>0\<close> show ?thesis by auto
qed

subsection\<open>Rest of separation axioms\<close>

theorem(in topgroup) T1_imp_T2:
  assumes "T{is T\<^sub>1}"
  shows "T{is T\<^sub>2}"
proof-
  {
    fix x y assume ass:"x\<in>\<Union>T" "y\<in>\<Union>T" "x\<noteq>y"
    {
      assume "(\<rm>y)\<ra>x=\<zero>"
      with ass(1,2) have "y=x" using group0.group0_2_L11[where a="y" and b="x"] group0_valid_in_tgroup by auto (*cannot be erased.*)
      with ass(3) have "False" by auto
    }
    then have "(\<rm>y)\<ra>x\<noteq>\<zero>" by auto
    then have "\<zero>\<noteq>(\<rm>y)\<ra>x" by auto
    from \<open>y\<in>\<Union>T\<close> have "(\<rm>y)\<in>\<Union>T" using neg_in_tgroup G_def by auto
    with \<open>x\<in>\<Union>T\<close> have "(\<rm>y)\<ra>x\<in>\<Union>T" using group0.group_op_closed[where a="\<rm>y" and b="x"] group0_valid_in_tgroup unfolding (*cannot be erased.*)
      G_def by auto
    with assms \<open>\<zero>\<noteq>(\<rm>y)\<ra>x\<close> obtain U where "U\<in>T" and "(\<rm>y)\<ra>x\<notin>U" and "\<zero>\<in>U" unfolding isT1_def using zero_in_tgroup
      by auto
    then have "U\<in>\<N>\<^sub>0" unfolding zerohoods_def G_def using Top_2_L3 by auto
    then obtain Q where "Q\<in>\<N>\<^sub>0" "Q\<subseteq>U" "(Q\<sad>Q)\<subseteq>U" "(\<sm>Q)=Q" using exists_procls_zerohood by blast
    with \<open>(\<rm>y)\<ra>x\<notin>U\<close> have "(\<rm>y)\<ra>x\<notin>Q" by auto
    from \<open>Q\<in>\<N>\<^sub>0\<close> have "Q\<subseteq>G" unfolding zerohoods_def by auto
    {
      assume "x\<in>y\<ltr>Q"
      with \<open>Q\<subseteq>G\<close> \<open>y\<in>\<Union>T\<close> obtain u where "u\<in>Q" and "x=y\<ra>u" unfolding ltrans_def grop_def using group0.ltrans_image group0_valid_in_tgroup
        unfolding G_def by auto
      with \<open>Q\<subseteq>G\<close> have "u\<in>\<Union>T" unfolding G_def by auto
      with \<open>x=y\<ra>u\<close> \<open>y\<in>\<Union>T\<close> \<open>x\<in>\<Union>T\<close> \<open>Q\<subseteq>G\<close> have "(\<rm>y)\<ra>x=u" using group0.group0_2_L18(2) group0_valid_in_tgroup unfolding G_def
        unfolding grsub_def grinv_def grop_def by auto
      with \<open>u\<in>Q\<close> have "(\<rm>y)\<ra>x\<in>Q" by auto
      then have "False" using \<open>(\<rm>y)\<ra>x\<notin>Q\<close> by auto
    }
    then have "x\<notin>y\<ltr>Q" by auto moreover
    {
      assume "y\<in>x\<ltr>Q"
      with \<open>Q\<subseteq>G\<close> \<open>x\<in>\<Union>T\<close> obtain u where "u\<in>Q" and "y=x\<ra>u" unfolding ltrans_def grop_def using group0.ltrans_image group0_valid_in_tgroup
        unfolding G_def by auto
      with \<open>Q\<subseteq>G\<close> have "u\<in>\<Union>T" unfolding G_def by auto
      with \<open>y=x\<ra>u\<close> \<open>y\<in>\<Union>T\<close> \<open>x\<in>\<Union>T\<close> \<open>Q\<subseteq>G\<close> have "(\<rm>x)\<ra>y=u" using group0.group0_2_L18(2) group0_valid_in_tgroup unfolding G_def
        unfolding grsub_def grinv_def grop_def by auto
      with \<open>u\<in>Q\<close> have "(\<rm>y)\<ra>x=\<rm>u" using group0.group_inv_of_two[OF group0_valid_in_tgroup group0.inverse_in_group[OF group0_valid_in_tgroup,of x],of y] (*From here no checked*)
        using \<open>x\<in>\<Union>T\<close> \<open>y\<in>\<Union>T\<close> using group0.group_inv_of_inv[OF group0_valid_in_tgroup] unfolding G_def grinv_def grop_def by auto
      moreover from \<open>u\<in>Q\<close> have "(\<rm>u)\<in>(\<sm>Q)" unfolding setninv_def grinv_def using func_imagedef[OF group0_2_T2[OF Ggroup] \<open>Q\<subseteq>G\<close>] by auto
      ultimately have "(\<rm>y)\<ra>x\<in>Q" using \<open>(\<rm>y)\<ra>x\<notin>Q\<close> \<open>(\<sm>Q)=Q\<close> unfolding setninv_def grinv_def by auto
      then have "False" using \<open>(\<rm>y)\<ra>x\<notin>Q\<close> by auto
    }
    then have "y\<notin>x\<ltr>Q" by auto moreover
    {
      fix t
      assume "t\<in>(x\<ltr>Q)\<inter>(y\<ltr>Q)"
      then have "t\<in>(x\<ltr>Q)" "t\<in>(y\<ltr>Q)" by auto
      with \<open>Q\<subseteq>G\<close> \<open>x\<in>\<Union>T\<close> \<open>y\<in>\<Union>T\<close> obtain u v where "u\<in>Q" "v\<in>Q" and "t=x\<ra>u" "t=y\<ra>v" unfolding ltrans_def grop_def using group0.ltrans_image[OF group0_valid_in_tgroup]
        unfolding G_def by auto
      then have "x\<ra>u=y\<ra>v" by auto
      moreover from \<open>u\<in>Q\<close> \<open>v\<in>Q\<close> \<open>Q\<subseteq>G\<close> have "u\<in>\<Union>T" "v\<in>\<Union>T" unfolding G_def by auto
      moreover note \<open>x\<in>\<Union>T\<close> \<open>y\<in>\<Union>T\<close>
      ultimately have "(\<rm>y)\<ra>(x\<ra>u)=v" using group0.group0_2_L18(2)[OF group0_valid_in_tgroup, of y v "x\<ra>u"] group0.group_op_closed[OF group0_valid_in_tgroup, of x u] unfolding G_def
        unfolding grsub_def grinv_def grop_def by auto
      then have "((\<rm>y)\<ra>x)\<ra>u=v" using group0.group_oper_assoc[OF group0_valid_in_tgroup]
        unfolding grop_def using \<open>x\<in>\<Union>T\<close> \<open>y\<in>\<Union>T\<close> \<open>u\<in>\<Union>T\<close> using group0.inverse_in_group[OF group0_valid_in_tgroup] unfolding G_def
        by auto
      then have "((\<rm>y)\<ra>x)=v\<rs>u" using group0.group0_2_L18(1)[OF group0_valid_in_tgroup,of "(\<rm>y)\<ra>x" u v]
        using \<open>(\<rm>y)\<ra>x\<in>\<Union>T\<close> \<open>u\<in>\<Union>T\<close> \<open>v\<in>\<Union>T\<close> unfolding G_def grsub_def grinv_def grop_def by force
      moreover
      from \<open>u\<in>Q\<close> have "(\<rm>u)\<in>(\<sm>Q)" unfolding setninv_def grinv_def using func_imagedef[OF group0_2_T2[OF Ggroup] \<open>Q\<subseteq>G\<close>] by auto
      then have "(\<rm>u)\<in>Q" using \<open>(\<sm>Q)=Q\<close> by auto
      with \<open>v\<in>Q\<close> have "\<langle>v,\<rm>u\<rangle>\<in>Q\<times>Q" by auto
      then have "f`\<langle>v,\<rm>u\<rangle>\<in>Q\<sad>Q" using lift_subset_suff[OF group0.group_oper_fun[OF group0_valid_in_tgroup] \<open>Q\<subseteq>G\<close> \<open>Q\<subseteq>G\<close>]
        unfolding setadd_def by auto
      with \<open>Q\<sad>Q\<subseteq>U\<close> have "v\<rs>u\<in>U" unfolding grsub_def grop_def by auto
      ultimately have "(\<rm>y)\<ra>x\<in>U" by auto
      with \<open>(\<rm>y)\<ra>x\<notin>U\<close> have "False" by auto
    }
    then have "(x\<ltr>Q)\<inter>(y\<ltr>Q)=0" by auto
    moreover have "x\<in>int(x\<ltr>Q)""y\<in>int(y\<ltr>Q)" using elem_in_int_ltrans \<open>Q\<in>\<N>\<^sub>0\<close>
      \<open>x\<in>\<Union>T\<close> \<open>y\<in>\<Union>T\<close> unfolding G_def by auto moreover
    have "int(x\<ltr>Q)\<subseteq>(x\<ltr>Q)""int(y\<ltr>Q)\<subseteq>(y\<ltr>Q)" using Top_2_L1 by auto
    moreover have "int(x\<ltr>Q)\<in>T" "int(y\<ltr>Q)\<in>T" using Top_2_L2 by auto
    ultimately have "int(x\<ltr>Q)\<in>T \<and> int(y\<ltr>Q)\<in>T \<and> x \<in> int(x\<ltr>Q) \<and> y \<in> int(y\<ltr>Q) \<and> int(x\<ltr>Q) \<inter> int(y\<ltr>Q) = 0"
      by blast
    then have "\<exists>U\<in>T. \<exists>V\<in>T. x\<in>U\<and>y\<in>V\<and>U\<inter>V=0" by auto
  }
  then show ?thesis using isT2_def by auto
qed

text\<open>Here follow some auxiliary lemmas.\<close>

lemma (in topgroup) trans_closure:
  assumes "x\<in>G" "A\<subseteq>G"
  shows "cl(x\<ltr>A)=x\<ltr>cl(A)"
proof-
  have "\<Union>T-(\<Union>T-(x\<ltr>A))=(x\<ltr>A)" unfolding ltrans_def using group0.group0_5_L1(2)[OF group0_valid_in_tgroup assms(1)]
    unfolding image_def range_def domain_def converse_def Pi_def by auto
  then have "cl(x\<ltr>A)=\<Union>T-int(\<Union>T-(x\<ltr>A))" using Top_3_L11(2)[of "\<Union>T-(x\<ltr>A)"] by auto moreover
  have "x\<ltr>G=G" using surj_image_eq group0.trans_bij(2)[OF group0_valid_in_tgroup assms(1)] bij_def by auto
  then have "\<Union>T-(x\<ltr>A)=x\<ltr>(\<Union>T-A)" using inj_image_dif[of "LeftTranslation(G, f, x)""G""G", OF _ assms(2)]
    unfolding ltrans_def G_def using group0.trans_bij(2)[OF group0_valid_in_tgroup assms(1)] bij_def by auto
  then have "int(\<Union>T-(x\<ltr>A))=int(x\<ltr>(\<Union>T-A))" by auto
  then have "int(\<Union>T-(x\<ltr>A))=x\<ltr>int(\<Union>T-A)" using ltrans_interior[OF assms(1),of "\<Union>T-A"] unfolding G_def by force
  have "\<Union>T-int(\<Union>T-A)=cl(\<Union>T-(\<Union>T-A))" using Top_3_L11(2)[of "\<Union>T-A"] by force
  have "\<Union>T-(\<Union>T-A)=A" using assms(2) G_def by auto
  with \<open>\<Union>T-int(\<Union>T-A)=cl(\<Union>T-(\<Union>T-A))\<close> have "\<Union>T-int(\<Union>T-A)=cl(A)" by auto
  have "\<Union>T-(\<Union>T-int(\<Union>T-A))=int(\<Union>T-A)" using Top_2_L2 by auto
  with \<open>\<Union>T-int(\<Union>T-A)=cl(A)\<close> have "int(\<Union>T-A)=\<Union>T-cl(A)" by auto
  with \<open>int(\<Union>T-(x\<ltr>A))=x\<ltr>int(\<Union>T-A)\<close> have "int(\<Union>T-(x\<ltr>A))=x\<ltr>(\<Union>T-cl(A))" by auto
  with \<open>x\<ltr>G=G\<close> have "int(\<Union>T-(x\<ltr>A))=\<Union>T-(x\<ltr>cl(A))" using inj_image_dif[of "LeftTranslation(G, f, x)""G""G""cl(A)"]
    unfolding ltrans_def using group0.trans_bij(2)[OF group0_valid_in_tgroup assms(1)] Top_3_L11(1) assms(2) unfolding bij_def G_def
    by auto
  then have "\<Union>T-int(\<Union>T-(x\<ltr>A))=\<Union>T-(\<Union>T-(x\<ltr>cl(A)))" by auto
  then have "\<Union>T-int(\<Union>T-(x\<ltr>A))=x\<ltr>cl(A)" unfolding ltrans_def using group0.group0_5_L1(2)[OF group0_valid_in_tgroup assms(1)]
    unfolding image_def range_def domain_def converse_def Pi_def by auto
  with \<open>cl(x\<ltr>A)=\<Union>T-int(\<Union>T-(x\<ltr>A))\<close> show ?thesis by auto
qed

lemma (in topgroup) trans_interior2: assumes A1: "g\<in>G" and A2: "A\<subseteq>G"
  shows "int(A)\<rtr>g = int(A\<rtr>g)"
proof -
  from assms have "A \<subseteq> \<Union>T" and "IsAhomeomorphism(T,T,RightTranslation(G,f,g))"
    using tr_homeo by auto
  then show ?thesis using int_top_invariant by simp
qed

lemma (in topgroup) trans_closure2:
  assumes "x\<in>G" "A\<subseteq>G"
  shows "cl(A\<rtr>x)=cl(A)\<rtr>x"
proof-
  have "\<Union>T-(\<Union>T-(A\<rtr>x))=(A\<rtr>x)" unfolding ltrans_def using group0.group0_5_L1(1)[OF group0_valid_in_tgroup assms(1)]
    unfolding image_def range_def domain_def converse_def Pi_def by auto
  then have "cl(A\<rtr>x)=\<Union>T-int(\<Union>T-(A\<rtr>x))" using Top_3_L11(2)[of "\<Union>T-(A\<rtr>x)"] by auto moreover
  have "G\<rtr>x=G" using surj_image_eq group0.trans_bij(1)[OF group0_valid_in_tgroup assms(1)] bij_def by auto
  then have "\<Union>T-(A\<rtr>x)=(\<Union>T-A)\<rtr>x" using inj_image_dif[of "RightTranslation(G, f, x)""G""G", OF _ assms(2)]
    unfolding rtrans_def G_def using group0.trans_bij(1)[OF group0_valid_in_tgroup assms(1)] bij_def by auto
  then have "int(\<Union>T-(A\<rtr>x))=int((\<Union>T-A)\<rtr>x)" by auto
  then have "int(\<Union>T-(A\<rtr>x))=int(\<Union>T-A)\<rtr>x" using trans_interior2[OF assms(1),of "\<Union>T-A"] unfolding G_def by force
  have "\<Union>T-int(\<Union>T-A)=cl(\<Union>T-(\<Union>T-A))" using Top_3_L11(2)[of "\<Union>T-A"] by force
  have "\<Union>T-(\<Union>T-A)=A" using assms(2) G_def by auto
  with \<open>\<Union>T-int(\<Union>T-A)=cl(\<Union>T-(\<Union>T-A))\<close> have "\<Union>T-int(\<Union>T-A)=cl(A)" by auto
  have "\<Union>T-(\<Union>T-int(\<Union>T-A))=int(\<Union>T-A)" using Top_2_L2 by auto
  with \<open>\<Union>T-int(\<Union>T-A)=cl(A)\<close> have "int(\<Union>T-A)=\<Union>T-cl(A)" by auto
  with \<open>int(\<Union>T-(A\<rtr>x))=int(\<Union>T-A)\<rtr>x\<close> have "int(\<Union>T-(A\<rtr>x))=(\<Union>T-cl(A))\<rtr>x" by auto
  with \<open>G\<rtr>x=G\<close> have "int(\<Union>T-(A\<rtr>x))=\<Union>T-(cl(A)\<rtr>x)" using inj_image_dif[of "RightTranslation(G, f, x)""G""G""cl(A)"]
    unfolding rtrans_def using group0.trans_bij(1)[OF group0_valid_in_tgroup assms(1)] Top_3_L11(1) assms(2) unfolding bij_def G_def
    by auto
  then have "\<Union>T-int(\<Union>T-(A\<rtr>x))=\<Union>T-(\<Union>T-(cl(A)\<rtr>x))" by auto
  then have "\<Union>T-int(\<Union>T-(A\<rtr>x))=cl(A)\<rtr>x" unfolding ltrans_def using group0.group0_5_L1(1)[OF group0_valid_in_tgroup assms(1)]
    unfolding image_def range_def domain_def converse_def Pi_def by auto
  with \<open>cl(A\<rtr>x)=\<Union>T-int(\<Union>T-(A\<rtr>x))\<close> show ?thesis by auto
qed

lemma (in topgroup) trans_subset:
  assumes "A\<subseteq>((\<rm>x)\<ltr>B)""x\<in>G""A\<subseteq>G""B\<subseteq>G"
  shows "x\<ltr>A\<subseteq>B"
proof-
  {
   fix t assume "t\<in>x\<ltr>A"
    with \<open>x\<in>G\<close> \<open>A\<subseteq>G\<close> obtain u where "u\<in>A" "t=x\<ra>u" unfolding ltrans_def grop_def using group0.ltrans_image[OF group0_valid_in_tgroup]
      unfolding G_def by auto
    with \<open>x\<in>G\<close> \<open>A\<subseteq>G\<close> \<open>u\<in>A\<close> have "(\<rm>x)\<ra>t=u" using group0.group0_2_L18(2)[OF group0_valid_in_tgroup, of "x""u""t"]
      group0.group_op_closed[OF group0_valid_in_tgroup,of x u] unfolding grop_def grinv_def by auto
    with \<open>u\<in>A\<close> have "(\<rm>x)\<ra>t\<in>A" by auto
    with \<open>A\<subseteq>(\<rm>x)\<ltr>B\<close> have "(\<rm>x)\<ra>t\<in>(\<rm>x)\<ltr>B" by auto
    with \<open>B\<subseteq>G\<close> obtain v where "(\<rm>x)\<ra>t=(\<rm>x)\<ra>v" "v\<in>B" unfolding ltrans_def grop_def using neg_in_tgroup[OF \<open>x\<in>G\<close>] group0.ltrans_image[OF group0_valid_in_tgroup]
      unfolding G_def by auto
    have "LeftTranslation(G,f,\<rm>x)\<in>inj(G,G)" using group0.trans_bij(2)[OF group0_valid_in_tgroup neg_in_tgroup[OF \<open>x\<in>G\<close>]] bij_def by auto
    then have eq:"\<forall>A\<in>G. \<forall>B\<in>G. LeftTranslation(G,f,\<rm>x)`A=LeftTranslation(G,f,\<rm>x)`B \<longrightarrow> A=B" unfolding inj_def by auto
    {
      fix A B assume "A\<in>G""B\<in>G"
      assume "f`\<langle>\<rm>x,A\<rangle>=f`\<langle>\<rm>x,B\<rangle>"
      then have "LeftTranslation(G,f,\<rm>x)`A=LeftTranslation(G,f,\<rm>x)`B" using group0.group0_5_L2(2)[OF group0_valid_in_tgroup neg_in_tgroup[OF \<open>x\<in>G\<close>]]
        \<open>A\<in>G\<close>\<open>B\<in>G\<close> by auto
      with eq \<open>A\<in>G\<close>\<open>B\<in>G\<close> have "A=B" by auto
    }
    then have eq1:"\<forall>A\<in>G. \<forall>B\<in>G. f`\<langle>\<rm>x,A\<rangle>=f`\<langle>\<rm>x,B\<rangle> \<longrightarrow> A=B" by auto
    from \<open>A\<subseteq>G\<close> \<open>u\<in>A\<close> have "u\<in>G" by auto
    with \<open>v\<in>B\<close> \<open>B\<subseteq>G\<close> \<open>t=x\<ra>u\<close> have "t\<in>G" "v\<in>G" using group0.group_op_closed[OF group0_valid_in_tgroup \<open>x\<in>G\<close>,of u] unfolding grop_def
      by auto
    with eq1 \<open>(\<rm>x)\<ra>t=(\<rm>x)\<ra>v\<close> have "t=v" unfolding grop_def by auto
    with \<open>v\<in>B\<close> have "t\<in>B" by auto
  }
  then show ?thesis by auto
qed

text\<open>Every topological group is regular, and hence $T_3$. The proof is in the next
section, since it uses local properties.\<close>

subsection\<open>Local properties\<close>

text\<open>In a topological group, all local properties depend only on the neighbourhoods
of the neutral element; when considering topological properties. The next result
of regularity, will use this idea, since translations preserve closed sets.\<close>

lemma (in topgroup) local_iff_neutral:
  assumes "\<forall>U\<in>T\<inter>\<N>\<^sub>0. \<exists>N\<in>\<N>\<^sub>0. N\<subseteq>U\<and> P(N,T)" "\<forall>N\<in>Pow(G). \<forall>x\<in>G. P(N,T) \<longrightarrow> P(x\<ltr>N,T)"
  shows "T{is locally}P"
proof-
  {
    fix x U assume "x\<in>\<Union>T""U\<in>T""x\<in>U"
    then have "(\<rm>x)\<ltr>U\<in>T\<inter>\<N>\<^sub>0" using open_tr_open(1) open_trans_neigh neg_in_tgroup unfolding G_def
      by auto
    with assms(1) obtain N where "N\<subseteq>((\<rm>x)\<ltr>U)""P(N,T)""N\<in>\<N>\<^sub>0" by auto
    note \<open>x\<in>\<Union>T\<close>\<open>N\<subseteq>((\<rm>x)\<ltr>U)\<close> moreover
    from \<open>U\<in>T\<close> have "U\<subseteq>\<Union>T" by auto moreover
    from \<open>N\<in>\<N>\<^sub>0\<close> have "N\<subseteq>G" unfolding zerohoods_def by auto
    ultimately have "(x\<ltr>N)\<subseteq>U" using trans_subset unfolding G_def by auto moreover
    from \<open>N\<subseteq>G\<close>\<open>x\<in>\<Union>T\<close> assms(2) \<open>P(N,T)\<close> have "P((x\<ltr>N),T)" unfolding G_def by auto moreover
    from \<open>N\<in>\<N>\<^sub>0\<close>\<open>x\<in>\<Union>T\<close> have "x\<in>int(x\<ltr>N)" using elem_in_int_ltrans unfolding G_def by auto
    ultimately have "\<exists>N\<in>Pow(U). x\<in>int(N)\<and>P(N,T)" by auto
  }
  then show ?thesis unfolding IsLocally_def[OF topSpaceAssum] by auto
qed

lemma (in topgroup) trans_closed:
  assumes "A{is closed in}T""x\<in>G"
  shows "(x\<ltr>A){is closed in}T"
proof-
  from assms(1) have "cl(A)=A" using Top_3_L8 unfolding IsClosed_def by auto
  then have "x\<ltr>cl(A)=x\<ltr>A" by auto
  then have "cl(x\<ltr>A)=x\<ltr>A" using trans_closure assms unfolding IsClosed_def by auto
  moreover have "x\<ltr>A\<subseteq>G" unfolding ltrans_def using group0.group0_5_L1(2)[OF group0_valid_in_tgroup \<open>x\<in>G\<close>]
      unfolding image_def range_def domain_def converse_def Pi_def by auto
  ultimately show ?thesis using Top_3_L8 unfolding G_def by auto
qed

text\<open>As it is written in the previous section, every topological group is regular.\<close>

theorem (in topgroup) topgroup_reg:
  shows "T{is regular}"
proof-
  {
    fix U assume "U\<in>T\<inter>\<N>\<^sub>0"
    then obtain V where "cl(V)\<subseteq>U""V\<in>\<N>\<^sub>0" using exist_basehoods_closed by blast
    then have "V\<subseteq>cl(V)" using cl_contains_set unfolding zerohoods_def G_def by auto
    then have "int(V)\<subseteq>int(cl(V))" using interior_mono by auto
    with \<open>V\<in>\<N>\<^sub>0\<close> have "cl(V)\<in>\<N>\<^sub>0" unfolding zerohoods_def G_def using Top_3_L11(1) by auto
    from \<open>V\<in>\<N>\<^sub>0\<close> have "cl(V){is closed in}T" using cl_is_closed unfolding zerohoods_def G_def by auto
    with \<open>cl(V)\<in>\<N>\<^sub>0\<close>\<open>cl(V)\<subseteq>U\<close> have "\<exists>N\<in>\<N>\<^sub>0. N\<subseteq>U\<and>N{is closed in}T" by auto
  }
  then have "\<forall>U\<in>T\<inter>\<N>\<^sub>0. \<exists>N\<in>\<N>\<^sub>0. N\<subseteq>U\<and>N{is closed in}T" by auto moreover
  have "\<forall>N\<in>Pow(G).( \<forall>x\<in>G. (N{is closed in}T\<longrightarrow>(x\<ltr>N){is closed in}T))" using trans_closed by auto
  ultimately have "T{is locally-closed}" using local_iff_neutral unfolding IsLocallyClosed_def by auto
  then show "T{is regular}" using regular_locally_closed by auto
qed

text\<open>The promised corollary follows:\<close>

corollary (in topgroup) T2_imp_T3:
  assumes "T{is T\<^sub>2}"
  shows "T{is T\<^sub>3}" using T2_is_T1 topgroup_reg isT3_def assms by auto

end


(*  Title:      JinjaDCI/Common/TypeRel.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   2003 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory Common/TypeRel.thy by Tobias Nipkow
*)

section \<open> Relations between Jinja Types \<close>

theory TypeRel imports
  "HOL-Library.Transitive_Closure_Table"
  Decl
begin

subsection \<open> The subclass relations \<close>

inductive_set
  subcls1 :: "'m prog \<Rightarrow> (cname \<times> cname) set"
  and subcls1' :: "'m prog \<Rightarrow> [cname, cname] \<Rightarrow> bool" ("_ \<turnstile> _ \<prec>\<^sup>1 _" [71,71,71] 70)
  for P :: "'m prog"
where
  "P \<turnstile> C  \<prec>\<^sup>1 D \<equiv> (C,D) \<in> subcls1 P"
| subcls1I: "\<lbrakk>class P C = Some (D,rest); C \<noteq> Object\<rbrakk> \<Longrightarrow> P \<turnstile> C \<prec>\<^sup>1 D"

abbreviation
  subcls  :: "'m prog \<Rightarrow> [cname, cname] \<Rightarrow> bool" ("_ \<turnstile> _ \<preceq>\<^sup>* _"  [71,71,71] 70)
  where "P \<turnstile> C  \<preceq>\<^sup>*  D \<equiv> (C,D) \<in> (subcls1 P)\<^sup>*"

lemma subcls1D: "P \<turnstile> C \<prec>\<^sup>1 D \<Longrightarrow> C \<noteq> Object \<and> (\<exists>fs ms. class P C = Some (D,fs,ms))"
(*<*)by(erule subcls1.induct)(fastforce simp add:is_class_def)(*>*)

lemma [iff]: "(P \<turnstile> Object \<preceq>\<^sup>* C) = (C = Object)"
(*<*)
apply(rule iffI)
 apply(erule converse_rtranclE)
  apply simp_all
done
(*>*)

lemma subcls1_def2:
  "subcls1 P =
     (SIGMA C:{C. is_class P C}. {D. C\<noteq>Object \<and> fst (the (class P C))=D})"
(*<*)
  by (fastforce simp:is_class_def dest: subcls1D elim: subcls1I)
(*>*)

lemma finite_subcls1: "finite (subcls1 P)"
(*<*)
apply (simp add: subcls1_def2)
apply(rule finite_SigmaI [OF finite_is_class])
apply(rule_tac B = "{fst (the (class P C))}" in finite_subset)
apply  auto
done
(*>*)

primrec supercls_lst :: "'m prog \<Rightarrow> cname list \<Rightarrow> bool" where
"supercls_lst P (C#Cs) = ((\<forall>C' \<in> set Cs. P \<turnstile> C' \<preceq>\<^sup>* C) \<and> supercls_lst P Cs)" |
"supercls_lst P [] = True"

lemma supercls_lst_app:
 "\<lbrakk> supercls_lst P (C#Cs); P \<turnstile> C \<preceq>\<^sup>* C' \<rbrakk> \<Longrightarrow> supercls_lst P (C'#C#Cs)"
 by auto

subsection\<open> The subtype relations \<close>

inductive
  widen   :: "'m prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _ \<le> _"   [71,71,71] 70)
  for P :: "'m prog"
where
  widen_refl[iff]: "P \<turnstile> T \<le> T"
| widen_subcls: "P \<turnstile> C \<preceq>\<^sup>* D  \<Longrightarrow>  P \<turnstile> Class C \<le> Class D"
| widen_null[iff]: "P \<turnstile> NT \<le> Class C"

abbreviation
  widens :: "'m prog \<Rightarrow> ty list \<Rightarrow> ty list \<Rightarrow> bool"
    ("_ \<turnstile> _ [\<le>] _" [71,71,71] 70) where
  "widens P Ts Ts' \<equiv> list_all2 (widen P) Ts Ts'"

lemma [iff]: "(P \<turnstile> T \<le> Void) = (T = Void)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P \<turnstile> T \<le> Boolean) = (T = Boolean)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P \<turnstile> T \<le> Integer) = (T = Integer)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P \<turnstile> Void \<le> T) = (T = Void)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P \<turnstile> Boolean \<le> T) = (T = Boolean)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma [iff]: "(P \<turnstile> Integer \<le> T) = (T = Integer)"
(*<*)by (auto elim: widen.cases)(*>*)

lemma Class_widen: "P \<turnstile> Class C \<le> T  \<Longrightarrow>  \<exists>D. T = Class D"
(*<*)
apply (ind_cases "P \<turnstile> Class C \<le> T")
apply auto
done
(*>*)

lemma [iff]: "(P \<turnstile> T \<le> NT) = (T = NT)"
(*<*)
apply(cases T)
apply(auto dest:Class_widen)
done
(*>*)

lemma Class_widen_Class [iff]: "(P \<turnstile> Class C \<le> Class D) = (P \<turnstile> C \<preceq>\<^sup>* D)"
(*<*)
apply (rule iffI)
apply (ind_cases "P \<turnstile> Class C \<le> Class D")
apply (auto elim: widen_subcls)
done
(*>*)

lemma widen_Class: "(P \<turnstile> T \<le> Class C) = (T = NT \<or> (\<exists>D. T = Class D \<and> P \<turnstile> D \<preceq>\<^sup>* C))"
(*<*)by(induct T, auto)(*>*)

lemma widen_trans[trans]: "\<lbrakk>P \<turnstile> S \<le> U; P \<turnstile> U \<le> T\<rbrakk> \<Longrightarrow> P \<turnstile> S \<le> T"
(*<*)
proof -
  assume "P\<turnstile>S \<le> U" thus "\<And>T. P \<turnstile> U \<le> T \<Longrightarrow> P \<turnstile> S \<le> T"
  proof induct
    case (widen_refl T T') thus "P \<turnstile> T \<le> T'" .
  next
    case (widen_subcls C D T)
    then obtain E where "T = Class E" by (blast dest: Class_widen)
    with widen_subcls show "P \<turnstile> Class C \<le> T" by (auto elim: rtrancl_trans)
  next
    case (widen_null C RT)
    then obtain D where "RT = Class D" by (blast dest: Class_widen)
    thus "P \<turnstile> NT \<le> RT" by auto
  qed
qed
(*>*)

lemma widens_trans [trans]: "\<lbrakk>P \<turnstile> Ss [\<le>] Ts; P \<turnstile> Ts [\<le>] Us\<rbrakk> \<Longrightarrow> P \<turnstile> Ss [\<le>] Us"
(*<*)by (rule list_all2_trans, rule widen_trans)(*>*)

(*<*)
lemmas widens_refl [iff] = list_all2_refl [of "widen P", OF widen_refl] for P
lemmas widens_Cons [iff] = list_all2_Cons1 [of "widen P"] for P
(*>*)

subsection\<open> Method lookup \<close>

inductive
  Methods :: "['m prog, cname, mname \<rightharpoonup> (staticb \<times> ty list \<times> ty \<times> 'm) \<times> cname] \<Rightarrow> bool"
                    ("_ \<turnstile> _ sees'_methods _" [51,51,51] 50)
  for P :: "'m prog"
where
  sees_methods_Object:
 "\<lbrakk> class P Object = Some(D,fs,ms); Mm = map_option (\<lambda>m. (m,Object)) \<circ> map_of ms \<rbrakk>
  \<Longrightarrow> P \<turnstile> Object sees_methods Mm"
| sees_methods_rec:
 "\<lbrakk> class P C = Some(D,fs,ms); C \<noteq> Object; P \<turnstile> D sees_methods Mm;
    Mm' = Mm ++ (map_option (\<lambda>m. (m,C)) \<circ> map_of ms) \<rbrakk>
  \<Longrightarrow> P \<turnstile> C sees_methods Mm'"

lemma sees_methods_fun:
assumes 1: "P \<turnstile> C sees_methods Mm"
shows "\<And>Mm'. P \<turnstile> C sees_methods Mm' \<Longrightarrow> Mm' = Mm"
 (*<*)
using 1
proof induct
  case (sees_methods_rec C D fs ms Dres Cres Cres')
  have "class": "class P C = Some (D, fs, ms)"
   and notObj: "C \<noteq> Object" and Dmethods: "P \<turnstile> D sees_methods Dres"
   and IH: "\<And>Dres'. P \<turnstile> D sees_methods Dres' \<Longrightarrow> Dres' = Dres"
   and Cres: "Cres = Dres ++ (map_option (\<lambda>m. (m,C)) \<circ> map_of ms)"
   and Cmethods': "P \<turnstile> C sees_methods Cres'" by fact+
  from Cmethods' notObj "class" obtain Dres'
    where Dmethods': "P \<turnstile> D sees_methods Dres'"
     and Cres': "Cres' = Dres' ++ (map_option (\<lambda>m. (m,C)) \<circ> map_of ms)"
    by(auto elim: Methods.cases)
  from Cres Cres' IH[OF Dmethods'] show "Cres' = Cres" by simp
next
  case sees_methods_Object thus ?case by(auto elim: Methods.cases)
qed
(*>*)

lemma visible_methods_exist:
  "P \<turnstile> C sees_methods Mm \<Longrightarrow> Mm M = Some(m,D) \<Longrightarrow>
   (\<exists>D' fs ms. class P D = Some(D',fs,ms) \<and> map_of ms M = Some m)"
 (*<*)by(induct rule:Methods.induct) auto(*>*)

lemma sees_methods_decl_above:
assumes Csees: "P \<turnstile> C sees_methods Mm"
shows "Mm M = Some(m,D) \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* D"
 (*<*)
using Csees
proof induct
next
  case sees_methods_Object thus ?case by auto
next
  case sees_methods_rec thus ?case
    by(fastforce simp:map_option_case split:option.splits
                elim:converse_rtrancl_into_rtrancl[OF subcls1I])
qed
(*>*)

lemma sees_methods_idemp:
assumes Cmethods: "P \<turnstile> C sees_methods Mm"
shows "\<And>m D. Mm M = Some(m,D) \<Longrightarrow>
              \<exists>Mm'. (P \<turnstile> D sees_methods Mm') \<and> Mm' M = Some(m,D)"
(*<*)
using Cmethods
proof induct
  case sees_methods_Object thus ?case
    by(fastforce dest: Methods.sees_methods_Object)
next
  case sees_methods_rec thus ?case
    by(fastforce split:option.splits dest: Methods.sees_methods_rec)
qed
(*>*)

(*FIXME something wrong with induct: need to attache [consumes 1]
directly to proof of thm, declare does not work. *)

lemma sees_methods_decl_mono:
assumes sub: "P \<turnstile> C' \<preceq>\<^sup>* C"
shows "P \<turnstile> C sees_methods Mm \<Longrightarrow>
       \<exists>Mm' Mm\<^sub>2. P \<turnstile> C' sees_methods Mm' \<and> Mm' = Mm ++ Mm\<^sub>2 \<and>
                 (\<forall>M m D. Mm\<^sub>2 M = Some(m,D) \<longrightarrow> P \<turnstile> D \<preceq>\<^sup>* C)"
(*<*)
      (is "_ \<Longrightarrow> \<exists>Mm' Mm2. ?Q C' C Mm' Mm2")
using sub
proof (induct rule:converse_rtrancl_induct)
  assume "P \<turnstile> C sees_methods Mm"
  hence "?Q C C Mm Map.empty" by simp
  thus "\<exists>Mm' Mm2. ?Q C C Mm' Mm2" by blast
next
  fix C'' C'
  assume sub1: "P \<turnstile> C'' \<prec>\<^sup>1 C'" and sub: "P \<turnstile> C' \<preceq>\<^sup>* C"
  and IH: "P \<turnstile> C sees_methods Mm \<Longrightarrow>
           \<exists>Mm' Mm2. P \<turnstile> C' sees_methods Mm' \<and>
                Mm' = Mm ++ Mm2 \<and> (\<forall>M m D. Mm2 M = Some(m,D) \<longrightarrow> P \<turnstile> D \<preceq>\<^sup>* C)"
  and Csees: "P \<turnstile> C sees_methods Mm"
  from IH[OF Csees] obtain Mm' Mm2 where C'sees: "P \<turnstile> C' sees_methods Mm'"
    and Mm': "Mm' = Mm ++ Mm2"
    and subC:"\<forall>M m D. Mm2 M = Some(m,D) \<longrightarrow> P \<turnstile> D \<preceq>\<^sup>* C" by blast
  obtain fs ms where "class": "class P C'' = Some(C',fs,ms)" "C'' \<noteq> Object"
    using subcls1D[OF sub1] by blast
  let ?Mm3 = "map_option (\<lambda>m. (m,C'')) \<circ> map_of ms"
  have "P \<turnstile> C'' sees_methods (Mm ++ Mm2) ++ ?Mm3"
    using sees_methods_rec[OF "class" C'sees refl] Mm' by simp
  hence "?Q C'' C ((Mm ++ Mm2) ++ ?Mm3) (Mm2++?Mm3)"
    using converse_rtrancl_into_rtrancl[OF sub1 sub]
    by simp (simp add:map_add_def subC split:option.split)
  thus "\<exists>Mm' Mm2. ?Q C'' C Mm' Mm2" by blast
qed
(*>*)

lemma sees_methods_is_class_Object:
 "P \<turnstile> D sees_methods Mm \<Longrightarrow> is_class P Object"
 by(induct rule: Methods.induct; simp add: is_class_def)

lemma sees_methods_sub_Obj: "P \<turnstile> C sees_methods Mm \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* Object"
proof(induct rule: Methods.induct)
  case (sees_methods_rec C D fs ms Mm Mm') show ?case
  using subcls1I[OF sees_methods_rec.hyps(1,2)] sees_methods_rec.hyps(4)
   by(rule converse_rtrancl_into_rtrancl)
qed(simp)

definition Method :: "'m prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> staticb \<Rightarrow> ty list \<Rightarrow> ty \<Rightarrow> 'm \<Rightarrow> cname \<Rightarrow> bool"
            ("_ \<turnstile> _ sees _, _ :  _\<rightarrow>_ = _ in _" [51,51,51,51,51,51,51,51] 50)
where
  "P \<turnstile> C sees M, b: Ts\<rightarrow>T = m in D  \<equiv>
  \<exists>Mm. P \<turnstile> C sees_methods Mm \<and> Mm M = Some((b,Ts,T,m),D)"

definition has_method :: "'m prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> staticb \<Rightarrow> bool"
            ("_ \<turnstile> _ has _, _" [51,0,0,51] 50)
where
  "P \<turnstile> C has M, b \<equiv> \<exists>Ts T m D. P \<turnstile> C sees M,b:Ts\<rightarrow>T = m in D"

lemma sees_method_fun:
  "\<lbrakk>P \<turnstile> C sees M,b:TS\<rightarrow>T = m in D; P \<turnstile> C sees M,b':TS'\<rightarrow>T' = m' in D' \<rbrakk>
   \<Longrightarrow> b = b' \<and> TS' = TS \<and> T' = T \<and> m' = m \<and> D' = D"
 (*<*)by(fastforce dest: sees_methods_fun simp:Method_def)(*>*)

lemma sees_method_decl_above:
  "P \<turnstile> C sees M,b:Ts\<rightarrow>T = m in D \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* D"
 (*<*)by(clarsimp simp:Method_def sees_methods_decl_above)(*>*)

lemma visible_method_exists:
  "P \<turnstile> C sees M,b:Ts\<rightarrow>T = m in D \<Longrightarrow>
  \<exists>D' fs ms. class P D = Some(D',fs,ms) \<and> map_of ms M = Some(b,Ts,T,m)"
(*<*)by(fastforce simp:Method_def dest!: visible_methods_exist)(*>*)

lemma sees_method_idemp:
  "P \<turnstile> C sees M,b:Ts\<rightarrow>T=m in D \<Longrightarrow> P \<turnstile> D sees M,b:Ts\<rightarrow>T=m in D"
 (*<*)by(fastforce simp: Method_def intro:sees_methods_idemp)(*>*)

lemma sees_method_decl_mono:
  "\<lbrakk> P \<turnstile> C' \<preceq>\<^sup>* C; P \<turnstile> C sees M,b:Ts\<rightarrow>T=m in D;
     P \<turnstile> C' sees M,b':Ts'\<rightarrow>T'=m' in D' \<rbrakk> \<Longrightarrow> P \<turnstile> D' \<preceq>\<^sup>* D"
 (*<*)
apply(frule sees_method_decl_above)
apply(unfold Method_def)
apply clarsimp
apply(drule (1) sees_methods_decl_mono)
apply clarsimp
apply(drule (1) sees_methods_fun)
apply clarsimp
apply(blast intro:rtrancl_trans)
done
(*>*)

lemma sees_methods_is_class: "P \<turnstile> C sees_methods Mm \<Longrightarrow> is_class P C"
(*<*)by (auto simp add: is_class_def elim: Methods.induct)(*>*)

lemma sees_method_is_class:
  "\<lbrakk> P \<turnstile> C sees M,b:Ts\<rightarrow>T=m in D \<rbrakk> \<Longrightarrow> is_class P C"
(*<*)by (auto simp add: is_class_def Method_def dest: sees_methods_is_class)(*>*)

lemma sees_method_is_class':
  "\<lbrakk> P \<turnstile> C sees M,b:Ts\<rightarrow>T=m in D \<rbrakk> \<Longrightarrow> is_class P D"
(*<*)by(drule sees_method_idemp, rule sees_method_is_class, assumption)(*>*)

lemma sees_method_sub_Obj: "P \<turnstile> C sees M,b:  Ts\<rightarrow>T = m in D \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* Object"
 by(auto simp: Method_def sees_methods_sub_Obj)

subsection\<open> Field lookup \<close>

inductive
  Fields :: "['m prog, cname, ((vname \<times> cname) \<times> staticb \<times> ty) list] \<Rightarrow> bool"
                  ("_ \<turnstile> _ has'_fields _" [51,51,51] 50)
  for P :: "'m prog"
where
  has_fields_rec:
  "\<lbrakk> class P C = Some(D,fs,ms); C \<noteq> Object; P \<turnstile> D has_fields FDTs;
     FDTs' = map (\<lambda>(F,b,T). ((F,C),b,T)) fs @ FDTs \<rbrakk>
   \<Longrightarrow> P \<turnstile> C has_fields FDTs'"
| has_fields_Object:
  "\<lbrakk> class P Object = Some(D,fs,ms); FDTs = map (\<lambda>(F,b,T). ((F,Object),b,T)) fs \<rbrakk>
   \<Longrightarrow> P \<turnstile> Object has_fields FDTs"

lemma has_fields_is_class:
 "P \<turnstile> C has_fields FDTs \<Longrightarrow> is_class P C"
(*<*)by (auto simp add: is_class_def elim: Fields.induct)(*>*)

lemma has_fields_fun:
assumes 1: "P \<turnstile> C has_fields FDTs"
shows "\<And>FDTs'. P \<turnstile> C has_fields FDTs' \<Longrightarrow> FDTs' = FDTs"
 (*<*)
using 1
proof induct
  case (has_fields_rec C D fs ms Dres Cres Cres')
  have "class": "class P C = Some (D, fs, ms)"
   and notObj: "C \<noteq> Object" and DFields: "P \<turnstile> D has_fields Dres"
   and IH: "\<And>Dres'. P \<turnstile> D has_fields Dres' \<Longrightarrow> Dres' = Dres"
   and Cres: "Cres = map (\<lambda>(F,b,T). ((F,C),b,T)) fs @ Dres"
   and CFields': "P \<turnstile> C has_fields Cres'" by fact+
  from CFields' notObj "class" obtain Dres'
    where DFields': "P \<turnstile> D has_fields Dres'"
     and Cres': "Cres' = map (\<lambda>(F,b,T). ((F,C),b,T)) fs @ Dres'"
    by(auto elim: Fields.cases)
  from Cres Cres' IH[OF DFields'] show "Cres' = Cres" by simp
next
  case has_fields_Object thus ?case by(auto elim: Fields.cases)
qed
(*>*)

lemma all_fields_in_has_fields:
assumes sub: "P \<turnstile> C has_fields FDTs"
shows "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* D; class P D = Some(D',fs,ms); (F,b,T) \<in> set fs \<rbrakk>
       \<Longrightarrow> ((F,D),b,T) \<in> set FDTs"
(*<*)
using sub apply(induct)
 apply(simp add:image_def)
 apply(erule converse_rtranclE)
  apply(force)
 apply(drule subcls1D)
 apply fastforce
apply(force simp:image_def)
done
(*>*)

lemma has_fields_decl_above:
assumes fields: "P \<turnstile> C has_fields FDTs"
shows "((F,D),b,T) \<in> set FDTs \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* D"
(*<*)
using fields apply(induct)
 prefer 2 apply fastforce
apply clarsimp
apply(erule disjE)
 apply(clarsimp simp add:image_def)
apply simp
apply(blast dest:subcls1I converse_rtrancl_into_rtrancl)
done
(*>*)

lemma subcls_notin_has_fields:
assumes fields: "P \<turnstile> C has_fields FDTs"
shows "((F,D),b,T) \<in> set FDTs \<Longrightarrow> (D,C) \<notin> (subcls1 P)\<^sup>+"
(*<*)
using fields apply(induct)
 prefer 2 apply(fastforce dest: tranclD)
apply clarsimp
apply(erule disjE)
 apply(clarsimp simp add:image_def)
 apply(drule tranclD)
 apply clarify
 apply(frule subcls1D)
 apply(fastforce dest:all_fields_in_has_fields)
apply simp
apply(blast dest:subcls1I trancl_into_trancl)
done
(*>*)

lemma subcls_notin_has_fields2:
assumes fields: "P \<turnstile> C has_fields FDTs"
shows "\<lbrakk> C \<noteq> Object; P \<turnstile> C \<prec>\<^sup>1 D \<rbrakk> \<Longrightarrow> (D,C) \<notin> (subcls1 P)\<^sup>*"
using fields proof(induct arbitrary: D)
  case has_fields_rec
  have "\<forall>C C' P. (C, C') \<notin> subcls1 P \<or> C \<noteq> Object \<and> (\<exists>fs ms. class P C = \<lfloor>(C', fs, ms)\<rfloor>)"
    using subcls1D by blast
  then have "(D, D) \<notin> (subcls1 P)\<^sup>+"
    by (metis (no_types) Pair_inject has_fields_rec.hyps(1) has_fields_rec.hyps(4)
     has_fields_rec.prems(2) option.inject tranclD)
  then show ?case
    by (meson has_fields_rec.prems(2) rtrancl_into_trancl1)
qed(fastforce dest: tranclD)

lemma has_fields_mono_lem:
assumes sub: "P \<turnstile> D \<preceq>\<^sup>* C"
shows "P \<turnstile> C has_fields FDTs
         \<Longrightarrow> \<exists>pre. P \<turnstile> D has_fields pre@FDTs \<and> dom(map_of pre) \<inter> dom(map_of FDTs) = {}"
(*<*)
using sub apply(induct rule:converse_rtrancl_induct)
 apply(rule_tac x = "[]" in exI)
 apply simp
apply clarsimp
apply(rename_tac D' D pre)
apply(subgoal_tac "(D',C) : (subcls1 P)^+")
 prefer 2 apply(erule (1) rtrancl_into_trancl2)
apply(drule subcls1D)
apply clarsimp
apply(rename_tac fs ms)
apply(drule (2) has_fields_rec)
 apply(rule refl)
apply(rule_tac x = "map (\<lambda>(F,b,T). ((F,D'),b,T)) fs @ pre" in exI)
apply simp
apply(simp add:Int_Un_distrib2)
apply(rule equals0I)
apply(auto dest: subcls_notin_has_fields simp:dom_map_of_conv_image_fst image_def)
done
(*>*)

lemma has_fields_declaring_classes:
shows "P \<turnstile> C has_fields FDTs
 \<Longrightarrow> \<exists>pre FDTs'. FDTs = pre@FDTs'
         \<and> (C \<noteq> Object \<longrightarrow> (\<exists>D fs ms. class P C = \<lfloor>(D,fs,ms)\<rfloor> \<and> P \<turnstile> D has_fields FDTs'))
             \<and> set(map (\<lambda>t. snd(fst t)) pre) \<subseteq> {C}
                \<and> set(map (\<lambda>t. snd(fst t)) FDTs') \<subseteq> {C'. C' \<noteq> C \<and> P \<turnstile> C \<preceq>\<^sup>* C'}"
proof(induct rule:Fields.induct)
  case (has_fields_rec C D fs ms FDTs FDTs')
  have sup1: "P \<turnstile> C \<prec>\<^sup>1 D" using has_fields_rec.hyps(1,2) by (simp add: subcls1.subcls1I)
  have "P \<turnstile> C has_fields FDTs'"
    using Fields.has_fields_rec[OF has_fields_rec.hyps(1-3)] has_fields_rec by auto
  then have nsup: "(D, C) \<notin> (subcls1 P)\<^sup>*" using subcls_notin_has_fields2 sup1 by auto
  show ?case using has_fields_rec sup1 nsup
    by(rule_tac x = "map (\<lambda>(F, y). ((F, C), y)) fs" in exI, clarsimp) auto
next
  case has_fields_Object then show ?case by fastforce
qed

lemma has_fields_mono_lem2:
assumes hf: "P \<turnstile> C has_fields FDTs"
 and cls: "class P C = Some(D,fs,ms)" and map_of: "map_of FDTs (F,C) = \<lfloor>(b,T)\<rfloor>"
shows "\<exists>FDTs'. FDTs = (map (\<lambda>(F,b,T). ((F,C),b,T)) fs) @ FDTs' \<and> map_of FDTs' (F,C) = None"
using assms
proof(cases "C = Object")
  case False
  let ?pre = "map (\<lambda>(F,b,T). ((F,C),b,T)) fs"
  have sub: "P \<turnstile> C \<preceq>\<^sup>* D" using cls False by (simp add: r_into_rtrancl subcls1.subcls1I)
  obtain FDTs' where fdts': "P \<turnstile> D has_fields FDTs'" "FDTs = ?pre @ FDTs'"
    using False assms(1,2) Fields.simps[of P C FDTs] by clarsimp
  then have int: "dom (map_of ?pre) \<inter> dom (map_of FDTs') = {}"
    using has_fields_mono_lem[OF sub, of FDTs'] has_fields_fun[OF hf] by fastforce
  have "C \<notin> (\<lambda>t. snd (fst t)) ` set FDTs'"
    using has_fields_declaring_classes[OF hf] cls False
          has_fields_fun[OF fdts'(1)] fdts'(2)
      by clarify auto
  then have "map_of FDTs' (F,C) = None" by(rule map_of_set_pcs_notin)
  then show ?thesis using fdts' int by simp
qed(auto dest: has_fields_Object has_fields_fun)

lemma has_fields_is_class_Object:
 "P \<turnstile> D has_fields FDTs \<Longrightarrow> is_class P Object"
 by(induct rule: Fields.induct; simp add: is_class_def)

lemma Object_fields:
 "\<lbrakk> P \<turnstile> Object has_fields FDTs; C \<noteq> Object \<rbrakk> \<Longrightarrow> map_of FDTs (F,C) = None"
 by(drule Fields.cases, auto simp: map_of_reinsert_neq_None)

definition has_field :: "'m prog \<Rightarrow> cname \<Rightarrow> vname \<Rightarrow> staticb \<Rightarrow> ty \<Rightarrow> cname \<Rightarrow> bool"
                   ("_ \<turnstile> _ has _,_:_ in _" [51,51,51,51,51,51] 50)
where
  "P \<turnstile> C has F,b:T in D  \<equiv>
  \<exists>FDTs. P \<turnstile> C has_fields FDTs \<and> map_of FDTs (F,D) = Some (b,T)"

lemma has_field_mono:
  "\<lbrakk> P \<turnstile> C has F,b:T in D; P \<turnstile> C' \<preceq>\<^sup>* C \<rbrakk> \<Longrightarrow> P \<turnstile> C' has F,b:T in D"
(*<*)
apply(clarsimp simp:has_field_def)
apply(drule (1) has_fields_mono_lem)
apply(fastforce simp: map_add_def split:option.splits)
done
(*>*)

lemma has_field_fun:
  "\<lbrakk>P \<turnstile> C has F,b:T in D; P \<turnstile> C has F,b':T' in D\<rbrakk> \<Longrightarrow> b = b' \<and> T' = T"
(*<*)by(fastforce simp:has_field_def dest:has_fields_fun)(*>*)

lemma has_field_idemp:
  "P \<turnstile> C has F,b:T in D \<Longrightarrow> P \<turnstile> D has F,b:T in D"
(*<*)
  apply (unfold has_field_def)
  apply clarsimp
  apply (rule_tac P = "map_of xs (F,D) = y" for xs y in mp)
   prefer 2 apply assumption
  apply (thin_tac "map_of xs (F,D) = y" for xs y)
  apply (erule Fields.induct)
   (* not Object *)
   apply clarsimp
   apply (frule map_of_SomeD)
   apply clarsimp
   apply (fastforce intro: has_fields_rec)
  (* Object *)
  apply clarsimp
  apply (frule map_of_SomeD)
  apply clarsimp
  apply (fastforce intro: has_fields_Object)
  done
(*>*)

lemma visible_fields_exist:
  "P \<turnstile> C has_fields FDTs \<Longrightarrow> map_of FDTs (F,D) = Some (b, T) \<Longrightarrow>
   (\<exists>D' fs ms. class P D = Some(D',fs,ms) \<and> map_of fs F = Some(b,T))"
apply (cut_tac
  Pa = "\<lambda>C FDTs. map_of FDTs (F,D) = Some (b, T) \<longrightarrow>
   (\<exists>D' fs ms. class P D = Some(D',fs,ms) \<and> map_of fs F = Some(b,T))"
  in Fields.induct, simp)
  apply clarsimp
  apply (case_tac "Ca = D")
   apply (simp, drule map_of_reinsert_SomeD, simp)
  apply (drule_tac D = D and F = F and fs = fs in map_of_reinsert_neq_None, simp)
 apply clarsimp
 apply (case_tac "Object = D")
  apply (simp, drule map_of_reinsert_SomeD, simp)
 apply (drule_tac D = D and F = F and fs = fs in map_of_reinsert_neq_None, simp)
apply simp
done

lemma map_of_remap_SomeD:
  "map_of (map (\<lambda>((k,k'),x). (k,(k',x))) t) k = Some (k',x) \<Longrightarrow> map_of t (k, k') = Some x"
(*<*)by (induct t) (auto simp:fun_upd_apply split: if_split_asm)(*>*)

lemma map_of_remap_SomeD2:
  "map_of (map (\<lambda>((k,k'),x,x'). (k,(k',x,x'))) t) k = Some (k',x,x') \<Longrightarrow> map_of t (k, k') = Some (x, x')"
(*<*)by (induct t) (auto simp:fun_upd_apply split: if_split_asm)(*>*)

lemma has_field_decl_above:
  "P \<turnstile> C has F,b:T in D \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* D"
(*<*)
apply(auto simp:has_field_def)
apply(blast intro: has_fields_decl_above map_of_SomeD map_of_remap_SomeD2)
done
(*>*)

definition sees_field :: "'m prog \<Rightarrow> cname \<Rightarrow> vname \<Rightarrow> staticb \<Rightarrow> ty \<Rightarrow> cname \<Rightarrow> bool"
                  ("_ \<turnstile> _ sees _,_:_ in _" [51,51,51,51,51,51] 50)
where
  "P \<turnstile> C sees F,b:T in D \<equiv>
  \<exists>FDTs. P \<turnstile> C has_fields FDTs \<and>
            map_of (map (\<lambda>((F,D),b,T). (F,(D,b,T))) FDTs) F = Some(D,b,T)"

lemma has_visible_field:
  "P \<turnstile> C sees F,b:T in D \<Longrightarrow> P \<turnstile> C has F,b:T in D"
(*<*)by(auto simp add:has_field_def sees_field_def map_of_remap_SomeD2)(*>*)

lemma sees_field_fun:
  "\<lbrakk>P \<turnstile> C sees F,b:T in D; P \<turnstile> C sees F,b':T' in D'\<rbrakk> \<Longrightarrow> b = b' \<and> T' = T \<and> D' = D"
(*<*)by(fastforce simp:sees_field_def dest:has_fields_fun)(*>*)

lemma sees_field_decl_above:
  "P \<turnstile> C sees F,b:T in D \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* D"
(*<*)
apply(auto simp:sees_field_def)
apply(blast intro: has_fields_decl_above map_of_SomeD map_of_remap_SomeD2)
done
(*>*)

lemma sees_field_idemp:
  "P \<turnstile> C sees F,b:T in D \<Longrightarrow> P \<turnstile> D sees F,b:T in D"
(*<*)
  apply (unfold sees_field_def)
  apply clarsimp
  apply (rule_tac P = "map_of xs F = y" for xs y in mp)
   prefer 2 apply assumption
  apply (thin_tac "map_of xs F = y" for xs y)
  apply (erule Fields.induct)
   (* not Object *)
   apply clarsimp
   apply (frule map_of_SomeD)
   apply clarsimp
   apply (fastforce intro: has_fields_rec)
  (* Object *)
  apply clarsimp
  apply (frule map_of_SomeD)
  apply clarsimp
  apply (fastforce intro: has_fields_Object)
  done
(*>*)

lemma has_field_sees_aux:
assumes hf: "P \<turnstile> C has_fields FDTs" and map: "map_of FDTs (F, C) = \<lfloor>(b, T)\<rfloor>"
shows "map_of (map (\<lambda>((F, D), b, T). (F, D, b, T)) FDTs) F = \<lfloor>(C, b, T)\<rfloor>"
proof -
  obtain D fs ms where fs: "class P C = Some(D,fs,ms)"
    using visible_fields_exist[OF assms] by clarsimp
  then obtain FDTs' where
     "FDTs = map (\<lambda>(F, b, T). ((F, C), b, T)) fs @ FDTs' \<and> map_of FDTs' (F, C) = None"
    using has_fields_mono_lem2[OF hf fs map] by clarsimp
  then show ?thesis using map_of_Some_None_split[OF _ _ map] by auto
qed

lemma has_field_sees: "P \<turnstile> C has F,b:T in C \<Longrightarrow> P \<turnstile> C sees F,b:T in C"
 by(auto simp:has_field_def sees_field_def has_field_sees_aux)

lemma has_field_is_class:
 "P \<turnstile> C has F,b:T in D \<Longrightarrow> is_class P C"
(*<*)by (auto simp add: is_class_def has_field_def elim: Fields.induct)(*>*)

lemma has_field_is_class':
 "P \<turnstile> C has F,b:T in D \<Longrightarrow> is_class P D"
(*<*)by(drule has_field_idemp, rule has_field_is_class, assumption)(*>*)

subsection "Functional lookup"

definition "method" :: "'m prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> cname \<times> staticb \<times> ty list \<times> ty \<times> 'm"
where
  "method P C M \<equiv>  THE (D,b,Ts,T,m). P \<turnstile> C sees M,b:Ts \<rightarrow> T = m in D"

definition field  :: "'m prog \<Rightarrow> cname \<Rightarrow> vname \<Rightarrow> cname \<times> staticb \<times> ty"
where
  "field P C F  \<equiv>  THE (D,b,T). P \<turnstile> C sees F,b:T in D"

definition fields :: "'m prog \<Rightarrow> cname \<Rightarrow> ((vname \<times> cname) \<times> staticb \<times> ty) list"
where
  "fields P C  \<equiv>  THE FDTs. P \<turnstile> C has_fields FDTs"

lemma fields_def2 [simp]: "P \<turnstile> C has_fields FDTs \<Longrightarrow> fields P C = FDTs"
(*<*)by (unfold fields_def) (auto dest: has_fields_fun)(*>*)

lemma field_def2 [simp]: "P \<turnstile> C sees F,b:T in D \<Longrightarrow> field P C F = (D,b,T)"
(*<*)by (unfold field_def) (auto dest: sees_field_fun)(*>*)

lemma method_def2 [simp]: "P \<turnstile> C sees M,b: Ts\<rightarrow>T = m in D \<Longrightarrow> method P C M = (D,b,Ts,T,m)"
(*<*)by (unfold method_def) (auto dest: sees_method_fun)(*>*)

text \<open> The following are the fields for initializing an object (non-static fields)
 and a class (just that class's static fields), respectively. \<close>

definition ifields :: "'m prog \<Rightarrow> cname \<Rightarrow> ((vname \<times> cname) \<times> staticb \<times> ty) list"
where
  "ifields P C  \<equiv>  filter (\<lambda>((F,D),b,T). b = NonStatic) (fields P C)"

definition isfields :: "'m prog \<Rightarrow> cname \<Rightarrow> ((vname \<times> cname) \<times> staticb \<times> ty) list"
where
  "isfields P C  \<equiv>  filter (\<lambda>((F,D),b,T). b = Static \<and> D = C) (fields P C)"

lemma ifields_def2[simp]: "\<lbrakk> P \<turnstile> C has_fields FDTs \<rbrakk> \<Longrightarrow> ifields P C = filter (\<lambda>((F,D),b,T). b = NonStatic) FDTs"
 by (simp add: ifields_def)

lemma isfields_def2[simp]: "\<lbrakk> P \<turnstile> C has_fields FDTs \<rbrakk> \<Longrightarrow> isfields P C = filter (\<lambda>((F,D),b,T). b = Static \<and> D = C) FDTs"
 by (simp add: isfields_def)

lemma ifields_def3: "\<lbrakk> P \<turnstile> C sees F,b:T in D; b = NonStatic \<rbrakk> \<Longrightarrow> (((F,D),b,T) \<in> set (ifields P C))"
(*<*) by (unfold ifields_def) (auto simp: sees_field_def map_of_SomeD map_of_remap_SomeD2) (*>*)

lemma isfields_def3: "\<lbrakk> P \<turnstile> C sees F,b:T in D; b = Static; D = C \<rbrakk> \<Longrightarrow> (((F,D),b,T) \<in> set (isfields P C))"
(*<*) by (unfold isfields_def) (auto simp: sees_field_def map_of_SomeD map_of_remap_SomeD2) (*>*)

definition seeing_class :: "'m prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> cname option" where
"seeing_class P C M =
  (if \<exists>Ts T m D. P \<turnstile> C sees M,Static:Ts\<rightarrow>T = m in D
 then Some (fst(method P C M))
 else None)"

lemma seeing_class_def2[simp]:
 "P \<turnstile> C sees M,Static:Ts\<rightarrow>T = m in D \<Longrightarrow> seeing_class P C M = Some D"
 by(fastforce simp: seeing_class_def)

(*<*)
end
(*>*)


(*  Title:      HOL/Nitpick.thy
    Author:     Jasmin Blanchette, TU Muenchen
    Copyright   2008, 2009, 2010

Nitpick: Yet another counterexample generator for Isabelle/HOL.
*)

section \<open>Nitpick: Yet Another Counterexample Generator for Isabelle/HOL\<close>

theory Nitpick
imports Record GCD
keywords
  "nitpick" :: diag and
  "nitpick_params" :: thy_decl
begin

datatype (plugins only: extraction) (dead 'a, dead 'b) fun_box = FunBox "'a \<Rightarrow> 'b"
datatype (plugins only: extraction) (dead 'a, dead 'b) pair_box = PairBox 'a 'b
datatype (plugins only: extraction) (dead 'a) word = Word "'a set"

typedecl bisim_iterator
typedecl unsigned_bit
typedecl signed_bit

consts
  unknown :: 'a
  is_unknown :: "'a \<Rightarrow> bool"
  bisim :: "bisim_iterator \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
  bisim_iterator_max :: bisim_iterator
  Quot :: "'a \<Rightarrow> 'b"
  safe_The :: "('a \<Rightarrow> bool) \<Rightarrow> 'a"

text \<open>
Alternative definitions.
\<close>

lemma Ex1_unfold[nitpick_unfold]: "Ex1 P \<equiv> \<exists>x. {x. P x} = {x}"
  apply (rule eq_reflection)
  apply (simp add: Ex1_def set_eq_iff)
  apply (rule iffI)
   apply (erule exE)
   apply (erule conjE)
   apply (rule_tac x = x in exI)
   apply (rule allI)
   apply (rename_tac y)
   apply (erule_tac x = y in allE)
  by auto

lemma rtrancl_unfold[nitpick_unfold]: "r\<^sup>* \<equiv> (r\<^sup>+)\<^sup>="
  by (simp only: rtrancl_trancl_reflcl)

lemma rtranclp_unfold[nitpick_unfold]: "rtranclp r a b \<equiv> (a = b \<or> tranclp r a b)"
  by (rule eq_reflection) (auto dest: rtranclpD)

lemma tranclp_unfold[nitpick_unfold]:
  "tranclp r a b \<equiv> (a, b) \<in> trancl {(x, y). r x y}"
  by (simp add: trancl_def)

lemma [nitpick_simp]:
  "of_nat n = (if n = 0 then 0 else 1 + of_nat (n - 1))"
  by (cases n) auto

definition prod :: "'a set \<Rightarrow> 'b set \<Rightarrow> ('a \<times> 'b) set" where
  "prod A B = {(a, b). a \<in> A \<and> b \<in> B}"

definition refl' :: "('a \<times> 'a) set \<Rightarrow> bool" where
  "refl' r \<equiv> \<forall>x. (x, x) \<in> r"

definition wf' :: "('a \<times> 'a) set \<Rightarrow> bool" where
  "wf' r \<equiv> acyclic r \<and> (finite r \<or> unknown)"

definition card' :: "'a set \<Rightarrow> nat" where
  "card' A \<equiv> if finite A then length (SOME xs. set xs = A \<and> distinct xs) else 0"

definition sum' :: "('a \<Rightarrow> 'b::comm_monoid_add) \<Rightarrow> 'a set \<Rightarrow> 'b" where
  "sum' f A \<equiv> if finite A then sum_list (map f (SOME xs. set xs = A \<and> distinct xs)) else 0"

inductive fold_graph' :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> bool" where
  "fold_graph' f z {} z" |
  "\<lbrakk>x \<in> A; fold_graph' f z (A - {x}) y\<rbrakk> \<Longrightarrow> fold_graph' f z A (f x y)"

text \<open>
The following lemmas are not strictly necessary but they help the
\textit{specialize} optimization.
\<close>

lemma The_psimp[nitpick_psimp]: "P = (=) x \<Longrightarrow> The P = x"
  by auto

lemma Eps_psimp[nitpick_psimp]:
  "\<lbrakk>P x; \<not> P y; Eps P = y\<rbrakk> \<Longrightarrow> Eps P = x"
  apply (cases "P (Eps P)")
   apply auto
  apply (erule contrapos_np)
  by (rule someI)

lemma case_unit_unfold[nitpick_unfold]:
  "case_unit x u \<equiv> x"
  apply (subgoal_tac "u = ()")
   apply (simp only: unit.case)
  by simp

declare unit.case[nitpick_simp del]

lemma case_nat_unfold[nitpick_unfold]:
  "case_nat x f n \<equiv> if n = 0 then x else f (n - 1)"
  apply (rule eq_reflection)
  by (cases n) auto

declare nat.case[nitpick_simp del]

lemma size_list_simp[nitpick_simp]:
  "size_list f xs = (if xs = [] then 0 else Suc (f (hd xs) + size_list f (tl xs)))"
  "size xs = (if xs = [] then 0 else Suc (size (tl xs)))"
  by (cases xs) auto

text \<open>
Auxiliary definitions used to provide an alternative representation for
\<open>rat\<close> and \<open>real\<close>.
\<close>

fun nat_gcd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "nat_gcd x y = (if y = 0 then x else nat_gcd y (x mod y))"

declare nat_gcd.simps [simp del]

definition nat_lcm :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
  "nat_lcm x y = x * y div (nat_gcd x y)"

lemma gcd_eq_nitpick_gcd [nitpick_unfold]:
  "gcd x y = Nitpick.nat_gcd x y"
  by (induct x y rule: nat_gcd.induct)
    (simp add: gcd_nat.simps Nitpick.nat_gcd.simps)

lemma lcm_eq_nitpick_lcm [nitpick_unfold]:
  "lcm x y = Nitpick.nat_lcm x y"
  by (simp only: lcm_nat_def Nitpick.nat_lcm_def gcd_eq_nitpick_gcd)

definition Frac :: "int \<times> int \<Rightarrow> bool" where
  "Frac \<equiv> \<lambda>(a, b). b > 0 \<and> coprime a b"

consts
  Abs_Frac :: "int \<times> int \<Rightarrow> 'a"
  Rep_Frac :: "'a \<Rightarrow> int \<times> int"

definition zero_frac :: 'a where
  "zero_frac \<equiv> Abs_Frac (0, 1)"

definition one_frac :: 'a where
  "one_frac \<equiv> Abs_Frac (1, 1)"

definition num :: "'a \<Rightarrow> int" where
  "num \<equiv> fst \<circ> Rep_Frac"

definition denom :: "'a \<Rightarrow> int" where
  "denom \<equiv> snd \<circ> Rep_Frac"

function norm_frac :: "int \<Rightarrow> int \<Rightarrow> int \<times> int" where
  "norm_frac a b =
    (if b < 0 then norm_frac (- a) (- b)
     else if a = 0 \<or> b = 0 then (0, 1)
     else let c = gcd a b in (a div c, b div c))"
  by pat_completeness auto
  termination by (relation "measure (\<lambda>(_, b). if b < 0 then 1 else 0)") auto

declare norm_frac.simps[simp del]

definition frac :: "int \<Rightarrow> int \<Rightarrow> 'a" where
  "frac a b \<equiv> Abs_Frac (norm_frac a b)"

definition plus_frac :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  [nitpick_simp]: "plus_frac q r = (let d = lcm (denom q) (denom r) in
    frac (num q * (d div denom q) + num r * (d div denom r)) d)"

definition times_frac :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  [nitpick_simp]: "times_frac q r = frac (num q * num r) (denom q * denom r)"

definition uminus_frac :: "'a \<Rightarrow> 'a" where
  "uminus_frac q \<equiv> Abs_Frac (- num q, denom q)"

definition number_of_frac :: "int \<Rightarrow> 'a" where
  "number_of_frac n \<equiv> Abs_Frac (n, 1)"

definition inverse_frac :: "'a \<Rightarrow> 'a" where
  "inverse_frac q \<equiv> frac (denom q) (num q)"

definition less_frac :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
  [nitpick_simp]: "less_frac q r \<longleftrightarrow> num (plus_frac q (uminus_frac r)) < 0"

definition less_eq_frac :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
  [nitpick_simp]: "less_eq_frac q r \<longleftrightarrow> num (plus_frac q (uminus_frac r)) \<le> 0"

definition of_frac :: "'a \<Rightarrow> 'b::{inverse,ring_1}" where
  "of_frac q \<equiv> of_int (num q) / of_int (denom q)"

axiomatization wf_wfrec :: "('a \<times> 'a) set \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b"

definition wf_wfrec' :: "('a \<times> 'a) set \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" where
  [nitpick_simp]: "wf_wfrec' R F x = F (cut (wf_wfrec R F) R x) x"

definition wfrec' ::  "('a \<times> 'a) set \<Rightarrow> (('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" where
  "wfrec' R F x \<equiv> if wf R then wf_wfrec' R F x else THE y. wfrec_rel R (\<lambda>f x. F (cut f R x) x) x y"

ML_file \<open>Tools/Nitpick/kodkod.ML\<close>
ML_file \<open>Tools/Nitpick/kodkod_sat.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_util.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_hol.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_mono.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_preproc.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_scope.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_peephole.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_rep.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_nut.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_kodkod.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_model.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_commands.ML\<close>
ML_file \<open>Tools/Nitpick/nitpick_tests.ML\<close>

setup \<open>
  Nitpick_HOL.register_ersatz_global
    [(\<^const_name>\<open>card\<close>, \<^const_name>\<open>card'\<close>),
     (\<^const_name>\<open>sum\<close>, \<^const_name>\<open>sum'\<close>),
     (\<^const_name>\<open>fold_graph\<close>, \<^const_name>\<open>fold_graph'\<close>),
     (\<^const_name>\<open>wf\<close>, \<^const_name>\<open>wf'\<close>),
     (\<^const_name>\<open>wf_wfrec\<close>, \<^const_name>\<open>wf_wfrec'\<close>),
     (\<^const_name>\<open>wfrec\<close>, \<^const_name>\<open>wfrec'\<close>)]
\<close>

hide_const (open) unknown is_unknown bisim bisim_iterator_max Quot safe_The FunBox PairBox Word prod
  refl' wf' card' sum' fold_graph' nat_gcd nat_lcm Frac Abs_Frac Rep_Frac
  zero_frac one_frac num denom norm_frac frac plus_frac times_frac uminus_frac number_of_frac
  inverse_frac less_frac less_eq_frac of_frac wf_wfrec wf_wfrec wfrec'

hide_type (open) bisim_iterator fun_box pair_box unsigned_bit signed_bit word

hide_fact (open) Ex1_unfold rtrancl_unfold rtranclp_unfold tranclp_unfold prod_def refl'_def wf'_def
  card'_def sum'_def The_psimp Eps_psimp case_unit_unfold case_nat_unfold
  size_list_simp nat_lcm_def Frac_def zero_frac_def one_frac_def
  num_def denom_def frac_def plus_frac_def times_frac_def uminus_frac_def
  number_of_frac_def inverse_frac_def less_frac_def less_eq_frac_def of_frac_def wf_wfrec'_def
  wfrec'_def

end


section\<open>Shifting the origin for integration of periodic functions\<close>

theory Periodic
  imports "HOL-Analysis.Analysis"
begin

lemma has_bochner_integral_null [intro]:
  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  assumes "N \<in> null_sets lebesgue"
  shows "has_bochner_integral (lebesgue_on N) f 0"
  unfolding has_bochner_integral_iff
proof
  show "integrable (lebesgue_on N) f"
  proof (subst integrable_restrict_space)
    show "N \<inter> space lebesgue \<in> sets lebesgue"
      using assms by force
    show "integrable lebesgue (\<lambda>x. indicat_real N x *\<^sub>R f x)"
    proof (rule integrable_cong_AE_imp)
      show "integrable lebesgue (\<lambda>x. 0)"
        by simp
      show *: "AE x in lebesgue. 0 = indicat_real N x *\<^sub>R f x"
        using assms
        by (simp add: indicator_def completion.null_sets_iff_AE eventually_mono)
      show "(\<lambda>x. indicat_real N x *\<^sub>R f x) \<in> borel_measurable lebesgue"
        by (auto intro: borel_measurable_AE [OF _ *])
    qed
  qed
  show "integral\<^sup>L (lebesgue_on N) f = 0"
  proof (rule integral_eq_zero_AE)
    show "AE x in lebesgue_on N. f x = 0"
      by (rule AE_I' [where N=N]) (auto simp: assms null_setsD2 null_sets_restrict_space)
  qed
qed

lemma has_bochner_integral_null_eq[simp]:
  fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  assumes "N \<in> null_sets lebesgue"
  shows "has_bochner_integral (lebesgue_on N) f i \<longleftrightarrow> i = 0"
  using assms has_bochner_integral_eq by blast

lemma periodic_integer_multiple:
   "(\<forall>x. f(x + a) = f x) \<longleftrightarrow> (\<forall>x. \<forall>n \<in> \<int>. f(x + n * a) = f x)" (is "?lhs = ?rhs")
proof
  assume L [rule_format]: ?lhs
  have nat: "f(x + of_nat n * a) = f x" for x n
  proof (induction n)
    case (Suc n)
    with L [of "x + of_nat n * a"] show ?case
      by (simp add: algebra_simps)
  qed auto
  have "f(x + of_int z * a) = f x" for x z
  proof (cases "z \<ge> 0")
    case True
    then show ?thesis
      by (metis nat of_nat_nat)
  next
    case False
    then show ?thesis
      using nat [of "x + of_int z * a" "nat (-z)"] by auto
  qed
  then show ?rhs
    by (auto simp: Ints_def)
qed (use Ints_1 in fastforce)

lemma has_integral_offset:
  fixes f :: "real \<Rightarrow> 'a::euclidean_space"
  assumes "has_bochner_integral (lebesgue_on {a..b}) f i"
  shows "has_bochner_integral (lebesgue_on {a-c..b-c}) (\<lambda>x. f(x + c)) i"
proof -
  have eq: "indicat_real {a..b} (x + c) = indicat_real {a-c..b-c} x" for x
    by (auto simp: indicator_def)
  have "has_bochner_integral lebesgue (\<lambda>x. indicator {a..b} x *\<^sub>R f x) i"
    using assms  by (auto simp: has_bochner_integral_restrict_space)
  then have "has_bochner_integral lebesgue (\<lambda>x. indicat_real {a-c..b-c} x *\<^sub>R f(x + c)) i"
    using has_bochner_integral_lebesgue_real_affine_iff [of 1 "(\<lambda>x. indicator {a..b} x *\<^sub>R f x)" i c]
    by (simp add: add_ac eq)
  then show ?thesis
    using assms by (auto simp: has_bochner_integral_restrict_space)
qed

lemma has_integral_periodic_offset_lemma:
  fixes f :: "real \<Rightarrow> 'a::euclidean_space"
  assumes periodic: "\<And>x. f(x + (b-a)) = f x" and f: "has_bochner_integral (lebesgue_on {a..a+c}) f i"
  shows "has_bochner_integral (lebesgue_on {b..b+c}) f i"
proof -
  have "f(x + a-b) = f x" for x
    using periodic [of "x + (a-b)"] by (simp add: algebra_simps)
  then show ?thesis
    using has_integral_offset [OF f, of "a-b"]
    by (auto simp: algebra_simps)
qed

lemma has_integral_periodic_offset_pos:
  fixes f :: "real \<Rightarrow> real"
  assumes f: "has_bochner_integral (lebesgue_on {a..b}) f i" and periodic: "\<And>x. f(x + (b-a)) = f x"
      and c: "c \<ge> 0" "a + c \<le> b"
  shows "has_bochner_integral (lebesgue_on {a..b}) (\<lambda>x. f(x + c)) i"
proof -
  have "{a..a + c} \<subseteq> {a..b}"
    by (simp add: assms(4))
  then have 1: "has_bochner_integral (lebesgue_on {a..a+c}) f(integral\<^sup>L (lebesgue_on {a..a+c}) f)"
    by (meson integrable_subinterval f has_bochner_integral_iff)
  then have 3: "has_bochner_integral (lebesgue_on {b..b+c}) f(integral\<^sup>L (lebesgue_on {a..a+c}) f)"
    using has_integral_periodic_offset_lemma periodic by blast
  have "{a + c..b} \<subseteq> {a..b}"
    by (simp add: c)
  then have 2: "has_bochner_integral (lebesgue_on {a+c..b}) f(integral\<^sup>L (lebesgue_on {a+c..b}) f)"
    by (meson integrable_subinterval f has_bochner_integral_integrable integrable.intros)
  have "integral\<^sup>L (lebesgue_on {a + c..b}) f + integral\<^sup>L (lebesgue_on {a..a + c}) f = i"
    by (metis integral_combine add.commute c f has_bochner_integral_iff le_add_same_cancel1)
  then have "has_bochner_integral (lebesgue_on {a+c..b+c}) f i"
    using has_bochner_integral_combine [OF _ _ 2 3] 1 2 by (simp add: c)
  then show ?thesis
    by (metis add_diff_cancel_right' has_integral_offset)
qed

lemma has_integral_periodic_offset_weak:
  fixes f :: "real \<Rightarrow> real"
  assumes f: "has_bochner_integral (lebesgue_on {a..b}) f i" and periodic: "\<And>x. f(x + (b-a)) = f x" and c: "\<bar>c\<bar> \<le> b-a"
  shows "has_bochner_integral (lebesgue_on {a..b}) (\<lambda>x. f(x + c)) i"
proof (cases "c \<ge> 0")
  case True
  then show ?thesis
    using c f has_integral_periodic_offset_pos periodic by auto
next
  case False
  have per': "f(- (x + (- a - - b))) = f(- x)" for x
    using periodic [of "(a-b)-x"] by simp
  have f': "has_bochner_integral (lebesgue_on {- b..- a}) (\<lambda>x. f(- x)) i"
    using f by blast
  show ?thesis
    using has_integral_periodic_offset_pos [of "-b" "-a" "\<lambda>x. f(-x)" i "-c", OF f' per'] c  False
    by (simp flip: has_bochner_integral_reflect_real [of b a])
qed

lemma has_integral_periodic_offset:
  fixes f :: "real \<Rightarrow> real"
  assumes f: "has_bochner_integral (lebesgue_on {a..b}) f i" and periodic: "\<And>x. f(x + (b-a)) = f x"
  shows "has_bochner_integral (lebesgue_on {a..b}) (\<lambda>x. f(x + c)) i"
proof -
  consider "b \<le> a" | "a < b" by linarith
  then show ?thesis
  proof cases
    case 1
    then have "{a..b} \<in> null_sets lebesgue"
      using less_eq_real_def by auto
    with f show ?thesis
      by auto
  next
    case 2
    define fba where "fba \<equiv> \<lambda>x. f(x + (b-a) * frac(c / (b-a)))"
    have eq: "fba x = f(x + c)"
      if "x \<in> {a..b}" for x
    proof -
      have "f(x + n * (b-a)) = f x" if "n \<in> \<int>" for n x
        using periodic periodic_integer_multiple that by blast
      then have "f((x + c) + - floor (c / (b - a)) * (b - a)) = f(x + c)"
        using Ints_of_int by blast
      moreover have "((x + c) + -floor (c / (b - a)) * (b - a)) = (x + (b - a) * frac (c / (b - a)))"
        using 2 by (simp add: field_simps frac_def)
      ultimately show ?thesis
        unfolding fba_def by metis
    qed
    have *: "has_bochner_integral (lebesgue_on {a..b}) fba i"
      unfolding fba_def
    proof (rule has_integral_periodic_offset_weak [OF f])
      show "f(x + (b - a)) = f x" for x
        by fact
      have "\<bar>frac (c / (b - a))\<bar> \<le> 1"
        using frac_unique_iff less_eq_real_def by auto
      then show "\<bar>(b - a) * frac (c / (b - a))\<bar> \<le> b - a"
        using "2" by auto
    qed
    then show ?thesis
    proof (rule has_bochner_integralI_AE [OF _ _ AE_I2])
      have "fba \<in> borel_measurable (lebesgue_on {a..b})"
        using "*" borel_measurable_has_bochner_integral by blast
      then show "(\<lambda>x. f(x + c)) \<in> borel_measurable (lebesgue_on {a..b})"
        by (subst measurable_lebesgue_cong [OF eq, symmetric])
    qed (auto simp: eq)
  qed
qed

lemma integrable_periodic_offset:
  fixes f :: "real \<Rightarrow> real"
  assumes f: "integrable (lebesgue_on {a..b}) f" and periodic: "\<And>x. f(x + (b-a)) = f x"
  shows "integrable (lebesgue_on {a..b}) (\<lambda>x. f(x + c))"
  using f has_integral_periodic_offset periodic
  by (simp add: has_bochner_integral_iff)

lemma absolutely_integrable_periodic_offset:
  fixes f :: "real \<Rightarrow> real"
  assumes f: "f absolutely_integrable_on {a..b}" and periodic: "\<And>x. f(x + (b-a)) = f x"
  shows "(\<lambda>x. f(x + c)) absolutely_integrable_on {a..b}" "(\<lambda>x. f(c + x)) absolutely_integrable_on {a..b}"
  using assms integrable_periodic_offset [of a b "f"]
  by (auto simp: integrable_restrict_space set_integrable_def add.commute [of c])

lemma integral_periodic_offset:
  fixes f :: "real \<Rightarrow> real"
  assumes periodic: "\<And>x. f(x + (b-a)) = f x"
  shows "integral\<^sup>L (lebesgue_on {a..b}) (\<lambda>x. f(x + c)) = integral\<^sup>L (lebesgue_on {a..b}) f"
proof (cases "integrable (lebesgue_on {a..b}) f")
  case True
  then show ?thesis
    using has_integral_periodic_offset periodic
    by (simp add: has_bochner_integral_iff)
next
  case False
  then have "\<not> integrable (lebesgue_on {a..b}) (\<lambda>x. f(x + c))"
    using periodic[of "_+c"]
    by (auto simp: algebra_simps intro: dest: integrable_periodic_offset [where c = "-c"])
  then have "integral\<^sup>L (lebesgue_on {a..b}) f = 0" "integral\<^sup>L (lebesgue_on {a..b}) (\<lambda>x. f(x + c)) = 0"
    using False not_integrable_integral_eq by blast+
  then show ?thesis
    by simp
qed

end