(*  Title:       Safe OCL
    Author:      Denis Nikiforov, March 2019
    Maintainer:  Denis Nikiforov <denis.nikif at gmail.com>
    License:     LGPL
*)
section \<open>Finite Maps\<close>
theory Finite_Map_Ext
  imports "HOL-Library.Finite_Map"
begin

type_notation fmap ("(_ \<rightharpoonup>\<^sub>f /_)" [22, 21] 21)

nonterminal fmaplets and fmaplet

syntax
  "_fmaplet"  :: "['a, 'a] \<Rightarrow> fmaplet"              ("_ /\<mapsto>\<^sub>f/ _")
  "_fmaplets" :: "['a, 'a] \<Rightarrow> fmaplet"              ("_ /[\<mapsto>\<^sub>f]/ _")
  ""          :: "fmaplet \<Rightarrow> fmaplets"              ("_")
  "_FMaplets" :: "[fmaplet, fmaplets] \<Rightarrow> fmaplets"  ("_,/ _")
  "_FMapUpd"  :: "['a \<rightharpoonup> 'b, fmaplets] \<Rightarrow> 'a \<rightharpoonup> 'b" ("_/'(_')" [900, 0] 900)
  "_FMap"     :: "fmaplets \<Rightarrow> 'a \<rightharpoonup> 'b"             ("(1[_])")

syntax (ASCII)
  "_fmaplet"  :: "['a, 'a] \<Rightarrow> fmaplet"              ("_ /|->f/ _")
  "_fmaplets" :: "['a, 'a] \<Rightarrow> fmaplet"              ("_ /[|->f]/ _")

translations
  "_FMapUpd m (_FMaplets xy ms)"      \<rightleftharpoons> "_FMapUpd (_FMapUpd m xy) ms"
  "_FMapUpd m (_fmaplet  x y)"        \<rightleftharpoons> "CONST fmupd x y m"
  "_FMap ms"                          \<rightleftharpoons> "_FMapUpd (CONST fmempty) ms"
  "_FMap (_FMaplets ms1 ms2)"         \<leftharpoondown> "_FMapUpd (_FMap ms1) ms2"
  "_FMaplets ms1 (_FMaplets ms2 ms3)" \<leftharpoondown> "_FMaplets (_FMaplets ms1 ms2) ms3"

(*** Helper Lemmas **********************************************************)

subsection \<open>Helper Lemmas\<close>

lemma fmrel_on_fset_fmdom:
  "fmrel_on_fset (fmdom ym) f xm ym \<Longrightarrow>
   k |\<in>| fmdom ym \<Longrightarrow>
   k |\<in>| fmdom xm"
  by (metis fmdom_notD fmdom_notI fmrel_on_fsetD option.rel_sel)

(*** Finite Map Merge *******************************************************)

subsection \<open>Merge Operation\<close>

definition "fmmerge f xm ym \<equiv>
  fmap_of_list (map
    (\<lambda>k. (k, f (the (fmlookup xm k)) (the (fmlookup ym k))))
    (sorted_list_of_fset (fmdom xm |\<inter>| fmdom ym)))"

lemma fmdom_fmmerge [simp]:
  "fmdom (fmmerge g xm ym) = fmdom xm |\<inter>| fmdom ym"
  by (auto simp add: fmmerge_def fmdom_of_list)

lemma fmmerge_commut:
  assumes "\<And>x y. x \<in> fmran' xm \<Longrightarrow> f x y = f y x"
  shows "fmmerge f xm ym = fmmerge f ym xm"
