header {* Basic facts about rings and modules *}

theory RingModuleFacts
imports Main
  "~~/src/HOL/Algebra/Module"
  "~~/src/HOL/Algebra/Coset"
  (*MonoidSums*)
begin

subsection {* Basic facts *}
text {*In a field, every nonzero element has an inverse.*} (* Add to Ring.*)
lemma (in field) inverse_exists [simp, intro]:
  assumes h1: "a\<in>carrier R"  and h2: "a\<noteq>\<zero>\<^bsub>R\<^esub>"
  shows "inv\<^bsub>R\<^esub> a\<in> carrier R"
proof -
  have 1: "Units R = carrier R - {\<zero>\<^bsub>R\<^esub>} " by (rule field_Units)
  from h1 h2 1 show ?thesis by auto
qed

text {* Multiplication by 0 in $R$ gives 0. (Note that this fact encompasses smult-l-null
as this is for module while that is for algebra, so smult-l-null is redundant.)*}
(*Add to Module. *)
lemma (in module) lmult_0 [simp]:
  assumes 1: "m\<in>carrier M"
  shows "\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m=\<zero>\<^bsub>M\<^esub>"
proof -
  from 1 have 0: "\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m\<in>carrier M" by simp
  from 1 have 2: "\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m = (\<zero>\<^bsub>R\<^esub> \<oplus>\<^bsub>R\<^esub> \<zero>\<^bsub>R\<^esub>) \<odot>\<^bsub>M\<^esub> m" by simp
  from 1 have 3: "(\<zero>\<^bsub>R\<^esub> \<oplus>\<^bsub>R\<^esub> \<zero>\<^bsub>R\<^esub>) \<odot>\<^bsub>M\<^esub> m=(\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m) \<oplus>\<^bsub>M\<^esub> (\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m)"  using [[simp_trace, simp_trace_depth_limit=3]]
    by (simp add: smult_l_distr del: R.add.r_one R.add.l_one)
  from 2 3 have 4: "\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m =(\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m) \<oplus>\<^bsub>M\<^esub> (\<zero>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> m)" by auto
  from 0 4 show ?thesis by (metis 1 M.add.l_cancel M.r_zero M.zero_closed)
qed

text {* Multiplication by 0 in $M$ gives 0. *} (*Add to Module.*)
lemma (in module) rmult_0 [simp]:
  assumes 0: "r\<in>carrier R"
  shows "r\<odot>\<^bsub>M\<^esub> \<zero>\<^bsub>M\<^esub>=\<zero>\<^bsub>M\<^esub>"
by (metis M.zero_closed R.zero_closed assms lmult_0 r_null smult_assoc1)

text {*Multiplication by $-1$ is the same as negation. May be useful as a simp rule. *}
(*Add to module.*)
lemma (in module) smult_minus_1:
  fixes v
  assumes 0:"v\<in>carrier M"
  shows "(\<ominus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>) \<odot>\<^bsub>M\<^esub> v= (\<ominus>\<^bsub>M\<^esub>  v)"
(*(simp add: M.l_neg)*)
proof -
  from 0 have a0: "\<one>\<^bsub>R\<^esub> \<odot>\<^bsub>M\<^esub> v = v" by simp
  from 0 have 1: "((\<ominus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>)\<oplus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>) \<odot>\<^bsub>M\<^esub> v=\<zero>\<^bsub>M\<^esub>"
    by (simp add:R.l_neg)
  from 0 have 2: "((\<ominus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>)\<oplus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>) \<odot>\<^bsub>M\<^esub> v=(\<ominus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>) \<odot>\<^bsub>M\<^esub> v \<oplus>\<^bsub>M\<^esub> \<one>\<^bsub>R\<^esub>\<odot>\<^bsub>M\<^esub> v"
    by (simp add: smult_l_distr)
  from 1 2 show ?thesis by (metis M.minus_equality R.add.inv_closed
    a0 assms one_closed smult_closed)
qed

text {*The version with equality reversed.*}
lemmas (in module)  smult_minus_1_back = smult_minus_1[THEN sym]

text{*-1 is not 0*}
lemma (in field) neg_1_not_0 [simp]: "\<ominus>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub> \<noteq> \<zero>\<^bsub>R\<^esub>"
by (metis local.minus_minus local.minus_zero one_closed zero_not_one)

text {* Note smult-assoc1 is the wrong way around for simplification.
This is the reverse of smult-assoc1. *}(*Add to Module. *)
lemma (in module) smult_assoc_simp:
"[| a \<in> carrier R; b \<in> carrier R; x \<in> carrier M |] ==>
      a \<odot>\<^bsub>M\<^esub> (b \<odot>\<^bsub>M\<^esub> x) = (a \<otimes> b) \<odot>\<^bsub>M\<^esub> x "
by (auto simp add: smult_assoc1)

(* Add to Group? *)
lemma (in group) show_r_one [simp]:
  "\<lbrakk>a\<in> carrier G; b\<in> carrier G\<rbrakk>\<Longrightarrow> (a \<otimes>\<^bsub>G\<^esub> b= a) = ( b= \<one>\<^bsub>G\<^esub>)"
by (metis l_inv r_one transpose_inv)

(* Add to Group? *)
lemma (in group) show_l_one [simp]:
  "\<lbrakk>a\<in> carrier G; b\<in> carrier G\<rbrakk>\<Longrightarrow> (a \<otimes>\<^bsub>G\<^esub> b= b) = ( a= \<one>\<^bsub>G\<^esub>)"
by (metis l_one one_closed r_cancel)

(* Add to Ring? *)
lemmas (in abelian_group) show_r_zero=add.show_r_one
lemmas (in abelian_group) show_l_zero=add.show_l_one

text {*A nontrivial ring has $0\neq 1$. *}(*Add to Ring.*)
lemma (in ring) nontrivial_ring [simp]:
  assumes "carrier R\<noteq>{\<zero>\<^bsub>R\<^esub>}"
  shows "\<zero>\<^bsub>R\<^esub>\<noteq>\<one>\<^bsub>R\<^esub>"
proof (rule ccontr)
  assume 1: "\<not>(\<zero>\<^bsub>R\<^esub>\<noteq>\<one>\<^bsub>R\<^esub>)"
  {
    fix r
    assume 2: "r\<in>carrier R"
    from 1 2 have 3: "\<one>\<^bsub>R\<^esub>\<otimes>\<^bsub>R\<^esub> r = \<zero>\<^bsub>R\<^esub>\<otimes>\<^bsub>R\<^esub> r" by auto
    from 2 3 have "r = \<zero>\<^bsub>R\<^esub>" by auto
  }
  from this assms show False by auto
qed

text {*Use as simp rule. To show $a-b=0$, it suffices to show $a=b$. *}(*Add to Ring.*)
lemma (in abelian_group) minus_other_side [simp]:
  "\<lbrakk>a\<in>carrier G; b\<in>carrier G\<rbrakk> \<Longrightarrow> (a\<ominus>\<^bsub>G\<^esub>b = \<zero>\<^bsub>G\<^esub>) = (a=b)"
by (metis add.inv_closed add.r_cancel minus_eq r_neg)

subsection {*Units group*}
text {*Define the units group $R^{\times}$ and show it is actually a group.*}(* Add to Ring.*)
definition units_group::"('a,'b) ring_scheme \<Rightarrow> 'a monoid"
  where "units_group R = \<lparr>carrier = Units R, mult = (\<lambda>x y. x\<otimes>\<^bsub>R\<^esub> y), one = \<one>\<^bsub>R\<^esub>\<rparr>"

text {*The units form a group. *}(*Add to Ring.*)
lemma (in ring) units_form_group: "group (units_group R)"
  apply (intro groupI)
  apply (unfold units_group_def, auto)
  apply (intro m_assoc)
  apply auto
  apply (unfold Units_def)
  apply auto
  done

text {*The units of a @{text "cring"} form a commutative group.*}(* Add to Ring.*)
lemma (in cring) units_form_cgroup: "comm_group (units_group R)"
  apply (intro comm_groupI)
  apply (unfold units_group_def) apply auto
  apply (intro m_assoc) apply auto
  apply (unfold Units_def) apply auto
  apply (rule m_comm) apply auto
  done

end


(* Authors: Gerwin Klein and Rafal Kolanski, 2012
   Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au>
                Rafal Kolanski <rafal.kolanski at nicta.com.au>
*)

section "Abstract Separation Algebra"

theory Separation_Algebra
imports Main
begin

text \<open>This theory is the main abstract separation algebra development\<close>

section \<open>Input syntax for lifting boolean predicates to separation predicates\<close>

abbreviation (input)
  pred_and :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool" (infixr "and" 35) where
  "a and b \<equiv> \<lambda>s. a s \<and> b s"

abbreviation (input)
  pred_or :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool" (infixr "or" 30) where
  "a or b \<equiv> \<lambda>s. a s \<or> b s"

abbreviation (input)
  pred_not :: "('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool" ("not _" [40] 40) where
  "not a \<equiv> \<lambda>s. \<not>a s"

abbreviation (input)
  pred_imp :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool" (infixr "imp" 25) where
  "a imp b \<equiv> \<lambda>s. a s \<longrightarrow> b s"

abbreviation (input)
  pred_K :: "'b \<Rightarrow> 'a \<Rightarrow> 'b" ("\<langle>_\<rangle>") where
  "\<langle>f\<rangle> \<equiv> \<lambda>s. f"

abbreviation (input)
  pred_ex :: "('b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool" (binder "EXS " 10) where
  "EXS x. P x \<equiv> \<lambda>s. \<exists>x. P x s"

abbreviation (input)
  pred_all :: "('b \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> bool" (binder "ALLS " 10) where
  "ALLS x. P x \<equiv> \<lambda>s. \<forall>x. P x s"

section \<open>Associative/Commutative Monoid Basis of Separation Algebras\<close>

class pre_sep_algebra = zero + plus +
  fixes sep_disj :: "'a => 'a => bool" (infix "##" 60)

  assumes sep_disj_zero [simp]: "x ## 0"
  assumes sep_disj_commuteI: "x ## y \<Longrightarrow> y ## x"

  assumes sep_add_zero [simp]: "x + 0 = x"
  assumes sep_add_commute: "x ## y \<Longrightarrow> x + y = y + x"

  assumes sep_add_assoc:
    "\<lbrakk> x ## y; y ## z; x ## z \<rbrakk> \<Longrightarrow> (x + y) + z = x + (y + z)"
begin

lemma sep_disj_commute: "x ## y = y ## x"
  by (blast intro: sep_disj_commuteI)

lemma sep_add_left_commute:
  assumes a: "a ## b" "b ## c" "a ## c"
  shows "b + (a + c) = a + (b + c)" (is "?lhs = ?rhs")
proof -
  have "?lhs = b + a + c" using a
    by (simp add: sep_add_assoc[symmetric] sep_disj_commute)
  also have "... = a + b + c" using a
    by (simp add: sep_add_commute sep_disj_commute)
  also have "... = ?rhs" using a
    by (simp add: sep_add_assoc sep_disj_commute)
  finally show ?thesis .
qed

lemmas sep_add_ac = sep_add_assoc sep_add_commute sep_add_left_commute
                    sep_disj_commute (* nearly always necessary *)

end

section \<open>Separation Algebra as Defined by Calcagno et al.\<close>

class sep_algebra = pre_sep_algebra +
  assumes sep_disj_addD1: "\<lbrakk> x ## y + z; y ## z \<rbrakk> \<Longrightarrow> x ## y"
  assumes sep_disj_addI1: "\<lbrakk> x ## y + z; y ## z \<rbrakk> \<Longrightarrow> x + y ##  z"
begin

subsection \<open>Basic Construct Definitions and Abbreviations\<close>

definition
  sep_conj :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool)" (infixr "**" 35)
  where
  "P ** Q \<equiv> \<lambda>h. \<exists>x y. x ## y \<and> h = x + y \<and> P x \<and> Q y"

notation
  sep_conj (infixr "\<and>*" 35)

definition
  sep_empty :: "'a \<Rightarrow> bool" ("\<box>") where
  "\<box> \<equiv> \<lambda>h. h = 0"

definition
  sep_impl :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool)" (infixr "\<longrightarrow>*" 25)
  where
  "P \<longrightarrow>* Q \<equiv> \<lambda>h. \<forall>h'. h ## h' \<and> P h' \<longrightarrow> Q (h + h')"

definition
  sep_substate :: "'a => 'a => bool" (infix "\<preceq>" 60) where
  "x \<preceq> y \<equiv> \<exists>z. x ## z \<and> x + z = y"

(* We want these to be abbreviations not definitions, because basic True and
   False will occur by simplification in sep_conj terms *)
abbreviation
  "sep_true \<equiv> \<langle>True\<rangle>"

abbreviation
  "sep_false \<equiv> \<langle>False\<rangle>"

definition
  sep_list_conj :: "('a \<Rightarrow> bool) list \<Rightarrow> ('a \<Rightarrow> bool)"  ("\<And>* _" [60] 90) where
  "sep_list_conj Ps \<equiv> foldl (**) \<box> Ps"

subsection \<open>Disjunction/Addition Properties\<close>

lemma disjoint_zero_sym [simp]: "0 ## x"
  by (simp add: sep_disj_commute)

lemma sep_add_zero_sym [simp]: "0 + x = x"
  by (simp add: sep_add_commute)

lemma sep_disj_addD2: "\<lbrakk> x ## y + z; y ## z \<rbrakk> \<Longrightarrow> x ## z"
  by (metis sep_disj_addD1 sep_add_ac)

lemma sep_disj_addD: "\<lbrakk> x ## y + z; y ## z \<rbrakk> \<Longrightarrow> x ## y \<and> x ## z"
  by (metis sep_disj_addD1 sep_disj_addD2)

lemma sep_add_disjD: "\<lbrakk> x + y ## z; x ## y \<rbrakk> \<Longrightarrow> x ## z \<and> y ## z"
  by (metis sep_disj_addD sep_disj_commuteI)

lemma sep_disj_addI2:
  "\<lbrakk> x ## y + z; y ## z \<rbrakk> \<Longrightarrow> x + z ## y"
  by (metis sep_add_ac sep_disj_addI1)

lemma sep_add_disjI1:
  "\<lbrakk> x + y ## z; x ## y \<rbrakk> \<Longrightarrow> x + z ## y"
  by (metis sep_add_ac sep_add_disjD sep_disj_addI2)

lemma sep_add_disjI2:
  "\<lbrakk> x + y ## z; x ## y \<rbrakk> \<Longrightarrow> z + y ## x"
  by (metis sep_add_ac sep_add_disjD sep_disj_addI2)

lemma sep_disj_addI3:
   "x + y ## z \<Longrightarrow> x ## y \<Longrightarrow> x ## y + z"
   by (metis sep_add_ac sep_add_disjD sep_add_disjI2)

lemma sep_disj_add:
  "\<lbrakk> y ## z; x ## y \<rbrakk> \<Longrightarrow> x ## y + z = x + y ## z"
  by (metis sep_disj_addI1 sep_disj_addI3)

subsection \<open>Substate Properties\<close>