proof -
  obtain zm where zm: "zm = sorted_list_of_fset (fmdom xm |\<inter>| fmdom ym)"
    by auto
  with assms have
    "map (\<lambda>k. (k, f (the (fmlookup xm k)) (the (fmlookup ym k)))) zm =
     map (\<lambda>k. (k, f (the (fmlookup ym k)) (the (fmlookup xm k)))) zm"
    by (auto) (metis fmdom_notI fmran'I notin_fset option.collapse)
  thus ?thesis
    unfolding fmmerge_def zm
    by (metis (no_types, lifting) inf_commute)
qed

lemma fmrel_on_fset_fmmerge1 [intro]:
  assumes "\<And>x y z. z \<in> fmran' zm \<Longrightarrow> f x z \<Longrightarrow> f y z \<Longrightarrow> f (g x y) z"
  assumes "fmrel_on_fset (fmdom zm) f xm zm"
  assumes "fmrel_on_fset (fmdom zm) f ym zm"
  shows "fmrel_on_fset (fmdom zm) f (fmmerge g xm ym) zm"
proof -
  {
    fix x a b c
    assume "x |\<in>| fmdom zm"
    moreover hence "x |\<in>| fmdom xm |\<inter>| fmdom ym"
      by (meson assms(2) assms(3) finterI fmrel_on_fset_fmdom)
    moreover assume "fmlookup xm x = Some a"
                and "fmlookup ym x = Some b"
                and "fmlookup zm x = Some c"
    moreover from assms calculation have "f (g a b) c"
      by (metis fmran'I fmrel_on_fsetD option.rel_inject(2))
    ultimately have
      "rel_option f (fmlookup (fmmerge g xm ym) x) (fmlookup zm x)"
      unfolding fmmerge_def fmlookup_of_list apply auto
      unfolding option_rel_Some2 apply (rule_tac ?x="g a b" in exI)
      unfolding map_of_map_restrict restrict_map_def
      by (auto simp: fmember.rep_eq)
  }
  with assms(2) assms(3) show ?thesis
    by (meson fmdomE fmrel_on_fsetI fmrel_on_fset_fmdom)
qed

lemma fmrel_on_fset_fmmerge2 [intro]:
  assumes "\<And>x y. x \<in> fmran' xm \<Longrightarrow> f x (g x y)"
  shows "fmrel_on_fset (fmdom ym) f xm (fmmerge g xm ym)"
proof -
  {
    fix x a b
    assume "x |\<in>| fmdom xm |\<inter>| fmdom ym"
       and "fmlookup xm x = Some a"
       and "fmlookup ym x = Some b"
    hence "rel_option f (fmlookup xm x) (fmlookup (fmmerge g xm ym) x)"
      unfolding fmmerge_def fmlookup_of_list apply auto
      unfolding option_rel_Some1 apply (rule_tac ?x="g a b" in exI)
      by (auto simp add: map_of_map_restrict fmember.rep_eq assms fmran'I)
  }
  with assms show ?thesis
    apply auto
    apply (rule fmrel_on_fsetI)
    by (metis (full_types) finterD1 fmdomE fmdom_fmmerge fmdom_notD rel_option_None2)
qed

(*** Acyclicity *************************************************************)

subsection \<open>Acyclicity\<close>

abbreviation "acyclic_on xs r \<equiv> (\<forall>x. x \<in> xs \<longrightarrow> (x, x) \<notin> r\<^sup>+)"

abbreviation "acyclicP_on xs r \<equiv> acyclic_on xs {(x, y). r x y}"

lemma fmrel_acyclic:
  "acyclicP_on (fmran' xm) R \<Longrightarrow>
   fmrel R\<^sup>+\<^sup>+ xm ym \<Longrightarrow>
   fmrel R ym xm \<Longrightarrow>
   xm = ym"
  by (metis (full_types) fmap_ext fmran'I fmrel_cases option.sel
        tranclp.trancl_into_trancl tranclp_unfold)

lemma fmrel_acyclic':
  assumes "acyclicP_on (fmran' ym) R"
  assumes "fmrel R\<^sup>+\<^sup>+ xm ym"
  assumes "fmrel R ym xm"
  shows "xm = ym"
proof -
  {
    fix x
    from assms(1) have
      "rel_option R\<^sup>+\<^sup>+ (fmlookup xm x) (fmlookup ym x) \<Longrightarrow>
       rel_option R (fmlookup ym x) (fmlookup xm x) \<Longrightarrow>
       rel_option R (fmlookup xm x) (fmlookup ym x)"
      by (metis (full_types) fmdom'_notD fmlookup_dom'_iff
            fmran'I option.rel_sel option.sel
            tranclp_into_tranclp2 tranclp_unfold)
  }
  with assms show ?thesis
    unfolding fmrel_iff
    by (metis fmap.rel_mono_strong fmrelI fmrel_acyclic tranclp.simps)
qed

lemma fmrel_on_fset_acyclic:
  "acyclicP_on (fmran' xm) R \<Longrightarrow>
   fmrel_on_fset (fmdom ym) R\<^sup>+\<^sup>+ xm ym \<Longrightarrow>
   fmrel_on_fset (fmdom xm) R ym xm \<Longrightarrow>
   xm = ym"
  unfolding fmrel_on_fset_fmrel_restrict
  by (metis (no_types, lifting) fmdom_filter fmfilter_alt_defs(5)
        fmfilter_cong fmlookup_filter fmrel_acyclic fmrel_fmdom_eq
        fmrestrict_fset_dom option.simps(3))

lemma fmrel_on_fset_acyclic':
  "acyclicP_on (fmran' ym) R \<Longrightarrow>
   fmrel_on_fset (fmdom ym) R\<^sup>+\<^sup>+ xm ym \<Longrightarrow>
   fmrel_on_fset (fmdom xm) R ym xm \<Longrightarrow>
   xm = ym"
  unfolding fmrel_on_fset_fmrel_restrict
  by (metis (no_types, lifting) ffmember_filter fmdom_filter
        fmfilter_alt_defs(5) fmfilter_cong fmrel_acyclic'
        fmrel_fmdom_eq fmrestrict_fset_dom)

(*** Transitive Closures ****************************************************)

subsection \<open>Transitive Closures\<close>

lemma fmrel_trans:
  "(\<And>x y z. x \<in> fmran' xm \<Longrightarrow> P x y \<Longrightarrow> Q y z \<Longrightarrow> R x z) \<Longrightarrow>
   fmrel P xm ym \<Longrightarrow> fmrel Q ym zm \<Longrightarrow> fmrel R xm zm"
  unfolding fmrel_iff
  by (metis fmdomE fmdom_notD fmran'I option.rel_inject(2) option.rel_sel)

lemma fmrel_on_fset_trans:
  "(\<And>x y z. x \<in> fmran' xm \<Longrightarrow> P x y \<Longrightarrow> Q y z \<Longrightarrow> R x z) \<Longrightarrow>
   fmrel_on_fset (fmdom ym) P xm ym \<Longrightarrow>
   fmrel_on_fset (fmdom zm) Q ym zm \<Longrightarrow>
   fmrel_on_fset (fmdom zm) R xm zm"
  apply (rule fmrel_on_fsetI)
  unfolding option.rel_sel apply auto
  apply (meson fmdom_notI fmrel_on_fset_fmdom)
  by (metis fmdom_notI fmran'I fmrel_on_fsetD fmrel_on_fset_fmdom
            option.rel_sel option.sel)

lemma trancl_to_fmrel:
  "(fmrel f)\<^sup>+\<^sup>+ xm ym \<Longrightarrow> fmrel f\<^sup>+\<^sup>+ xm ym"
  apply (induct rule: tranclp_induct)
  apply (simp add: fmap.rel_mono_strong)
  by (rule fmrel_trans; auto)

lemma fmrel_trancl_fmdom_eq:
  "(fmrel f)\<^sup>+\<^sup>+ xm ym \<Longrightarrow> fmdom xm = fmdom ym"
  by (induct rule: tranclp_induct; simp add: fmrel_fmdom_eq)

text \<open>
  The proof was derived from the accepted answer on the website
  Stack Overflow that is available at
  @{url "https://stackoverflow.com/a/53585232/632199"}
  and provided with the permission of the author of the answer.\<close>

lemma fmupd_fmdrop:
  "fmlookup xm k = Some x \<Longrightarrow>
   xm = fmupd k x (fmdrop k xm)"
  apply (rule fmap_ext)
  unfolding fmlookup_drop fmupd_lookup
  by auto

lemma fmap_eqdom_Cons1:
  assumes "fmlookup xm i = None"
      and "fmdom (fmupd i x xm) = fmdom ym"
      and "fmrel R (fmupd i x xm) ym"
    shows "(\<exists>z zm. fmlookup zm i = None \<and> ym = (fmupd i z zm) \<and>
                   R x z \<and> fmrel R xm zm)"
proof -
  from assms(2) obtain y where "fmlookup ym i = Some y" by force
  then obtain z zm where z_zm: "ym = fmupd i z zm \<and> fmlookup zm i = None"
    using fmupd_fmdrop by force
  {
    assume "\<not> R x z"
    with z_zm have "\<not> fmrel R (fmupd i x xm) ym"
      by (metis fmrel_iff fmupd_lookup option.simps(11))
  }
  with assms(3) moreover have "R x z" by auto
  {
    assume "\<not> fmrel R xm zm"
    with assms(1) have "\<not> fmrel R (fmupd i x xm) ym"
      by (metis fmrel_iff fmupd_lookup option.rel_sel z_zm)
  }
  with assms(3) moreover have "fmrel R xm zm" by auto
  ultimately show ?thesis using z_zm by blast
qed

text \<open>
  The proof was derived from the accepted answer on the website
  Stack Overflow that is available at
  @{url "https://stackoverflow.com/a/53585232/632199"}
  and provided with the permission of the author of the answer.\<close>

lemma fmap_eqdom_induct [consumes 2, case_names nil step]:
  assumes R: "fmrel R xm ym"
    and dom_eq: "fmdom xm = fmdom ym"
    and nil: "P (fmap_of_list []) (fmap_of_list [])"
    and step:
    "\<And>x xm y ym i.
    \<lbrakk>R x y; fmrel R xm ym; fmdom xm = fmdom ym; P xm ym\<rbrakk> \<Longrightarrow>
    P (fmupd i x xm) (fmupd i y ym)"
  shows "P xm ym"
  using R dom_eq
proof (induct xm arbitrary: ym)
  case fmempty thus ?case
    by (metis fempty_iff fmdom_empty fmempty_of_list fmfilter_alt_defs(5)
              fmfilter_false fmrestrict_fset_dom local.nil)
next
  case (fmupd i x xm) show ?case
  proof -
    obtain y where "fmlookup ym i = Some y"
      by (metis fmupd.prems(1) fmrel_cases fmupd_lookup option.discI)
    from fmupd.hyps(2) fmupd.prems(1) fmupd.prems(2) obtain z zm where
      "fmlookup zm i = None" and
      ym_eq_z_zm: "ym = (fmupd i z zm)" and
      R_x_z: "R x z" and
      R_xm_zm: "fmrel R xm zm"
      using fmap_eqdom_Cons1 by metis
    hence dom_xm_eq_dom_zm: "fmdom xm = fmdom zm"
      using fmrel_fmdom_eq by blast
    with R_xm_zm fmupd.hyps(1) have "P xm zm" by blast
    with R_x_z R_xm_zm dom_xm_eq_dom_zm have
      "P (fmupd i x xm) (fmupd i z zm)"
      by (rule step)
    thus ?thesis by (simp add: ym_eq_z_zm)
  qed
qed

text \<open>
  The proof was derived from the accepted answer on the website
  Stack Overflow that is available at
  @{url "https://stackoverflow.com/a/53585232/632199"}
  and provided with the permission of the author of the answer.\<close>

lemma fmrel_to_rtrancl:
  assumes as_r: "reflp r"
      and rel_rpp_xm_ym: "fmrel r\<^sup>*\<^sup>* xm ym"
    shows "(fmrel r)\<^sup>*\<^sup>* xm ym"
proof -
  from rel_rpp_xm_ym have "fmdom xm = fmdom ym"
    using fmrel_fmdom_eq by blast
  with rel_rpp_xm_ym show "(fmrel r)\<^sup>*\<^sup>* xm ym"
  proof (induct rule: fmap_eqdom_induct)
    case nil show ?case by auto
  next
    case (step x xm y ym i) show ?case
    proof -
      from step.hyps(1) have "(fmrel r)\<^sup>*\<^sup>* (fmupd i x xm) (fmupd i y xm)"
      proof (induct rule: rtranclp_induct)
        case base show ?case by simp
      next
        case (step y z) show ?case
        proof -
          from as_r have "fmrel r xm xm"
            by (simp add: fmap.rel_reflp reflpD)
          with step.hyps(2) have "(fmrel r)\<^sup>*\<^sup>* (fmupd i y xm) (fmupd i z xm)"
            by (simp add: fmrel_upd r_into_rtranclp)
          with step.hyps(3) show ?thesis by simp
        qed
      qed
      also from step.hyps(4) have "(fmrel r)\<^sup>*\<^sup>* (fmupd i y xm) (fmupd i y ym)"
      proof (induct rule: rtranclp_induct)
        case base show ?case by simp
      next
        case (step ya za) show ?case
        proof -
          from step.hyps(2) as_r have "(fmrel r)\<^sup>*\<^sup>* (fmupd i y ya) (fmupd i y za)"
            by (simp add: fmrel_upd r_into_rtranclp reflp_def)
          with step.hyps(3) show ?thesis by simp
        qed
      qed
      finally show ?thesis by simp
    qed
  qed
qed

text \<open>
  The proof was derived from the accepted answer on the website
  Stack Overflow that is available at
  @{url "https://stackoverflow.com/a/53585232/632199"}
  and provided with the permission of the author of the answer.\<close>

lemma fmrel_to_trancl:
  assumes "reflp r"
      and "fmrel r\<^sup>+\<^sup>+ xm ym"
    shows "(fmrel r)\<^sup>+\<^sup>+ xm ym"
proof -
  from assms(2) have "fmrel r\<^sup>*\<^sup>* xm ym"
    by (drule_tac ?Ra="r\<^sup>*\<^sup>*" in fmap.rel_mono_strong; auto)
  with assms(1) have "(fmrel r)\<^sup>*\<^sup>* xm ym"
    by (simp add: fmrel_to_rtrancl)
  with assms(1) show ?thesis
    by (metis fmap.rel_reflp reflpD rtranclpD tranclp.r_into_trancl)
qed

lemma fmrel_tranclp_induct:
  "fmrel r\<^sup>+\<^sup>+ a b \<Longrightarrow>
   reflp r \<Longrightarrow>
   (\<And>y. fmrel r a y \<Longrightarrow> P y) \<Longrightarrow>
   (\<And>y z. (fmrel r)\<^sup>+\<^sup>+ a y \<Longrightarrow> fmrel r y z \<Longrightarrow> P y \<Longrightarrow> P z) \<Longrightarrow> P b"
  apply (drule fmrel_to_trancl, simp)
  by (erule tranclp_induct; simp)

lemma fmrel_converse_tranclp_induct:
  "fmrel r\<^sup>+\<^sup>+ a b \<Longrightarrow>
   reflp r \<Longrightarrow>
   (\<And>y. fmrel r y b \<Longrightarrow> P y) \<Longrightarrow>
   (\<And>y z. fmrel r y z \<Longrightarrow> fmrel r\<^sup>+\<^sup>+ z b \<Longrightarrow> P z \<Longrightarrow> P y) \<Longrightarrow> P a"
  apply (drule fmrel_to_trancl, simp)
  by (erule converse_tranclp_induct; simp add: trancl_to_fmrel)

lemma fmrel_tranclp_trans_induct:
  "fmrel r\<^sup>+\<^sup>+ a b \<Longrightarrow>
   reflp r \<Longrightarrow>
   (\<And>x y. fmrel r x y \<Longrightarrow> P x y) \<Longrightarrow>
   (\<And>x y z. fmrel r\<^sup>+\<^sup>+ x y \<Longrightarrow> P x y \<Longrightarrow> fmrel r\<^sup>+\<^sup>+ y z \<Longrightarrow> P y z \<Longrightarrow> P x z) \<Longrightarrow>
   P a b"
  apply (drule fmrel_to_trancl, simp)
  apply (erule tranclp_trans_induct, simp)
  using trancl_to_fmrel by blast

(*** Finite Map Size Calculation ********************************************)

subsection \<open>Size Calculation\<close>

text \<open>
  The contents of the subsection was derived from the accepted answer
  on the website Stack Overflow that is available at
  @{url "https://stackoverflow.com/a/53244203/632199"}
  and provided with the permission of the author of the answer.\<close>

abbreviation "tcf \<equiv> (\<lambda> v::('a \<times> nat). (\<lambda> r::nat. snd v + r))"

interpretation tcf: comp_fun_commute tcf
proof
  fix x y :: "'a \<times> nat"
  show "tcf y \<circ> tcf x = tcf x \<circ> tcf y"
  proof -
    fix z
    have "(tcf y \<circ> tcf x) z = snd y + snd x + z" by auto
    also have "(tcf x \<circ> tcf y) z = snd y + snd x + z" by auto
    finally have "(tcf y \<circ> tcf x) z = (tcf x \<circ> tcf y) z" by auto
    thus "(tcf y \<circ> tcf x) = (tcf x \<circ> tcf y)" by auto
  qed
qed

lemma ffold_rec_exp:
  assumes "k |\<in>| fmdom x"
    and "ky = (k, the (fmlookup (fmmap f x) k))"
  shows "ffold tcf 0 (fset_of_fmap (fmmap f x)) =
        tcf ky (ffold tcf 0 ((fset_of_fmap (fmmap f x)) |-| {|ky|}))"
proof -
  have "ky |\<in>| (fset_of_fmap (fmmap f x))"
    using assms by auto
  thus ?thesis
    by (simp add: tcf.ffold_rec)
qed

lemma elem_le_ffold' [intro]:
  "z \<in> fmran' x \<Longrightarrow>
   f z < Suc (ffold tcf 0 (fset_of_fmap (fmmap f x)))"
  apply (erule fmran'E)
  apply (frule fmdomI)
  by (subst ffold_rec_exp, auto)

(*** Code Setup *************************************************************)

subsection \<open>Code Setup\<close>

abbreviation "fmmerge_fun f xm ym \<equiv>
  fmap_of_list (map
    (\<lambda>k. if k |\<in>| fmdom xm \<and> k |\<in>| fmdom ym
         then (k, f (the (fmlookup xm k)) (the (fmlookup ym k)))
         else (k, undefined))
    (sorted_list_of_fset (fmdom xm |\<inter>| fmdom ym)))"

lemma fmmerge_fun_simp [code_abbrev, simp]:
  "fmmerge_fun f xm ym = fmmerge f xm ym"
  unfolding fmmerge_def
  apply (rule_tac ?f="fmap_of_list" in HOL.arg_cong)
  by (simp add: notin_fset)

end


theory Scope_Extrusion
  imports Main
begin

section \<open>Syntax\<close>

type_synonym atom = string
type_synonym index = nat

datatype name =
  Free atom (\<open>\<circ>' _\<close> [200] 990)
| Bound index (\<open>\<bullet>' _\<close> [200] 990)

datatype process =
  PInaction (\<open>\<zero>\<close>)
| POutput name name process (\<open>_\<^bold>!_._\<close> [130, 130, 130] 160)
| PInput name process (\<open>_\<^bold>?._\<close> [130,130] 160)  (* this binds a name *)
| PParallel process process (infix \<open>\<^bold>|\<close> 120)
| PRestrict process (\<open>'(\<nu>')' _\<close> [130] 160) (* this binds a name *)
| PChoice process process (infix \<open>\<^bold>+\<close> 120)

text \<open>Example processes\<close>
term \<open>\<circ>''a''\<^bold>!\<circ>''b''.P \<^bold>| Q\<close>
term \<open>(\<nu>) P \<^bold>| Q\<close>
term \<open>\<bullet>0\<^bold>?.P \<^bold>+ Q\<close> (* this is an invalid term: it contains an unguarded bound name *)

subsection \<open>Locally nameless machinery\<close>
subsubsection \<open>Opening\<close>
fun open_name_name where
  \<open>open_name_name _ _ (\<circ>n) = \<circ>n\<close>
| \<open>open_name_name k x (\<bullet>i) = (if i = k then \<circ>x else \<bullet>i)\<close>

fun open_name where
  \<open>open_name _ _ \<zero> = \<zero>\<close>
| \<open>open_name k x (a\<^bold>!b. P) = open_name_name k x a\<^bold>!open_name_name k x b.(open_name k x P)\<close>
| \<open>open_name k x (a\<^bold>?.P) = open_name_name k x a\<^bold>?.open_name (k + 1) x P\<close>
| \<open>open_name k x (P \<^bold>| Q) = open_name k x P \<^bold>| open_name k x Q\<close>
| \<open>open_name k x ((\<nu>)P) = (\<nu>) open_name (k + 1) x P\<close>
| \<open>open_name k x (P \<^bold>+ Q) = open_name k x P \<^bold>+ open_name k x Q\<close>

definition opening_name where
  \<open>opening_name x P \<equiv> open_name 0 x P\<close>

subsubsection \<open>Closing\<close>
fun close_name_name where
  \<open>close_name_name k x (\<circ>n) = (if x = n then \<bullet>k else \<circ>n)\<close>
| \<open>close_name_name _ _ (\<bullet>i) = \<bullet>i\<close>

fun close_name where
  \<open>close_name _ _ \<zero> = \<zero>\<close>
| \<open>close_name k x (a\<^bold>!b. P) = close_name_name k x a\<^bold>!close_name_name k x b.(close_name k x P)\<close>
| \<open>close_name k x (a\<^bold>?.P) = close_name_name k x a\<^bold>?.close_name (k + 1) x P\<close>
| \<open>close_name k x (P \<^bold>| Q) = close_name k x P \<^bold>| close_name k x Q\<close>
| \<open>close_name k x ((\<nu>)P) = (\<nu>) close_name (k + 1) x P\<close>
| \<open>close_name k x (P \<^bold>+ Q) = close_name k x P \<^bold>+ close_name k x Q\<close>

definition closing_name where
  \<open>closing_name x P \<equiv> close_name 0 x P\<close>

subsubsection \<open>Locally closed terms\<close>
inductive lc_name where
  LCFree: \<open>lc_name (\<circ>x)\<close>

inductive lc where
  LCInaction: \<open>lc \<zero>\<close>
| LCOutput:   \<open>\<lbrakk>lc_name x; lc_name y; lc P\<rbrakk> \<Longrightarrow> lc (x\<^bold>!y. P)\<close>
| LCInput:    \<open>\<lbrakk>lc_name x; \<exists>L. finite L \<and> (\<forall>y. y \<notin> L \<longrightarrow> lc (opening_name y P))\<rbrakk> \<Longrightarrow> lc (x\<^bold>?.P)\<close>
| LCParallel: \<open>\<lbrakk>lc P; lc Q\<rbrakk> \<Longrightarrow> lc (P \<^bold>| Q)\<close>
| LCRestrict: \<open>\<lbrakk>\<exists>L. finite L \<and> (\<forall>y. y \<notin> L \<longrightarrow> lc (opening_name y P))\<rbrakk> \<Longrightarrow> lc ((\<nu>)P)\<close>
| LCChoice:   \<open>\<lbrakk>lc P; lc Q\<rbrakk> \<Longrightarrow> lc (P \<^bold>+ Q)\<close>

definition body where
  \<open>body P \<equiv> \<exists>L. finite L \<and> (\<forall>x. x \<notin> L \<longrightarrow> lc (opening_name x P))\<close>

lemma lc_input_iff_body: \<open>lc (x\<^bold>?.P) \<longleftrightarrow> (body P \<and> lc_name x)\<close>
  unfolding body_def
proof (safe)
  assume *: \<open>lc (x\<^bold>?.P)\<close>
  then show \<open>\<exists>L. finite L \<and> (\<forall>x. x \<notin> L \<longrightarrow> lc (opening_name x P))\<close>
    using lc.cases by fastforce
next
  assume \<open>lc (x\<^bold>?.P)\<close>
  then show \<open>lc_name x\<close>
    using lc.cases by blast
next
  fix L
  assume \<open>lc_name x\<close> \<open>finite L\<close> \<open>\<forall>x. x \<notin> L \<longrightarrow> lc (opening_name x P)\<close>
  then show \<open>lc (x\<^bold>?.P)\<close>
    using LCInput by blast
qed

lemma lc_restriction_iff_body: \<open>lc ((\<nu>)P) \<longleftrightarrow> body P\<close>
  unfolding body_def
proof
  assume *: \<open>lc ((\<nu>)P)\<close>
  then show \<open>\<exists>L. finite L \<and> (\<forall>x. x \<notin> L \<longrightarrow> lc (opening_name x P))\<close>
    using lc.cases by fastforce
next
  assume \<open>\<exists>L. finite L \<and> (\<forall>x. x \<notin> L \<longrightarrow> lc (opening_name x P))\<close>
  then show \<open>lc ((\<nu>)P)\<close>
    by (simp add: LCRestrict)
qed

lemma open_var_lc: \<open>body P \<Longrightarrow> lc (opening_name x P)\<close>
proof (unfold body_def)
  assume \<open>\<exists>L. finite L \<and> (\<forall>x. x \<notin> L \<longrightarrow> lc (opening_name x P))\<close>
  then obtain L where *: \<open>finite L\<close> \<open>\<forall>x. x \<notin> L \<longrightarrow> lc (opening_name x P)\<close>
    by blast
  then show \<open>lc (opening_name x P)\<close>
    sorry
qed

lemma close_var_lc: \<open>lc P \<Longrightarrow> body (closing_name x P)\<close>
  unfolding body_def
proof
  assume \<open>lc P\<close>
  then have \<open>(\<forall>y. y \<notin> {x} \<longrightarrow> lc (opening_name y (closing_name x P)))\<close>
  proof (induction P rule: lc.induct)
    case LCInaction
    then show ?case
      by (simp add: closing_name_def lc.LCInaction opening_name_def)
  next
    case (LCOutput x' y' P)
    fix z :: \<open>char list\<close>
    from \<open>lc_name x'\<close> have \<open>\<exists>xn. x' = Free xn\<close>
      using lc_name.simps by auto
    moreover from \<open>lc_name y'\<close> have \<open>\<exists>yn. y' = Free yn\<close>
      using lc_name.simps by auto
    ultimately show ?case
      unfolding opening_name_def closing_name_def
      by (smt (verit, ccfv_threshold) LCOutput.IH close_name.simps close_name_name.simps(1) closing_name_def lc.simps lc_name.intros open_name.simps open_name_name.simps opening_name_def)
  next
    case (LCInput P x')
    then show ?case
      sorry
  next
    case (LCParallel P Q)
    then show ?case sorry
  next
    case (LCRestrict P)
    then show ?case sorry
  next
    case (LCChoice P Q)
    then show ?case sorry
  qed
  then show \<open>finite {x} \<and> (\<forall>y. y \<notin> {x} \<longrightarrow> lc (opening_name y (closing_name x P)))\<close>
    by simp
qed

subsubsection \<open>Free names\<close>
fun fn_names where
  \<open>fn_names (\<circ>n) = {n}\<close>
| \<open>fn_names (\<bullet>i) = {}\<close>

fun fn where
  \<open>fn \<zero> = {}\<close>
| \<open>fn (x\<^bold>!y. P) = fn_names x \<union> fn_names y \<union> fn P\<close>
| \<open>fn (x\<^bold>?.P) = fn_names x \<union> fn P\<close>
| \<open>fn (P \<^bold>| Q) = fn P \<union> fn Q\<close>
| \<open>fn ((\<nu>)P) = fn P\<close>
| \<open>fn (P \<^bold>+ Q) = fn P \<union> fn Q\<close>

definition fresh (infix \<open>\<sharp>\<close> 110) where
  \<open>n \<sharp> P \<equiv> n \<notin> fn P\<close>

definition closed where
  \<open>closed P \<equiv> fn P = {}\<close>

lemma open_var_fn: \<open>fn (opening_name x P) \<subseteq> fn P \<union> {x}\<close>
  unfolding opening_name_def
proof (induction P)
  case (POutput x1 x2 P)
  then show ?case sorry
next
  case (PInput x1 P)
  then show ?case sorry
next
  case (PRestrict P)
  then show ?case sorry
qed auto

lemma close_var_fn: \<open>fn (closing_name x P) = fn P - {x}\<close>
  unfolding closing_name_def
proof (induction P)
  case (POutput a b P)
  then show ?case sorry
next
  case (PInput x1 P)
  then show ?case sorry
next
  case (PRestrict P)
  then show ?case sorry
qed auto

subsubsection \<open>Substitution\<close>
fun subst_name where
  \<open>subst_name (\<circ>n) a b = (if b = n then a else \<circ>n)\<close>
| \<open>subst_name (\<bullet>i) _ _ = \<bullet>i\<close>

fun subst (\<open>_\<lbrace>' _'/' _\<rbrace>\<close> [200, 900, 900] 200) where
  \<open>\<zero>\<lbrace>a/b\<rbrace> = \<zero>\<close>
| \<open>(x\<^bold>!y. P)\<lbrace>a/b\<rbrace> = (subst_name x a b\<^bold>!subst_name y a b. P\<lbrace>a/b\<rbrace>)\<close>
| \<open>(x\<^bold>?.P)\<lbrace>a/b\<rbrace> = subst_name x a b\<^bold>?.P\<lbrace>a/b\<rbrace>\<close>
| \<open>(P \<^bold>| Q)\<lbrace>a/b\<rbrace> = (P\<lbrace>a/b\<rbrace>) \<^bold>| (Q\<lbrace>a/b\<rbrace>)\<close>
| \<open>((\<nu>)P)\<lbrace>a/b\<rbrace> = (\<nu>)(P\<lbrace>a/b\<rbrace>)\<close>
| \<open>(P \<^bold>+ Q)\<lbrace>a/b\<rbrace> = (P\<lbrace>a/b\<rbrace>) \<^bold>+ (Q\<lbrace>a/b\<rbrace>)\<close>

lemma subst_lc: \<open>\<lbrakk>lc P; lc_name y\<rbrakk> \<Longrightarrow> lc (P\<lbrace>y/x\<rbrace>)\<close>
proof (induction P rule: lc.induct)
  case (LCOutput x y P)
  then show ?case sorry
next
  case (LCInput P x)
  then show ?case sorry
next
  case (LCRestrict P)
  then show ?case sorry
qed (simp_all add: lc.intros)

lemma subst_body: \<open>\<lbrakk>body P; lc_name y\<rbrakk> \<Longrightarrow> body (P\<lbrace>y/x\<rbrace>)\<close>
proof (induction P)
  case PInaction
  then show ?case
    by simp
qed (metis lc_input_iff_body subst.simps(3) subst_lc)+

lemma subst_open_var: \<open>\<lbrakk>x \<noteq> y; lc_name z\<rbrakk> \<Longrightarrow> (opening_name y P)\<lbrace>z/x\<rbrace> = opening_name y (P\<lbrace>z/x\<rbrace>)\<close>
  unfolding opening_name_def
proof (induction P)
  case (POutput x1 x2 P)
  then show ?case sorry
next
  case (PInput x1 P)
  then show ?case sorry
next
  case (PRestrict P)
  then show ?case sorry
qed auto

lemma subst_close_var: \<open>\<lbrakk>x \<noteq> y; y \<noteq> z\<rbrakk> \<Longrightarrow> (closing_name y P)\<lbrace>\<circ>z/x\<rbrace> = closing_name y (P\<lbrace>\<circ>z/x\<rbrace>)\<close>
  sorry

lemma subst_fresh: \<open>x \<sharp> P \<Longrightarrow> P\<lbrace>y/x\<rbrace> = P\<close>
  unfolding fresh_def
proof (induction P)
  case (POutput x1 x2 P)
  moreover from POutput have \<open>x \<notin> fn_names x1\<close> \<open>x \<notin> fn_names x2\<close>
    by simp+
  then have \<open>subst_name x1 y x = x1\<close> \<open>subst_name x2 y x = x2\<close>
    by (metis fn_names.elims insertCI subst_name.simps)+
  ultimately show ?case
    by simp
next
  case (PInput x1 P)
  then show ?case
    by (metis UnI1 UnI2 fn.simps(3) fn_names.elims insertCI subst.simps(3) subst_name.simps)
qed simp_all

subsection \<open>Examples\<close>
lemma \<open>lc (\<circ>''a''\<^bold>!\<circ>''b''.\<zero> \<^bold>| \<zero>)\<close>
  using LCInaction LCOutput LCParallel lc_name.intros by auto

lemma \<open>lc ((\<nu>) (\<zero> \<^bold>| \<bullet>0\<^bold>!\<circ>''a''.\<zero>))\<close>
proof (rule LCRestrict, rule exI)
  show \<open>finite {''a''} \<and> (\<forall>y. y \<notin> {''a''} \<longrightarrow> lc (opening_name y (\<zero> \<^bold>| \<bullet>0\<^bold>!\<circ>''a''.\<zero>)))\<close>
  proof
    show \<open>finite {''a''}\<close> by simp
  next
    show \<open>\<forall>y. y \<notin> {''a''} \<longrightarrow> lc (opening_name y (\<zero> \<^bold>| \<bullet>0\<^bold>!\<circ>''a''.\<zero>))\<close>
    proof (rule allI, rule impI)
      fix y
      assume \<open>y \<notin> {''a''}\<close>
      have \<open>lc (\<zero> \<^bold>| \<circ>y\<^bold>!\<circ>''a''.\<zero>)\<close>
      proof
        show \<open>lc \<zero>\<close> ..
      next
        show \<open>lc (\<circ>y\<^bold>!\<circ>''a''.\<zero>)\<close>
        proof
          show \<open>lc_name (\<circ>y)\<close> ..
        next
          show \<open>lc_name (\<circ>''a'')\<close> ..
        next
          show \<open>lc \<zero>\<close> ..
        qed
      qed
      then show \<open>lc (opening_name y (\<zero> \<^bold>| \<bullet>0\<^bold>!\<circ>''a''.\<zero>))\<close>
        unfolding opening_name_def by simp
    qed
  qed
qed

lemma \<open>\<not> lc (\<bullet>0\<^bold>?.P \<^bold>+ Q)\<close>
proof
  assume \<open>lc (\<bullet>0\<^bold>?.P \<^bold>+ Q)\<close>
  then show False
  proof (rule lc.cases; auto)
    assume \<open>lc (\<bullet>0\<^bold>?.P)\<close>
    then show False
    proof (rule lc.cases; auto)
      assume \<open>lc_name (\<bullet>0)\<close>
      then show False
        using lc_name.cases by auto
    qed
  qed
qed

section \<open>Semantics\<close>

subsection \<open>Actions\<close>
datatype action =
  AFreeOut atom atom (\<open>_\<^bold>!_\<close> [300,300] 400)
| ABoundOut atom atom (\<open>_\<^bold>!'(_')\<close> [300,300] 400)
| AIn atom atom (\<open>_\<^bold>?_\<close> [300,300] 400)
| AInternal (\<open>\<tau>\<close>)

fun names where
  \<open>names (x\<^bold>!y) = {x,y}\<close>
| \<open>names (x\<^bold>!(y)) = {x,y}\<close>
| \<open>names (x\<^bold>?y) = {x,y}\<close>
| \<open>names \<tau> = {}\<close>

inductive transition :: \<open>process \<Rightarrow> action \<Rightarrow> process \<Rightarrow> bool\<close> (\<open>_ \<midarrow>_\<rightarrow> _\<close> [100,400,100] 800) where
  TOut: \<open>lc P \<Longrightarrow> (\<circ>x\<^bold>!\<circ>y. P) \<midarrow>x\<^bold>!y\<rightarrow> P\<close>
| TIn:  \<open>body P \<Longrightarrow> (\<circ>x\<^bold>?.P) \<midarrow>x\<^bold>?y\<rightarrow> opening_name y P\<close>
| TSumL: \<open>lc P \<Longrightarrow> lc Q \<Longrightarrow> P \<midarrow>\<alpha>\<rightarrow> P' \<Longrightarrow> (P \<^bold>+ Q) \<midarrow>\<alpha>\<rightarrow> P'\<close>
| TSumR: \<open>lc Q \<Longrightarrow> lc P \<Longrightarrow> P \<midarrow>\<alpha>\<rightarrow> P' \<Longrightarrow> (Q \<^bold>+ P) \<midarrow>\<alpha>\<rightarrow> P'\<close>
| TParL: \<open>\<lbrakk>lc P; lc Q; names \<alpha> \<inter> fn Q = {}; P \<midarrow>\<alpha>\<rightarrow> P'\<rbrakk> \<Longrightarrow> (P \<^bold>| Q) \<midarrow>\<alpha>\<rightarrow> (P' \<^bold>| Q)\<close>
| TParR: \<open>\<lbrakk>lc P; lc Q; names \<alpha> \<inter> fn P = {}; Q \<midarrow>\<alpha>\<rightarrow> Q'\<rbrakk> \<Longrightarrow> (P \<^bold>| Q) \<midarrow>\<alpha>\<rightarrow> (P \<^bold>| Q')\<close>
| TCommL: \<open>\<lbrakk>P \<midarrow>x\<^bold>!y\<rightarrow> P'; Q \<midarrow>x\<^bold>?y\<rightarrow> Q'\<rbrakk> \<Longrightarrow> (P \<^bold>| Q) \<midarrow>\<tau>\<rightarrow> (P' \<^bold>| Q')\<close>
| TCommR: \<open>\<lbrakk>P \<midarrow>x\<^bold>?y\<rightarrow> P'; Q \<midarrow>x\<^bold>!y\<rightarrow> Q'\<rbrakk> \<Longrightarrow> (P \<^bold>| Q) \<midarrow>\<tau>\<rightarrow> (P' \<^bold>| Q')\<close>
| TCloseL: \<open>\<lbrakk>P \<midarrow>x\<^bold>!(z)\<rightarrow> P'; Q \<midarrow>x\<^bold>?z\<rightarrow> Q'; z \<sharp> Q\<rbrakk> \<Longrightarrow> (P \<^bold>| Q) \<midarrow>\<tau>\<rightarrow> ((\<nu>) closing_name z (P' \<^bold>| Q'))\<close>
| TCloseR: \<open>\<lbrakk>P \<midarrow>x\<^bold>?z\<rightarrow> P'; Q \<midarrow>x\<^bold>!(z)\<rightarrow> Q'; z \<sharp> P\<rbrakk> \<Longrightarrow> (P \<^bold>| Q) \<midarrow>\<tau>\<rightarrow> ((\<nu>) closing_name z (P' \<^bold>| Q'))\<close>
| TOpen: \<open>\<lbrakk>opening_name z P \<midarrow>x\<^bold>!z\<rightarrow> opening_name z P'; z \<noteq> x\<rbrakk> \<Longrightarrow> ((\<nu>) P) \<midarrow>x\<^bold>!(z)\<rightarrow> opening_name z P'\<close>
| TRes: \<open>lc P \<Longrightarrow> P \<midarrow>\<alpha>\<rightarrow> P' \<Longrightarrow> ((\<nu>) P) \<midarrow>\<alpha>\<rightarrow> (\<nu>) P'\<close>

lemma regularity: \<open>P \<midarrow>\<alpha>\<rightarrow> P' \<Longrightarrow> lc P \<and> lc P'\<close>
  sorry

subsection \<open>Examples\<close>

lemma \<open>(((\<nu>) (\<circ>''x''\<^bold>!\<bullet>0.\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero>)) \<^bold>| \<circ>''x''\<^bold>?.(\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>))
              \<midarrow>\<tau>\<rightarrow> ((\<nu>) (\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero> \<^bold>| (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>)))\<close>
proof -
  have \<open>((\<nu>) (\<circ>''x''\<^bold>!\<bullet>0.\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero>)) \<midarrow>''x''\<^bold>!(''s'')\<rightarrow> opening_name ''s'' (\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero>)\<close>
  proof (rule TOpen)
    have \<open>\<circ>''x''\<^bold>!\<circ>''s''.\<circ>''s''\<^bold>!\<circ>''a''.\<circ>''s''\<^bold>!\<circ>''b''.\<zero> \<midarrow>''x''\<^bold>!''s''\<rightarrow> \<circ>''s''\<^bold>!\<circ>''a''. \<circ>''s''\<^bold>!\<circ>''b''.\<zero>\<close>
      by (rule TOut) (simp add: LCInaction LCOutput lc_name.intros)
    then show \<open>opening_name ''s'' (\<circ>''x''\<^bold>!\<bullet>0.\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero>) \<midarrow>''x''\<^bold>!''s''\<rightarrow> opening_name ''s'' (\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero>)\<close>
      unfolding opening_name_def by simp
  qed (simp)
  then have \<open>((\<nu>) (\<circ>''x''\<^bold>!\<bullet>0.\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero>)) \<midarrow>''x''\<^bold>!(''s'')\<rightarrow> \<circ>''s''\<^bold>!\<circ>''a''. \<circ>''s''\<^bold>!\<circ>''b''.\<zero>\<close>
    unfolding opening_name_def by simp
  moreover have \<open>\<circ>''x''\<^bold>?.(\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>) \<midarrow>''x''\<^bold>?''s''\<rightarrow> opening_name ''s'' (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>)\<close>
  proof (rule TIn)
    show \<open>body (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>)\<close>
      unfolding body_def
    proof (rule exI, rule conjI)
      show \<open>finite {}\<close> by simp
    next
      show \<open>\<forall>x. x \<notin> {} \<longrightarrow> lc (opening_name x (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>))\<close>
      proof
        fix x
        show \<open>x \<notin> {} \<longrightarrow> lc (opening_name x (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>))\<close>
        proof
          assume \<open>x \<notin> {}\<close>
          have \<open>lc (\<circ>x\<^bold>?.\<circ>x\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>)\<close>
          proof (rule LCParallel)
            show \<open>lc (\<circ>x\<^bold>?.\<circ>x\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero>)\<close>
            proof (rule LCInput)
              show \<open>lc_name (\<circ>x)\<close> by (rule LCFree)
            next
              show \<open>\<exists>L. finite L \<and> (\<forall>y. y \<notin> L \<longrightarrow> lc (opening_name y (\<circ>x\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero>)))\<close>
              proof (rule exI, rule conjI)
                show \<open>finite {}\<close> by simp
              next
                show \<open>\<forall>y. y \<notin> {} \<longrightarrow> lc (opening_name y (\<circ>x\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero>)) \<close>
                proof (rule allI, rule impI)
                  fix y :: atom
                  assume \<open>y \<notin> {}\<close>
                  have \<open>lc (\<circ>x\<^bold>?.\<circ>y\<^bold>!\<bullet>0.\<zero>)\<close>
                  proof (rule LCInput)
                    show \<open>lc_name (\<circ>x)\<close> by (rule LCFree)
                  next
                    show \<open>\<exists>L. finite L \<and> (\<forall>ya. ya \<notin> L \<longrightarrow> lc (opening_name ya (\<circ>y\<^bold>!\<bullet>0.\<zero>)))\<close>
                    proof (rule exI, rule conjI)
                      show \<open>finite {}\<close> by simp
                    next
                      show \<open>\<forall>w. w \<notin> {} \<longrightarrow> lc (opening_name w (\<circ>y\<^bold>!\<bullet>0.\<zero>))\<close>
                      proof (rule allI, rule impI)
                        fix w :: atom
                        assume \<open>w \<notin> {}\<close>
                        have \<open>lc (\<circ>y\<^bold>!\<circ>w.\<zero>)\<close>
                          by (simp add: LCInaction LCOutput lc_name.intros)
                        then show \<open>lc (opening_name w (\<circ>y\<^bold>!\<bullet>0.\<zero>))\<close>
                          unfolding opening_name_def by simp
                      qed
                    qed
                  qed
                  then show \<open>lc (opening_name y (\<circ>x\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero>))\<close>
                    unfolding opening_name_def by simp
                qed
              qed
            qed
          next
            show \<open>lc (\<circ>''z''\<^bold>?.\<zero>)\<close>
              by (metis LCInaction LCInput infinite_imp_nonempty lc_name.intros open_name.simps(1) opening_name_def)
          qed
          then show \<open>lc (opening_name x (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>))\<close>
            unfolding opening_name_def by simp
        qed
      qed
    qed
  qed
  then have \<open>\<circ>''x''\<^bold>?.(\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>) \<midarrow>''x''\<^bold>?''s''\<rightarrow> (\<circ>''s''\<^bold>?.\<circ>''s''\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>)\<close>
    unfolding opening_name_def by simp
  ultimately have \<open>(\<nu>)\<circ>''x''\<^bold>!\<bullet>0.\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero> \<^bold>|
    \<circ>''x''\<^bold>?.(\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>|
              \<circ>''z''\<^bold>?.\<zero>) \<midarrow>\<tau>\<rightarrow> (\<nu>) (closing_name ''s'' (\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero> \<^bold>| (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>)))\<close>
    sorry
  then show \<open>(\<nu>)\<circ>''x''\<^bold>!\<bullet>0.\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero> \<^bold>|
    \<circ>''x''\<^bold>?.(\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>|
              \<circ>''z''\<^bold>?.\<zero>) \<midarrow>\<tau>\<rightarrow> (\<nu>) (\<bullet>0\<^bold>!\<circ>''a''.\<bullet>0\<^bold>!\<circ>''b''.\<zero> \<^bold>| (\<bullet>0\<^bold>?.\<bullet>1\<^bold>?.\<bullet>1\<^bold>!\<bullet>0.\<zero> \<^bold>| \<circ>''z''\<^bold>?.\<zero>))\<close>
    unfolding closing_name_def by simp
qed

section \<open>Bisimulation\<close>

subsection \<open>Observability\<close>

datatype observation =
  ObsIn atom (\<open>_\<^bold>\<questiondown>\<close>)
| ObsOut atom (\<open>_\<^bold>\<exclamdown>\<close>)

inductive observable (\<open>_\<down>\<^bsub>_\<^esub>\<close> [30,30] 30) where
  OIn: \<open>\<exists>P' y. P \<midarrow>x\<^bold>?y\<rightarrow> P' \<Longrightarrow> P\<down>\<^bsub>x\<^bold>\<questiondown>\<^esub>\<close>
| OOutFree: \<open>\<exists>P' y. P \<midarrow>x\<^bold>!y\<rightarrow> P' \<Longrightarrow> P\<down>\<^bsub>x\<^bold>\<exclamdown>\<^esub>\<close>
| OOutBound: \<open>\<exists>P' z. P \<midarrow>x\<^bold>!(z)\<rightarrow> P' \<Longrightarrow> P\<down>\<^bsub>x\<^bold>\<exclamdown>\<^esub>\<close>

subsection \<open>Strong barbed bisimulation\<close>

inductive bisimilar (infix \<open>\<sim>\<close> 200) where
\<open>\<lbrakk>
  P\<down>\<^bsub>\<mu>\<^esub> \<longrightarrow> Q\<down>\<^bsub>\<mu>\<^esub>; P \<midarrow>\<tau>\<rightarrow> P' \<longrightarrow> (\<exists>Q'. Q \<midarrow>\<tau>\<rightarrow> Q' \<and> P' \<sim> Q');
  Q\<down>\<^bsub>\<mu>\<^esub> \<longrightarrow> P\<down>\<^bsub>\<mu>\<^esub>; Q \<midarrow>\<tau>\<rightarrow> Q' \<longrightarrow> (\<exists>P'. P \<midarrow>\<tau>\<rightarrow> P' \<and> P' \<sim> Q')\<rbrakk>
  \<Longrightarrow> P \<sim> Q\<close>

section \<open>Bisimulation is an equivalence relation\<close>

theorem \<open>equivp (\<sim>)\<close>
  sorry

end


(*
  Title:    HOL/Analysis/Infinite_Set_Sum.thy
  Author:   Manuel Eberl, TU München

  A theory of sums over possible infinite sets. (Only works for absolute summability)
*)
section \<open>Sums over Infinite Sets\<close>

theory Infinite_Set_Sum
  imports Set_Integral
begin

(* TODO Move *)
lemma sets_eq_countable:
  assumes "countable A" "space M = A" "\<And>x. x \<in> A \<Longrightarrow> {x} \<in> sets M"
  shows   "sets M = Pow A"
proof (intro equalityI subsetI)
  fix X assume "X \<in> Pow A"
  hence "(\<Union>x\<in>X. {x}) \<in> sets M"
    by (intro sets.countable_UN' countable_subset[OF _ assms(1)]) (auto intro!: assms(3))
  also have "(\<Union>x\<in>X. {x}) = X" by auto
  finally show "X \<in> sets M" .
next
  fix X assume "X \<in> sets M"
  from sets.sets_into_space[OF this] and assms
    show "X \<in> Pow A" by simp
qed

lemma measure_eqI_countable':
  assumes spaces: "space M = A" "space N = A"
  assumes sets: "\<And>x. x \<in> A \<Longrightarrow> {x} \<in> sets M" "\<And>x. x \<in> A \<Longrightarrow> {x} \<in> sets N"
  assumes A: "countable A"
  assumes eq: "\<And>a. a \<in> A \<Longrightarrow> emeasure M {a} = emeasure N {a}"
  shows "M = N"
proof (rule measure_eqI_countable)
  show "sets M = Pow A"
    by (intro sets_eq_countable assms)
  show "sets N = Pow A"
    by (intro sets_eq_countable assms)
qed fact+

lemma count_space_PiM_finite:
  fixes B :: "'a \<Rightarrow> 'b set"
  assumes "finite A" "\<And>i. countable (B i)"
  shows   "PiM A (\<lambda>i. count_space (B i)) = count_space (PiE A B)"
proof (rule measure_eqI_countable')
  show "space (PiM A (\<lambda>i. count_space (B i))) = PiE A B"
    by (simp add: space_PiM)
  show "space (count_space (PiE A B)) = PiE A B" by simp
next
  fix f assume f: "f \<in> PiE A B"
  hence "PiE A (\<lambda>x. {f x}) \<in> sets (Pi\<^sub>M A (\<lambda>i. count_space (B i)))"
    by (intro sets_PiM_I_finite assms) auto
  also from f have "PiE A (\<lambda>x. {f x}) = {f}"
    by (intro PiE_singleton) (auto simp: PiE_def)
  finally show "{f} \<in> sets (Pi\<^sub>M A (\<lambda>i. count_space (B i)))" .
next
  interpret product_sigma_finite "(\<lambda>i. count_space (B i))"
    by (intro product_sigma_finite.intro sigma_finite_measure_count_space_countable assms)
  thm sigma_finite_measure_count_space
  fix f assume f: "f \<in> PiE A B"
  hence "{f} = PiE A (\<lambda>x. {f x})"
    by (intro PiE_singleton [symmetric]) (auto simp: PiE_def)
  also have "emeasure (Pi\<^sub>M A (\<lambda>i. count_space (B i))) \<dots> =
               (\<Prod>i\<in>A. emeasure (count_space (B i)) {f i})"
    using f assms by (subst emeasure_PiM) auto
  also have "\<dots> = (\<Prod>i\<in>A. 1)"
    by (intro prod.cong refl, subst emeasure_count_space_finite) (use f in auto)
  also have "\<dots> = emeasure (count_space (PiE A B)) {f}"
    using f by (subst emeasure_count_space_finite) auto
  finally show "emeasure (Pi\<^sub>M A (\<lambda>i. count_space (B i))) {f} =
                  emeasure (count_space (Pi\<^sub>E A B)) {f}" .
qed (simp_all add: countable_PiE assms)

definition\<^marker>\<open>tag important\<close> abs_summable_on ::
    "('a \<Rightarrow> 'b :: {banach, second_countable_topology}) \<Rightarrow> 'a set \<Rightarrow> bool"
    (infix "abs'_summable'_on" 50)
 where
   "f abs_summable_on A \<longleftrightarrow> integrable (count_space A) f"

definition\<^marker>\<open>tag important\<close> infsetsum ::
    "('a \<Rightarrow> 'b :: {banach, second_countable_topology}) \<Rightarrow> 'a set \<Rightarrow> 'b"
 where
   "infsetsum f A = lebesgue_integral (count_space A) f"

syntax (ASCII)
  "_infsetsum" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::{banach, second_countable_topology}"
  ("(3INFSETSUM _:_./ _)" [0, 51, 10] 10)
syntax
  "_infsetsum" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::{banach, second_countable_topology}"
  ("(2\<Sum>\<^sub>a_\<in>_./ _)" [0, 51, 10] 10)
translations \<comment> \<open>Beware of argument permutation!\<close>
  "\<Sum>\<^sub>ai\<in>A. b" \<rightleftharpoons> "CONST infsetsum (\<lambda>i. b) A"

syntax (ASCII)
  "_uinfsetsum" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::{banach, second_countable_topology}"
  ("(3INFSETSUM _:_./ _)" [0, 51, 10] 10)
syntax
  "_uinfsetsum" :: "pttrn \<Rightarrow> 'b \<Rightarrow> 'b::{banach, second_countable_topology}"
  ("(2\<Sum>\<^sub>a_./ _)" [0, 10] 10)
translations \<comment> \<open>Beware of argument permutation!\<close>
  "\<Sum>\<^sub>ai. b" \<rightleftharpoons> "CONST infsetsum (\<lambda>i. b) (CONST UNIV)"

syntax (ASCII)
  "_qinfsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a::{banach, second_countable_topology}"
  ("(3INFSETSUM _ |/ _./ _)" [0, 0, 10] 10)
syntax
  "_qinfsetsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a::{banach, second_countable_topology}"
  ("(2\<Sum>\<^sub>a_ | (_)./ _)" [0, 0, 10] 10)
translations
  "\<Sum>\<^sub>ax|P. t" => "CONST infsetsum (\<lambda>x. t) {x. P}"

print_translation \<open>
let
  fun sum_tr' [Abs (x, Tx, t), Const (\<^const_syntax>\<open>Collect\<close>, _) $ Abs (y, Ty, P)] =
        if x <> y then raise Match
        else
          let
            val x' = Syntax_Trans.mark_bound_body (x, Tx);
            val t' = subst_bound (x', t);
            val P' = subst_bound (x', P);
          in
            Syntax.const \<^syntax_const>\<open>_qinfsetsum\<close> $ Syntax_Trans.mark_bound_abs (x, Tx) $ P' $ t'
          end
    | sum_tr' _ = raise Match;
in [(\<^const_syntax>\<open>infsetsum\<close>, K sum_tr')] end
\<close>

lemma restrict_count_space_subset:
  "A \<subseteq> B \<Longrightarrow> restrict_space (count_space B) A = count_space A"
  by (subst restrict_count_space) (simp_all add: Int_absorb2)

lemma abs_summable_on_restrict:
  fixes f :: "'a \<Rightarrow> 'b :: {banach, second_countable_topology}"
  assumes "A \<subseteq> B"
  shows   "f abs_summable_on A \<longleftrightarrow> (\<lambda>x. indicator A x *\<^sub>R f x) abs_summable_on B"
proof -
  have "count_space A = restrict_space (count_space B) A"
    by (rule restrict_count_space_subset [symmetric]) fact+
  also have "integrable \<dots> f \<longleftrightarrow> set_integrable (count_space B) A f"
    by (simp add: integrable_restrict_space set_integrable_def)
  finally show ?thesis
    unfolding abs_summable_on_def set_integrable_def .
qed

lemma abs_summable_on_altdef: "f abs_summable_on A \<longleftrightarrow> set_integrable (count_space UNIV) A f"
  unfolding abs_summable_on_def set_integrable_def
  by (metis (no_types) inf_top.right_neutral integrable_restrict_space restrict_count_space sets_UNIV)

lemma abs_summable_on_altdef':
  "A \<subseteq> B \<Longrightarrow> f abs_summable_on A \<longleftrightarrow> set_integrable (count_space B) A f"
  unfolding abs_summable_on_def set_integrable_def
  by (metis (no_types) Pow_iff abs_summable_on_def inf.orderE integrable_restrict_space restrict_count_space_subset sets_count_space space_count_space)

lemma abs_summable_on_norm_iff [simp]:
  "(\<lambda>x. norm (f x)) abs_summable_on A \<longleftrightarrow> f abs_summable_on A"
  by (simp add: abs_summable_on_def integrable_norm_iff)

lemma abs_summable_on_normI: "f abs_summable_on A \<Longrightarrow> (\<lambda>x. norm (f x)) abs_summable_on A"
  by simp

lemma abs_summable_complex_of_real [simp]: "(\<lambda>n. complex_of_real (f n)) abs_summable_on A \<longleftrightarrow> f abs_summable_on A"
  by (simp add: abs_summable_on_def complex_of_real_integrable_eq)

lemma abs_summable_on_comparison_test:
  assumes "g abs_summable_on A"
  assumes "\<And>x. x \<in> A \<Longrightarrow> norm (f x) \<le> norm (g x)"
  shows   "f abs_summable_on A"
  using assms Bochner_Integration.integrable_bound[of "count_space A" g f]
  unfolding abs_summable_on_def by (auto simp: AE_count_space)

lemma abs_summable_on_comparison_test':
  assumes "g abs_summable_on A"
  assumes "\<And>x. x \<in> A \<Longrightarrow> norm (f x) \<le> g x"
  shows   "f abs_summable_on A"
proof (rule abs_summable_on_comparison_test[OF assms(1), of f])
  fix x assume "x \<in> A"
  with assms(2) have "norm (f x) \<le> g x" .
  also have "\<dots> \<le> norm (g x)" by simp
  finally show "norm (f x) \<le> norm (g x)" .
qed

lemma abs_summable_on_cong [cong]:
  "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> A = B \<Longrightarrow> (f abs_summable_on A) \<longleftrightarrow> (g abs_summable_on B)"
  unfolding abs_summable_on_def by (intro integrable_cong) auto

lemma abs_summable_on_cong_neutral:
  assumes "\<And>x. x \<in> A - B \<Longrightarrow> f x = 0"
  assumes "\<And>x. x \<in> B - A \<Longrightarrow> g x = 0"
  assumes "\<And>x. x \<in> A \<inter> B \<Longrightarrow> f x = g x"
  shows   "f abs_summable_on A \<longleftrightarrow> g abs_summable_on B"
  unfolding abs_summable_on_altdef set_integrable_def using assms
  by (intro Bochner_Integration.integrable_cong refl)
     (auto simp: indicator_def split: if_splits)

lemma abs_summable_on_restrict':
  fixes f :: "'a \<Rightarrow> 'b :: {banach, second_countable_topology}"
  assumes "A \<subseteq> B"
  shows   "f abs_summable_on A \<longleftrightarrow> (\<lambda>x. if x \<in> A then f x else 0) abs_summable_on B"
  by (subst abs_summable_on_restrict[OF assms]) (intro abs_summable_on_cong, auto)

lemma abs_summable_on_nat_iff:
  "f abs_summable_on (A :: nat set) \<longleftrightarrow> summable (\<lambda>n. if n \<in> A then norm (f n) else 0)"
proof -
  have "f abs_summable_on A \<longleftrightarrow> summable (\<lambda>x. norm (if x \<in> A then f x else 0))"
    by (subst abs_summable_on_restrict'[of _ UNIV])
       (simp_all add: abs_summable_on_def integrable_count_space_nat_iff)
  also have "(\<lambda>x. norm (if x \<in> A then f x else 0)) = (\<lambda>x. if x \<in> A then norm (f x) else 0)"
    by auto
  finally show ?thesis .
qed

lemma abs_summable_on_nat_iff':
  "f abs_summable_on (UNIV :: nat set) \<longleftrightarrow> summable (\<lambda>n. norm (f n))"
  by (subst abs_summable_on_nat_iff) auto

lemma nat_abs_summable_on_comparison_test:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, second_countable_topology}"
  assumes "g abs_summable_on I"
  assumes "\<And>n. \<lbrakk>n\<ge>N; n \<in> I\<rbrakk> \<Longrightarrow> norm (f n) \<le> g n"
  shows   "f abs_summable_on I"
  using assms by (fastforce simp add: abs_summable_on_nat_iff intro: summable_comparison_test')

lemma abs_summable_comparison_test_ev:
  assumes "g abs_summable_on I"
  assumes "eventually (\<lambda>x. x \<in> I \<longrightarrow> norm (f x) \<le> g x) sequentially"
  shows   "f abs_summable_on I"
  by (metis (no_types, lifting) nat_abs_summable_on_comparison_test eventually_at_top_linorder assms)

lemma abs_summable_on_Cauchy:
  "f abs_summable_on (UNIV :: nat set) \<longleftrightarrow> (\<forall>e>0. \<exists>N. \<forall>m\<ge>N. \<forall>n. (\<Sum>x = m..<n. norm (f x)) < e)"
  by (simp add: abs_summable_on_nat_iff' summable_Cauchy sum_nonneg)

lemma abs_summable_on_finite [simp]: "finite A \<Longrightarrow> f abs_summable_on A"
  unfolding abs_summable_on_def by (rule integrable_count_space)

lemma abs_summable_on_empty [simp, intro]: "f abs_summable_on {}"
  by simp

lemma abs_summable_on_subset:
  assumes "f abs_summable_on B" and "A \<subseteq> B"
  shows   "f abs_summable_on A"
  unfolding abs_summable_on_altdef
  by (rule set_integrable_subset) (insert assms, auto simp: abs_summable_on_altdef)

lemma abs_summable_on_union [intro]:
  assumes "f abs_summable_on A" and "f abs_summable_on B"
  shows   "f abs_summable_on (A \<union> B)"
  using assms unfolding abs_summable_on_altdef by (intro set_integrable_Un) auto

lemma abs_summable_on_insert_iff [simp]:
  "f abs_summable_on insert x A \<longleftrightarrow> f abs_summable_on A"
proof safe
  assume "f abs_summable_on insert x A"
  thus "f abs_summable_on A"
    by (rule abs_summable_on_subset) auto
next
  assume "f abs_summable_on A"
  from abs_summable_on_union[OF this, of "{x}"]
    show "f abs_summable_on insert x A" by simp
qed

lemma abs_summable_sum:
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x abs_summable_on B"
  shows   "(\<lambda>y. \<Sum>x\<in>A. f x y) abs_summable_on B"
  using assms unfolding abs_summable_on_def by (intro Bochner_Integration.integrable_sum)

lemma abs_summable_Re: "f abs_summable_on A \<Longrightarrow> (\<lambda>x. Re (f x)) abs_summable_on A"
  by (simp add: abs_summable_on_def)

lemma abs_summable_Im: "f abs_summable_on A \<Longrightarrow> (\<lambda>x. Im (f x)) abs_summable_on A"
  by (simp add: abs_summable_on_def)

lemma abs_summable_on_finite_diff:
  assumes "f abs_summable_on A" "A \<subseteq> B" "finite (B - A)"
  shows   "f abs_summable_on B"
proof -
  have "f abs_summable_on (A \<union> (B - A))"
    by (intro abs_summable_on_union assms abs_summable_on_finite)
  also from assms have "A \<union> (B - A) = B" by blast
  finally show ?thesis .
qed

lemma abs_summable_on_reindex_bij_betw:
  assumes "bij_betw g A B"
  shows   "(\<lambda>x. f (g x)) abs_summable_on A \<longleftrightarrow> f abs_summable_on B"
proof -
  have *: "count_space B = distr (count_space A) (count_space B) g"
    by (rule distr_bij_count_space [symmetric]) fact
  show ?thesis unfolding abs_summable_on_def
    by (subst *, subst integrable_distr_eq[of _ _ "count_space B"])
       (insert assms, auto simp: bij_betw_def)
qed

lemma abs_summable_on_reindex:
  assumes "(\<lambda>x. f (g x)) abs_summable_on A"
  shows   "f abs_summable_on (g ` A)"
proof -
  define g' where "g' = inv_into A g"
  from assms have "(\<lambda>x. f (g x)) abs_summable_on (g' ` g ` A)"
    by (rule abs_summable_on_subset) (auto simp: g'_def inv_into_into)
  also have "?this \<longleftrightarrow> (\<lambda>x. f (g (g' x))) abs_summable_on (g ` A)" unfolding g'_def
    by (intro abs_summable_on_reindex_bij_betw [symmetric] inj_on_imp_bij_betw inj_on_inv_into) auto
  also have "\<dots> \<longleftrightarrow> f abs_summable_on (g ` A)"
    by (intro abs_summable_on_cong refl) (auto simp: g'_def f_inv_into_f)
  finally show ?thesis .
qed

lemma abs_summable_on_reindex_iff:
  "inj_on g A \<Longrightarrow> (\<lambda>x. f (g x)) abs_summable_on A \<longleftrightarrow> f abs_summable_on (g ` A)"
  by (intro abs_summable_on_reindex_bij_betw inj_on_imp_bij_betw)

lemma abs_summable_on_Sigma_project2:
  fixes A :: "'a set" and B :: "'a \<Rightarrow> 'b set"
  assumes "f abs_summable_on (Sigma A B)" "x \<in> A"
  shows   "(\<lambda>y. f (x, y)) abs_summable_on (B x)"
proof -
  from assms(2) have "f abs_summable_on (Sigma {x} B)"
    by (intro abs_summable_on_subset [OF assms(1)]) auto
  also have "?this \<longleftrightarrow> (\<lambda>z. f (x, snd z)) abs_summable_on (Sigma {x} B)"
    by (rule abs_summable_on_cong) auto
  finally have "(\<lambda>y. f (x, y)) abs_summable_on (snd ` Sigma {x} B)"
    by (rule abs_summable_on_reindex)
  also have "snd ` Sigma {x} B = B x"
    using assms by (auto simp: image_iff)
  finally show ?thesis .
qed

lemma abs_summable_on_Times_swap:
  "f abs_summable_on A \<times> B \<longleftrightarrow> (\<lambda>(x,y). f (y,x)) abs_summable_on B \<times> A"
proof -
  have bij: "bij_betw (\<lambda>(x,y). (y,x)) (B \<times> A) (A \<times> B)"
    by (auto simp: bij_betw_def inj_on_def)
  show ?thesis
    by (subst abs_summable_on_reindex_bij_betw[OF bij, of f, symmetric])
       (simp_all add: case_prod_unfold)
qed

lemma abs_summable_on_0 [simp, intro]: "(\<lambda>_. 0) abs_summable_on A"
  by (simp add: abs_summable_on_def)

lemma abs_summable_on_uminus [intro]:
  "f abs_summable_on A \<Longrightarrow> (\<lambda>x. -f x) abs_summable_on A"
  unfolding abs_summable_on_def by (rule Bochner_Integration.integrable_minus)

lemma abs_summable_on_add [intro]:
  assumes "f abs_summable_on A" and "g abs_summable_on A"
  shows   "(\<lambda>x. f x + g x) abs_summable_on A"
  using assms unfolding abs_summable_on_def by (rule Bochner_Integration.integrable_add)

lemma abs_summable_on_diff [intro]:
  assumes "f abs_summable_on A" and "g abs_summable_on A"
  shows   "(\<lambda>x. f x - g x) abs_summable_on A"
  using assms unfolding abs_summable_on_def by (rule Bochner_Integration.integrable_diff)

lemma abs_summable_on_scaleR_left [intro]:
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "(\<lambda>x. f x *\<^sub>R c) abs_summable_on A"
  using assms unfolding abs_summable_on_def by (intro Bochner_Integration.integrable_scaleR_left)

lemma abs_summable_on_scaleR_right [intro]:
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "(\<lambda>x. c *\<^sub>R f x) abs_summable_on A"
  using assms unfolding abs_summable_on_def by (intro Bochner_Integration.integrable_scaleR_right)

lemma abs_summable_on_cmult_right [intro]:
  fixes f :: "'a \<Rightarrow> 'b :: {banach, real_normed_algebra, second_countable_topology}"
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "(\<lambda>x. c * f x) abs_summable_on A"
  using assms unfolding abs_summable_on_def by (intro Bochner_Integration.integrable_mult_right)

lemma abs_summable_on_cmult_left [intro]:
  fixes f :: "'a \<Rightarrow> 'b :: {banach, real_normed_algebra, second_countable_topology}"
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "(\<lambda>x. f x * c) abs_summable_on A"
  using assms unfolding abs_summable_on_def by (intro Bochner_Integration.integrable_mult_left)

lemma abs_summable_on_prod_PiE:
  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c :: {real_normed_field,banach,second_countable_topology}"
  assumes finite: "finite A" and countable: "\<And>x. x \<in> A \<Longrightarrow> countable (B x)"
  assumes summable: "\<And>x. x \<in> A \<Longrightarrow> f x abs_summable_on B x"
  shows   "(\<lambda>g. \<Prod>x\<in>A. f x (g x)) abs_summable_on PiE A B"
proof -
  define B' where "B' = (\<lambda>x. if x \<in> A then B x else {})"
  from assms have [simp]: "countable (B' x)" for x
    by (auto simp: B'_def)
  then interpret product_sigma_finite "count_space \<circ> B'"
    unfolding o_def by (intro product_sigma_finite.intro sigma_finite_measure_count_space_countable)
  from assms have "integrable (PiM A (count_space \<circ> B')) (\<lambda>g. \<Prod>x\<in>A. f x (g x))"
    by (intro product_integrable_prod) (auto simp: abs_summable_on_def B'_def)
  also have "PiM A (count_space \<circ> B') = count_space (PiE A B')"
    unfolding o_def using finite by (intro count_space_PiM_finite) simp_all
  also have "PiE A B' = PiE A B" by (intro PiE_cong) (simp_all add: B'_def)
  finally show ?thesis by (simp add: abs_summable_on_def)
qed

lemma not_summable_infsetsum_eq:
  "\<not>f abs_summable_on A \<Longrightarrow> infsetsum f A = 0"
  by (simp add: abs_summable_on_def infsetsum_def not_integrable_integral_eq)

lemma infsetsum_altdef:
  "infsetsum f A = set_lebesgue_integral (count_space UNIV) A f"
  unfolding set_lebesgue_integral_def
  by (subst integral_restrict_space [symmetric])
     (auto simp: restrict_count_space_subset infsetsum_def)

lemma infsetsum_altdef':
  "A \<subseteq> B \<Longrightarrow> infsetsum f A = set_lebesgue_integral (count_space B) A f"
  unfolding set_lebesgue_integral_def
  by (subst integral_restrict_space [symmetric])
     (auto simp: restrict_count_space_subset infsetsum_def)

lemma nn_integral_conv_infsetsum:
  assumes "f abs_summable_on A" "\<And>x. x \<in> A \<Longrightarrow> f x \<ge> 0"
  shows   "nn_integral (count_space A) f = ennreal (infsetsum f A)"
  using assms unfolding infsetsum_def abs_summable_on_def
  by (subst nn_integral_eq_integral) auto

lemma infsetsum_conv_nn_integral:
  assumes "nn_integral (count_space A) f \<noteq> \<infinity>" "\<And>x. x \<in> A \<Longrightarrow> f x \<ge> 0"
  shows   "infsetsum f A = enn2real (nn_integral (count_space A) f)"
  unfolding infsetsum_def using assms
  by (subst integral_eq_nn_integral) auto

lemma infsetsum_cong [cong]:
  "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> A = B \<Longrightarrow> infsetsum f A = infsetsum g B"
  unfolding infsetsum_def by (intro Bochner_Integration.integral_cong) auto

lemma infsetsum_0 [simp]: "infsetsum (\<lambda>_. 0) A = 0"
  by (simp add: infsetsum_def)

lemma infsetsum_all_0: "(\<And>x. x \<in> A \<Longrightarrow> f x = 0) \<Longrightarrow> infsetsum f A = 0"
  by simp

lemma infsetsum_nonneg: "(\<And>x. x \<in> A \<Longrightarrow> f x \<ge> (0::real)) \<Longrightarrow> infsetsum f A \<ge> 0"
  unfolding infsetsum_def by (rule Bochner_Integration.integral_nonneg) auto

lemma sum_infsetsum:
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x abs_summable_on B"
  shows   "(\<Sum>x\<in>A. \<Sum>\<^sub>ay\<in>B. f x y) = (\<Sum>\<^sub>ay\<in>B. \<Sum>x\<in>A. f x y)"
  using assms by (simp add: infsetsum_def abs_summable_on_def Bochner_Integration.integral_sum)

lemma Re_infsetsum: "f abs_summable_on A \<Longrightarrow> Re (infsetsum f A) = (\<Sum>\<^sub>ax\<in>A. Re (f x))"
  by (simp add: infsetsum_def abs_summable_on_def)

lemma Im_infsetsum: "f abs_summable_on A \<Longrightarrow> Im (infsetsum f A) = (\<Sum>\<^sub>ax\<in>A. Im (f x))"
  by (simp add: infsetsum_def abs_summable_on_def)

lemma infsetsum_of_real:
  shows "infsetsum (\<lambda>x. of_real (f x)
           :: 'a :: {real_normed_algebra_1,banach,second_countable_topology,real_inner}) A =
             of_real (infsetsum f A)"
  unfolding infsetsum_def
  by (rule integral_bounded_linear'[OF bounded_linear_of_real bounded_linear_inner_left[of 1]]) auto

lemma infsetsum_finite [simp]: "finite A \<Longrightarrow> infsetsum f A = (\<Sum>x\<in>A. f x)"
  by (simp add: infsetsum_def lebesgue_integral_count_space_finite)

lemma infsetsum_nat:
  assumes "f abs_summable_on A"
  shows   "infsetsum f A = (\<Sum>n. if n \<in> A then f n else 0)"
proof -
  from assms have "infsetsum f A = (\<Sum>n. indicator A n *\<^sub>R f n)"
    unfolding infsetsum_altdef abs_summable_on_altdef set_lebesgue_integral_def set_integrable_def
 by (subst integral_count_space_nat) auto
  also have "(\<lambda>n. indicator A n *\<^sub>R f n) = (\<lambda>n. if n \<in> A then f n else 0)"
    by auto
  finally show ?thesis .
qed

lemma infsetsum_nat':
  assumes "f abs_summable_on UNIV"
  shows   "infsetsum f UNIV = (\<Sum>n. f n)"
  using assms by (subst infsetsum_nat) auto

lemma sums_infsetsum_nat:
  assumes "f abs_summable_on A"
  shows   "(\<lambda>n. if n \<in> A then f n else 0) sums infsetsum f A"
proof -
  from assms have "summable (\<lambda>n. if n \<in> A then norm (f n) else 0)"
    by (simp add: abs_summable_on_nat_iff)
  also have "(\<lambda>n. if n \<in> A then norm (f n) else 0) = (\<lambda>n. norm (if n \<in> A then f n else 0))"
    by auto
  finally have "summable (\<lambda>n. if n \<in> A then f n else 0)"
    by (rule summable_norm_cancel)
  with assms show ?thesis
    by (auto simp: sums_iff infsetsum_nat)
qed

lemma sums_infsetsum_nat':
  assumes "f abs_summable_on UNIV"
  shows   "f sums infsetsum f UNIV"
  using sums_infsetsum_nat [OF assms] by simp

lemma infsetsum_Un_disjoint:
  assumes "f abs_summable_on A" "f abs_summable_on B" "A \<inter> B = {}"
  shows   "infsetsum f (A \<union> B) = infsetsum f A + infsetsum f B"
  using assms unfolding infsetsum_altdef abs_summable_on_altdef
  by (subst set_integral_Un) auto

lemma infsetsum_Diff:
  assumes "f abs_summable_on B" "A \<subseteq> B"
  shows   "infsetsum f (B - A) = infsetsum f B - infsetsum f A"
proof -
  have "infsetsum f ((B - A) \<union> A) = infsetsum f (B - A) + infsetsum f A"
    using assms(2) by (intro infsetsum_Un_disjoint abs_summable_on_subset[OF assms(1)]) auto
  also from assms(2) have "(B - A) \<union> A = B"
    by auto
  ultimately show ?thesis
    by (simp add: algebra_simps)
qed

lemma infsetsum_Un_Int:
  assumes "f abs_summable_on (A \<union> B)"
  shows   "infsetsum f (A \<union> B) = infsetsum f A + infsetsum f B - infsetsum f (A \<inter> B)"
proof -
  have "A \<union> B = A \<union> (B - A \<inter> B)"
    by auto
  also have "infsetsum f \<dots> = infsetsum f A + infsetsum f (B - A \<inter> B)"
    by (intro infsetsum_Un_disjoint abs_summable_on_subset[OF assms]) auto
  also have "infsetsum f (B - A \<inter> B) = infsetsum f B - infsetsum f (A \<inter> B)"
    by (intro infsetsum_Diff abs_summable_on_subset[OF assms]) auto
  finally show ?thesis
    by (simp add: algebra_simps)
qed

lemma infsetsum_reindex_bij_betw:
  assumes "bij_betw g A B"
  shows   "infsetsum (\<lambda>x. f (g x)) A = infsetsum f B"
proof -
  have *: "count_space B = distr (count_space A) (count_space B) g"
    by (rule distr_bij_count_space [symmetric]) fact
  show ?thesis unfolding infsetsum_def
    by (subst *, subst integral_distr[of _ _ "count_space B"])
       (insert assms, auto simp: bij_betw_def)
qed

theorem infsetsum_reindex:
  assumes "inj_on g A"
  shows   "infsetsum f (g ` A) = infsetsum (\<lambda>x. f (g x)) A"
  by (intro infsetsum_reindex_bij_betw [symmetric] inj_on_imp_bij_betw assms)

lemma infsetsum_cong_neutral:
  assumes "\<And>x. x \<in> A - B \<Longrightarrow> f x = 0"
  assumes "\<And>x. x \<in> B - A \<Longrightarrow> g x = 0"
  assumes "\<And>x. x \<in> A \<inter> B \<Longrightarrow> f x = g x"
  shows   "infsetsum f A = infsetsum g B"
  unfolding infsetsum_altdef set_lebesgue_integral_def using assms
  by (intro Bochner_Integration.integral_cong refl)
     (auto simp: indicator_def split: if_splits)

lemma infsetsum_mono_neutral:
  fixes f g :: "'a \<Rightarrow> real"
  assumes "f abs_summable_on A" and "g abs_summable_on B"
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x \<le> g x"
  assumes "\<And>x. x \<in> A - B \<Longrightarrow> f x \<le> 0"
  assumes "\<And>x. x \<in> B - A \<Longrightarrow> g x \<ge> 0"
  shows   "infsetsum f A \<le> infsetsum g B"
  using assms unfolding infsetsum_altdef set_lebesgue_integral_def abs_summable_on_altdef set_integrable_def
  by (intro Bochner_Integration.integral_mono) (auto simp: indicator_def)

lemma infsetsum_mono_neutral_left:
  fixes f g :: "'a \<Rightarrow> real"
  assumes "f abs_summable_on A" and "g abs_summable_on B"
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x \<le> g x"
  assumes "A \<subseteq> B"
  assumes "\<And>x. x \<in> B - A \<Longrightarrow> g x \<ge> 0"
  shows   "infsetsum f A \<le> infsetsum g B"
  using \<open>A \<subseteq> B\<close> by (intro infsetsum_mono_neutral assms) auto

lemma infsetsum_mono_neutral_right:
  fixes f g :: "'a \<Rightarrow> real"
  assumes "f abs_summable_on A" and "g abs_summable_on B"
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x \<le> g x"
  assumes "B \<subseteq> A"
  assumes "\<And>x. x \<in> A - B \<Longrightarrow> f x \<le> 0"
  shows   "infsetsum f A \<le> infsetsum g B"
  using \<open>B \<subseteq> A\<close> by (intro infsetsum_mono_neutral assms) auto

lemma infsetsum_mono:
  fixes f g :: "'a \<Rightarrow> real"
  assumes "f abs_summable_on A" and "g abs_summable_on A"
  assumes "\<And>x. x \<in> A \<Longrightarrow> f x \<le> g x"
  shows   "infsetsum f A \<le> infsetsum g A"
  by (intro infsetsum_mono_neutral assms) auto

lemma norm_infsetsum_bound:
  "norm (infsetsum f A) \<le> infsetsum (\<lambda>x. norm (f x)) A"
  unfolding abs_summable_on_def infsetsum_def
  by (rule Bochner_Integration.integral_norm_bound)

theorem infsetsum_Sigma:
  fixes A :: "'a set" and B :: "'a \<Rightarrow> 'b set"
  assumes [simp]: "countable A" and "\<And>i. countable (B i)"
  assumes summable: "f abs_summable_on (Sigma A B)"
  shows   "infsetsum f (Sigma A B) = infsetsum (\<lambda>x. infsetsum (\<lambda>y. f (x, y)) (B x)) A"
proof -
  define B' where "B' = (\<Union>i\<in>A. B i)"
  have [simp]: "countable B'"
    unfolding B'_def by (intro countable_UN assms)
  interpret pair_sigma_finite "count_space A" "count_space B'"
    by (intro pair_sigma_finite.intro sigma_finite_measure_count_space_countable) fact+

  have "integrable (count_space (A \<times> B')) (\<lambda>z. indicator (Sigma A B) z *\<^sub>R f z)"
    using summable
    by (metis (mono_tags, lifting) abs_summable_on_altdef abs_summable_on_def integrable_cong integrable_mult_indicator set_integrable_def sets_UNIV)
  also have "?this \<longleftrightarrow> integrable (count_space A \<Otimes>\<^sub>M count_space B') (\<lambda>(x, y). indicator (B x) y *\<^sub>R f (x, y))"
    by (intro Bochner_Integration.integrable_cong)
       (auto simp: pair_measure_countable indicator_def split: if_splits)
  finally have integrable: \<dots> .

  have "infsetsum (\<lambda>x. infsetsum (\<lambda>y. f (x, y)) (B x)) A =
          (\<integral>x. infsetsum (\<lambda>y. f (x, y)) (B x) \<partial>count_space A)"
    unfolding infsetsum_def by simp
  also have "\<dots> = (\<integral>x. \<integral>y. indicator (B x) y *\<^sub>R f (x, y) \<partial>count_space B' \<partial>count_space A)"
  proof (rule Bochner_Integration.integral_cong [OF refl])
    show "\<And>x. x \<in> space (count_space A) \<Longrightarrow>
         (\<Sum>\<^sub>ay\<in>B x. f (x, y)) = LINT y|count_space B'. indicat_real (B x) y *\<^sub>R f (x, y)"
      using infsetsum_altdef'[of _ B']
      unfolding set_lebesgue_integral_def B'_def
      by auto
  qed
  also have "\<dots> = (\<integral>(x,y). indicator (B x) y *\<^sub>R f (x, y) \<partial>(count_space A \<Otimes>\<^sub>M count_space B'))"
    by (subst integral_fst [OF integrable]) auto
  also have "\<dots> = (\<integral>z. indicator (Sigma A B) z *\<^sub>R f z \<partial>count_space (A \<times> B'))"
    by (intro Bochner_Integration.integral_cong)
       (auto simp: pair_measure_countable indicator_def split: if_splits)
  also have "\<dots> = infsetsum f (Sigma A B)"
    unfolding set_lebesgue_integral_def [symmetric]
    by (rule infsetsum_altdef' [symmetric]) (auto simp: B'_def)
  finally show ?thesis ..
qed

lemma infsetsum_Sigma':
  fixes A :: "'a set" and B :: "'a \<Rightarrow> 'b set"
  assumes [simp]: "countable A" and "\<And>i. countable (B i)"
  assumes summable: "(\<lambda>(x,y). f x y) abs_summable_on (Sigma A B)"
  shows   "infsetsum (\<lambda>x. infsetsum (\<lambda>y. f x y) (B x)) A = infsetsum (\<lambda>(x,y). f x y) (Sigma A B)"
  using assms by (subst infsetsum_Sigma) auto

lemma infsetsum_Times:
  fixes A :: "'a set" and B :: "'b set"
  assumes [simp]: "countable A" and "countable B"
  assumes summable: "f abs_summable_on (A \<times> B)"
  shows   "infsetsum f (A \<times> B) = infsetsum (\<lambda>x. infsetsum (\<lambda>y. f (x, y)) B) A"
  using assms by (subst infsetsum_Sigma) auto

lemma infsetsum_Times':
  fixes A :: "'a set" and B :: "'b set"
  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c :: {banach, second_countable_topology}"
  assumes [simp]: "countable A" and [simp]: "countable B"
  assumes summable: "(\<lambda>(x,y). f x y) abs_summable_on (A \<times> B)"
  shows   "infsetsum (\<lambda>x. infsetsum (\<lambda>y. f x y) B) A = infsetsum (\<lambda>(x,y). f x y) (A \<times> B)"
  using assms by (subst infsetsum_Times) auto

lemma infsetsum_swap:
  fixes A :: "'a set" and B :: "'b set"
  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c :: {banach, second_countable_topology}"
  assumes [simp]: "countable A" and [simp]: "countable B"
  assumes summable: "(\<lambda>(x,y). f x y) abs_summable_on A \<times> B"
  shows   "infsetsum (\<lambda>x. infsetsum (\<lambda>y. f x y) B) A = infsetsum (\<lambda>y. infsetsum (\<lambda>x. f x y) A) B"
proof -
  from summable have summable': "(\<lambda>(x,y). f y x) abs_summable_on B \<times> A"
    by (subst abs_summable_on_Times_swap) auto
  have bij: "bij_betw (\<lambda>(x, y). (y, x)) (B \<times> A) (A \<times> B)"
    by (auto simp: bij_betw_def inj_on_def)
  have "infsetsum (\<lambda>x. infsetsum (\<lambda>y. f x y) B) A = infsetsum (\<lambda>(x,y). f x y) (A \<times> B)"
    using summable by (subst infsetsum_Times) auto
  also have "\<dots> = infsetsum (\<lambda>(x,y). f y x) (B \<times> A)"
    by (subst infsetsum_reindex_bij_betw[OF bij, of "\<lambda>(x,y). f x y", symmetric])
       (simp_all add: case_prod_unfold)
  also have "\<dots> = infsetsum (\<lambda>y. infsetsum (\<lambda>x. f x y) A) B"
    using summable' by (subst infsetsum_Times) auto
  finally show ?thesis .
qed

theorem abs_summable_on_Sigma_iff:
  assumes [simp]: "countable A" and "\<And>x. x \<in> A \<Longrightarrow> countable (B x)"
  shows   "f abs_summable_on Sigma A B \<longleftrightarrow>
             (\<forall>x\<in>A. (\<lambda>y. f (x, y)) abs_summable_on B x) \<and>
             ((\<lambda>x. infsetsum (\<lambda>y. norm (f (x, y))) (B x)) abs_summable_on A)"
proof safe
  define B' where "B' = (\<Union>x\<in>A. B x)"
  have [simp]: "countable B'"
    unfolding B'_def using assms by auto
  interpret pair_sigma_finite "count_space A" "count_space B'"
    by (intro pair_sigma_finite.intro sigma_finite_measure_count_space_countable) fact+
  {
    assume *: "f abs_summable_on Sigma A B"
    thus "(\<lambda>y. f (x, y)) abs_summable_on B x" if "x \<in> A" for x
      using that by (rule abs_summable_on_Sigma_project2)

    have "set_integrable (count_space (A \<times> B')) (Sigma A B) (\<lambda>z. norm (f z))"
      using abs_summable_on_normI[OF *]
      by (subst abs_summable_on_altdef' [symmetric]) (auto simp: B'_def)
    also have "count_space (A \<times> B') = count_space A \<Otimes>\<^sub>M count_space B'"
      by (simp add: pair_measure_countable)
    finally have "integrable (count_space A)
                    (\<lambda>x. lebesgue_integral (count_space B')
                      (\<lambda>y. indicator (Sigma A B) (x, y) *\<^sub>R norm (f (x, y))))"
      unfolding set_integrable_def by (rule integrable_fst')
    also have "?this \<longleftrightarrow> integrable (count_space A)
                    (\<lambda>x. lebesgue_integral (count_space B')
                      (\<lambda>y. indicator (B x) y *\<^sub>R norm (f (x, y))))"
      by (intro integrable_cong refl) (simp_all add: indicator_def)
    also have "\<dots> \<longleftrightarrow> integrable (count_space A) (\<lambda>x. infsetsum (\<lambda>y. norm (f (x, y))) (B x))"
      unfolding set_lebesgue_integral_def [symmetric]
      by (intro integrable_cong refl infsetsum_altdef' [symmetric]) (auto simp: B'_def)
    also have "\<dots> \<longleftrightarrow> (\<lambda>x. infsetsum (\<lambda>y. norm (f (x, y))) (B x)) abs_summable_on A"
      by (simp add: abs_summable_on_def)
    finally show \<dots> .
  }
  {
    assume *: "\<forall>x\<in>A. (\<lambda>y. f (x, y)) abs_summable_on B x"
    assume "(\<lambda>x. \<Sum>\<^sub>ay\<in>B x. norm (f (x, y))) abs_summable_on A"
    also have "?this \<longleftrightarrow> (\<lambda>x. \<integral>y\<in>B x. norm (f (x, y)) \<partial>count_space B') abs_summable_on A"
      by (intro abs_summable_on_cong refl infsetsum_altdef') (auto simp: B'_def)
    also have "\<dots> \<longleftrightarrow> (\<lambda>x. \<integral>y. indicator (Sigma A B) (x, y) *\<^sub>R norm (f (x, y)) \<partial>count_space B')
                        abs_summable_on A" (is "_ \<longleftrightarrow> ?h abs_summable_on _")
      unfolding set_lebesgue_integral_def
      by (intro abs_summable_on_cong) (auto simp: indicator_def)
    also have "\<dots> \<longleftrightarrow> integrable (count_space A) ?h"
      by (simp add: abs_summable_on_def)
    finally have **: \<dots> .

    have "integrable (count_space A \<Otimes>\<^sub>M count_space B') (\<lambda>z. indicator (Sigma A B) z *\<^sub>R f z)"
    proof (rule Fubini_integrable, goal_cases)
      case 3
      {
        fix x assume x: "x \<in> A"
        with * have "(\<lambda>y. f (x, y)) abs_summable_on B x"
          by blast
        also have "?this \<longleftrightarrow> integrable (count_space B')
                      (\<lambda>y. indicator (B x) y *\<^sub>R f (x, y))"
          unfolding set_integrable_def [symmetric]
         using x by (intro abs_summable_on_altdef') (auto simp: B'_def)
        also have "(\<lambda>y. indicator (B x) y *\<^sub>R f (x, y)) =
                     (\<lambda>y. indicator (Sigma A B) (x, y) *\<^sub>R f (x, y))"
          using x by (auto simp: indicator_def)
        finally have "integrable (count_space B')
                        (\<lambda>y. indicator (Sigma A B) (x, y) *\<^sub>R f (x, y))" .
      }
      thus ?case by (auto simp: AE_count_space)
    qed (insert **, auto simp: pair_measure_countable)
    moreover have "count_space A \<Otimes>\<^sub>M count_space B' = count_space (A \<times> B')"
      by (simp add: pair_measure_countable)
    moreover have "set_integrable (count_space (A \<times> B')) (Sigma A B) f \<longleftrightarrow>
                 f abs_summable_on Sigma A B"
      by (rule abs_summable_on_altdef' [symmetric]) (auto simp: B'_def)
    ultimately show "f abs_summable_on Sigma A B"
      by (simp add: set_integrable_def)
  }
qed

lemma abs_summable_on_Sigma_project1:
  assumes "(\<lambda>(x,y). f x y) abs_summable_on Sigma A B"
  assumes [simp]: "countable A" and "\<And>x. x \<in> A \<Longrightarrow> countable (B x)"
  shows   "(\<lambda>x. infsetsum (\<lambda>y. norm (f x y)) (B x)) abs_summable_on A"
  using assms by (subst (asm) abs_summable_on_Sigma_iff) auto

lemma abs_summable_on_Sigma_project1':
  assumes "(\<lambda>(x,y). f x y) abs_summable_on Sigma A B"
  assumes [simp]: "countable A" and "\<And>x. x \<in> A \<Longrightarrow> countable (B x)"
  shows   "(\<lambda>x. infsetsum (\<lambda>y. f x y) (B x)) abs_summable_on A"
  by (intro abs_summable_on_comparison_test' [OF abs_summable_on_Sigma_project1[OF assms]]
        norm_infsetsum_bound)

theorem infsetsum_prod_PiE:
  fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c :: {real_normed_field,banach,second_countable_topology}"
  assumes finite: "finite A" and countable: "\<And>x. x \<in> A \<Longrightarrow> countable (B x)"
  assumes summable: "\<And>x. x \<in> A \<Longrightarrow> f x abs_summable_on B x"
  shows   "infsetsum (\<lambda>g. \<Prod>x\<in>A. f x (g x)) (PiE A B) = (\<Prod>x\<in>A. infsetsum (f x) (B x))"
proof -
  define B' where "B' = (\<lambda>x. if x \<in> A then B x else {})"
  from assms have [simp]: "countable (B' x)" for x
    by (auto simp: B'_def)
  then interpret product_sigma_finite "count_space \<circ> B'"
    unfolding o_def by (intro product_sigma_finite.intro sigma_finite_measure_count_space_countable)
  have "infsetsum (\<lambda>g. \<Prod>x\<in>A. f x (g x)) (PiE A B) =
          (\<integral>g. (\<Prod>x\<in>A. f x (g x)) \<partial>count_space (PiE A B))"
    by (simp add: infsetsum_def)
  also have "PiE A B = PiE A B'"
    by (intro PiE_cong) (simp_all add: B'_def)
  hence "count_space (PiE A B) = count_space (PiE A B')"
    by simp
  also have "\<dots> = PiM A (count_space \<circ> B')"
    unfolding o_def using finite by (intro count_space_PiM_finite [symmetric]) simp_all
  also have "(\<integral>g. (\<Prod>x\<in>A. f x (g x)) \<partial>\<dots>) = (\<Prod>x\<in>A. infsetsum (f x) (B' x))"
    by (subst product_integral_prod)
       (insert summable finite, simp_all add: infsetsum_def B'_def abs_summable_on_def)
  also have "\<dots> = (\<Prod>x\<in>A. infsetsum (f x) (B x))"
    by (intro prod.cong refl) (simp_all add: B'_def)
  finally show ?thesis .
qed

lemma infsetsum_uminus: "infsetsum (\<lambda>x. -f x) A = -infsetsum f A"
  unfolding infsetsum_def abs_summable_on_def
  by (rule Bochner_Integration.integral_minus)

lemma infsetsum_add:
  assumes "f abs_summable_on A" and "g abs_summable_on A"
  shows   "infsetsum (\<lambda>x. f x + g x) A = infsetsum f A + infsetsum g A"
  using assms unfolding infsetsum_def abs_summable_on_def
  by (rule Bochner_Integration.integral_add)

lemma infsetsum_diff:
  assumes "f abs_summable_on A" and "g abs_summable_on A"
  shows   "infsetsum (\<lambda>x. f x - g x) A = infsetsum f A - infsetsum g A"
  using assms unfolding infsetsum_def abs_summable_on_def
  by (rule Bochner_Integration.integral_diff)

lemma infsetsum_scaleR_left:
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "infsetsum (\<lambda>x. f x *\<^sub>R c) A = infsetsum f A *\<^sub>R c"
  using assms unfolding infsetsum_def abs_summable_on_def
  by (rule Bochner_Integration.integral_scaleR_left)

lemma infsetsum_scaleR_right:
  "infsetsum (\<lambda>x. c *\<^sub>R f x) A = c *\<^sub>R infsetsum f A"
  unfolding infsetsum_def abs_summable_on_def
  by (subst Bochner_Integration.integral_scaleR_right) auto

lemma infsetsum_cmult_left:
  fixes f :: "'a \<Rightarrow> 'b :: {banach, real_normed_algebra, second_countable_topology}"
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "infsetsum (\<lambda>x. f x * c) A = infsetsum f A * c"
  using assms unfolding infsetsum_def abs_summable_on_def
  by (rule Bochner_Integration.integral_mult_left)

lemma infsetsum_cmult_right:
  fixes f :: "'a \<Rightarrow> 'b :: {banach, real_normed_algebra, second_countable_topology}"
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "infsetsum (\<lambda>x. c * f x) A = c * infsetsum f A"
  using assms unfolding infsetsum_def abs_summable_on_def
  by (rule Bochner_Integration.integral_mult_right)

lemma infsetsum_cdiv:
  fixes f :: "'a \<Rightarrow> 'b :: {banach, real_normed_field, second_countable_topology}"
  assumes "c \<noteq> 0 \<Longrightarrow> f abs_summable_on A"
  shows   "infsetsum (\<lambda>x. f x / c) A = infsetsum f A / c"
  using assms unfolding infsetsum_def abs_summable_on_def by auto

(* TODO Generalise with bounded_linear *)

lemma
  fixes f :: "'a \<Rightarrow> 'c :: {banach, real_normed_field, second_countable_topology}"
  assumes [simp]: "countable A" and [simp]: "countable B"
  assumes "f abs_summable_on A" and "g abs_summable_on B"
  shows   abs_summable_on_product: "(\<lambda>(x,y). f x * g y) abs_summable_on A \<times> B"
    and   infsetsum_product: "infsetsum (\<lambda>(x,y). f x * g y) (A \<times> B) =
                                infsetsum f A * infsetsum g B"
proof -
  from assms show "(\<lambda>(x,y). f x * g y) abs_summable_on A \<times> B"
    by (subst abs_summable_on_Sigma_iff)
       (auto intro!: abs_summable_on_cmult_right simp: norm_mult infsetsum_cmult_right)
  with assms show "infsetsum (\<lambda>(x,y). f x * g y) (A \<times> B) = infsetsum f A * infsetsum g B"
    by (subst infsetsum_Sigma)
       (auto simp: infsetsum_cmult_left infsetsum_cmult_right)
qed

end