lemma sep_substate_disj_add:
  "x ## y \<Longrightarrow> x \<preceq> x + y"
  unfolding sep_substate_def by blast

lemma sep_substate_disj_add':
  "x ## y \<Longrightarrow> x \<preceq> y + x"
  by (simp add: sep_add_ac sep_substate_disj_add)

subsection \<open>Separating Conjunction Properties\<close>

lemma sep_conjD:
  "(P \<and>* Q) h \<Longrightarrow> \<exists>x y. x ## y \<and> h = x + y \<and> P x \<and> Q y"
  by (simp add: sep_conj_def)

lemma sep_conjE:
  "\<lbrakk> (P ** Q) h; \<And>x y. \<lbrakk> P x; Q y; x ## y; h = x + y \<rbrakk> \<Longrightarrow> X \<rbrakk> \<Longrightarrow> X"
  by (auto simp: sep_conj_def)

lemma sep_conjI:
  "\<lbrakk> P x; Q y; x ## y; h = x + y \<rbrakk> \<Longrightarrow> (P ** Q) h"
  by (auto simp: sep_conj_def)

lemma sep_conj_commuteI:
  "(P ** Q) h \<Longrightarrow> (Q ** P) h"
  by (auto intro!: sep_conjI elim!: sep_conjE simp: sep_add_ac)

lemma sep_conj_commute:
  "(P ** Q) = (Q ** P)"
  by (rule ext) (auto intro: sep_conj_commuteI)

lemma sep_conj_assoc:
  "((P ** Q) ** R) = (P ** Q ** R)" (is "?lhs = ?rhs")
proof (rule ext, rule iffI)
  fix h
  assume a: "?lhs h"
  then obtain x y z where "P x" and "Q y" and "R z"
                      and "x ## y" and "x ## z" and "y ## z" and "x + y ## z"
                      and "h = x + y + z"
    by (auto dest!: sep_conjD dest: sep_add_disjD)
  moreover
  then have "x ## y + z"
    by (simp add: sep_disj_add)
  ultimately
  show "?rhs h"
    by (auto simp: sep_add_ac intro!: sep_conjI)
next
  fix h
  assume a: "?rhs h"
  then obtain x y z where "P x" and "Q y" and "R z"
                      and "x ## y" and "x ## z" and "y ## z" and "x ## y + z"
                      and "h = x + y + z"
    by (fastforce elim!: sep_conjE simp: sep_add_ac dest: sep_disj_addD)
  thus "?lhs h"
    by (metis sep_conj_def sep_disj_addI1)
qed

lemma sep_conj_impl:
  "\<lbrakk> (P ** Q) h; \<And>h. P h \<Longrightarrow> P' h; \<And>h. Q h \<Longrightarrow> Q' h \<rbrakk> \<Longrightarrow> (P' ** Q') h"
  by (erule sep_conjE, auto intro!: sep_conjI)

lemma sep_conj_impl1:
  assumes P: "\<And>h. P h \<Longrightarrow> I h"
  shows "(P ** R) h \<Longrightarrow> (I ** R) h"
  by (auto intro: sep_conj_impl P)

lemma sep_globalise:
  "\<lbrakk> (P ** R) h; (\<And>h. P h \<Longrightarrow> Q h) \<rbrakk> \<Longrightarrow> (Q ** R) h"
  by (fast elim: sep_conj_impl)

lemma sep_conj_trivial_strip2:
  "Q = R \<Longrightarrow> (Q ** P) = (R ** P)" by simp

lemma disjoint_subheaps_exist:
  "\<exists>x y. x ## y \<and> h = x + y"
  by (rule_tac x=0 in exI, auto)

lemma sep_conj_left_commute: (* for permutative rewriting *)
  "(P ** (Q ** R)) = (Q ** (P ** R))" (is "?x = ?y")
proof -
  have "?x = ((Q ** R) ** P)" by (simp add: sep_conj_commute)
  also have "\<dots> = (Q ** (R ** P))" by (subst sep_conj_assoc, simp)
  finally show ?thesis by (simp add: sep_conj_commute)
qed

lemmas sep_conj_ac = sep_conj_commute sep_conj_assoc sep_conj_left_commute

lemma ab_semigroup_mult_sep_conj: "class.ab_semigroup_mult (**)"
  by (unfold_locales)
     (auto simp: sep_conj_ac)

lemma sep_empty_zero [simp,intro!]: "\<box> 0"
  by (simp add: sep_empty_def)

subsection \<open>Properties of \<open>sep_true\<close> and \<open>sep_false\<close>\<close>

lemma sep_conj_sep_true:
  "P h \<Longrightarrow> (P ** sep_true) h"
  by (simp add: sep_conjI[where y=0])

lemma sep_conj_sep_true':
  "P h \<Longrightarrow> (sep_true ** P) h"
  by (simp add: sep_conjI[where x=0])

lemma sep_conj_true [simp]:
  "(sep_true ** sep_true) = sep_true"
  unfolding sep_conj_def
  by (auto intro!: ext intro: disjoint_subheaps_exist)

lemma sep_conj_false_right [simp]:
  "(P ** sep_false) = sep_false"
  by (force elim: sep_conjE intro!: ext)

lemma sep_conj_false_left [simp]:
  "(sep_false ** P) = sep_false"
  by (subst sep_conj_commute) (rule sep_conj_false_right)

subsection \<open>Properties of zero (@{const sep_empty})\<close>

lemma sep_conj_empty [simp]:
  "(P ** \<box>) = P"
  by (simp add: sep_conj_def sep_empty_def)

lemma sep_conj_empty'[simp]:
  "(\<box> ** P) = P"
  by (subst sep_conj_commute, rule sep_conj_empty)

lemma sep_conj_sep_emptyI:
  "P h \<Longrightarrow> (P ** \<box>) h"
  by simp

lemma sep_conj_sep_emptyE:
  "\<lbrakk> P s; (P ** \<box>) s \<Longrightarrow> (Q ** R) s \<rbrakk> \<Longrightarrow> (Q ** R) s"
  by simp

lemma monoid_add: "class.monoid_add ((**)) \<box>"
  by (unfold_locales) (auto simp: sep_conj_ac)

lemma comm_monoid_add: "class.comm_monoid_add (**) \<box>"
  by (unfold_locales) (auto simp: sep_conj_ac)

subsection \<open>Properties of top (\<open>sep_true\<close>)\<close>

lemma sep_conj_true_P [simp]:
  "(sep_true ** (sep_true ** P)) = (sep_true ** P)"
  by (simp add: sep_conj_assoc[symmetric])

lemma sep_conj_disj:
  "((P or Q) ** R) = ((P ** R) or (Q ** R))"
  by (auto simp: sep_conj_def intro!: ext)

lemma sep_conj_sep_true_left:
  "(P ** Q) h \<Longrightarrow> (sep_true ** Q) h"
  by (erule sep_conj_impl, simp+)

lemma sep_conj_sep_true_right:
  "(P ** Q) h \<Longrightarrow> (P ** sep_true) h"
  by (subst (asm) sep_conj_commute, drule sep_conj_sep_true_left,
      simp add: sep_conj_ac)

subsection \<open>Separating Conjunction with Quantifiers\<close>

lemma sep_conj_conj:
  "((P and Q) ** R) h \<Longrightarrow> ((P ** R) and (Q ** R)) h"
  by (force intro: sep_conjI elim!: sep_conjE)

lemma sep_conj_exists1:
  "((EXS x. P x) ** Q) = (EXS x. (P x ** Q))"
  by (force intro!: ext intro: sep_conjI elim: sep_conjE)

lemma sep_conj_exists2:
  "(P ** (EXS x. Q x)) = (EXS x. P ** Q x)"
  by (force intro!: sep_conjI ext elim!: sep_conjE)

lemmas sep_conj_exists = sep_conj_exists1 sep_conj_exists2

lemma sep_conj_spec:
  "((ALLS x. P x) ** Q) h \<Longrightarrow> (P x ** Q) h"
  by (force intro: sep_conjI elim: sep_conjE)

subsection \<open>Properties of Separating Implication\<close>

lemma sep_implI:
  assumes a: "\<And>h'. \<lbrakk> h ## h'; P h' \<rbrakk> \<Longrightarrow> Q (h + h')"
  shows "(P \<longrightarrow>* Q) h"
  unfolding sep_impl_def by (auto elim: a)

lemma sep_implD:
  "(x \<longrightarrow>* y) h \<Longrightarrow> \<forall>h'. h ## h' \<and> x h' \<longrightarrow> y (h + h')"
  by (force simp: sep_impl_def)

lemma sep_implE:
  "(x \<longrightarrow>* y) h \<Longrightarrow> (\<forall>h'. h ## h' \<and> x h' \<longrightarrow> y (h + h') \<Longrightarrow> Q) \<Longrightarrow> Q"
  by (auto dest: sep_implD)

lemma sep_impl_sep_true [simp]:
  "(P \<longrightarrow>* sep_true) = sep_true"
  by (force intro!: sep_implI ext)

lemma sep_impl_sep_false [simp]:
  "(sep_false \<longrightarrow>* P) = sep_true"
  by (force intro!: sep_implI ext)

lemma sep_impl_sep_true_P:
  "(sep_true \<longrightarrow>* P) h \<Longrightarrow> P h"
  by (clarsimp dest!: sep_implD elim!: allE[where x=0])

lemma sep_impl_sep_true_false [simp]:
  "(sep_true \<longrightarrow>* sep_false) = sep_false"
  by (force intro!: ext dest: sep_impl_sep_true_P)

lemma sep_conj_sep_impl:
  "\<lbrakk> P h; \<And>h. (P ** Q) h \<Longrightarrow> R h \<rbrakk> \<Longrightarrow> (Q \<longrightarrow>* R) h"
proof (rule sep_implI)
  fix h' h
  assume "P h" and "h ## h'" and "Q h'"
  hence "(P ** Q) (h + h')" by (force intro: sep_conjI)
  moreover assume "\<And>h. (P ** Q) h \<Longrightarrow> R h"
  ultimately show "R (h + h')" by simp
qed

lemma sep_conj_sep_impl2:
  "\<lbrakk> (P ** Q) h; \<And>h. P h \<Longrightarrow> (Q \<longrightarrow>* R) h \<rbrakk> \<Longrightarrow> R h"
  by (force dest: sep_implD elim: sep_conjE)

lemma sep_conj_sep_impl_sep_conj2:
  "(P ** R) h \<Longrightarrow> (P ** (Q \<longrightarrow>* (Q ** R))) h"
  by (erule (1) sep_conj_impl, erule sep_conj_sep_impl, simp add: sep_conj_ac)

subsection \<open>Pure assertions\<close>

definition
  pure :: "('a \<Rightarrow> bool) \<Rightarrow> bool" where
  "pure P \<equiv> \<forall>h h'. P h = P h'"

lemma pure_sep_true:
  "pure sep_true"
  by (simp add: pure_def)

lemma pure_sep_false:
  "pure sep_true"
  by (simp add: pure_def)

lemma pure_split:
  "pure P = (P = sep_true \<or> P = sep_false)"
  by (force simp: pure_def intro!: ext)

lemma pure_sep_conj:
  "\<lbrakk> pure P; pure Q \<rbrakk> \<Longrightarrow> pure (P \<and>* Q)"
  by (force simp: pure_split)

lemma pure_sep_impl:
  "\<lbrakk> pure P; pure Q \<rbrakk> \<Longrightarrow> pure (P \<longrightarrow>* Q)"
  by (force simp: pure_split)

lemma pure_conj_sep_conj:
  "\<lbrakk> (P and Q) h; pure P \<or> pure Q \<rbrakk> \<Longrightarrow> (P \<and>* Q) h"
  by (metis pure_def sep_add_zero sep_conjI sep_conj_commute sep_disj_zero)

lemma pure_sep_conj_conj:
  "\<lbrakk> (P \<and>* Q) h; pure P; pure Q \<rbrakk> \<Longrightarrow> (P and Q) h"
  by (force simp: pure_split)

lemma pure_conj_sep_conj_assoc:
  "pure P \<Longrightarrow> ((P and Q) \<and>* R) = (P and (Q \<and>* R))"
  by (auto simp: pure_split)

lemma pure_sep_impl_impl:
  "\<lbrakk> (P \<longrightarrow>* Q) h; pure P \<rbrakk> \<Longrightarrow> P h \<longrightarrow> Q h"
  by (force simp: pure_split dest: sep_impl_sep_true_P)

lemma pure_impl_sep_impl:
  "\<lbrakk> P h \<longrightarrow> Q h; pure P; pure Q \<rbrakk> \<Longrightarrow> (P \<longrightarrow>* Q) h"
  by (force simp: pure_split)

lemma pure_conj_right: "(Q \<and>* (\<langle>P'\<rangle> and Q')) = (\<langle>P'\<rangle> and (Q \<and>* Q'))"
  by (rule ext, rule, rule, clarsimp elim!: sep_conjE)
     (erule sep_conj_impl, auto)

lemma pure_conj_right': "(Q \<and>* (P' and \<langle>Q'\<rangle>)) = (\<langle>Q'\<rangle> and (Q \<and>* P'))"
  by (simp add: conj_comms pure_conj_right)

lemma pure_conj_left: "((\<langle>P'\<rangle> and Q') \<and>* Q) = (\<langle>P'\<rangle> and (Q' \<and>* Q))"
  by (simp add: pure_conj_right sep_conj_ac)

lemma pure_conj_left': "((P' and \<langle>Q'\<rangle>) \<and>* Q) = (\<langle>Q'\<rangle> and (P' \<and>* Q))"
  by (subst conj_comms, subst pure_conj_left, simp)

lemmas pure_conj = pure_conj_right pure_conj_right' pure_conj_left
    pure_conj_left'

declare pure_conj[simp add]

subsection \<open>Intuitionistic assertions\<close>

definition intuitionistic :: "('a \<Rightarrow> bool) \<Rightarrow> bool" where
  "intuitionistic P \<equiv> \<forall>h h'. P h \<and> h \<preceq> h' \<longrightarrow> P h'"

lemma intuitionisticI:
  "(\<And>h h'. \<lbrakk> P h; h \<preceq> h' \<rbrakk> \<Longrightarrow> P h') \<Longrightarrow> intuitionistic P"
  by (unfold intuitionistic_def, fast)

lemma intuitionisticD:
  "\<lbrakk> intuitionistic P; P h; h \<preceq> h' \<rbrakk> \<Longrightarrow> P h'"
  by (unfold intuitionistic_def, fast)

lemma pure_intuitionistic:
  "pure P \<Longrightarrow> intuitionistic P"
  by (clarsimp simp: intuitionistic_def pure_def, fast)

lemma intuitionistic_conj:
  "\<lbrakk> intuitionistic P; intuitionistic Q \<rbrakk> \<Longrightarrow> intuitionistic (P and Q)"
  by (force intro: intuitionisticI dest: intuitionisticD)

lemma intuitionistic_disj:
  "\<lbrakk> intuitionistic P; intuitionistic Q \<rbrakk> \<Longrightarrow> intuitionistic (P or Q)"
  by (force intro: intuitionisticI dest: intuitionisticD)

lemma intuitionistic_forall:
  "(\<And>x. intuitionistic (P x)) \<Longrightarrow> intuitionistic (ALLS x. P x)"
  by (force intro: intuitionisticI dest: intuitionisticD)

lemma intuitionistic_exists:
  "(\<And>x. intuitionistic (P x)) \<Longrightarrow> intuitionistic (EXS x. P x)"
  by (force intro: intuitionisticI dest: intuitionisticD)

lemma intuitionistic_sep_conj_sep_true:
  "intuitionistic (sep_true \<and>* P)"
proof (rule intuitionisticI)
  fix h h' r
  assume a: "(sep_true \<and>* P) h"
  then obtain x y where P: "P y" and h: "h = x + y" and xyd: "x ## y"
    by - (drule sep_conjD, clarsimp)
  moreover assume a2: "h \<preceq> h'"
  then obtain z where h': "h' = h + z" and hzd: "h ## z"
    by (clarsimp simp: sep_substate_def)

  moreover have "(P \<and>* sep_true) (y + (x + z))"
    using P h hzd xyd
    by (metis sep_add_disjI1 sep_disj_commute sep_conjI)
  ultimately show "(sep_true \<and>* P) h'" using hzd
    by (auto simp: sep_conj_commute sep_add_ac dest!: sep_disj_addD)
qed

lemma intuitionistic_sep_impl_sep_true:
  "intuitionistic (sep_true \<longrightarrow>* P)"
proof (rule intuitionisticI)
  fix h h'
  assume imp: "(sep_true \<longrightarrow>* P) h" and hh': "h \<preceq> h'"

  from hh' obtain z where h': "h' = h + z" and hzd: "h ## z"
    by (clarsimp simp: sep_substate_def)
  show "(sep_true \<longrightarrow>* P) h'" using imp h' hzd
    apply (clarsimp dest!: sep_implD)
    apply (metis sep_add_assoc sep_add_disjD sep_disj_addI3 sep_implI)
    done
qed

lemma intuitionistic_sep_conj:
  assumes ip: "intuitionistic (P::('a \<Rightarrow> bool))"
  shows "intuitionistic (P \<and>* Q)"
proof (rule intuitionisticI)
  fix h h'
  assume sc: "(P \<and>* Q) h" and hh': "h \<preceq> h'"

  from hh' obtain z where h': "h' = h + z" and hzd: "h ## z"
    by (clarsimp simp: sep_substate_def)

  from sc obtain x y where px: "P x" and qy: "Q y"
                       and h: "h = x + y" and xyd: "x ## y"
    by (clarsimp simp: sep_conj_def)

  have "x ## z" using hzd h xyd
    by (metis sep_add_disjD)

  with ip px have "P (x + z)"
    by (fastforce elim: intuitionisticD sep_substate_disj_add)

  thus "(P \<and>* Q) h'" using h' h hzd qy xyd
    by (metis (full_types) sep_add_commute sep_add_disjD sep_add_disjI2
              sep_add_left_commute sep_conjI)
qed

lemma intuitionistic_sep_impl:
  assumes iq: "intuitionistic Q"
  shows "intuitionistic (P \<longrightarrow>* Q)"
proof (rule intuitionisticI)
  fix h h'
  assume imp: "(P \<longrightarrow>* Q) h" and hh': "h \<preceq> h'"

  from hh' obtain z where h': "h' = h + z" and hzd: "h ## z"
    by (clarsimp simp: sep_substate_def)

  {
    fix x
    assume px: "P x" and hzx: "h + z ## x"

    have "h + x \<preceq> h + x + z" using hzx hzd
    by (metis sep_add_disjI1 sep_substate_def)

    with imp hzd iq px hzx
    have "Q (h + z + x)"
    by (metis intuitionisticD sep_add_assoc sep_add_ac sep_add_disjD sep_implE)
  }

  with imp h' hzd iq show "(P \<longrightarrow>* Q) h'"
    by (fastforce intro: sep_implI)
qed

lemma strongest_intuitionistic:
  "\<not> (\<exists>Q. (\<forall>h. (Q h \<longrightarrow> (P \<and>* sep_true) h)) \<and> intuitionistic Q \<and>
      Q \<noteq> (P \<and>* sep_true) \<and> (\<forall>h. P h \<longrightarrow> Q h))"
  by (fastforce intro!: ext sep_substate_disj_add
                dest!: sep_conjD intuitionisticD)

lemma weakest_intuitionistic:
  "\<not> (\<exists>Q. (\<forall>h. ((sep_true \<longrightarrow>* P) h \<longrightarrow> Q h)) \<and> intuitionistic Q \<and>
      Q \<noteq> (sep_true \<longrightarrow>* P) \<and> (\<forall>h. Q h \<longrightarrow> P h))"
  apply (clarsimp intro!: ext)
  apply (rule iffI)
   apply (rule sep_implI)
   apply (drule_tac h="x" and h'="x + h'" in intuitionisticD)
     apply (clarsimp simp: sep_add_ac sep_substate_disj_add)+
  done

lemma intuitionistic_sep_conj_sep_true_P:
  "\<lbrakk> (P \<and>* sep_true) s; intuitionistic P \<rbrakk> \<Longrightarrow> P s"
  by (force dest: intuitionisticD elim: sep_conjE sep_substate_disj_add)

lemma intuitionistic_sep_conj_sep_true_simp:
  "intuitionistic P \<Longrightarrow> (P \<and>* sep_true) = P"
  by (fast intro!: sep_conj_sep_true ext
           elim: intuitionistic_sep_conj_sep_true_P)

lemma intuitionistic_sep_impl_sep_true_P:
  "\<lbrakk> P h; intuitionistic P \<rbrakk> \<Longrightarrow> (sep_true \<longrightarrow>* P) h"
  by (force intro!: sep_implI dest: intuitionisticD
            intro: sep_substate_disj_add)

lemma intuitionistic_sep_impl_sep_true_simp:
  "intuitionistic P \<Longrightarrow> (sep_true \<longrightarrow>* P) = P"
  by (fast intro!: ext
           elim: sep_impl_sep_true_P intuitionistic_sep_impl_sep_true_P)

subsection \<open>Strictly exact assertions\<close>

definition strictly_exact :: "('a \<Rightarrow> bool) \<Rightarrow> bool" where
  "strictly_exact P \<equiv> \<forall>h h'. P h \<and> P h' \<longrightarrow> h = h'"

lemma strictly_exactD:
  "\<lbrakk> strictly_exact P; P h; P h' \<rbrakk> \<Longrightarrow> h = h'"
  by (unfold strictly_exact_def, fast)

lemma strictly_exactI:
  "(\<And>h h'. \<lbrakk> P h; P h' \<rbrakk> \<Longrightarrow> h = h') \<Longrightarrow> strictly_exact P"
  by (unfold strictly_exact_def, fast)

lemma strictly_exact_sep_conj:
  "\<lbrakk> strictly_exact P; strictly_exact Q \<rbrakk> \<Longrightarrow> strictly_exact (P \<and>* Q)"
  apply (rule strictly_exactI)
  apply (erule sep_conjE)+
  apply (drule_tac h="x" and h'="xa" in strictly_exactD, assumption+)
  apply (drule_tac h="y" and h'="ya" in strictly_exactD, assumption+)
  apply clarsimp
  done

lemma strictly_exact_conj_impl:
  "\<lbrakk> (Q \<and>* sep_true) h; P h; strictly_exact Q \<rbrakk> \<Longrightarrow> (Q \<and>* (Q \<longrightarrow>* P)) h"
  by (force intro: sep_conjI sep_implI dest: strictly_exactD elim!: sep_conjE
            simp: sep_add_commute sep_add_assoc)

end

interpretation sep: ab_semigroup_mult "(**)"
  by (rule ab_semigroup_mult_sep_conj)

interpretation sep: comm_monoid_add "(**)" \<box>
  by (rule comm_monoid_add)

section \<open>Separation Algebra with Stronger, but More Intuitive Disjunction Axiom\<close>

class stronger_sep_algebra = pre_sep_algebra +
  assumes sep_add_disj_eq [simp]: "y ## z \<Longrightarrow> x ## y + z = (x ## y \<and> x ## z)"
begin

lemma sep_disj_add_eq [simp]: "x ## y \<Longrightarrow> x + y ## z = (x ## z \<and> y ## z)"
  by (metis sep_add_disj_eq sep_disj_commute)

subclass sep_algebra by standard auto

end

section \<open>Folding separating conjunction over lists of predicates\<close>

lemma sep_list_conj_Nil [simp]: "\<And>* [] = \<box>"
  by (simp add: sep_list_conj_def)

(* apparently these two are rarely used and had to be removed from List.thy *)
lemma (in semigroup_add) foldl_assoc:
shows "foldl (+) (x+y) zs = x + (foldl (+) y zs)"
by (induct zs arbitrary: y) (simp_all add:add.assoc)

lemma (in monoid_add) foldl_absorb0:
shows "x + (foldl (+) 0 zs) = foldl (+) x zs"
by (induct zs) (simp_all add:foldl_assoc)

lemma sep_list_conj_Cons [simp]: "\<And>* (x#xs) = (x ** \<And>* xs)"
  by (simp add: sep_list_conj_def sep.foldl_absorb0)

lemma sep_list_conj_append [simp]: "\<And>* (xs @ ys) = (\<And>* xs ** \<And>* ys)"
  by (simp add: sep_list_conj_def sep.foldl_absorb0)

lemma (in comm_monoid_add) foldl_map_filter:
  "foldl (+) 0 (map f (filter P xs)) +
     foldl (+) 0 (map f (filter (not P) xs))
   = foldl (+) 0 (map f xs)"
proof (induct xs)
  case Nil thus ?case by clarsimp
next
  case (Cons x xs)
  hence IH: "foldl (+) 0 (map f xs) =
               foldl (+) 0 (map f (filter P xs)) +
               foldl (+) 0 (map f [x\<leftarrow>xs . \<not> P x])"
               by (simp only: eq_commute)

  have foldl_Cons':
    "\<And>x xs. foldl (+) 0 (x # xs) = x + (foldl (+) 0 xs)"
    by (simp, subst foldl_absorb0[symmetric], rule refl)

  { assume "P x"
    hence ?case by (auto simp del: foldl_Cons simp add: foldl_Cons' IH ac_simps)
  } moreover {
    assume "\<not> P x"
    hence ?case by (auto simp del: foldl_Cons simp add: foldl_Cons' IH ac_simps)
  }
  ultimately show ?case by blast
qed

section \<open>Separation Algebra with a Cancellative Monoid (for completeness)\<close>

text \<open>
  Separation algebra with a cancellative monoid. The results of being a precise
  assertion (distributivity over separating conjunction) require this.
  although we never actually use this property in our developments, we keep
  it here for completeness.
\<close>
class cancellative_sep_algebra = sep_algebra +
  assumes sep_add_cancelD: "\<lbrakk> x + z = y + z ; x ## z ; y ## z \<rbrakk> \<Longrightarrow> x = y"
begin

definition
  (* In any heap, there exists at most one subheap for which P holds *)
  precise :: "('a \<Rightarrow> bool) \<Rightarrow> bool" where
  "precise P = (\<forall>h hp hp'. hp \<preceq> h \<and> P hp \<and> hp' \<preceq> h \<and> P hp' \<longrightarrow> hp = hp')"

lemma "precise ((=) s)"
  by (metis (full_types) precise_def)

lemma sep_add_cancel:
  "x ## z \<Longrightarrow> y ## z \<Longrightarrow> (x + z = y + z) = (x = y)"
  by (metis sep_add_cancelD)

lemma precise_distribute:
  "precise P = (\<forall>Q R. ((Q and R) \<and>* P) = ((Q \<and>* P) and (R \<and>* P)))"
proof (rule iffI)
  assume pp: "precise P"
  {
    fix Q R
    fix h hp hp' s

    { assume a: "((Q and R) \<and>* P) s"
      hence "((Q \<and>* P) and (R \<and>* P)) s"
        by (fastforce dest!: sep_conjD elim: sep_conjI)
    }
    moreover
    { assume qs: "(Q \<and>* P) s" and qr: "(R \<and>* P) s"

      from qs obtain x y where sxy: "s = x + y" and xy: "x ## y"
                           and x: "Q x" and y: "P y"
        by (fastforce dest!: sep_conjD)
      from qr obtain x' y' where sxy': "s = x' + y'" and xy': "x' ## y'"
                           and x': "R x'" and y': "P y'"
        by (fastforce dest!: sep_conjD)

      from sxy have ys: "y \<preceq> x + y" using xy
        by (fastforce simp: sep_substate_disj_add' sep_disj_commute)
      from sxy' have ys': "y' \<preceq> x' + y'" using xy'
        by (fastforce simp: sep_substate_disj_add' sep_disj_commute)

      from pp have yy: "y = y'" using sxy sxy' xy xy' y y' ys ys'
        by (fastforce simp: precise_def)

      hence "x = x'" using sxy sxy' xy xy'
        by (fastforce dest!: sep_add_cancelD)

      hence "((Q and R) \<and>* P) s" using sxy x x' yy y' xy'
        by (fastforce intro: sep_conjI)
    }
    ultimately
    have "((Q and R) \<and>* P) s = ((Q \<and>* P) and (R \<and>* P)) s" using pp by blast
  }
  thus "\<forall>Q R. ((Q and R) \<and>* P) = ((Q \<and>* P) and (R \<and>* P))" by (blast intro!: ext)

next
  assume a: "\<forall>Q R. ((Q and R) \<and>* P) = ((Q \<and>* P) and (R \<and>* P))"
  thus "precise P"
  proof (clarsimp simp: precise_def)
    fix h hp hp' Q R
    assume hp: "hp \<preceq> h" and hp': "hp' \<preceq> h" and php: "P hp" and php': "P hp'"

    obtain z where hhp: "h = hp + z" and hpz: "hp ## z" using hp
      by (clarsimp simp: sep_substate_def)
    obtain z' where hhp': "h = hp' + z'" and hpz': "hp' ## z'" using hp'
      by (clarsimp simp: sep_substate_def)

    have h_eq: "z' + hp' = z + hp" using hhp hhp' hpz hpz'
      by (fastforce simp: sep_add_ac)

    from hhp hhp' a hpz hpz' h_eq
    have "\<forall>Q R. ((Q and R) \<and>* P) (z + hp) = ((Q \<and>* P) and (R \<and>* P)) (z' + hp')"
      by (fastforce simp: h_eq sep_add_ac sep_conj_commute)

    hence "(((=) z and (=) z') \<and>* P) (z + hp) =
           (((=) z \<and>* P) and ((=) z' \<and>* P)) (z' + hp')" by blast

    thus  "hp = hp'" using php php' hpz hpz' h_eq
      by (fastforce dest!: iffD2 cong: conj_cong
                    simp: sep_add_ac sep_add_cancel sep_conj_def)
  qed
qed

lemma strictly_precise: "strictly_exact P \<Longrightarrow> precise P"
  by (metis precise_def strictly_exactD)

end

end


(*
  Title:      Singleton.thy
  Author:     Diego Marmsoler
*)
section "A Theory of Singletons"
text\<open>
  In the following, we formalize the specification of the singleton pattern as described in~\<^cite>\<open>"Marmsoler2018c"\<close>.
\<close>

theory Singleton
imports DynamicArchitectures.Dynamic_Architecture_Calculus
begin
subsection Singletons
text \<open>
  In the following we formalize a variant of the Singleton pattern.
\<close>
locale singleton = dynamic_component cmp active
    for active :: "'id \<Rightarrow> cnf \<Rightarrow> bool" ("\<parallel>_\<parallel>\<^bsub>_\<^esub>" [0,110]60)
    and cmp :: "'id \<Rightarrow> cnf \<Rightarrow> 'cmp" ("\<sigma>\<^bsub>_\<^esub>(_)" [0,110]60) +
assumes alwaysActive: "\<And>k. \<exists>id. \<parallel>id\<parallel>\<^bsub>k\<^esub>"
    and unique: "\<exists>id. \<forall>k. \<forall>id'. (\<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id = id')"
begin
subsubsection "Calculus Interpretation"
text \<open>
\noindent
@{thm[source] baIA}: @{thm baIA [no_vars]}
\<close>
text \<open>
\noindent
@{thm[source] baIN1}: @{thm baIN1 [no_vars]}
\<close>
text \<open>
\noindent
@{thm[source] baIN2}: @{thm baIN2 [no_vars]}
\<close>

subsubsection "Architectural Guarantees"

definition "the_singleton \<equiv> THE id. \<forall>k. \<forall>id'. \<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id' = id"

theorem ts_prop:
  fixes k::cnf
  shows "\<And>id. \<parallel>id\<parallel>\<^bsub>k\<^esub> \<Longrightarrow> id = the_singleton"
    and "\<parallel>the_singleton\<parallel>\<^bsub>k\<^esub>"
proof -
  { fix id
    assume a1: "\<parallel>id\<parallel>\<^bsub>k\<^esub>"
  have "(THE id. \<forall>k. \<forall>id'. \<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id' = id) = id"
  proof (rule the_equality)
    show "\<forall>k id'. \<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id' = id"
    proof
      fix k show "\<forall>id'. \<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id' = id"
      proof
        fix id' show "\<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id' = id"
        proof
          assume "\<parallel>id'\<parallel>\<^bsub>k\<^esub>"
          from unique have "\<exists>id. \<forall>k. \<forall>id'. (\<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id = id')" .
          then obtain i'' where "\<forall>k. \<forall>id'. (\<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> i'' = id')" by auto
            with \<open>\<parallel>id'\<parallel>\<^bsub>k\<^esub>\<close> have "id=i''" and "id'=i''" using a1 by auto
          thus "id' = id" by simp
        qed
      qed
    qed
  next
      fix i'' show "\<forall>k id'. \<parallel>id'\<parallel>\<^bsub>k\<^esub> \<longrightarrow> id' = i'' \<Longrightarrow> i'' = id" using a1 by auto
  qed
    hence "\<parallel>id\<parallel>\<^bsub>k\<^esub> \<Longrightarrow> id = the_singleton" by (simp add: the_singleton_def)
  } note g1 = this
  thus "\<And>id. \<parallel>id\<parallel>\<^bsub>k\<^esub> \<Longrightarrow> id = the_singleton" by simp

  from alwaysActive obtain id where "\<parallel>id\<parallel>\<^bsub>k\<^esub>" by blast
  with g1 have "id = the_singleton" by simp
  with \<open>\<parallel>id\<parallel>\<^bsub>k\<^esub>\<close> show "\<parallel>the_singleton\<parallel>\<^bsub>k\<^esub>" by simp
qed
declare ts_prop(2)[simp]

lemma lNact_active[simp]:
  fixes cid t n
  shows "\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> = n"
  using lNact_active ts_prop(2) by auto

lemma lNxt_active[simp]:
  fixes cid t n
  shows "\<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n\<^esub> = n"
by (simp add: nxtAct_active)

lemma baI[intro]:
  fixes t n a
  assumes "\<phi> (\<sigma>\<^bsub>the_singleton\<^esub>(t n))"
  shows "eval the_singleton t t' n [\<phi>]\<^sub>b" using assms by (simp add: baIANow)

lemma baE[elim]:
  fixes t n a
  assumes "eval the_singleton t t' n [\<phi>]\<^sub>b"
  shows "\<phi> (\<sigma>\<^bsub>the_singleton\<^esub>(t n))" using assms by (simp add: baEANow)

lemma evtE[elim]:
  fixes t id n a
  assumes "eval the_singleton t t' n (\<diamond>\<^sub>b \<gamma>)"
  shows "\<exists>n'\<ge>n. eval the_singleton t t' n' \<gamma>"
proof -
  have "\<parallel>the_singleton\<parallel>\<^bsub>t n\<^esub>" by simp
  with assms obtain n' where "n'\<ge>\<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" and "(\<exists>i\<ge>n'. \<parallel>the_singleton\<parallel>\<^bsub>t i\<^esub> \<and>
    (\<forall>n''\<ge>\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n'\<^esub>. n'' \<le> \<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n'\<^esub> \<longrightarrow> eval the_singleton t t' n'' \<gamma>)) \<or>
    \<not> (\<exists>i\<ge>n'. \<parallel>the_singleton\<parallel>\<^bsub>t i\<^esub>) \<and> eval the_singleton t t' n' \<gamma>" using evtEA[of n "the_singleton" t] by blast
  moreover have "\<parallel>the_singleton\<parallel>\<^bsub>t n'\<^esub>" by simp
  ultimately have
    "\<forall>n''\<ge>\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n'\<^esub>. n'' \<le> \<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n'\<^esub> \<longrightarrow> eval the_singleton t t' n'' \<gamma>" by auto
  hence "eval the_singleton t t' n' \<gamma>" by simp
  moreover from \<open>n'\<ge>\<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<close> have "n'\<ge>n" by (simp add: nxtAct_active)
  ultimately show ?thesis by auto
qed

lemma globE[elim]:
  fixes t id n a
  assumes "eval the_singleton t t' n (\<box>\<^sub>b \<gamma>)"
  shows "\<forall>n'\<ge>n. eval the_singleton t t' n' \<gamma>"
proof
  fix n' show "n \<le> n' \<longrightarrow> eval the_singleton t t' n' \<gamma>"
  proof
    assume "n\<le>n'"
    hence "\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n\<^esub> \<le> n'" by simp
    moreover have "\<parallel>the_singleton\<parallel>\<^bsub>t n\<^esub>" by simp
    ultimately show "eval the_singleton t t' n' \<gamma>"
      using \<open>eval the_singleton t t' n (\<box>\<^sub>b \<gamma>)\<close> globEA by blast
  qed
qed

lemma untilE[elim]:
  fixes t id n \<gamma>' \<gamma>
  assumes "eval the_singleton t t' n (\<gamma>' \<UU>\<^sub>b \<gamma>)"
  shows "\<exists>n'\<ge>n. eval the_singleton t t' n' \<gamma> \<and> (\<forall>n''\<ge>n. n'' < n' \<longrightarrow> eval the_singleton t t' n'' \<gamma>')"
proof -
  have "\<parallel>the_singleton\<parallel>\<^bsub>t n\<^esub>" by simp
  with \<open>eval the_singleton t t' n (\<gamma>' \<UU>\<^sub>b \<gamma>)\<close> obtain n' where "n'\<ge>\<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n\<^esub>" and
   "(\<exists>i\<ge>n'. \<parallel>the_singleton\<parallel>\<^bsub>t i\<^esub>) \<and>
   (\<forall>n''\<ge>\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n'\<^esub>. n'' \<le> \<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n'\<^esub> \<longrightarrow> eval the_singleton t t' n'' \<gamma>) \<and>
   (\<forall>n''\<ge>\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>. n'' < \<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n'\<^esub> \<longrightarrow> eval the_singleton t t' n'' \<gamma>') \<or>
   \<not> (\<exists>i\<ge>n'. \<parallel>the_singleton\<parallel>\<^bsub>t i\<^esub>) \<and>
   eval the_singleton t t' n' \<gamma> \<and> (\<forall>n''\<ge>\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>. n'' < n' \<longrightarrow> eval the_singleton t t' n'' \<gamma>')"
  using untilEA[of n "the_singleton" t t' \<gamma>' \<gamma>] by auto
  moreover have "\<parallel>the_singleton\<parallel>\<^bsub>t n'\<^esub>" by simp
  ultimately have
    "(\<forall>n''\<ge>\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n'\<^esub>. n'' \<le> \<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n'\<^esub> \<longrightarrow> eval the_singleton t t' n'' \<gamma>) \<and>
    (\<forall>n''\<ge>\<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n\<^esub>. n'' < \<langle>the_singleton \<Leftarrow> t\<rangle>\<^bsub>n'\<^esub> \<longrightarrow> eval the_singleton t t' n'' \<gamma>')" by auto
  hence "eval the_singleton t t' n' \<gamma>" and "(\<forall>n''\<ge>n. n'' < n' \<longrightarrow> eval the_singleton t t' n'' \<gamma>')" by auto
  with \<open>eval the_singleton t t' n' \<gamma>\<close> \<open>n'\<ge>\<langle>the_singleton \<rightarrow> t\<rangle>\<^bsub>n\<^esub>\<close> show ?thesis by auto
qed
end

end


(*  Author:     Tobias Nipkow, 2007  *)

section\<open>Linear real arithmetic\<close>

theory LinArith
imports QE "HOL-Library.ListVector" Complex_Main
begin

declare iprod_assoc[simp]

subsection\<open>Basics\<close>

subsubsection\<open>Syntax and Semantics\<close>

datatype atom = Less real "real list" | Eq real "real list"

fun is_Less :: "atom \<Rightarrow> bool" where
"is_Less (Less r rs) = True" |
"is_Less f = False"

abbreviation "is_Eq \<equiv> Not \<circ> is_Less"

lemma is_Less_iff: "is_Less f = (\<exists>r rs. f = Less r rs)"
by(induct f) auto

lemma is_Eq_iff: "(\<forall>i j. a \<noteq> Less i j) = (\<exists>i j. a = Eq i j)"
by(cases a) auto

fun neg\<^sub>R :: "atom \<Rightarrow> atom fm" where
"neg\<^sub>R (Less r t) = Or (Atom(Less (-r) (-t))) (Atom(Eq r t))" |
"neg\<^sub>R (Eq r t) = Or (Atom(Less r t)) (Atom(Less (-r) (-t)))"

fun hd_coeff :: "atom \<Rightarrow> real" where
"hd_coeff (Less r cs) = (case cs of [] \<Rightarrow> 0 | c#_ \<Rightarrow> c)" |
"hd_coeff (Eq r cs) = (case cs of [] \<Rightarrow> 0 | c#_ \<Rightarrow> c)"

definition "depends\<^sub>R a = (hd_coeff a \<noteq> 0)"

fun decr\<^sub>R :: "atom \<Rightarrow> atom" where
"decr\<^sub>R (Less r rs) = Less r (tl rs)" |
"decr\<^sub>R (Eq r rs) = Eq r (tl rs)"

fun I\<^sub>R :: "atom \<Rightarrow> real list \<Rightarrow> bool" where
"I\<^sub>R (Less r cs) xs = (r < \<langle>cs,xs\<rangle>)" |
"I\<^sub>R (Eq r cs) xs = (r = \<langle>cs,xs\<rangle>)"

definition "atoms\<^sub>0 = ATOM.atoms\<^sub>0 depends\<^sub>R"
(* FIXME !!! (incl: display should hide params)*)

interpretation R: ATOM neg\<^sub>R "(\<lambda>a. True)" I\<^sub>R depends\<^sub>R decr\<^sub>R
  rewrites "ATOM.atoms\<^sub>0 depends\<^sub>R = atoms\<^sub>0"
proof goal_cases
  case 1
  thus ?case
    apply(unfold_locales)
        apply(case_tac a)
         apply simp_all
     apply(case_tac a)
      apply simp_all
      apply arith
     apply arith
    apply(case_tac a)
    apply(simp_all add:depends\<^sub>R_def split:list.splits)
    done
next
  case 2
  thus ?case by(simp add:atoms\<^sub>0_def)
qed

setup \<open>Sign.revert_abbrev "" @{const_abbrev R.I}\<close>
setup \<open>Sign.revert_abbrev "" @{const_abbrev R.lift_nnf_qe}\<close>

subsubsection\<open>Shared constructions\<close>

fun combine :: "(real * real list) \<Rightarrow> (real * real list) \<Rightarrow> atom" where
"combine (r\<^sub>1,cs\<^sub>1) (r\<^sub>2,cs\<^sub>2) = Less (r\<^sub>1-r\<^sub>2) (cs\<^sub>2 - cs\<^sub>1)"

(* More efficient combination than rhs of combine_conv below; unused
lemma combine_code:
  "combine (r1,c1,cs1) (r2,c2,cs2) =
  Less (c1*r2-c2*r1) (zipwith0 (%x y. c1*y-c2*x) cs1 cs2)"
apply(rule sym)
apply(simp)
apply(induct cs1 arbitrary:cs2)
 apply simp
apply(case_tac cs2)
 apply simp
apply simp
done*)

definition "lbounds as = [(r/c, (-1/c) *\<^sub>s cs). Less r (c#cs) \<leftarrow> as, c>0]"
definition "ubounds as = [(r/c, (-1/c) *\<^sub>s cs). Less r (c#cs) \<leftarrow> as, c<0]"
definition "ebounds as = [(r/c, (-1/c) *\<^sub>s cs). Eq r (c#cs) \<leftarrow> as, c\<noteq>0]"

lemma set_lbounds:
 "set(lbounds as) = {(r/c, (-1/c) *\<^sub>s cs)|r c cs. Less r (c#cs) \<in> set as \<and> c>0}"
by(force simp: lbounds_def split:list.splits atom.splits if_splits)
lemma set_ubounds:
 "set(ubounds as) = {(r/c, (-1/c) *\<^sub>s cs)|r c cs. Less r (c#cs) \<in> set as \<and> c<0}"
by(force simp: ubounds_def split:list.splits atom.splits if_splits)
lemma set_ebounds:
  "set(ebounds as) = {(r/c, (-1/c) *\<^sub>s cs)|r c cs. Eq r (c#cs) \<in> set as \<and> c\<noteq>0}"
by(force simp: ebounds_def split:list.splits atom.splits if_splits)

abbreviation EQ where
"EQ f xs \<equiv> {(r - \<langle>cs,xs\<rangle>)/c|r c cs. Eq r (c#cs) \<in> set(R.atoms\<^sub>0 f) \<and> c\<noteq>0}"
abbreviation LB where
"LB f xs \<equiv> {(r - \<langle>cs,xs\<rangle>)/c|r c cs. Less r (c#cs) \<in> set(R.atoms\<^sub>0 f) \<and> c>0}"
abbreviation UB where
"UB f xs \<equiv> {(r - \<langle>cs,xs\<rangle>)/c|r c cs. Less r (c#cs) \<in> set(R.atoms\<^sub>0 f) \<and> c<0}"

fun asubst :: "real * real list \<Rightarrow> atom \<Rightarrow> atom" where
"asubst (r,cs) (Less s (d#ds)) = Less (s - d*r) (d *\<^sub>s cs + ds)" |
"asubst (r,cs) (Eq s (d#ds)) = Eq (s - d*r) (d *\<^sub>s cs + ds)" |
"asubst (r,cs) (Less s []) = Less s []" |
"asubst (r,cs) (Eq s []) = Eq s []"

abbreviation "subst \<phi> rcs \<equiv> map\<^sub>f\<^sub>m (asubst rcs) \<phi>"

definition eval :: "real * real list \<Rightarrow> real list \<Rightarrow> real" where
"eval rcs xs = fst rcs + \<langle>snd rcs,xs\<rangle>"

lemma I_asubst:
 "I\<^sub>R (asubst t a) xs = I\<^sub>R a (eval t xs # xs)"
proof(cases a)
  case (Less r cs)
  thus ?thesis by(cases t, cases cs,
    simp_all add:eval_def distrib_left iprod_left_add_distrib)
    arith
next
  case (Eq r cs)
  thus ?thesis
    by(cases t, cases cs, simp_all add:eval_def distrib_left iprod_left_add_distrib)
      arith
qed

lemma I_subst:
  "qfree \<phi> \<Longrightarrow> R.I (subst \<phi> t) xs = R.I \<phi> (eval t xs # xs)"
by(induct \<phi>)(simp_all add:I_asubst)
lemma I_subst_pretty:
  "qfree \<phi> \<Longrightarrow> R.I (subst \<phi> (r,cs)) xs = R.I \<phi> ((r + \<langle>cs,xs\<rangle>) # xs)"
by(simp add:I_subst eval_def)

fun min_inf :: "atom fm \<Rightarrow> atom fm" ("inf\<^sub>-") where
"inf\<^sub>- (And \<phi>\<^sub>1 \<phi>\<^sub>2) = and (inf\<^sub>- \<phi>\<^sub>1) (inf\<^sub>- \<phi>\<^sub>2)" |
"inf\<^sub>- (Or \<phi>\<^sub>1 \<phi>\<^sub>2) = or (inf\<^sub>- \<phi>\<^sub>1) (inf\<^sub>- \<phi>\<^sub>2)" |
"inf\<^sub>- (Atom(Less r (c#cs))) =
  (if c<0 then TrueF else if c>0 then FalseF else Atom(Less r cs))" |
"inf\<^sub>- (Atom(Eq r (c#cs))) = (if c=0 then Atom(Eq r cs) else FalseF)" |
"inf\<^sub>- \<phi> = \<phi>"

fun plus_inf :: "atom fm \<Rightarrow> atom fm" ("inf\<^sub>+") where
"inf\<^sub>+ (And \<phi>\<^sub>1 \<phi>\<^sub>2) = and (inf\<^sub>+ \<phi>\<^sub>1) (inf\<^sub>+ \<phi>\<^sub>2)" |
"inf\<^sub>+ (Or \<phi>\<^sub>1 \<phi>\<^sub>2) = or (inf\<^sub>+ \<phi>\<^sub>1) (inf\<^sub>+ \<phi>\<^sub>2)" |
"inf\<^sub>+ (Atom(Less r (c#cs))) =
  (if c>0 then TrueF else if c<0 then FalseF else Atom(Less r cs))" |
"inf\<^sub>+ (Atom(Eq r (c#cs))) = (if c=0 then Atom(Eq r cs) else FalseF)" |
"inf\<^sub>+ \<phi> = \<phi>"

lemma qfree_min_inf: "qfree \<phi> \<Longrightarrow> qfree(inf\<^sub>- \<phi>)"
by(induct \<phi> rule:min_inf.induct) simp_all

lemma qfree_plus_inf: "qfree \<phi> \<Longrightarrow> qfree(inf\<^sub>+ \<phi>)"
by(induct \<phi> rule:plus_inf.induct) simp_all

lemma min_inf:
  "nqfree f \<Longrightarrow> \<exists>x. \<forall>y\<le>x. R.I (inf\<^sub>- f) xs = R.I f (y # xs)"
  (is "_ \<Longrightarrow> \<exists>x. ?P f x")
proof(induct f)
  case (Atom a)
  show ?case
  proof (cases a)
    case (Less r cs)
    show ?thesis
    proof(cases cs)
      case Nil thus ?thesis using Less by simp
    next
      case (Cons c cs)
      { assume "c=0" hence ?thesis using Less Cons by simp }
      moreover
      { assume "c<0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> + 1)/c)" using Less Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      moreover
      { assume "c>0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> - 1)/c)" using Less Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      ultimately show ?thesis by force
    qed
  next
    case (Eq r cs)
    show ?thesis
    proof(cases cs)
      case Nil thus ?thesis using Eq by simp
    next
      case (Cons c cs)
      { assume "c=0" hence ?thesis using Eq Cons by simp }
      moreover
      { assume "c<0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> + 1)/c)" using Eq Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      moreover
      { assume "c>0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> - 1)/c)" using Eq Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      ultimately show ?thesis by force
    qed
  qed
next
  case (And f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (And f1 f2) (min x1 x2)" by(force simp:and_def)
  thus ?case ..
next
  case (Or f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (Or f1 f2) (min x1 x2)" by(force simp:or_def)
  thus ?case ..
qed simp_all

lemma plus_inf:
  "nqfree f \<Longrightarrow> \<exists>x. \<forall>y\<ge>x. R.I (inf\<^sub>+ f) xs = R.I f (y # xs)"
  (is "_ \<Longrightarrow> \<exists>x. ?P f x")
proof(induct f)
  case (Atom a)
  show ?case
  proof (cases a)
    case (Less r cs)
    show ?thesis
    proof(cases cs)
      case Nil thus ?thesis using Less by simp
    next
      case (Cons c cs)
      { assume "c=0" hence ?thesis using Less Cons by simp }
      moreover
      { assume "c<0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> - 1)/c)" using Less Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      moreover
      { assume "c>0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> + 1)/c)" using Less Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      ultimately show ?thesis by force
    qed
  next
    case (Eq r cs)
    show ?thesis
    proof(cases cs)
      case Nil thus ?thesis using Eq by simp
    next
      case (Cons c cs)
      { assume "c=0" hence ?thesis using Eq Cons by simp }
      moreover
      { assume "c<0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> - 1)/c)" using Eq Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      moreover
      { assume "c>0"
        hence "?P (Atom a) ((r - \<langle>cs,xs\<rangle> + 1)/c)" using Eq Cons
          by(auto simp add: field_simps)
        hence ?thesis .. }
      ultimately show ?thesis by force
    qed
  qed
next
  case (And f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (And f1 f2) (max x1 x2)" by(force simp:and_def)
  thus ?case ..
next
  case (Or f1 f2)
  then obtain x1 x2 where "?P f1 x1" "?P f2 x2" by fastforce+
  hence "?P (Or f1 f2) (max x1 x2)" by(force simp:or_def)
  thus ?case ..
qed simp_all

context notes [[simp_depth_limit = 4]]
begin

lemma LBex:
 "\<lbrakk> nqfree f; R.I f (x#xs); \<not>R.I (inf\<^sub>- f) xs; x \<notin> EQ f xs \<rbrakk>
  \<Longrightarrow> \<exists>l\<in> LB f xs. l < x"
apply(induct f)
apply simp
apply simp
apply(rename_tac a)
apply(case_tac a)
apply(auto simp add: depends\<^sub>R_def field_simps split:if_splits list.splits)
apply fastforce+
done

lemma UBex:
 "\<lbrakk> nqfree f; R.I f (x#xs); \<not>R.I (inf\<^sub>+ f) xs; x \<notin> EQ f xs \<rbrakk>
  \<Longrightarrow> \<exists>u\<in> UB f xs. x < u"
apply(induct f)
apply simp
apply simp
apply(rename_tac a)
apply(case_tac a)
apply(auto simp add: depends\<^sub>R_def field_simps split:if_splits list.splits)
apply fastforce+
done

end

lemma finite_LB: "finite(LB f xs)"
proof -
  have "LB f xs = (\<lambda>(r,cs). r + \<langle>cs,xs\<rangle>) ` set(lbounds(R.atoms\<^sub>0 f))"
    by (force simp:set_lbounds image_def field_simps)
  thus ?thesis by simp
qed

lemma finite_UB: "finite(UB f xs)"
proof -
  have "UB f xs = (\<lambda>(r,cs). r + \<langle>cs,xs\<rangle>) ` set(ubounds(R.atoms\<^sub>0 f))"
    by (force simp:set_ubounds image_def field_simps)
  thus ?thesis by simp
qed

end


section \<open>Various preliminary material\<close>
theory Zeta_Library
imports
  "HOL-Complex_Analysis.Complex_Analysis"
  "HOL-Real_Asymp.Real_Asymp"
  "Dirichlet_Series.Dirichlet_Series_Analysis"
begin

subsection \<open>Facts about limits\<close>

lemma at_within_altdef:
  "at x within A = (INF S\<in>{S. open S \<and> x \<in> S}. principal (S \<inter> (A - {x})))"
  unfolding at_within_def nhds_def inf_principal [symmetric]
    by (subst INF_inf_distrib [symmetric]) (auto simp: INF_constant)

lemma tendsto_at_left_realI_sequentially:
  fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
  assumes *: "\<And>X. filterlim X (at_left c) sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
  shows "(f \<longlongrightarrow> y) (at_left c)"
proof -
  obtain A where A: "decseq A" "open (A n)" "y \<in> A n" "nhds y = (INF n. principal (A n))" for n
    by (rule nhds_countable[of y]) (rule that)

  have "\<forall>m. \<exists>d<c. \<forall>x\<in>{d<..<c}. f x \<in> A m"
  proof (rule ccontr)
    assume "\<not> (\<forall>m. \<exists>d<c. \<forall>x\<in>{d<..<c}. f x \<in> A m)"
    then obtain m where **: "\<And>d. d < c \<Longrightarrow> \<exists>x\<in>{d<..<c}. f x \<notin> A m"
      by auto
    have "\<exists>X. \<forall>n. (f (X n) \<notin> A m \<and> X n < c) \<and> X (Suc n) > c - max 0 ((c - X n) / 2)"
    proof (intro dependent_nat_choice, goal_cases)
      case 1
      from **[of "c - 1"] show ?case by auto
    next
      case (2 x n)
      with **[of "c - max 0 (c - x) / 2"] show ?case by force
    qed
    then obtain X where X: "\<And>n. f (X n) \<notin> A m" "\<And>n. X n < c" "\<And>n. X (Suc n) > c - max 0 ((c - X n) / 2)"
      by auto (metis diff_gt_0_iff_gt half_gt_zero_iff max.absorb3 max.commute)
    have X_ge: "X n \<ge> c - (c - X 0) / 2 ^ n" for n
    proof (induction n)
      case (Suc n)
      have "c - (c - X 0) / 2 ^ Suc n = c - (c - (c - (c - X 0) / 2 ^ n)) / 2"
        by simp
      also have "c - (c - (c - (c - X 0) / 2 ^ n)) / 2 \<le> c - (c - X n) / 2"
        by (intro diff_left_mono divide_right_mono Suc diff_right_mono) auto
      also have "\<dots> = c - max 0 ((c - X n) / 2)"
        using X[of n] by (simp add: max_def)
      also have "\<dots> < X (Suc n)"
        using X[of n] by simp
      finally show ?case by linarith
    qed auto

    have "X \<longlonglongrightarrow> c"
    proof (rule tendsto_sandwich)
      show "eventually (\<lambda>n. X n \<le> c) sequentially"
        using X by (intro always_eventually) (auto intro!: less_imp_le)
      show "eventually (\<lambda>n. X n \<ge> c - (c - X 0) / 2 ^ n) sequentially"
        using X_ge by (intro always_eventually) auto
    qed real_asymp+
    hence "filterlim X (at_left c) sequentially"
      by (rule tendsto_imp_filterlim_at_left)
         (use X in \<open>auto intro!: always_eventually less_imp_le\<close>)
    from topological_tendstoD[OF *[OF this] A(2, 3), of m] X(1) show False
      by auto
  qed

  then obtain d where d: "d m < c" "x \<in> {d m<..<c} \<Longrightarrow> f x \<in> A m" for m x
    by metis
  have ***: "at_left c = (INF S\<in>{S. open S \<and> c \<in> S}. principal (S \<inter> {..<c}))"
    by (simp add: at_within_altdef)
  from d show ?thesis
    unfolding *** A using A(1,2) by (intro filterlim_base[of _ "\<lambda>m. {d m<..}"]) auto
qed

lemma
  shows at_right_PInf [simp]: "at_right (\<infinity> :: ereal) = bot"
    and at_left_MInf [simp]: "at_left (-\<infinity> :: ereal) = bot"
proof -
  have "{(\<infinity>::ereal)<..} = {}" "{..<-(\<infinity>::ereal)} = {}"
    by auto
  thus "at_right (\<infinity> :: ereal) = bot" "at_left (-\<infinity> :: ereal) = bot"
    by (simp_all add: at_within_def)
qed

lemma tendsto_at_left_erealI_sequentially:
  fixes f :: "ereal \<Rightarrow> 'b::first_countable_topology"
  assumes *: "\<And>X. filterlim X (at_left c) sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
  shows "(f \<longlongrightarrow> y) (at_left c)"
proof (cases c)
  case [simp]: PInf
  have "((\<lambda>x. f (ereal x)) \<longlongrightarrow> y) at_top" using assms
    by (intro tendsto_at_topI_sequentially assms)
       (simp_all flip: ereal_tendsto_simps add: o_def filterlim_at)
  thus ?thesis
    by (simp add: at_left_PInf filterlim_filtermap)
next
  case [simp]: MInf
  thus ?thesis by auto
next
  case [simp]: (real c')
  have "((\<lambda>x. f (ereal x)) \<longlongrightarrow> y) (at_left c')"
  proof (intro tendsto_at_left_realI_sequentially assms)
    fix X assume *: "filterlim X (at_left c') sequentially"
    show "filterlim (\<lambda>n. ereal (X n)) (at_left c) sequentially"
      by (rule filterlim_compose[OF _ *])
         (simp add: sequentially_imp_eventually_within tendsto_imp_filterlim_at_left)
  qed
  thus ?thesis
    by (simp add: at_left_ereal filterlim_filtermap)
qed

lemma tendsto_at_right_realI_sequentially:
  fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
  assumes *: "\<And>X. filterlim X (at_right c) sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
  shows "(f \<longlongrightarrow> y) (at_right c)"
proof -
  obtain A where A: "decseq A" "open (A n)" "y \<in> A n" "nhds y = (INF n. principal (A n))" for n
    by (rule nhds_countable[of y]) (rule that)

  have "\<forall>m. \<exists>d>c. \<forall>x\<in>{c<..<d}. f x \<in> A m"
  proof (rule ccontr)
    assume "\<not> (\<forall>m. \<exists>d>c. \<forall>x\<in>{c<..<d}. f x \<in> A m)"
    then obtain m where **: "\<And>d. d > c \<Longrightarrow> \<exists>x\<in>{c<..<d}. f x \<notin> A m"
      by auto
    have "\<exists>X. \<forall>n. (f (X n) \<notin> A m \<and> X n > c) \<and> X (Suc n) < c + max 0 ((X n - c) / 2)"
    proof (intro dependent_nat_choice, goal_cases)
      case 1
      from **[of "c + 1"] show ?case by auto
    next
      case (2 x n)
      with **[of "c + max 0 (x - c) / 2"] show ?case by force
    qed
    then obtain X where X: "\<And>n. f (X n) \<notin> A m" "\<And>n. X n > c" "\<And>n. X (Suc n) < c + max 0 ((X n - c) / 2)"
      by auto (metis add.left_neutral half_gt_zero_iff less_diff_eq max.absorb4)
    have X_le: "X n \<le> c + (X 0 - c) / 2 ^ n" for n
    proof (induction n)
      case (Suc n)
      have "X (Suc n) < c + max 0 ((X n - c) / 2)"
        by (intro X)
      also have "\<dots> = c + (X n - c) / 2"
        using X[of n] by (simp add: field_simps max_def)
      also have "\<dots> \<le> c + (c + (X 0 - c) / 2 ^ n - c) / 2"
        by (intro add_left_mono divide_right_mono Suc diff_right_mono) auto
      also have "\<dots> = c + (X 0 - c) / 2 ^ Suc n"
        by simp
      finally show ?case by linarith
    qed auto

    have "X \<longlonglongrightarrow> c"
    proof (rule tendsto_sandwich)
      show "eventually (\<lambda>n. X n \<ge> c) sequentially"
        using X by (intro always_eventually) (auto intro!: less_imp_le)
      show "eventually (\<lambda>n. X n \<le> c + (X 0 - c) / 2 ^ n) sequentially"
        using X_le by (intro always_eventually) auto
    qed real_asymp+
    hence "filterlim X (at_right c) sequentially"
      by (rule tendsto_imp_filterlim_at_right)
         (use X in \<open>auto intro!: always_eventually less_imp_le\<close>)
    from topological_tendstoD[OF *[OF this] A(2, 3), of m] X(1) show False
      by auto
  qed

  then obtain d where d: "d m > c" "x \<in> {c<..<d m} \<Longrightarrow> f x \<in> A m" for m x
    by metis
  have ***: "at_right c = (INF S\<in>{S. open S \<and> c \<in> S}. principal (S \<inter> {c<..}))"
    by (simp add: at_within_altdef)
  from d show ?thesis
    unfolding *** A using A(1,2) by (intro filterlim_base[of _ "\<lambda>m. {..<d m}"]) auto
qed

lemma tendsto_at_right_erealI_sequentially:
  fixes f :: "ereal \<Rightarrow> 'b::first_countable_topology"
  assumes *: "\<And>X. filterlim X (at_right c) sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
  shows "(f \<longlongrightarrow> y) (at_right c)"
proof (cases c)
  case [simp]: MInf
  have "((\<lambda>x. f (-ereal x)) \<longlongrightarrow> y) at_top" using assms
   by (intro tendsto_at_topI_sequentially assms)
      (simp_all flip: uminus_ereal.simps ereal_tendsto_simps add: o_def filterlim_at)
  thus ?thesis
    by (simp add: at_right_MInf filterlim_filtermap at_top_mirror)
next
  case [simp]: PInf
  thus ?thesis by auto
next
  case [simp]: (real c')
  have "((\<lambda>x. f (ereal x)) \<longlongrightarrow> y) (at_right c')"
  proof (intro tendsto_at_right_realI_sequentially assms)
    fix X assume *: "filterlim X (at_right c') sequentially"
    show "filterlim (\<lambda>n. ereal (X n)) (at_right c) sequentially"
      by (rule filterlim_compose[OF _ *])
         (simp add: sequentially_imp_eventually_within tendsto_imp_filterlim_at_right)
  qed
  thus ?thesis
    by (simp add: at_right_ereal filterlim_filtermap)
qed

proposition analytic_continuation':
  assumes hol: "f holomorphic_on S" "g holomorphic_on S"
      and "open S" and "connected S"
      and "U \<subseteq> S" and "\<xi> \<in> S"
      and "\<xi> islimpt U"
      and fU0 [simp]: "\<And>z. z \<in> U \<Longrightarrow> f z = g z"
      and "w \<in> S"
    shows "f w = g w"
  using analytic_continuation[OF holomorphic_on_diff[OF hol] assms(3-7) _ assms(9)] assms(8)
  by simp

subsection \<open>Various facts about integrals\<close>

lemma continuous_on_imp_set_integrable_cbox:
  fixes h :: "'a :: euclidean_space \<Rightarrow> 'b :: euclidean_space"
  assumes "continuous_on (cbox a b) h"
  shows   "set_integrable lborel (cbox a b) h"
  by (simp add: assms borel_integrable_compact set_integrable_def)

subsection \<open>Uniform convergence of integrals\<close>

lemma has_absolute_integral_change_of_variables_1':
  fixes f :: "real \<Rightarrow> real" and g :: "real \<Rightarrow> real"
  assumes S: "S \<in> sets lebesgue"
    and der_g: "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)"
    and inj: "inj_on g S"
  shows "(\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) absolutely_integrable_on S \<and>
           integral S (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R f(g x)) = b
     \<longleftrightarrow> f absolutely_integrable_on (g ` S) \<and> integral (g ` S) f = b"
proof -
  have "(\<lambda>x. \<bar>g' x\<bar> *\<^sub>R vec (f(g x)) :: real ^ 1) absolutely_integrable_on S \<and>
           integral S (\<lambda>x. \<bar>g' x\<bar> *\<^sub>R vec (f(g x))) = (vec b :: real ^ 1)
         \<longleftrightarrow> (\<lambda>x. vec (f x) :: real ^ 1) absolutely_integrable_on (g ` S) \<and>
           integral (g ` S) (\<lambda>x. vec (f x)) = (vec b :: real ^ 1)"
    using assms unfolding has_real_derivative_iff_has_vector_derivative
    by (intro has_absolute_integral_change_of_variables_1 assms) auto
  thus ?thesis
    by (simp add: absolutely_integrable_on_1_iff integral_on_1_eq)
qed

lemma uniform_limit_set_lebesgue_integral:
  fixes f :: "'a \<Rightarrow> 'b :: euclidean_space \<Rightarrow> 'c :: {banach, second_countable_topology}"
  assumes "set_integrable lborel X' g"
  assumes [measurable]: "X' \<in> sets borel"
  assumes [measurable]: "\<And>y. y \<in> Y \<Longrightarrow> set_borel_measurable borel X' (f y)"
  assumes "\<And>y. y \<in> Y \<Longrightarrow> (AE t\<in>X' in lborel. norm (f y t) \<le> g t)"
  assumes "eventually (\<lambda>x. X x \<in> sets borel \<and> X x \<subseteq> X') F"
  assumes "filterlim (\<lambda>x. set_lebesgue_integral lborel (X x) g)
             (nhds (set_lebesgue_integral lborel X' g)) F"
  shows "uniform_limit Y
           (\<lambda>x y. set_lebesgue_integral lborel (X x) (f y))
           (\<lambda>y. set_lebesgue_integral lborel X' (f y)) F"
proof (rule uniform_limitI, goal_cases)
  case (1 \<epsilon>)
  have integrable_g: "set_integrable lborel U g"
    if "U \<in> sets borel" "U \<subseteq> X'" for U
    by (rule set_integrable_subset[OF assms(1)]) (use that in auto)
  have "eventually (\<lambda>x. dist (set_lebesgue_integral lborel (X x) g)
                             (set_lebesgue_integral lborel X' g) < \<epsilon>) F"
    using \<open>\<epsilon> > 0\<close> assms by (auto simp: tendsto_iff)
  from this show ?case using \<open>eventually (\<lambda>_. _ \<and> _) F\<close>
  proof eventually_elim
    case (elim x)
    hence [measurable]:"X x \<in> sets borel" and "X x \<subseteq> X'" by auto
    have integrable: "set_integrable lborel U (f y)"
      if "y \<in> Y" "U \<in> sets borel" "U \<subseteq> X'" for y U
      apply (rule set_integrable_subset)
        apply (rule set_integrable_bound[OF assms(1)])
         apply (use assms(3) that in \<open>simp add: set_borel_measurable_def\<close>)
      using assms(4)[OF \<open>y \<in> Y\<close>] apply eventually_elim apply force
      using that apply simp_all
      done
    show ?case
    proof
      fix y assume "y \<in> Y"
      have "dist (set_lebesgue_integral lborel (X x) (f y))
                 (set_lebesgue_integral lborel X' (f y)) =
            norm (set_lebesgue_integral lborel X' (f y) -
                  set_lebesgue_integral lborel (X x) (f y))"
        by (simp add: dist_norm norm_minus_commute)
      also have "set_lebesgue_integral lborel X' (f y) -
                    set_lebesgue_integral lborel (X x) (f y) =
                 set_lebesgue_integral lborel (X' - X x) (f y)"
        unfolding set_lebesgue_integral_def
        apply (subst Bochner_Integration.integral_diff [symmetric])
        unfolding set_integrable_def [symmetric]
          apply (rule integrable; (fact | simp))
         apply (rule integrable; fact)
        apply (intro Bochner_Integration.integral_cong)
         apply (use \<open>X x \<subseteq> X'\<close> in \<open>auto simp: indicator_def\<close>)
        done
      also have "norm \<dots> \<le> (\<integral>t\<in>X'-X x. norm (f y t) \<partial>lborel)"
        by (intro set_integral_norm_bound integrable) (fact | simp)+
      also have "AE t\<in>X' - X x in lborel. norm (f y t) \<le> g t"
        using assms(4)[OF \<open>y \<in> Y\<close>] by eventually_elim auto
      with \<open>y \<in> Y\<close> have "(\<integral>t\<in>X'-X x. norm (f y t) \<partial>lborel) \<le> (\<integral>t\<in>X'-X x. g t \<partial>lborel)"
        by (intro set_integral_mono_AE set_integrable_norm integrable integrable_g) auto
      also have "\<dots> = (\<integral>t\<in>X'. g t \<partial>lborel) - (\<integral>t\<in>X x. g t \<partial>lborel)"
        unfolding set_lebesgue_integral_def
        apply (subst Bochner_Integration.integral_diff [symmetric])
        unfolding set_integrable_def [symmetric]
          apply (rule integrable_g; (fact | simp))
         apply (rule integrable_g; fact)
        apply (intro Bochner_Integration.integral_cong)
         apply (use \<open>X x \<subseteq> X'\<close> in \<open>auto simp: indicator_def\<close>)
        done
      also have "\<dots> \<le> dist (\<integral>t\<in>X x. g t \<partial>lborel) (\<integral>t\<in>X'. g t \<partial>lborel)"
        by (simp add: dist_norm)
      also have "\<dots> < \<epsilon>" by fact
      finally show "dist (set_lebesgue_integral lborel (X x) (f y))
                         (set_lebesgue_integral lborel X' (f y)) < \<epsilon>" .
    qed
  qed
qed

lemma integral_dominated_convergence_at_right:
  fixes s :: "real \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}" and w :: "'a \<Rightarrow> real"
    and f :: "'a \<Rightarrow> 'b" and M and c :: real
  assumes "f \<in> borel_measurable M" "\<And>t. s t \<in> borel_measurable M" "integrable M w"
  assumes lim: "AE x in M. ((\<lambda>i. s i x) \<longlongrightarrow> f x) (at_right c)"
  assumes bound: "\<forall>\<^sub>F i in at_right c. AE x in M. norm (s i x) \<le> w x"
  shows "((\<lambda>t. integral\<^sup>L M (s t)) \<longlongrightarrow> integral\<^sup>L M f) (at_right c)"
proof (rule tendsto_at_right_realI_sequentially)
  fix X :: "nat \<Rightarrow> real" assume X: "filterlim X (at_right c) sequentially"
  from filterlim_iff[THEN iffD1, OF this, rule_format, OF bound]
  obtain N where w: "\<And>n. N \<le> n \<Longrightarrow> AE x in M. norm (s (X n) x) \<le> w x"
    by (auto simp: eventually_sequentially)

  show "(\<lambda>n. integral\<^sup>L M (s (X n))) \<longlonglongrightarrow> integral\<^sup>L M f"
  proof (rule LIMSEQ_offset, rule integral_dominated_convergence)
    show "AE x in M. norm (s (X (n + N)) x) \<le> w x" for n
      by (rule w) auto
    show "AE x in M. (\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
      using lim
    proof eventually_elim
      fix x assume "((\<lambda>i. s i x) \<longlongrightarrow> f x) (at_right c)"
      then show "(\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
        by (intro LIMSEQ_ignore_initial_segment filterlim_compose[OF _ X])
    qed
  qed fact+
qed

lemma integral_dominated_convergence_at_left:
  fixes s :: "real \<Rightarrow> 'a \<Rightarrow> 'b::{banach, second_countable_topology}" and w :: "'a \<Rightarrow> real"
    and f :: "'a \<Rightarrow> 'b" and M and c :: real
  assumes "f \<in> borel_measurable M" "\<And>t. s t \<in> borel_measurable M" "integrable M w"
  assumes lim: "AE x in M. ((\<lambda>i. s i x) \<longlongrightarrow> f x) (at_left c)"
  assumes bound: "\<forall>\<^sub>F i in at_left c. AE x in M. norm (s i x) \<le> w x"
  shows "((\<lambda>t. integral\<^sup>L M (s t)) \<longlongrightarrow> integral\<^sup>L M f) (at_left c)"
proof (rule tendsto_at_left_realI_sequentially)
  fix X :: "nat \<Rightarrow> real" assume X: "filterlim X (at_left c) sequentially"
  from filterlim_iff[THEN iffD1, OF this, rule_format, OF bound]
  obtain N where w: "\<And>n. N \<le> n \<Longrightarrow> AE x in M. norm (s (X n) x) \<le> w x"
    by (auto simp: eventually_sequentially)

  show "(\<lambda>n. integral\<^sup>L M (s (X n))) \<longlonglongrightarrow> integral\<^sup>L M f"
  proof (rule LIMSEQ_offset, rule integral_dominated_convergence)
    show "AE x in M. norm (s (X (n + N)) x) \<le> w x" for n
      by (rule w) auto
    show "AE x in M. (\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
      using lim
    proof eventually_elim
      fix x assume "((\<lambda>i. s i x) \<longlongrightarrow> f x) (at_left c)"
      then show "(\<lambda>n. s (X (n + N)) x) \<longlonglongrightarrow> f x"
        by (intro LIMSEQ_ignore_initial_segment filterlim_compose[OF _ X])
    qed
  qed fact+
qed

lemma uniform_limit_interval_integral_right:
  fixes f :: "'a \<Rightarrow> real \<Rightarrow> 'c :: {banach, second_countable_topology}"
  assumes "interval_lebesgue_integrable lborel a b g"
  assumes [measurable]: "\<And>y. y \<in> Y \<Longrightarrow> set_borel_measurable borel (einterval a b) (f y)"
  assumes "\<And>y. y \<in> Y \<Longrightarrow> (AE t\<in>einterval a b in lborel. norm (f y t) \<le> g t)"
  assumes "a < b"
  shows   "uniform_limit Y (\<lambda>b' y. LBINT t=a..b'. f y t) (\<lambda>y. LBINT t=a..b. f y t) (at_left b)"
proof (cases "Y = {}")
  case False
  have g_nonneg: "AE t\<in>einterval a b in lborel. g t \<ge> 0"
  proof -
    from \<open>Y \<noteq> {}\<close> obtain y where "y \<in> Y" by auto
    from assms(3)[OF this] show ?thesis
      by eventually_elim (auto elim: order.trans[rotated])
  qed

  have ev: "eventually (\<lambda>b'. b' \<in> {a<..<b}) (at_left b)"
    using \<open>a < b\<close> by (intro eventually_at_leftI)
  with \<open>a < b\<close> have "?thesis \<longleftrightarrow> uniform_limit Y (\<lambda>b' y. \<integral>t\<in>einterval a (min b b'). f y t \<partial>lborel)
                                  (\<lambda>y. \<integral>t\<in>einterval a b. f y t \<partial>lborel) (at_left b)"
    by (intro filterlim_cong arg_cong2[where f = uniformly_on])
       (auto simp: interval_lebesgue_integral_def fun_eq_iff min_def
             intro!: eventually_mono[OF ev])
  also have \<dots>
  proof (rule uniform_limit_set_lebesgue_integral[where g = g], goal_cases)
    show "\<forall>\<^sub>F b' in at_left b. einterval a (min b b') \<in> sets borel \<and>
                              einterval a (min b b') \<subseteq> einterval a b"
      using ev by eventually_elim (auto simp: einterval_def)
  next
    show "((\<lambda>b'. set_lebesgue_integral lborel (einterval a (min b b')) g) \<longlongrightarrow>
            set_lebesgue_integral lborel (einterval a b) g) (at_left b)"
      unfolding set_lebesgue_integral_def
    proof (intro tendsto_at_left_erealI_sequentially integral_dominated_convergence)
      have *: "set_borel_measurable borel (einterval a b) g"
        using assms(1) less_imp_le[OF \<open>a < b\<close>]
        by (simp add: interval_lebesgue_integrable_def set_integrable_def set_borel_measurable_def)
      show "(\<lambda>x. indicat_real (einterval a b) x *\<^sub>R g x) \<in> borel_measurable lborel"
        using * by (simp add: set_borel_measurable_def)
      fix X :: "nat \<Rightarrow> ereal" and n :: nat
      have "set_borel_measurable borel (einterval a (min b (X n))) g"
        by (rule set_borel_measurable_subset[OF *]) (auto simp: einterval_def)
      thus "(\<lambda>x. indicat_real (einterval a (min b (X n))) x *\<^sub>R g x) \<in> borel_measurable lborel"
        by (simp add: set_borel_measurable_def)
    next
      fix X :: "nat \<Rightarrow> ereal"
      assume X: "filterlim X (at_left b) sequentially"
      show "AE x in lborel. (\<lambda>n. indicat_real (einterval a (min b (X n))) x *\<^sub>R g x)
               \<longlonglongrightarrow> indicat_real (einterval a b) x *\<^sub>R g x"
      proof (rule AE_I2)
        fix x :: real
        have "(\<lambda>t. indicator (einterval a (min b (X t))) x :: real) \<longlonglongrightarrow>
                indicator (einterval a b) x"
        proof (cases "x \<in> einterval a b")
          case False
          hence "x \<notin> einterval a (min b (X t))"for t by (auto simp: einterval_def)
          with False show ?thesis by (simp add: indicator_def)
        next
          case True
          with \<open>a < b\<close> have "eventually (\<lambda>t. t \<in> {max a x<..<b}) (at_left b)"
            by (intro eventually_at_leftI[of "ereal x"]) (auto simp: einterval_def min_def)
          from this and X have "eventually (\<lambda>t. X t \<in> {max a x<..<b}) sequentially"
            by (rule eventually_compose_filterlim)
          hence "eventually (\<lambda>t. indicator (einterval a (min b (X t))) x = (1 :: real)) sequentially"
            by eventually_elim (use True in \<open>auto simp: indicator_def einterval_def\<close>)
          from tendsto_eventually[OF this] and True show ?thesis
            by (simp add: indicator_def)
        qed
        thus "(\<lambda>n. indicat_real (einterval a (min b (X n))) x *\<^sub>R g x)
                 \<longlonglongrightarrow> indicat_real (einterval a b) x *\<^sub>R g x" by (intro tendsto_intros)
      qed
    next
      fix X :: "nat \<Rightarrow> ereal" and n :: nat
      show "AE x in lborel. norm (indicator (einterval a (min b (X n))) x *\<^sub>R g x) \<le>
              indicator (einterval a b) x *\<^sub>R g x"
        using g_nonneg by eventually_elim (auto simp: indicator_def einterval_def)
    qed (use assms less_imp_le[OF \<open>a < b\<close>] in
         \<open>auto simp: interval_lebesgue_integrable_def set_integrable_def\<close>)
  qed (use assms in \<open>auto simp: interval_lebesgue_integrable_def\<close>)
  finally show ?thesis .
qed auto

lemma uniform_limit_interval_integral_left:
  fixes f :: "'a \<Rightarrow> real \<Rightarrow> 'c :: {banach, second_countable_topology}"
  assumes "interval_lebesgue_integrable lborel a b g"
  assumes [measurable]: "\<And>y. y \<in> Y \<Longrightarrow> set_borel_measurable borel (einterval a b) (f y)"
  assumes "\<And>y. y \<in> Y \<Longrightarrow> (AE t\<in>einterval a b in lborel. norm (f y t) \<le> g t)"
  assumes "a < b"
  shows   "uniform_limit Y (\<lambda>a' y. LBINT t=a'..b. f y t) (\<lambda>y. LBINT t=a..b. f y t) (at_right a)"
proof (cases "Y = {}")
  case False
  have g_nonneg: "AE t\<in>einterval a b in lborel. g t \<ge> 0"
  proof -
    from \<open>Y \<noteq> {}\<close> obtain y where "y \<in> Y" by auto
    from assms(3)[OF this] show ?thesis
      by eventually_elim (auto elim: order.trans[rotated])
  qed

  have ev: "eventually (\<lambda>b'. b' \<in> {a<..<b}) (at_right a)"
    using \<open>a < b\<close> by (intro eventually_at_rightI)
  with \<open>a < b\<close> have "?thesis \<longleftrightarrow> uniform_limit Y (\<lambda>a' y. \<integral>t\<in>einterval (max a a') b. f y t \<partial>lborel)
                                  (\<lambda>y. \<integral>t\<in>einterval a b. f y t \<partial>lborel) (at_right a)"
    by (intro filterlim_cong arg_cong2[where f = uniformly_on])
       (auto simp: interval_lebesgue_integral_def fun_eq_iff max_def
             intro!: eventually_mono[OF ev])
  also have \<dots>
  proof (rule uniform_limit_set_lebesgue_integral[where g = g], goal_cases)
    show "\<forall>\<^sub>F a' in at_right a. einterval (max a a') b \<in> sets borel \<and>
                              einterval (max a a') b \<subseteq> einterval a b"
      using ev by eventually_elim (auto simp: einterval_def)
  next
    show "((\<lambda>a'. set_lebesgue_integral lborel (einterval (max a a') b) g) \<longlongrightarrow>
            set_lebesgue_integral lborel (einterval a b) g) (at_right a)"
      unfolding set_lebesgue_integral_def
    proof (intro tendsto_at_right_erealI_sequentially integral_dominated_convergence)
      have *: "set_borel_measurable borel (einterval a b) g"
        using assms(1) less_imp_le[OF \<open>a < b\<close>]
        by (simp add: interval_lebesgue_integrable_def set_integrable_def set_borel_measurable_def)
      show "(\<lambda>x. indicat_real (einterval a b) x *\<^sub>R g x) \<in> borel_measurable lborel"
        using * by (simp add: set_borel_measurable_def)
      fix X :: "nat \<Rightarrow> ereal" and n :: nat
      have "set_borel_measurable borel (einterval (max a (X n)) b) g"
        by (rule set_borel_measurable_subset[OF *]) (auto simp: einterval_def)
      thus "(\<lambda>x. indicat_real (einterval (max a (X n)) b) x *\<^sub>R g x) \<in> borel_measurable lborel"
        by (simp add: set_borel_measurable_def)
    next
      fix X :: "nat \<Rightarrow> ereal"
      assume X: "filterlim X (at_right a) sequentially"
      show "AE x in lborel. (\<lambda>n. indicat_real (einterval (max a (X n)) b) x *\<^sub>R g x)
               \<longlonglongrightarrow> indicat_real (einterval a b) x *\<^sub>R g x"
      proof (rule AE_I2)
        fix x :: real
        have "(\<lambda>t. indicator (einterval (max a (X t)) b) x :: real) \<longlonglongrightarrow>
                indicator (einterval a b) x"
        proof (cases "x \<in> einterval a b")
          case False
          hence "x \<notin> einterval (max a (X t)) b"for t by (auto simp: einterval_def)
          with False show ?thesis by (simp add: indicator_def)
        next
          case True
          with \<open>a < b\<close> have "eventually (\<lambda>t. t \<in> {a<..<x}) (at_right a)"
            by (intro eventually_at_rightI[of _ "ereal x"]) (auto simp: einterval_def min_def)
          from this and X have "eventually (\<lambda>t. X t \<in> {a<..<x}) sequentially"
            by (rule eventually_compose_filterlim)
          hence "eventually (\<lambda>t. indicator (einterval (max a (X t)) b) x = (1 :: real)) sequentially"
            by eventually_elim (use True in \<open>auto simp: indicator_def einterval_def\<close>)
          from tendsto_eventually[OF this] and True show ?thesis
            by (simp add: indicator_def)
        qed
        thus "(\<lambda>n. indicat_real (einterval (max a (X n)) b) x *\<^sub>R g x)
                 \<longlonglongrightarrow> indicat_real (einterval a b) x *\<^sub>R g x" by (intro tendsto_intros)
      qed
    next
      fix X :: "nat \<Rightarrow> ereal" and n :: nat
      show "AE x in lborel. norm (indicator (einterval (max a (X n)) b) x *\<^sub>R g x) \<le>
              indicator (einterval a b) x *\<^sub>R g x"
        using g_nonneg by eventually_elim (auto simp: indicator_def einterval_def)
    qed (use assms less_imp_le[OF \<open>a < b\<close>] in
         \<open>auto simp: interval_lebesgue_integrable_def set_integrable_def\<close>)
  qed (use assms in \<open>auto simp: interval_lebesgue_integrable_def\<close>)
  finally show ?thesis .
qed auto

lemma uniform_limit_interval_integral_sequentially:
  fixes f :: "'a \<Rightarrow> real \<Rightarrow> 'c :: {banach, second_countable_topology}"
  assumes "interval_lebesgue_integrable lborel a b g"
  assumes [measurable]: "\<And>y. y \<in> Y \<Longrightarrow> set_borel_measurable borel (einterval a b) (f y)"
  assumes "\<And>y. y \<in> Y \<Longrightarrow> (AE t\<in>einterval a b in lborel. norm (f y t) \<le> g t)"
  assumes a': "filterlim a' (at_right a) sequentially"
  assumes b': "filterlim b' (at_left b) sequentially"
  assumes "a < b"
  shows   "uniform_limit Y (\<lambda>n y. LBINT t=a' n..b' n. f y t)
             (\<lambda>y. LBINT t=a..b. f y t) sequentially"
proof (cases "Y = {}")
  case False
  have g_nonneg: "AE t\<in>einterval a b in lborel. g t \<ge> 0"
  proof -
    from \<open>Y \<noteq> {}\<close> obtain y where "y \<in> Y" by auto
    from assms(3)[OF this] show ?thesis
      by eventually_elim (auto elim: order.trans[rotated])
  qed

  have ev: "eventually (\<lambda>n. a < a' n \<and> a' n < b' n \<and> b' n < b) sequentially"
  proof -
    from ereal_dense2[OF \<open>a < b\<close>] obtain t where t: "a < ereal t" "ereal t < b" by blast
    from t have "eventually (\<lambda>n. a' n \<in> {a<..<t}) sequentially"
      by (intro eventually_compose_filterlim[OF _ a'] eventually_at_rightI[of _ "ereal t"])
    moreover from t have "eventually (\<lambda>n. b' n \<in> {t<..<b}) sequentially"
      by (intro eventually_compose_filterlim[OF _ b'] eventually_at_leftI[of "ereal t"])
    ultimately show "eventually (\<lambda>n. a < a' n \<and> a' n < b' n \<and> b' n < b) sequentially"
      by eventually_elim auto
  qed

  have "?thesis \<longleftrightarrow> uniform_limit Y (\<lambda>n y. \<integral>t\<in>einterval (max a (a' n)) (min b (b' n)). f y t \<partial>lborel)
                      (\<lambda>y. \<integral>t\<in>einterval a b. f y t \<partial>lborel) sequentially" using \<open>a < b\<close>
    by (intro filterlim_cong arg_cong2[where f = uniformly_on])
       (auto simp: interval_lebesgue_integral_def fun_eq_iff min_def max_def
             intro!: eventually_mono[OF ev])
  also have \<dots>
  proof (rule uniform_limit_set_lebesgue_integral[where g = g], goal_cases)
    show "\<forall>\<^sub>F n in sequentially. einterval (max a (a' n)) (min b (b' n)) \<in> sets borel \<and>
                                einterval (max a (a' n)) (min b (b' n)) \<subseteq> einterval a b"
      using ev by eventually_elim (auto simp: einterval_def)
  next
    show "((\<lambda>n. set_lebesgue_integral lborel (einterval (max a (a' n)) (min b (b' n))) g) \<longlongrightarrow>
            set_lebesgue_integral lborel (einterval a b) g) sequentially"
      unfolding set_lebesgue_integral_def
    proof (intro integral_dominated_convergence)
      have *: "set_borel_measurable borel (einterval a b) g"
        using assms(1) less_imp_le[OF \<open>a < b\<close>]
        by (simp add: interval_lebesgue_integrable_def set_integrable_def set_borel_measurable_def)
      show "(\<lambda>x. indicat_real (einterval a b) x *\<^sub>R g x) \<in> borel_measurable lborel"
        using * by (simp add: set_borel_measurable_def)
      fix n :: nat
      have "set_borel_measurable borel (einterval (max a (a' n)) (min b (b' n))) g"
        by (rule set_borel_measurable_subset[OF *]) (auto simp: einterval_def)
      thus "(\<lambda>x. indicat_real (einterval (max a (a' n)) (min b (b' n))) x *\<^sub>R g x) \<in> borel_measurable lborel"
        by (simp add: set_borel_measurable_def)
    next
      show "AE x in lborel. (\<lambda>n. indicat_real (einterval (max a (a' n)) (min b (b' n))) x *\<^sub>R g x)
               \<longlonglongrightarrow> indicat_real (einterval a b) x *\<^sub>R g x"
      proof (rule AE_I2)
        fix x :: real
        have "(\<lambda>t. indicator (einterval (max a (a' t)) (min b (b' t))) x :: real) \<longlonglongrightarrow>
                indicator (einterval a b) x"
        proof (cases "x \<in> einterval a b")
          case False
          hence "x \<notin> einterval (max a (a' t)) (min b (b' t))"for t
            by (auto simp: einterval_def)
          with False show ?thesis by (simp add: indicator_def)
        next
          case True
          with \<open>a < b\<close> have "eventually (\<lambda>t. t \<in> {a<..<x}) (at_right a)"
            by (intro eventually_at_rightI[of _ "ereal x"]) (auto simp: einterval_def min_def)

          have "eventually (\<lambda>n. x \<in> {a' n<..<b' n}) sequentially"
          proof -
            have "eventually (\<lambda>n. a' n \<in> {a<..<x}) sequentially" using True
              by (intro eventually_compose_filterlim[OF _ a'] eventually_at_rightI[of _ "ereal x"])
                 (auto simp: einterval_def)
            moreover have "eventually (\<lambda>n. b' n \<in> {x<..<b}) sequentially" using True
              by (intro eventually_compose_filterlim[OF _ b'] eventually_at_leftI[of "ereal x"])
                 (auto simp: einterval_def)
            ultimately show "eventually (\<lambda>n. x \<in> {a' n<..<b' n}) sequentially"
              by eventually_elim auto
          qed
          hence "eventually (\<lambda>t. indicator (einterval (max a (a' t)) (min b (b' t))) x = (1 :: real)) sequentially"
            by eventually_elim (use True in \<open>auto simp: indicator_def einterval_def\<close>)
          from tendsto_eventually[OF this] and True show ?thesis
            by (simp add: indicator_def)
        qed
        thus "(\<lambda>n. indicat_real (einterval (max a (a' n)) (min b (b' n))) x *\<^sub>R g x)
                 \<longlonglongrightarrow> indicat_real (einterval a b) x *\<^sub>R g x" by (intro tendsto_intros)
      qed
    next
      fix X :: "nat \<Rightarrow> ereal" and n :: nat
      show "AE x in lborel. norm (indicator (einterval (max a (a' n)) (min b (b' n))) x *\<^sub>R g x) \<le>
              indicator (einterval a b) x *\<^sub>R g x"
        using g_nonneg by eventually_elim (auto simp: indicator_def einterval_def)
    qed (use assms less_imp_le[OF \<open>a < b\<close>] in
         \<open>auto simp: interval_lebesgue_integrable_def set_integrable_def\<close>)
  qed (use assms in \<open>auto simp: interval_lebesgue_integrable_def\<close>)
  finally show ?thesis .
qed auto

lemma interval_lebesgue_integrable_combine:
  assumes "interval_lebesgue_integrable lborel A B f"
  assumes "interval_lebesgue_integrable lborel B C f"
  assumes "set_borel_measurable borel (einterval A C) f"
  assumes "A \<le> B" "B \<le> C"
  shows   "interval_lebesgue_integrable lborel A C f"
proof -
  have meas: "set_borel_measurable borel (einterval A B \<union> einterval B C) f"
    by (rule set_borel_measurable_subset[OF assms(3)]) (use assms in \<open>auto simp: einterval_def\<close>)
  have "set_integrable lborel (einterval A B \<union> einterval B C) f"
    using assms by (intro set_integrable_Un) (auto simp: interval_lebesgue_integrable_def)
  also have "?this \<longleftrightarrow> set_integrable lborel (einterval A C) f"
  proof (cases "B \<in> {\<infinity>, -\<infinity>}")
    case True
    with assms have "einterval A B \<union> einterval B C = einterval A C"
      by (auto simp: einterval_def)
    thus ?thesis by simp
  next
    case False
    then obtain B' where [simp]: "B = ereal B'"
      by (cases B) auto
    have "indicator (einterval A C) x = (indicator (einterval A B \<union> einterval B C) x :: real)"
      if "x \<noteq> B'" for x using assms(4,5) that
      by (cases A; cases C) (auto simp: einterval_def indicator_def)
    hence "{x \<in> space lborel. indicat_real (einterval A B \<union> einterval B C) x *\<^sub>R f x \<noteq>
              indicat_real (einterval A C) x *\<^sub>R f x} \<subseteq> {B'}" by force
    thus ?thesis unfolding set_integrable_def using meas assms
      by (intro integrable_cong_AE AE_I[of _ _ "{B'}"])
         (simp_all add: set_borel_measurable_def)
  qed
  also have "\<dots> \<longleftrightarrow> ?thesis"
    using order.trans[OF assms(4,5)] by (simp add: interval_lebesgue_integrable_def)
  finally show ?thesis .
qed

lemma interval_lebesgue_integrable_bigo_right:
  fixes A B :: real
  fixes f :: "real \<Rightarrow> real"
  assumes "f \<in> O[at_left B](g)"
  assumes cont: "continuous_on {A..<B} f"
  assumes meas: "set_borel_measurable borel {A<..<B} f"
  assumes "interval_lebesgue_integrable lborel A B g"
  assumes "A < B"
  shows   "interval_lebesgue_integrable lborel A B f"
proof -
  from assms(1) obtain c where c: "c > 0" "eventually (\<lambda>x. norm (f x) \<le> c * norm (g x)) (at_left B)"
    by (elim landau_o.bigE)
  then obtain B' where B': "B' < B" "\<And>x. x \<in> {B'<..<B} \<Longrightarrow> norm (f x) \<le> c * norm (g x)"
    using \<open>A < B\<close> by (auto simp: Topological_Spaces.eventually_at_left[of A])

  show ?thesis
  proof (rule interval_lebesgue_integrable_combine)
    show "interval_lebesgue_integrable lborel A (max A B') f"
      using B' assms
      by (intro interval_integrable_continuous_on continuous_on_subset[OF cont]) auto
    show "set_borel_measurable borel (einterval (ereal A) (ereal B)) f"
      using assms by simp
    have meas': "set_borel_measurable borel {max A B'<..<B} f"
      by (rule set_borel_measurable_subset[OF meas]) auto
    have "set_integrable lborel {max A B'<..<B} f"
    proof (rule set_integrable_bound[OF _ _ AE_I2[OF impI]])
      have "set_integrable lborel {A<..<B} (\<lambda>x. c * g x)"
        using assms by (simp add: interval_lebesgue_integrable_def)
      thus "set_integrable lborel {max A B'<..<B} (\<lambda>x. c * g x)"
        by (rule set_integrable_subset) auto
    next
      fix x assume "x \<in> {max A B'<..<B}"
      hence "norm (f x) \<le> c * norm (g x)"
        by (intro B') auto
      also have "\<dots> \<le> norm (c * g x)"
        unfolding norm_mult by (intro mult_right_mono) auto
      finally show  "norm (f x) \<le> norm (c * g x)" .
    qed (use meas' in \<open>simp_all add: set_borel_measurable_def\<close>)
    thus "interval_lebesgue_integrable lborel (ereal (max A B')) (ereal B) f"
      unfolding interval_lebesgue_integrable_def einterval_eq_Icc using \<open>B' < B\<close> assms by simp
  qed (use B' assms in auto)
qed

lemma interval_lebesgue_integrable_bigo_left:
  fixes A B :: real
  fixes f :: "real \<Rightarrow> real"
  assumes "f \<in> O[at_right A](g)"
  assumes cont: "continuous_on {A<..B} f"
  assumes meas: "set_borel_measurable borel {A<..<B} f"
  assumes "interval_lebesgue_integrable lborel A B g"
  assumes "A < B"
  shows   "interval_lebesgue_integrable lborel A B f"
proof -
  from assms(1) obtain c where c: "c > 0" "eventually (\<lambda>x. norm (f x) \<le> c * norm (g x)) (at_right A)"
    by (elim landau_o.bigE)
  then obtain A' where A': "A' > A" "\<And>x. x \<in> {A<..<A'} \<Longrightarrow> norm (f x) \<le> c * norm (g x)"
    using \<open>A < B\<close> by (auto simp: Topological_Spaces.eventually_at_right[of A])

  show ?thesis
  proof (rule interval_lebesgue_integrable_combine)
    show "interval_lebesgue_integrable lborel (min B A') B f"
      using A' assms
      by (intro interval_integrable_continuous_on continuous_on_subset[OF cont]) auto
    show "set_borel_measurable borel (einterval (ereal A) (ereal B)) f"
      using assms by simp
    have meas': "set_borel_measurable borel {A<..<min B A'} f"
      by (rule set_borel_measurable_subset[OF meas]) auto
    have "set_integrable lborel {A<..<min B A'} f"
    proof (rule set_integrable_bound[OF _ _ AE_I2[OF impI]])
      have "set_integrable lborel {A<..<B} (\<lambda>x. c * g x)"
        using assms by (simp add: interval_lebesgue_integrable_def)
      thus "set_integrable lborel {A<..<min B A'} (\<lambda>x. c * g x)"
        by (rule set_integrable_subset) auto
    next
      fix x assume "x \<in> {A<..<min B A'}"
      hence "norm (f x) \<le> c * norm (g x)"
        by (intro A') auto
      also have "\<dots> \<le> norm (c * g x)"
        unfolding norm_mult by (intro mult_right_mono) auto
      finally show  "norm (f x) \<le> norm (c * g x)" .
    qed (use meas' in \<open>simp_all add: set_borel_measurable_def\<close>)
    thus "interval_lebesgue_integrable lborel (ereal A) (ereal (min B A')) f"
      unfolding interval_lebesgue_integrable_def einterval_eq_Icc using \<open>A' > A\<close> assms by simp
  qed (use A' assms in auto)
qed

subsection \<open>Other material\<close>

(* TODO: Library *)
lemma summable_comparison_test_bigo:
  fixes f :: "nat \<Rightarrow> real"
  assumes "summable (\<lambda>n. norm (g n))" "f \<in> O(g)"
  shows   "summable f"
proof -
  from \<open>f \<in> O(g)\<close> obtain C where C: "eventually (\<lambda>x. norm (f x) \<le> C * norm (g x)) at_top"
    by (auto elim: landau_o.bigE)
  thus ?thesis
    by (rule summable_comparison_test_ev) (insert assms, auto intro: summable_mult)
qed

lemma fps_expansion_cong:
  assumes "eventually (\<lambda>x. g x = h x) (nhds x)"
  shows   "fps_expansion g x = fps_expansion h x"
proof -
  have "(deriv ^^ n) g x = (deriv ^^ n) h x" for n
    by (intro higher_deriv_cong_ev assms refl)
  thus ?thesis by (simp add: fps_expansion_def)
qed

lemma fps_expansion_eq_zero_iff:
  assumes "g holomorphic_on ball z r" "r > 0"
  shows   "fps_expansion g z = 0 \<longleftrightarrow> (\<forall>z\<in>ball z r. g z = 0)"
proof
  assume *: "\<forall>z\<in>ball z r. g z = 0"
  have "eventually (\<lambda>w. w \<in> ball z r) (nhds z)"
    using assms by (intro eventually_nhds_in_open) auto
  hence "eventually (\<lambda>z. g z = 0) (nhds z)"
    by eventually_elim (use * in auto)
  hence "fps_expansion g z = fps_expansion (\<lambda>_. 0) z"
    by (intro fps_expansion_cong)
  thus "fps_expansion g z = 0"
    by (simp add: fps_expansion_def fps_zero_def)
next
  assume *: "fps_expansion g z = 0"
  have "g w = 0" if "w \<in> ball z r" for w
    by (rule holomorphic_fun_eq_0_on_ball[OF assms(1) that])
       (use * in \<open>auto simp: fps_expansion_def fps_eq_iff\<close>)
  thus "\<forall>w\<in>ball z r. g w = 0" by blast
qed

lemma fds_nth_higher_deriv:
  "fds_nth ((fds_deriv ^^ k) F) = (\<lambda>n. (-1) ^ k * of_real (ln n) ^ k * fds_nth F n)"
  by (induction k) (auto simp: fds_nth_deriv fun_eq_iff simp flip: scaleR_conv_of_real)

lemma binomial_n_n_minus_one [simp]: "n > 0 \<Longrightarrow> n choose (n - Suc 0) = n"
  by (cases n) auto

lemma has_field_derivative_complex_powr_right:
  "w \<noteq> 0 \<Longrightarrow> ((\<lambda>z. w powr z) has_field_derivative Ln w * w powr z) (at z within A)"
  by (rule DERIV_subset, rule has_field_derivative_powr_right) auto

lemmas has_field_derivative_complex_powr_right' =
  has_field_derivative_complex_powr_right[THEN DERIV_chain2]

end


(*  Title:      HOL/HOLCF/IOA/ex/TrivEx.thy
    Author:     Olaf Müller
*)

section {* Trivial Abstraction Example *}

theory TrivEx
imports Abstraction
begin

datatype action = INC

definition
  C_asig :: "action signature" where
  "C_asig = ({},{INC},{})"
definition
  C_trans :: "(action, nat)transition set" where
  "C_trans =
   {tr. let s = fst(tr);
            t = snd(snd(tr))
        in case fst(snd(tr))
        of
        INC       => t = Suc(s)}"
definition
  C_ioa :: "(action, nat)ioa" where
  "C_ioa = (C_asig, {0}, C_trans,{},{})"

definition
  A_asig :: "action signature" where
  "A_asig = ({},{INC},{})"
definition
  A_trans :: "(action, bool)transition set" where
  "A_trans =
   {tr. let s = fst(tr);
            t = snd(snd(tr))
        in case fst(snd(tr))
        of
        INC       => t = True}"
definition
  A_ioa :: "(action, bool)ioa" where
  "A_ioa = (A_asig, {False}, A_trans,{},{})"

definition
  h_abs :: "nat => bool" where
  "h_abs n = (n~=0)"

axiomatization where
  MC_result: "validIOA A_ioa (<>[] <%(b,a,c). b>)"

lemma h_abs_is_abstraction:
  "is_abstraction h_abs C_ioa A_ioa"
apply (unfold is_abstraction_def)
apply (rule conjI)
txt {* start states *}
apply (simp (no_asm) add: h_abs_def starts_of_def C_ioa_def A_ioa_def)
txt {* step case *}
apply (rule allI)+
apply (rule imp_conj_lemma)
apply (simp (no_asm) add: trans_of_def C_ioa_def A_ioa_def C_trans_def A_trans_def)
apply (induct_tac "a")
apply (simp add: h_abs_def)
done

lemma TrivEx_abstraction: "validIOA C_ioa (<>[] <%(n,a,m). n~=0>)"
apply (rule AbsRuleT1)
apply (rule h_abs_is_abstraction)
apply (rule MC_result)
apply abstraction
apply (simp add: h_abs_def)
done

end