section \<open>Transferring Theorems Between Graph Libraries\<close>
theory Graph_Library_Adaptor
  imports TA_Library.Graphs More_Graph_Theory
begin

no_notation funcset (infixr "\<rightarrow>" 60)

subsection \<open>Miscellaneous\<close>

lemma (in -) pair_in_pair_set_iff:
  "(a, b) \<in> {(x, y). P x y} \<longleftrightarrow> P a b"
  by auto

subsection \<open>From \<open>Graph_Theory\<close> to \<open>Graphs\<close>\<close>

context pre_digraph
begin

definition "E \<equiv> \<lambda>x y. (x, y) \<in> arcs_ends G"

interpretation Graph_Defs E .

lemma dominates_iff:
  "u \<rightarrow>\<^bsub>G\<^esub> v \<longleftrightarrow> E u v"
  unfolding E_def by simp

lemma reachable1_iff:
  "u \<rightarrow>\<^sup>+\<^bsub>G\<^esub> v \<longleftrightarrow> reaches1 u v"
  unfolding tranclp_unfold E_def by simp

end

context wf_digraph
begin

interpretation Graph_Defs E .

lemma reachable_iff:
  "u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v \<longleftrightarrow> reaches u v" if "u \<in> verts G"
  apply (rule iffI)
  subgoal premises prems
    using prems unfolding reachable_def by induction (auto simp: dominates_iff)
  subgoal premises prems
    using prems by induction
      (auto 4 3 simp: that dominates_iff[symmetric] reachable_def intro: rtrancl_on_into_rtrancl_on)
  done

lemma vwalk_iff:
  "vwalk (u # xs) G \<longleftrightarrow> steps (u # xs)" if "u \<in> verts G"
  apply (rule iffI)
   apply (induction rule: vwalk_induct; auto simp: dominates_iff)
  subgoal premises prems
    using prems that by (induction "u # xs" arbitrary: u xs; simp add: adj_in_verts(2) dominates_iff)
  done

lemmas graph_convs1 = reachable_iff reachable1_iff vwalk_iff

end

context dag
begin

sublocale graph: DAG E
  by standard (auto simp: graph_convs1 intro: acyclic)

\<comment> \<open>Transferring a theorem: every DAG has a topological numbering\<close>
lemma topological_numbering:
  fixes S assumes "finite S"
  shows "\<exists>f :: _ \<Rightarrow> nat. inj_on f S \<and> (\<forall>x \<in> S. \<forall>y \<in> S. x \<rightarrow> y \<longrightarrow> f x < f y)"
  using graph.topological_numbering[OF assms] unfolding dominates_iff .

end

sublocale fin_digraph \<subseteq> graph: Finite_Graph E
  by standard (auto intro!: finite_subset[OF _ finite_verts] simp: E_def Graph_Defs.vertices_def)

sublocale fin_dag \<subseteq> graph: Finite_DAG E ..

subsection \<open>From \<open>Graphs\<close> to \<open>Graph_Theory\<close>\<close>

context Graph_Defs
begin

definition "G = \<lparr>verts = UNIV, arcs = {(a, b). E a b}, tail = fst, head = snd\<rparr>"

definition "G\<^sub>p = \<lparr>pverts = UNIV, parcs = {(a, b). E a b}\<rparr>"

lemma G_pair_conv:
  "with_proj G\<^sub>p = G"
  unfolding G\<^sub>p_def G_def with_proj_def by simp

sublocale digraph: nomulti_digraph G
  by standard (auto simp: G_def arc_to_ends_def)

sublocale pdigraph: pair_wf_digraph G\<^sub>p
  using G_pair_conv digraph.wf_digraph_axioms wf_digraph_wp_iff by metis

lemma arc_to_ends_eq[simp]:
  "arc_to_ends G = id"
  by (auto simp add: G_def arc_to_ends_def)

lemma arcs_ends_eq[simp]:
  "arcs_ends G = {(a, b). E a b}"
  unfolding arcs_ends_def arc_to_ends_eq by (simp add: G_def)

lemma dominates_iff[simp]:
  "u \<rightarrow>\<^bsub>G\<^esub> v \<longleftrightarrow> E u v"
  by simp

lemma verts_eq[simp]:
  "verts G = UNIV"
  unfolding G_def by simp

lemma reachable_iff:
  "u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v \<longleftrightarrow> u \<rightarrow>* v"
  apply (simp only: reachable_def arcs_ends_eq verts_eq)
  apply (rule iffI)
  subgoal premises prems
    using prems by induction auto
  subgoal premises prems
    using prems by induction (auto intro: rtrancl_on_into_rtrancl_on)
  done

lemma reachable1_iff:
  "u \<rightarrow>\<^sup>+\<^bsub>G\<^esub> v \<longleftrightarrow> u \<rightarrow>\<^sup>+ v"
  by (simp only: arcs_ends_eq pair_in_pair_set_iff tranclp_unfold)

lemma vwalk_iff:
  "vwalk xs G \<longleftrightarrow> steps xs"
  apply (rule iffI)
   apply (induction rule: vwalk_induct; auto)
  apply (induction rule: steps.induct; auto)
  done

lemmas graph_convs2 = reachable_iff reachable1_iff vwalk_iff

\<comment> \<open>Transferring a theorem (@{thm digraph.reachable_vpath_conv}):\<close>
lemma reachable_path_conv:
  "u \<rightarrow>* v \<longleftrightarrow> (\<exists>p. steps p \<and> distinct p \<and> hd p = u \<and> last p = v)"
  unfolding graph_convs2[symmetric] by (simp add: digraph.reachable_vpath_conv vpath_def)

end

context Subgraph_Defs
begin

definition "G' = \<lparr>verts = UNIV, arcs = {(a, b). E' a b}, tail = fst, head = snd\<rparr>"

definition "G\<^sub>p' = \<lparr>pverts = UNIV, parcs = {(a, b). E' a b}\<rparr>"

lemma G'_pair_conv:
  "with_proj G\<^sub>p' = G'"
  unfolding G\<^sub>p'_def G'_def with_proj_def by simp

sublocale digraph_sub: wf_digraph G'
  unfolding wf_digraph_def G'_def by simp

sublocale pdigraph_sub: pair_wf_digraph G\<^sub>p'
  using G'_pair_conv digraph_sub.wf_digraph_axioms wf_digraph_wp_iff by metis

lemma verts_eq[simp]:
  "verts G' = UNIV"
  unfolding G'_def by simp

end

context Subgraph
begin

lemma subgraph:
  "subgraph G' G.G"
  unfolding subgraph_def
  apply (intro conjI)
  subgoal
    by simp
  subgoal
    by (auto simp: G.G_def G'_def)
  subgoal
    by (simp add: G.digraph.wf_digraph_axioms)
  subgoal
    by (simp add: digraph_sub.wf_digraph_axioms)
  subgoal
    by (simp add: compatible_def G.G_def G'_def)
  done

lemma spanning:
  "spanning G' G.G"
  unfolding spanning_def by (simp add: subgraph)

lemma G'_eq:
  "G'.G = G'"
  by (auto simp: Graph_Defs.G_def G'_def)

lemmas subgraph_convs = G'.graph_convs2[unfolded G'_eq]

end

context Subgraph_Node_Defs
begin

\<comment> \<open>Node-induced subgraph. Compare with @{term G'}.\<close>
definition "G\<^sub>n = \<lparr>verts = {x. V x}, arcs = {(a, b). E' a b}, tail = fst, head = snd\<rparr>"

sublocale digraph_nodes: wf_digraph G\<^sub>n
  unfolding wf_digraph_def G\<^sub>n_def E'_def by simp

lemma verts_eq[simp]:
  "verts G\<^sub>n = {x. V x}"
  unfolding G\<^sub>n_def by simp

lemma arcs_eq[simp]:
  "arcs G\<^sub>n = arcs G'"
  unfolding G\<^sub>n_def G'_def by simp

lemma subgraph_dominatesI:
  "a \<rightarrow>\<^bsub>G\<^sub>n\<^esub> b" if "a \<rightarrow> b" "V a" "V b"
  using that by (intro digraph_nodes.dominatesI) (auto simp: G\<^sub>n_def arc_to_ends_def E'_def)

lemma arcs_ends_eq:
  "arcs_ends G\<^sub>n = arcs_ends G'"
  unfolding G\<^sub>n_def G'_def E'_def arcs_ends_def arc_to_ends_def by simp

lemma subgraph_nodes':
  "subgraph G\<^sub>n G'"
  unfolding subgraph_def
  apply (intro conjI)
  subgoal
    by simp
  subgoal
    by simp
  subgoal
    by (simp add: digraph_sub.wf_digraph_axioms)
  subgoal
    by (simp add: digraph_nodes.wf_digraph_axioms)
  subgoal
    by (simp add: compatible_def G'_def G\<^sub>n_def)
  done

lemma subgraph_nodes:
  "subgraph G\<^sub>n G"
  by (rule subgraph_nodes' subgraph subgraph_trans)+

lemma induced_subgraph:
  "induced_subgraph G\<^sub>n G"
  unfolding induced_subgraph_def by (intro conjI subgraph_nodes) (auto simp: G\<^sub>n_def G_def E'_def)

\<comment> \<open>The notions of walks in the two versions of node-induced subgraphs are not equivalent
for empty paths, thus this is the only valid ``standard'' conversion theorem between paths:\<close>
lemma reachable1_iff:
  "u \<rightarrow>\<^sup>+\<^bsub>G\<^sub>n\<^esub> v \<longleftrightarrow> u \<rightarrow>\<^sup>+\<^bsub>G'\<^esub> v"
  unfolding arcs_ends_eq ..

lemma dominates_iff:
  "u \<rightarrow>\<^bsub>G\<^sub>n\<^esub> v \<longleftrightarrow> E' u v"
  unfolding G\<^sub>n_def arcs_ends_def arc_to_ends_def E'_def by simp

lemma subgraph_vwalk_iff:
  "vwalk (v # vs) G\<^sub>n \<longleftrightarrow> G'.steps (v # vs)" if "V v"
  apply (rule iffI)
   apply (induction rule: vwalk_induct; auto simp: dominates_iff; fail)
  subgoal premises prems
    using prems that
    by (induction "v # vs" arbitrary: v vs rule: G'.steps.induct; auto simp: dominates_iff E'_def)
  done

lemma subgraph_reaches_iff:
  "u \<rightarrow>\<^sup>*\<^bsub>G\<^sub>n\<^esub> v \<longleftrightarrow> G'.reaches u v" if "V u"
  by (simp add: that G'.reaches_steps_iff2 digraph_nodes.reachable_vwalk_conv2 subgraph_vwalk_iff)

lemma subgraph_reaches1_iff:
  "u \<rightarrow>\<^sup>+\<^bsub>G\<^sub>n\<^esub> v \<longleftrightarrow> G'.reaches1 u v"
  unfolding reachable1_iff subgraph_convs ..

end

context Graph_Invariant
begin

lemma reachable_iff:
  "u \<rightarrow>\<^sup>*\<^bsub>G\<^sub>n\<^esub> v \<longleftrightarrow> u \<rightarrow>\<^sup>*\<^bsub>G\<^esub> v" if "P u"
  using that by (simp add: graph_convs2 subgraph_reaches_iff invariant_reaches_iff)

lemma reachable1_iff:
  "u \<rightarrow>\<^sup>+\<^bsub>G\<^sub>n\<^esub> v \<longleftrightarrow> u \<rightarrow>\<^sup>+\<^bsub>G\<^esub> v" if "P u"
  unfolding subgraph_reaches1_iff invariant_reaches1_iff[OF that] graph_convs2 ..

lemma vwalk_iff:
  "vwalk (u # vs) G\<^sub>n \<longleftrightarrow> vwalk (u # vs) G" if "P u"
  using that by (simp add: subgraph_vwalk_iff invariant_steps_iff graph_convs2)

end

subsection \<open>Application: Topological Numberings on the SCCs of a Digraph\<close>

context fin_digraph
begin

interpretation scc_digraph: fin_dag scc_graph
  by (rule scc_digraphI)

definition
  "scc_num \<equiv> SOME f :: (_ \<Rightarrow> nat).
    inj_on f sccs_verts \<and> (\<forall>x\<in>sccs_verts. \<forall>y\<in>sccs_verts. x \<rightarrow>\<^bsub>scc_graph\<^esub> y \<longrightarrow> f x < f y)"

lemma
  shows scc_num_inj: "inj_on scc_num sccs_verts" (is ?thesis1)
    and scc_num_topological:
    "\<forall>x\<in>sccs_verts. \<forall>y\<in>sccs_verts. x \<rightarrow>\<^bsub>scc_graph\<^esub> y \<longrightarrow> scc_num x < scc_num y" (is ?thesis2)
proof -
  from scc_digraph.topological_numbering[OF finite_sccs_verts] have "?thesis1 \<and> ?thesis2"
    unfolding scc_num_def by (rule someI_ex)
  then show ?thesis1 and ?thesis2
    by auto
qed

end

context Finite_Graph
begin

interpretation Graph_Invariant
  where E = E and P = "\<lambda>x. x \<in> vertices"
  by standard (auto simp: vertices_def)

interpretation digraph_nodes: fin_digraph G\<^sub>n
  apply standard
  subgoal finite_verts
    by (simp add: Subgraph_Node_Defs.G\<^sub>n_def finite_graph)
  subgoal
    by (rule finite_subset[where B = "verts G\<^sub>n \<times> verts G\<^sub>n"])
       (auto simp: G'_def E'_def G\<^sub>n_def finite_graph)
  done

definition
  "is_max_scc S \<equiv>
  S \<subseteq> vertices \<and> S \<noteq> {} \<and> (\<forall>u \<in> S. \<forall>v \<in> S. u \<rightarrow>* v) \<and> (\<forall>u \<in> S. \<forall>v. v \<notin> S \<longrightarrow> \<not>u \<rightarrow>* v \<or> \<not>v \<rightarrow>* u)"

lemma is_max_scc_iff:
  "is_max_scc S \<longleftrightarrow> S \<in> digraph_nodes.sccs_verts"
proof (rule iffI)
  assume "is_max_scc S"
  then show "S \<in> digraph_nodes.sccs_verts"
    unfolding is_max_scc_def digraph_nodes.sccs_verts_def
    by (clarsimp, safe) (auto simp: reachable_iff graph_convs2 invariant_reaches)
next
  assume "S \<in> digraph_nodes.sccs_verts"
  then have "S \<subseteq> vertices"
    using digraph_nodes.sccs_verts_subsets by auto
  then show "is_max_scc S"
    using \<open>S \<in> _\<close> unfolding is_max_scc_def digraph_nodes.sccs_verts_def
    by (auto simp: Graph_Defs.reachable_iff in_mono invariant_reaches reachable_iff)
qed

lemma max_sccI:
  assumes "a \<in> vertices"
  obtains A where "is_max_scc A" "a \<in> A"
  subgoal premises that
    using assms
    by (intro that[of "{b. a \<rightarrow>* b \<and> b \<rightarrow>* a}"])
       (auto intro: invariant_reaches simp: is_max_scc_def, (meson rtranclp_trans)+)
       \<comment> \<open>XXX: graph automation\<close>
  done

lemma is_max_scc_disjoint:
  assumes "is_max_scc V" "is_max_scc W" "V \<noteq> W"
  shows "V \<inter> W = {}"
  using assms unfolding is_max_scc_iff by (rule digraph_nodes.sccs_verts_disjoint)

definition
  "edge V W \<equiv> \<exists>a \<in> V. \<exists>b \<in> W. V \<noteq> W \<and> E a b"

definition
  "scc_num \<equiv> SOME f :: (_ \<Rightarrow> nat).
    inj_on f {V. is_max_scc V} \<and> (\<forall>V. \<forall>W. is_max_scc V \<and> is_max_scc W \<and> edge V W \<longrightarrow> f V < f W)"

interpretation scc_digraph: fin_dag digraph_nodes.scc_graph
  by (rule digraph_nodes.scc_digraphI)

lemma edge_iff:
  "edge x y \<longleftrightarrow> x \<rightarrow>\<^bsub>digraph_nodes.scc_graph\<^esub> y"
  if "x \<in> digraph_nodes.sccs_verts" "y \<in> digraph_nodes.sccs_verts"
  unfolding edge_def
  apply rule
  subgoal
    using that unfolding digraph_nodes.scc_graph_def arcs_ends_def arc_to_ends_def
    unfolding G\<^sub>n_def G'_def E'_def by (auto simp add: vertices_def)
  using subgraph_nodes
  by (auto 4 3 dest!: digraph.adj_mono[rotated] elim!: digraph_nodes.scc_graph_edgeE)

lemma
  shows scc_num_inj: "inj_on scc_num {V. is_max_scc V}" (is ?thesis1)
    and scc_num_topological:
    "\<forall>V. \<forall>W. is_max_scc V \<and> is_max_scc W \<and> edge V W \<longrightarrow> scc_num V < scc_num W" (is ?thesis2)
proof -
  let ?P = "\<lambda>f :: (_ \<Rightarrow> nat).
    inj_on f {V. is_max_scc V} \<and> (\<forall>V. \<forall>W. is_max_scc V \<and> is_max_scc W \<and> edge V W \<longrightarrow> f V < f W)"
  from digraph_nodes.scc_num_inj digraph_nodes.scc_num_topological have "?thesis1 \<and> ?thesis2"
    unfolding scc_num_def by - (rule someI[where P = ?P], auto simp: is_max_scc_iff edge_iff)
  then show ?thesis1 and ?thesis2
    by auto
qed

end

end


section \<open>Weak Transition Systems\<close>

theory "Transition_Systems-Weak_Transition_Systems"
imports
  "Transition_Systems-Transition_Systems"
begin

locale weak_transition_system =
  transition_system \<open>transition\<close>
  for transition :: "'a \<Rightarrow> 'p relation" (\<open>'(\<rightarrow>\<lparr>_\<rparr>')\<close>) +
  fixes silent :: 'a (\<open>\<tau>\<close>)
begin

subsection \<open>Weak Transitions\<close>

definition weak_transition :: "'a \<Rightarrow> 'p relation" (\<open>'(\<Rightarrow>\<lparr>_\<rparr>')\<close>) where
  [simp]: "(\<Rightarrow>\<lparr>\<alpha>\<rparr>) = (if \<alpha> = \<tau> then (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* else (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>*)"

abbreviation weak_transition_std :: "'p \<Rightarrow> 'a \<Rightarrow> 'p \<Rightarrow> bool" (\<open>(_ \<Rightarrow>\<lparr>_\<rparr>/ _)\<close> [51, 0, 51] 50) where
  "p \<Rightarrow>\<lparr>\<alpha>\<rparr> q \<equiv> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) p q"

lemma transition_in_weak_transition_rule:
  assumes "p \<rightarrow>\<lparr>\<alpha>\<rparr> q"
  shows "p \<Rightarrow>\<lparr>\<alpha>\<rparr> q"
  using assms
  by auto

subsection \<open>The Weak System\<close>

sublocale weak: transition_system \<open>weak_transition\<close> .

notation weak.simulation (\<open>weak'_sim\<close>)
notation weak.bisimulation (\<open>weak'_bisim\<close>)
notation weak.bisimilarity (infix \<open>\<approx>\<close> 50)
notation weak.constant_bisimilarity (\<open>[\<approx>]\<close>)
notation weak.simulation_up_to (\<open>weak'_sim\<^bsub>_\<^esub>\<close>)
notation weak.bisimulation_up_to (\<open>weak'_bisim\<^bsub>_\<^esub>\<close>)

lemma mutual_silent_weak_transitions_up_to_bisimilarity:
  assumes "p \<Rightarrow>\<lparr>\<tau>\<rparr> p'" and "p' \<approx> q" and "q \<Rightarrow>\<lparr>\<tau>\<rparr> q'" and "q' \<approx> p"
  shows "p \<approx> q"
using assms
proof (coinduction arbitrary: p q p' q' rule: weak.symmetric_up_to_rule [where \<F> = "[\<approx>]"])
  case (simulation \<alpha> s p q p' q')
  from \<open>p \<Rightarrow>\<lparr>\<alpha>\<rparr> s\<close> and \<open>q' \<approx> p\<close> obtain t where "q' \<Rightarrow>\<lparr>\<alpha>\<rparr> t" and "s \<approx> t"
    using weak.bisimilarity_is_simulation
    by (blast dest: weak.bisimilarity_symmetry_rule)
  from \<open>q \<Rightarrow>\<lparr>\<tau>\<rparr> q'\<close> and \<open>q' \<Rightarrow>\<lparr>\<alpha>\<rparr> t\<close> have "q \<Rightarrow>\<lparr>\<alpha>\<rparr> t"
    by (slowsimp intro: rtranclp_trans)
  with \<open>s \<approx> t\<close> show ?case
    by fastforce
qed (respectful, iprover)

subsection \<open>The Mixed System\<close>

sublocale mixed: simulation_system \<open>transition\<close> \<open>weak_transition\<close> .

notation mixed.simulation (\<open>mixed'_sim\<close>)
notation mixed.bisimulation (\<open>mixed'_bisim\<close>)
notation mixed.bisimilarity (infix \<open>\<asymp>\<close> 50)
notation mixed.constant_bisimilarity (\<open>[\<asymp>]\<close>)
notation mixed.simulation_up_to (\<open>mixed'_sim\<^bsub>_\<^esub>\<close>)
notation mixed.bisimulation_up_to (\<open>mixed'_bisim\<^bsub>_\<^esub>\<close>)

subsection \<open>Relationships between the Weak and the Mixed System\<close>

context begin

private lemma mixed_simulation_is_multi_silent_simulation:
  assumes "mixed_sim K"
  shows "K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* \<le> (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO K\<inverse>\<inverse>"
proof -
  have "K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^bsup>n\<^esup> \<le> (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO K\<inverse>\<inverse>" for n
  proof (induction n)
    case 0
    show ?case by auto
  next
    case (Suc n)
    have "K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^bsup>Suc n\<^esup> = K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^bsup>n\<^esup> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)"
      by simp
    also have "\<dots> \<le> (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)"
      using Suc.IH by blast
    also have "\<dots> \<le> (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO (\<Rightarrow>\<lparr>\<tau>\<rparr>) OO K\<inverse>\<inverse>"
      using \<open>mixed_sim K\<close> by blast
    also have "\<dots> = (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO K\<inverse>\<inverse>"
      by (auto intro: rtranclp_trans)
    finally show ?case .
  qed
  then show ?thesis
    unfolding rtranclp_is_Sup_relpowp
    by blast
qed

lemma weak_simulation_is_mixed_simulation_and_vice_versa:
  shows "weak_sim K \<longleftrightarrow> mixed_sim K"
proof
  assume "weak_sim K"
  have "K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) \<le> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO K\<inverse>\<inverse>" for \<alpha>
  proof -
    have "K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) \<le> K\<inverse>\<inverse> OO (\<Rightarrow>\<lparr>\<alpha>\<rparr>)"
      by auto
    also have "\<dots> \<le> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO K\<inverse>\<inverse>"
      using \<open>weak_sim K\<close> by simp
    finally show ?thesis .
  qed
  then show "mixed_sim K"
    by simp
next
  assume "mixed_sim K"
  have "K\<inverse>\<inverse> OO (\<Rightarrow>\<lparr>\<alpha>\<rparr>) \<le> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO K\<inverse>\<inverse>" for \<alpha>
  proof (cases "\<alpha> = \<tau>")
    case True
    then show ?thesis
      using mixed_simulation_is_multi_silent_simulation [OF \<open>mixed_sim K\<close>] by simp
  next
    case False
    from \<open>\<alpha> \<noteq> \<tau>\<close> have "K\<inverse>\<inverse> OO (\<Rightarrow>\<lparr>\<alpha>\<rparr>) = K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>*"
      by simp
    also have "\<dots> \<le> (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>*"
      using mixed_simulation_is_multi_silent_simulation [OF \<open>mixed_sim K\<close>] by blast
    also have "\<dots> \<le> (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO K\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>*"
      using \<open>mixed_sim K\<close> by blast
    also have "\<dots> \<le> (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<rightarrow>\<lparr>\<tau>\<rparr>)\<^sup>*\<^sup>* OO K\<inverse>\<inverse>"
      using mixed_simulation_is_multi_silent_simulation [OF \<open>mixed_sim K\<close>] by blast
    also have "\<dots> = (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO K\<inverse>\<inverse>"
      using \<open>\<alpha> \<noteq> \<tau>\<close> by (simp, blast intro: rtranclp_trans)
    finally show ?thesis .
  qed
  then show "weak_sim K"
    by simp
qed

end

lemma weak_bisimulation_is_mixed_bisimulation_and_vice_versa:
  shows "weak_bisim K \<longleftrightarrow> mixed_bisim K"
  using weak_simulation_is_mixed_simulation_and_vice_versa
  by (simp del: conversep_conversep)

theorem weak_bisimilarity_is_mixed_bisimilarity:
  shows "(\<approx>) = (\<asymp>)"
proof -
  have "(\<approx>) = (GREATEST K. weak_bisim K)"
    using weak.bisimilarity_is_greatest_bisimulation .
  also have "\<dots> = (GREATEST K. mixed_bisim K)"
    by (simp only: weak_bisimulation_is_mixed_bisimulation_and_vice_versa)
  also have "\<dots> = (\<asymp>)"
    by (simp only: mixed.bisimilarity_is_greatest_bisimulation)
  finally show ?thesis .
qed

corollary mixed_bisimilarity_reflexivity_rule:
  shows "p \<asymp> p"
  using weak.bisimilarity_reflexivity_rule
  unfolding weak_bisimilarity_is_mixed_bisimilarity .

corollary mixed_bisimilarity_reflexivity:
  shows "reflp (\<asymp>)"
  using weak.bisimilarity_reflexivity
  unfolding weak_bisimilarity_is_mixed_bisimilarity .

corollary mixed_bisimilarity_transitivity_rule:
  assumes "p \<asymp> q" and "q \<asymp> r"
  shows "p \<asymp> r"
  using weak.bisimilarity_transitivity_rule and assms
  unfolding weak_bisimilarity_is_mixed_bisimilarity .

corollary mixed_bisimilarity_transitivity:
  shows "transp (\<asymp>)"
  using weak.bisimilarity_transitivity
  unfolding weak_bisimilarity_is_mixed_bisimilarity .

theorem mixed_bisimilarity_is_equivalence:
  shows "equivp (\<asymp>)"
  using
    mixed_bisimilarity_reflexivity
  and
    mixed.bisimilarity_symmetry
  and
    mixed_bisimilarity_transitivity
  by (fact equivpI)

subsection \<open>Relationships between the Normal and the Mixed System\<close>

lemma simulation_is_mixed_simulation:
  assumes "sim K"
  shows "mixed_sim K"
  using assms by (simp, blast)

lemma bisimulation_is_mixed_bisimulation:
  assumes "bisim K"
  shows "mixed_bisim K"
  using simulation_is_mixed_simulation and assms by blast

theorem bisimilarity_in_mixed_bisimilarity:
  shows "(\<sim>) \<le> (\<asymp>)"
proof -
  have "bisim (\<sim>)"
    using bisimilarity_is_bisimulation .
  then have "mixed_bisim (\<sim>)"
    by (fact bisimulation_is_mixed_bisimulation)
  then show "(\<sim>) \<le> (\<asymp>)"
    by (fact mixed.bisimulation_in_bisimilarity)
qed

subsection \<open>Relationships between the Normal and the Weak System\<close>

lemma simulation_is_weak_simulation:
  assumes "sim K"
  shows "weak_sim K"
  unfolding weak_simulation_is_mixed_simulation_and_vice_versa
  using simulation_is_mixed_simulation and assms .

lemma bisimulation_is_weak_bisimulation:
  assumes "bisim K"
  shows "weak_bisim K"
  unfolding weak_bisimulation_is_mixed_bisimulation_and_vice_versa
  using bisimulation_is_mixed_bisimulation and assms .

theorem bisimilarity_in_weak_bisimilarity:
  shows "(\<sim>) \<le> (\<approx>)"
  unfolding weak_bisimilarity_is_mixed_bisimilarity
  using bisimilarity_in_mixed_bisimilarity .

subsection \<open>Cleanup of notation\<close>

text \<open>
  We have no notation for the weak and mixed variants of the following relations and therefore
  remove their notation here in order to be able to use it later for their weak or mixed variants.

  We cannot do this cleanup right at the beginning, because surprisingly the notation for said
  relations is restored by the \<^theory_text>\<open>sublocale\<close> specifications for \<^theory_text>\<open>weak\<close> and \<^theory_text>\<open>mixed\<close>.
\<close>

no_notation unilateral_progression (infix "\<hookrightarrow>" 50)

no_notation bilateral_progression (infix "\<mapsto>" 50)

no_notation shortcut_progression (infix "\<leadsto>" 50)

subsection \<open>``Up to'' Methods\<close>

lemma pre_bisimilarity_chain_is_mixed_respectful [respectful]:
  assumes "mixed.respectful \<F>"
  shows "mixed.respectful ([\<sim>] \<frown> \<F>)"
proof -
  write mixed.unilateral_progression (infix "\<hookrightarrow>" 50)
  write mixed.shortcut_progression (infix "\<leadsto>" 50)
  have "([\<sim>] \<frown> \<F>) K \<leadsto> ([\<sim>] \<frown> \<F>) L" if "K \<leadsto> L" for K and L
  proof -
    from \<open>mixed.respectful \<F>\<close> and \<open>K \<leadsto> L\<close>
    have "\<F> K \<le> \<F> L" and "\<F> K \<hookrightarrow> \<F> L" and "(\<F> K)\<inverse>\<inverse> \<hookrightarrow> (\<F> L)\<inverse>\<inverse>"
      by simp_all
    have forward: "((\<sim>) OO \<F> K)\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) \<le> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO ((\<sim>) OO \<F> L)\<inverse>\<inverse>" for \<alpha>
    proof -
      have "((\<sim>) OO \<F> K)\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) = (\<F> K)\<inverse>\<inverse> OO (\<sim>)\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>)"
        by blast
      also have "\<dots> \<le> (\<F> K)\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<sim>)\<inverse>\<inverse>"
        using bisimilarity_is_simulation by blast
      also have "\<dots> \<le> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<F> L)\<inverse>\<inverse> OO (\<sim>)\<inverse>\<inverse>"
        using \<open>\<F> K \<hookrightarrow> \<F> L\<close> by blast
      also have "\<dots> = (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO ((\<sim>) OO \<F> L)\<inverse>\<inverse>"
        by blast
      finally show ?thesis .
    qed
    have backward: "((\<sim>) OO \<F> K)\<inverse>\<inverse>\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) \<le> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO ((\<sim>) OO \<F> L)\<inverse>\<inverse>\<inverse>\<inverse>" for \<alpha>
    proof -
      have "((\<sim>) OO \<F> K)\<inverse>\<inverse>\<inverse>\<inverse> OO (\<rightarrow>\<lparr>\<alpha>\<rparr>) = (\<sim>) OO \<F> K OO (\<rightarrow>\<lparr>\<alpha>\<rparr>)"
        by (simp add: relcompp_assoc)
      also have"\<dots> \<le> (\<sim>) OO (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO \<F> L"
        using \<open>(\<F> K)\<inverse>\<inverse> \<hookrightarrow> (\<F> L)\<inverse>\<inverse>\<close> by blast
      also have "\<dots> = (\<sim>)\<inverse>\<inverse> OO (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO \<F> L"
        by (blast intro: bisimilarity_symmetry_rule)
      also have "\<dots> \<le> (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<sim>)\<inverse>\<inverse> OO \<F> L"
        using bisimilarity_is_simulation [THEN simulation_is_weak_simulation]
        by blast
      also have "\<dots> = (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO (\<sim>) OO \<F> L"
        by (blast intro: bisimilarity_symmetry_rule)
      also have "\<dots> = (\<Rightarrow>\<lparr>\<alpha>\<rparr>) OO ((\<sim>) OO \<F> L)\<inverse>\<inverse>\<inverse>\<inverse>"
        by simp
      finally show ?thesis .
    qed
    from \<open>\<F> K \<le> \<F> L\<close> and forward and backward show ?thesis
      by auto
  qed
  then show ?thesis
    by simp
qed

lemma post_bisimilarity_chain_is_mixed_respectful [respectful]:
  assumes "mixed.respectful \<F>"
  shows "mixed.respectful (\<F> \<frown> [\<sim>])"
proof -
  have "(\<F> \<frown> [\<sim>]) = ([\<sim>] \<frown> \<F>\<^sup>\<dagger>)\<^sup>\<dagger>"
    by (rule ext) (auto intro: bisimilarity_symmetry_rule)
  moreover from \<open>mixed.respectful \<F>\<close> have "mixed.respectful ([\<sim>] \<frown> \<F>\<^sup>\<dagger>)\<^sup>\<dagger>"
    by respectful
  ultimately show ?thesis
    by simp
qed

end

end


(*  Title:      Jinja/BV/SemiType.thy

    Author:     Tobias Nipkow, Gerwin Klein
    Copyright   2000 TUM
*)

section \<open> The Jinja Type System as a Semilattice \<close>

theory SemiType
imports "../Common/WellForm" "../DFA/Semilattices"
begin

definition super :: "'a prog \<Rightarrow> cname \<Rightarrow> cname"
where "super P C \<equiv> fst (the (class P C))"

lemma superI:
  "(C,D) \<in> subcls1 P \<Longrightarrow> super P C = D"
  by (unfold super_def) (auto dest: subcls1D)

primrec the_Class :: "ty \<Rightarrow> cname"
where
  "the_Class (Class C) = C"

definition sup :: "'c prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty err"
where
  "sup P T\<^sub>1 T\<^sub>2 \<equiv>
  if is_refT T\<^sub>1 \<and> is_refT T\<^sub>2 then
  OK (if T\<^sub>1 = NT then T\<^sub>2 else
      if T\<^sub>2 = NT then T\<^sub>1 else
      (Class (exec_lub (subcls1 P) (super P) (the_Class T\<^sub>1) (the_Class T\<^sub>2))))
  else
  (if T\<^sub>1 = T\<^sub>2 then OK T\<^sub>1 else Err)"

lemma sup_def':
  "sup P = (\<lambda>T\<^sub>1 T\<^sub>2.
  if is_refT T\<^sub>1 \<and> is_refT T\<^sub>2 then
  OK (if T\<^sub>1 = NT then T\<^sub>2 else
      if T\<^sub>2 = NT then T\<^sub>1 else
      (Class (exec_lub (subcls1 P) (super P) (the_Class T\<^sub>1) (the_Class T\<^sub>2))))
  else
  (if T\<^sub>1 = T\<^sub>2 then OK T\<^sub>1 else Err))"
  by (simp add: sup_def fun_eq_iff)

abbreviation
  subtype :: "'c prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"
  where "subtype P \<equiv> widen P"

definition esl :: "'c prog \<Rightarrow> ty esl"
where
  "esl P \<equiv> (types P, subtype P, sup P)"

(* FIXME: move to wellform *)
lemma is_class_is_subcls:
  "wf_prog m P \<Longrightarrow> is_class P C = P \<turnstile> C \<preceq>\<^sup>* Object"
(*<*)by (fastforce simp:is_class_def
                  elim: subcls_C_Object converse_rtranclE subcls1I
                  dest: subcls1D)
(*>*)

(* FIXME: move to wellform *)
lemma subcls_antisym:
  "\<lbrakk>wf_prog m P; P \<turnstile> C \<preceq>\<^sup>* D; P \<turnstile> D \<preceq>\<^sup>* C\<rbrakk> \<Longrightarrow> C = D"
  (*<*) by (auto dest: acyclic_subcls1 acyclic_impl_antisym_rtrancl antisymD) (*>*)

(* FIXME: move to wellform *)
lemma widen_antisym:
  "\<lbrakk> wf_prog m P; P \<turnstile> T \<le> U; P \<turnstile> U \<le> T \<rbrakk> \<Longrightarrow> T = U"
(*<*)
apply (cases T)
 apply (cases U)
 apply auto
apply (cases U)
 apply (auto elim!: subcls_antisym)
done
(*>*)

lemma order_widen [intro,simp]:
  "wf_prog m P \<Longrightarrow> order (subtype P)"
(*<*)
  apply (unfold Semilat.order_def lesub_def)
  apply (auto intro: widen_trans widen_antisym)
  done
(*>*)

(* FIXME: move to TypeRel *)
lemma NT_widen:
  "P \<turnstile> NT \<le> T = (T = NT \<or> (\<exists>C. T = Class C))"
(*<*) by (cases T) auto (*>*)

(* FIXME: move to TypeRel *)
lemma Class_widen2: "P \<turnstile> Class C \<le> T = (\<exists>D. T = Class D \<and> P \<turnstile> C \<preceq>\<^sup>* D)"
(*<*) by (cases T) auto (*>*)

lemma wf_converse_subcls1_impl_acc_subtype:
  "wf ((subcls1 P)^-1) \<Longrightarrow> acc (subtype P)"
(*<*)
apply (unfold Semilat.acc_def lesssub_def)
apply (drule_tac p = "(subcls1 P)^-1 - Id" in wf_subset)
 apply blast
apply (drule wf_trancl)
apply (simp add: wf_eq_minimal)
apply clarify
apply (unfold lesub_def)
apply (rename_tac M T)
apply (case_tac "\<exists>C. Class C \<in> M")
 prefer 2
 apply (case_tac T)
     apply fastforce
    apply fastforce
   apply fastforce
  apply simp
  apply (rule_tac x = NT in bexI)
   apply (rule allI)
   apply (rule impI, erule conjE)
   apply (clarsimp simp add: NT_widen)
  apply simp
 apply clarsimp
apply (erule_tac x = "{C. Class C : M}" in allE)
apply auto
apply (rename_tac D)
apply (rule_tac x = "Class D" in bexI)
 prefer 2
 apply assumption
apply clarify
apply (clarsimp simp: Class_widen2)
apply (insert rtrancl_r_diff_Id [symmetric, of "subcls1 P"])
apply simp
apply (erule rtranclE)
 apply blast
apply (drule rtrancl_converseI)
apply (subgoal_tac "((subcls1 P)-Id)^-1 = ((subcls1 P)^-1 - Id)")
 prefer 2
 apply blast
apply simp
apply (blast intro: rtrancl_into_trancl2)
done
(*>*)

lemma wf_subtype_acc [intro, simp]:
  "wf_prog wf_mb P \<Longrightarrow> acc (subtype P)"
(*<*) by (rule wf_converse_subcls1_impl_acc_subtype, rule wf_subcls1) (*>*)

lemma exec_lub_refl [simp]: "exec_lub r f T T = T"
(*<*) by (simp add: exec_lub_def while_unfold) (*>*)

lemma closed_err_types:
  "wf_prog wf_mb P \<Longrightarrow> closed (err (types P)) (lift2 (sup P))"
(*<*)
  apply (unfold closed_def plussub_def lift2_def sup_def')
  apply (frule acyclic_subcls1)
  apply (frule single_valued_subcls1)
  apply (auto simp: is_type_def is_refT_def is_class_is_subcls split: err.split ty.splits)
  apply (blast dest!: is_lub_exec_lub is_lubD is_ubD intro!: is_ubI superI)
  done
(*>*)

lemma sup_subtype_greater:
  "\<lbrakk> wf_prog wf_mb P; is_type P t1; is_type P t2; sup P t1 t2 = OK s \<rbrakk>
  \<Longrightarrow> subtype P t1 s \<and> subtype P t2 s"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"

  { fix c1 c2
    assume is_class: "is_class P c1" "is_class P c2"
    with wf_prog
    obtain
      "P \<turnstile> c1 \<preceq>\<^sup>* Object"
      "P \<turnstile> c2 \<preceq>\<^sup>* Object"
      by (blast intro: subcls_C_Object)
    with single_valued_subcls1[OF wf_prog]
    obtain u where
      "is_lub ((subcls1 P)^* ) c1 c2 u"
      by (blast dest: single_valued_has_lubs)
    moreover
    note acyclic_subcls1[OF wf_prog]
    moreover
    have "\<forall>x y. (x, y) \<in> subcls1 P \<longrightarrow> super P x = y"
      by (blast intro: superI)
    ultimately
    have "P \<turnstile> c1 \<preceq>\<^sup>* exec_lub (subcls1 P) (super P) c1 c2 \<and>
          P \<turnstile> c2 \<preceq>\<^sup>* exec_lub (subcls1 P) (super P) c1 c2"
      by (simp add: exec_lub_conv) (blast dest: is_lubD is_ubD)
  } note this [simp]

  assume "is_type P t1" "is_type P t2" "sup P t1 t2 = OK s"
  thus ?thesis
    apply (unfold sup_def)
    apply (cases s)
    apply (auto simp add: is_refT_def split: if_split_asm)
    done
qed
(*>*)

lemma sup_subtype_smallest:
  "\<lbrakk> wf_prog wf_mb P; is_type P a; is_type P b; is_type P c;
      subtype P a c; subtype P b c; sup P a b = OK d \<rbrakk>
  \<Longrightarrow> subtype P d c"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"

  { fix c1 c2 D
    assume is_class: "is_class P c1" "is_class P c2"
    assume le: "P \<turnstile> c1 \<preceq>\<^sup>* D" "P \<turnstile> c2 \<preceq>\<^sup>* D"
    from wf_prog is_class
    obtain
      "P \<turnstile> c1 \<preceq>\<^sup>* Object"
      "P \<turnstile> c2 \<preceq>\<^sup>* Object"
      by (blast intro: subcls_C_Object)
    with single_valued_subcls1[OF wf_prog]
    obtain u where
      lub: "is_lub ((subcls1 P)^* ) c1 c2 u"
      by (blast dest: single_valued_has_lubs)
    with acyclic_subcls1[OF wf_prog]
    have "exec_lub (subcls1 P) (super P) c1 c2 = u"
      by (blast intro: superI exec_lub_conv)
    moreover
    from lub le
    have "P \<turnstile> u \<preceq>\<^sup>* D"
      by (simp add: is_lub_def is_ub_def)
    ultimately
    have "P \<turnstile> exec_lub (subcls1 P) (super P) c1 c2 \<preceq>\<^sup>* D"
      by blast
  } note this [intro]

  have [dest!]:
    "\<And>C T. P \<turnstile> Class C \<le> T \<Longrightarrow> \<exists>D. T=Class D \<and> P \<turnstile> C \<preceq>\<^sup>* D"
    by (frule Class_widen, auto)

  assume "is_type P a" "is_type P b" "is_type P c"
         "subtype P a c" "subtype P b c" "sup P a b = OK d"
  thus ?thesis
    by (auto simp add: sup_def is_refT_def
             split: if_split_asm)
qed
(*>*)

lemma sup_exists:
  "\<lbrakk> subtype P a c; subtype P b c \<rbrakk> \<Longrightarrow> \<exists>T. sup P a b = OK T"
(*<*)
apply (unfold sup_def)
apply (cases b)
apply auto
apply (cases a)
apply auto
apply (cases a)
apply auto
done
(*>*)

lemma err_semilat_JType_esl:
  "wf_prog wf_mb P \<Longrightarrow> err_semilat (esl P)"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"
  hence "order (subtype P)"..
  moreover from wf_prog
  have "closed (err (types P)) (lift2 (sup P))"
    by (rule closed_err_types)
  moreover
  from wf_prog have
    "(\<forall>x\<in>err (types P). \<forall>y\<in>err (types P). x \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> x \<squnion>\<^bsub>lift2 (sup P)\<^esub> y) \<and>
     (\<forall>x\<in>err (types P). \<forall>y\<in>err (types P). y \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> x \<squnion>\<^bsub>lift2 (sup P)\<^esub> y)"
    by (auto simp add: lesub_def plussub_def Err.le_def lift2_def sup_subtype_greater split: err.split)
  moreover from wf_prog have
    "\<forall>x\<in>err (types P). \<forall>y\<in>err (types P). \<forall>z\<in>err (types P).
    x \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> z \<and> y \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> z \<longrightarrow> x \<squnion>\<^bsub>lift2 (sup P)\<^esub> y \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> z"
    by (unfold lift2_def plussub_def lesub_def Err.le_def)
       (auto intro: sup_subtype_smallest dest:sup_exists split: err.split)
  ultimately show ?thesis by (simp add: esl_def semilat_def sl_def Err.sl_def)
qed
(*>*)

end


(*  Title:      statecharts/DataSpace/Data.thy

    Author:     Steffen Helke, Software Engineering Group
    Copyright   2010 Technische Universitaet Berlin
*)

header {* Data Space Assignments *}
theory Data
imports DataSpace
begin

subsection {* Total data space assignments *}

definition
  Data :: "['d list, 'd dataspace]
                => bool" where
  "Data L D = (((length L) = (PartNum D)) \<and>
               (\<forall> i \<in> {n. n < (PartNum D)}. (L!i) \<in> (PartDom D i)))"

lemma Data_EmptySet:
    "([@ t. True], Abs_dataspace [UNIV])\<in> { (L,D) | L D. Data L D }";
apply (unfold Data_def PartDom_def)
apply auto
apply (subst Abs_dataspace_inverse)
apply auto
done

definition
  "data =
    { (L,D) |
             (L::('d list))
             (D::('d dataspace)).
              Data L D }"

typedef 'd data = "data :: ('d list * 'd dataspace) set"
  unfolding data_def
  apply (rule exI)
  apply (rule Data_EmptySet)
  done

definition
 DataValue :: "('d data) => ('d list)" where
 "DataValue = fst o Rep_data"

definition
 DataSpace :: "('d data) => ('d dataspace)" where
 "DataSpace = snd o Rep_data"

definition
 DataPart :: "['d data, nat] => 'd" ("(_ !P!/ _)" [10,11]10) where
 "DataPart d n = (DataValue d) ! n"

lemma Rep_data_tuple:
  "Rep_data D = (DataValue D, DataSpace D)";
by (unfold DataValue_def DataSpace_def, simp)

lemma Rep_data_select:
  "(DataValue D, DataSpace D) \<in> data";
apply (subst Rep_data_tuple [THEN sym])
apply (rule Rep_data)
done

lemma Data_select:
  "Data (DataValue D) (DataSpace D)"
apply (cut_tac D=D in Rep_data_select)
apply (unfold data_def)
apply auto
done

lemma length_DataValue_PartNum [simp]:
  "length (DataValue D) = PartNum (Data.DataSpace D)"
apply (cut_tac D=D in Data_select)
apply (unfold Data_def)
apply auto
done

lemma DataValue_PartDom [simp]:
  "i < PartNum (Data.DataSpace D) \<Longrightarrow>
   DataValue D ! i \<in> PartDom (Data.DataSpace D) i";
apply (cut_tac D=D in Data_select)
apply (unfold Data_def)
apply auto
done

lemma DataPart_PartDom [simp]:
  "i < PartNum (Data.DataSpace d) \<longrightarrow> (d !P! i) \<in> ((Data.DataSpace d) !D! i)";
apply (unfold DataPart_def)
apply auto
done

subsection {* Partial data space assignments *}

definition
  PData :: "['d option list, 'd dataspace] => bool" where
  "PData L D == ((length L) = (PartNum D)) \<and>
                (\<forall> i \<in> {n. n < (PartNum D)}.
                    (L!i) \<noteq> None \<longrightarrow> the (L!i) \<in> (PartDom D i))"

lemma PData_EmptySet:
    "([Some (@ t. True)], Abs_dataspace [UNIV]) \<in> { (L,D) | L D. PData L D }";
apply (unfold PData_def PartDom_def)
apply auto
apply (subst Abs_dataspace_inverse)
apply auto
done

definition
  "pdata =
    { (L,D) |
             (L::('d option list))
             (D::('d dataspace)).
              PData L D }"

typedef 'd pdata = "pdata :: ('d option list * 'd dataspace) set"
  unfolding pdata_def
  apply (rule exI)
  apply (rule PData_EmptySet)
  done

definition
  PDataValue :: "('d pdata) => ('d option list)" where
 "PDataValue = fst o Rep_pdata"

definition
  PDataSpace :: "('d pdata) => ('d dataspace)" where
 "PDataSpace = snd o Rep_pdata"

definition
  Data2PData :: "('d data) => ('d pdata)" where
 "Data2PData D = (let
                      (L,DP) = Rep_data D;
                      OL     = map Some L
                  in
                      Abs_pdata (OL,DP))"

definition
  PData2Data :: "('d pdata) => ('d data)" where
 "PData2Data D = (let
                      (OL,DP) = Rep_pdata D;
                       L      = map the OL
                  in
                      Abs_data (L,DP))"

definition
  DefaultPData :: "('d dataspace) => ('d pdata)" where
 "DefaultPData D = Abs_pdata (replicate (PartNum D) None, D)"

definition
  OptionOverride :: "('d option * 'd) => 'd" where
 "OptionOverride P = (if (fst P) = None then (snd P) else (the (fst P)))"

definition
  DataOverride :: "['d pdata, 'd data] => 'd data" ("(_ [D+]/ _)" [10,11]10) where
 "DataOverride D1 D2 =
                (let
                    (L1,DP1) = Rep_pdata D1;
                    (L2,DP2) = Rep_data D2;
                    L        = map OptionOverride (zip L1 L2)
                 in
                    Abs_data (L,DP2))"

lemma Rep_pdata_tuple:
  "Rep_pdata D = (PDataValue D, PDataSpace D)"
apply (unfold PDataValue_def PDataSpace_def)
apply (simp)
done

lemma Rep_pdata_select:
  "(PDataValue D, PDataSpace D) \<in> pdata";
apply (subst Rep_pdata_tuple [THEN sym])
apply (rule Rep_pdata)
done

lemma PData_select:
  "PData (PDataValue D) (PDataSpace D)"
apply (cut_tac D=D in Rep_pdata_select)
apply (unfold pdata_def)
apply auto
done

subsubsection {* @{text "DefaultPData"} *}

lemma PData_DefaultPData [simp]:
   "PData (replicate (PartNum D) None) D"
apply (unfold PData_def)
apply auto
done

lemma pdata_DefaultPData [simp]:
   "(replicate (PartNum D) None, D) \<in> pdata "
apply (unfold pdata_def)
apply auto
done

lemma PDataSpace_DefaultPData [simp]:
   "PDataSpace (DefaultPData D) = D"
apply (unfold DataSpace_def PDataSpace_def DefaultPData_def)
apply auto
apply (subst Abs_pdata_inverse)
apply auto
done

lemma length_PartNum_PData [simp]:
  "length (PDataValue P) = PartNum (PDataSpace P)"
apply (cut_tac D=P in Rep_pdata_select)
apply (unfold pdata_def PData_def)
apply auto
done

subsubsection {* @{text "Data2PData"} *}

lemma PData_Data2PData [simp]:
  "PData (map Some (DataValue D)) (Data.DataSpace D)";
apply (unfold PData_def)
apply auto
done

lemma pdata_Data2PData [simp]:
  "(map Some (DataValue D), Data.DataSpace D) \<in> pdata";
apply (unfold pdata_def)
apply auto
done

lemma DataSpace_Data2PData [simp]:
  "(PDataSpace (Data2PData D)) = (Data.DataSpace D)"
apply (unfold DataSpace_def PDataSpace_def Data2PData_def Let_def)
apply auto
apply (cut_tac D=D in Rep_data_tuple)
apply auto
apply (subst Abs_pdata_inverse)
apply auto
done

lemma PDataValue_Data2PData_DataValue [simp]:
     "(map the (PDataValue (Data2PData D))) = DataValue D";
apply (unfold DataValue_def PDataValue_def Data2PData_def Let_def)
apply auto
apply (cut_tac D=D in Rep_data_tuple)
apply auto
apply (subst Abs_pdata_inverse)
apply simp
apply (simp del: map_map)
done

lemma DataSpace_PData2Data:
   "Data (map the (PDataValue D)) (PDataSpace D) \<Longrightarrow>
   (Data.DataSpace (PData2Data D) = (PDataSpace D))"
apply (unfold DataSpace_def PDataSpace_def PData2Data_def Let_def)
apply auto
apply (cut_tac D=D in Rep_pdata_tuple)
apply auto
apply (subst Abs_data_inverse)
apply (unfold data_def)
apply auto
done

lemma PartNum_PDataValue_PartDom [simp]:
   "\<lbrakk> i < PartNum (PDataSpace Q);
      PDataValue Q ! i = Some y \<rbrakk> \<Longrightarrow>
      y \<in> PartDom (PDataSpace Q) i"
apply (cut_tac D=Q in Rep_pdata_select)
apply (unfold pdata_def PData_def)
apply auto
done

subsubsection {* @{text "DataOverride"} *}

lemma Data_DataOverride:
 "((PDataSpace P) = (Data.DataSpace Q)) \<Longrightarrow>
  Data (map OptionOverride (zip (PDataValue P) (Data.DataValue Q))) (Data.DataSpace Q)"
apply (unfold Data_def)
apply auto
apply (unfold OptionOverride_def)
apply auto
apply (rename_tac i D)
apply (case_tac "PDataValue P ! i = None")
apply auto
apply (drule sym)
apply auto
done

lemma data_DataOverride:
 "((PDataSpace P) = (Data.DataSpace Q)) \<Longrightarrow>
   (map OptionOverride (zip (PDataValue P) (Data.DataValue Q)), Data.DataSpace Q) \<in> data";
apply (unfold data_def)
apply auto
apply (rule Data_DataOverride)
apply fast
done

lemma DataSpace_DataOverride [simp]:
 "((Data.DataSpace D) = (PDataSpace E)) \<Longrightarrow>
   Data.DataSpace (E [D+] D) = (Data.DataSpace D)"
apply (unfold DataSpace_def DataOverride_def Let_def)
apply auto
apply (cut_tac D=D in Rep_data_tuple)
apply (cut_tac D=E in Rep_pdata_tuple)
apply auto
apply (subst Abs_data_inverse)
apply auto
apply (drule sym)
apply simp
apply (rule data_DataOverride)
apply auto
done

lemma DataValue_DataOverride [simp]:
 "((PDataSpace P) = (Data.DataSpace Q)) \<Longrightarrow>
  (DataValue (P [D+] Q)) = (map OptionOverride (zip (PDataValue P) (Data.DataValue Q)))"
apply (unfold DataValue_def DataOverride_def Let_def)
apply auto
apply (cut_tac D=P in Rep_pdata_tuple)
apply (cut_tac D=Q in Rep_data_tuple)
apply auto
apply (subst Abs_data_inverse)
apply auto
apply (rule data_DataOverride)
apply auto
done

subsubsection {* @{text "OptionOverride"} *}

lemma DataValue_OptionOverride_nth:
 "\<lbrakk> ((PDataSpace P) = (DataSpace Q));
    i < PartNum (DataSpace Q) \<rbrakk> \<Longrightarrow>
    (DataValue (P [D+] Q) ! i) =
    OptionOverride (PDataValue P ! i, DataValue Q ! i)"
apply auto
done

lemma None_OptionOverride [simp]:
   "(fst P) = None \<Longrightarrow> OptionOverride P = (snd P)";
apply (unfold OptionOverride_def)
apply auto
done

lemma Some_OptionOverride [simp]:
   "(fst P) \<noteq> None \<Longrightarrow> OptionOverride P = the (fst P)";
apply (unfold OptionOverride_def)
apply auto
done

end


(*
   Copyright 2017 Myriam Begel

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
*)

theory "HoareTripleForBasicBlocks"

imports "HoareTripleForInstructions"
"../attic/BasicBlocks"
"../EvmFacts"

begin
type_synonym pred = "(state_element set \<Rightarrow> bool)"

definition triple_inst_sem :: "network \<Rightarrow> pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
"triple_inst_sem n pre inst post ==
    \<forall>co_ctx presult rest stopper.
     (pre \<and>* code {inst} \<and>* rest) (instruction_result_as_set co_ctx presult) \<longrightarrow>
      ((post \<and>* code {inst} \<and>* rest) (instruction_result_as_set co_ctx
          (program_sem stopper co_ctx 1 n presult)))"

definition triple_seq_sem :: "network \<Rightarrow> pred \<Rightarrow> pos_inst list \<Rightarrow> pred \<Rightarrow> bool" where
"triple_seq_sem n pre insts post ==
    \<forall>co_ctx presult rest stopper.
     (pre \<and>* code (set insts) \<and>* rest) (instruction_result_as_set co_ctx presult) \<longrightarrow>
      ((post \<and>* code (set insts) \<and>* rest) (instruction_result_as_set co_ctx
          (program_sem stopper co_ctx (length insts) n presult)))"

definition triple_sem_t :: "network \<Rightarrow> pred \<Rightarrow> pos_inst set \<Rightarrow> pred \<Rightarrow> bool" where
"triple_sem_t n pre insts post ==
    \<forall> co_ctx presult rest (stopper::instruction_result \<Rightarrow> unit).
       (pre ** code insts ** rest) (instruction_result_as_set co_ctx presult) \<longrightarrow>
       ((post ** code insts ** rest) (instruction_result_as_set co_ctx
            (program_sem_t co_ctx n presult))) "

(* We define here the program logic for BLOCKSs *)
(* We start with Hoare triples valid for the execution of one instruction *)

(* We have to add more instructions here *)
definition iszero_stack :: "w256 \<Rightarrow> w256" where
"iszero_stack w = (if w = 0 then (word_of_int 1) else (word_of_int 0))"

fun arith_2_1_low:: "arith_inst \<Rightarrow> w256 \<Rightarrow> w256 \<Rightarrow> w256" where
 "arith_2_1_low MUL = (\<lambda> a b .  a * b) "
| "arith_2_1_low DIV =
	(\<lambda> a divisor .
		(if divisor =(((word_of_int 0) ::  256 word))
			then(((word_of_int 0) ::  256 word))
			else (\<lambda> i .  word_of_int ( i)) ((Word.uint a) div (Word.uint divisor))))"
| "arith_2_1_low MOD =
  (\<lambda> a divisor .  (if divisor =(((word_of_int 0) ::  256 word)) then(((word_of_int 0) ::  256 word)) else
            (\<lambda> i .  word_of_int ( i)) ((Word.uint a) mod (Word.uint divisor))))"
| "arith_2_1_low _ = (\<lambda> a b . 0)"

fun arith_2_1_verylow:: "arith_inst \<Rightarrow> w256 \<Rightarrow> w256 \<Rightarrow> w256" where
 "arith_2_1_verylow ADD = (\<lambda> a b .  a + b) "
| "arith_2_1_verylow SUB = (\<lambda> a b .  a - b) "
| "arith_2_1_verylow inst_GT =
	(\<lambda> a b .  if a > b then(((word_of_int 1) ::  256 word)) else(((word_of_int 0) ::  256 word)))"
| "arith_2_1_verylow inst_EQ =
	(\<lambda> a b .  if a = b then(((word_of_int 1) ::  256 word)) else(((word_of_int 0) ::  256 word)))"
| "arith_2_1_verylow inst_LT =
	(\<lambda> a b .  if b > a then(((word_of_int 1) ::  256 word)) else(((word_of_int 0) ::  256 word)))"
| "arith_2_1_verylow _ = (\<lambda> a b . 0)"

fun arith_3_1:: "arith_inst \<Rightarrow> w256 \<Rightarrow> w256 \<Rightarrow> w256 \<Rightarrow> w256" where
 "arith_3_1 ADDMOD =
		(\<lambda> a b divisor .
     (if divisor =(((word_of_int 0) ::  256 word)) then(((word_of_int 0) ::  256 word))
			else (\<lambda> i .  word_of_int ( i)) ((Word.uint a + Word.uint b) mod (Word.uint divisor))))"
| "arith_3_1 MULMOD =
		(\<lambda> a b divisor .
     (if divisor =(((word_of_int 0) ::  256 word)) then(((word_of_int 0) ::  256 word))
			else (\<lambda> i .  word_of_int ( i)) ((Word.uint a * Word.uint b) mod (Word.uint divisor))))"
| "arith_3_1 _ = (\<lambda> a b c . 0)"

inductive triple_inst_arith :: "network \<Rightarrow> pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
  inst_arith_mul :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Glow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith MUL)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (v*w) \<and>*
       gas_pred (g - Glow) \<and>* rest)"
| inst_arith_div :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Glow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith DIV)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_2_1_low DIV v w) \<and>*
       gas_pred (g - Glow) \<and>* rest)"
| inst_arith_mod :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Glow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith MOD)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_2_1_low MOD v w) \<and>*
       gas_pred (g - Glow) \<and>* rest)"
|  inst_arith_add :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith ADD)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_2_1_verylow ADD v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_arith_sub :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith SUB)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_2_1_verylow SUB v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_arith_gt :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith inst_GT)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_2_1_verylow inst_GT v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_arith_eq :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith inst_EQ)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_2_1_verylow inst_EQ v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_arith_lt :
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith inst_LT)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_2_1_verylow inst_LT v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_arith_addmod :
    "triple_inst_arith net
      (\<langle> h \<le> 1021 \<and> Gmid \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc (Suc h))) \<and>* stack (Suc (Suc h)) u \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith ADDMOD)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_3_1 ADDMOD u v w) \<and>*
       gas_pred (g - Gmid) \<and>* rest)"
|  inst_arith_mulmod :
    "triple_inst_arith net
      (\<langle> h \<le> 1021 \<and> Gmid \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc (Suc h))) \<and>* stack (Suc (Suc h)) u \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith MULMOD)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (arith_3_1 MULMOD u v w) \<and>*
       gas_pred (g - Gmid) \<and>* rest)"
| inst_iszero :
    "triple_inst_arith net
      (\<langle> h \<le> 1023 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc h) \<and>* stack h w \<and>* gas_pred g \<and>* rest)
      (n, Arith ISZERO)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (iszero_stack w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
(*| inst_exp :(*Written from lem - syntax error*)
    "triple_inst_arith net
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Arith EXP)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (word_of_int (word_exp (uint v) (unat w))) \<and>*
       gas_pred (g - (Gexp + if w = 0 then 0 else Gexbyte net * (1 + log256floor (uint w:: int)))) \<and>* rest)"*)

fun bits_2_1_verylow:: "bits_inst \<Rightarrow> w256 \<Rightarrow> w256 \<Rightarrow> w256" where
 "bits_2_1_verylow BYTE = get_byte"
| "bits_2_1_verylow inst_AND = (\<lambda> a b .  a AND b)"
| "bits_2_1_verylow inst_OR = (\<lambda> a b .  a OR b)"
| "bits_2_1_verylow inst_XOR = (\<lambda> a b .  a XOR b)"
| "bits_2_1_verylow _ = (\<lambda> a b  . 0)"

inductive triple_inst_bits :: "pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
  inst_bits_not :
    "triple_inst_bits
      (\<langle> h \<le> 1023 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc h) \<and>* stack h w \<and>* gas_pred g \<and>* rest)
      (n, Bits inst_NOT)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (NOT w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_bits_and :
    "triple_inst_bits
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Bits inst_AND)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>*
       stack h (bits_2_1_verylow inst_AND v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_bits_or :
    "triple_inst_bits
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Bits inst_OR)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (bits_2_1_verylow inst_OR v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_bits_xor :
    "triple_inst_bits
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Bits inst_XOR)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (bits_2_1_verylow inst_XOR v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"
|  inst_bits_byte :
    "triple_inst_bits
      (\<langle> h \<le> 1022 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc (Suc h)) \<and>* stack (Suc h) v \<and>* stack h w \<and>*
			 gas_pred g \<and>* rest)
      (n, Bits BYTE)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (bits_2_1_verylow BYTE v w) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"

inductive triple_inst_pc :: "pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
  inst_jumpdest :
    "triple_inst_pc
      (\<langle> h \<le> 1024 \<and> Gjumpdest \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height h \<and>* gas_pred g \<and>* rest)
      (n, Pc JUMPDEST)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height h \<and>* gas_pred (g - Gjumpdest) \<and>* rest)"
| inst_instPC :
    "triple_inst_pc
      (\<langle> h \<le> 1023 \<and> Gbase \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height h \<and>* gas_pred g \<and>* rest)
      (n, Pc PC)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height (Suc h) \<and>* stack h (word_of_int n) \<and>*
       gas_pred (g - Gbase) \<and>* rest)"

inductive triple_inst_stack :: "pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
  inst_push_n :
    "triple_inst_stack
      (\<langle> h \<le> 1023 \<and> length lst > 0 \<and> 32 \<ge> length lst \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height h \<and>* gas_pred g \<and>* rest)
      (n, Stack (PUSH_N lst))
      (program_counter (n + (1 + int (length lst))) \<and>*
       continuing \<and>* stack_height (Suc h) \<and>* gas_pred (g - Gverylow) \<and>*
       stack h (word_rcat lst) \<and>* rest)"
| inst_pop :
    "triple_inst_stack
      (\<langle> h \<le> 1023 \<and> Gbase \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height (Suc h) \<and>* stack h w \<and>* gas_pred g \<and>* rest)
      (n, Stack POP)
      (program_counter (n + 1) \<and>* continuing \<and>*
       stack_height h \<and>* gas_pred (g - Gbase) \<and>* rest)"
| inst_calldataload :
    "triple_inst_stack
      (\<langle> h \<le> 1023 \<and> Gverylow \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>* sent_data lst \<and>*
       stack_height (Suc h) \<and>* stack h u \<and>* gas_pred g \<and>* rest)
      (n, Stack CALLDATALOAD)
      (program_counter (n + 1) \<and>* continuing \<and>* sent_data lst \<and>*
       stack_height (Suc h) \<and>* stack h (read_word_from_bytes (unat u) lst) \<and>*
       gas_pred (g - Gverylow) \<and>* rest)"

inductive triple_inst_misc :: "network \<Rightarrow> pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
 inst_stop :
    "triple_inst_misc net
      (\<langle> h \<le> 1024 \<and> 0 \<le> g\<rangle> \<and>* continuing \<and>*
       program_counter n \<and>* stack_height h \<and>* gas_pred g \<and>* rest)
      (n, Misc STOP)
      (stack_height h \<and>* not_continuing \<and>*
       program_counter n \<and>* action (ContractReturn []) \<and>*
       gas_pred g \<and>* rest)"
|inst_return :
    "triple_inst_misc net
     (\<langle> h \<le> 1022 \<and> m \<ge> 0 \<and> length lst = unat v \<and> (Cmem (M m u v) - Cmem m) \<le> g \<rangle> \<and>*
      continuing \<and>* memory_usage m \<and>* memory_range u lst \<and>*
      program_counter n \<and>* stack_height (Suc (Suc h)) \<and>* gas_pred g \<and>*
      stack (Suc h) u \<and>* stack h v \<and>* rest)
     (n, Misc RETURN)
     (stack_height (Suc (Suc h)) \<and>* not_continuing \<and>* memory_usage (M m u v) \<and>*
      action (ContractReturn lst) \<and>* gas_pred (g - (Cmem (M m u v) - Cmem m)) \<and>*
      stack (Suc h) u \<and>* stack h v \<and>* memory_range u lst \<and>*
      program_counter n \<and>* rest)"
| inst_suicide :
    "triple_inst_misc net
    (\<langle> h \<le> 1024 \<and> Csuicide (\<not> existence) net \<le> g \<and> at_least_eip150 net\<rangle> \<and>*
     continuing \<and>* account_existence addr existence \<and>*
     program_counter n \<and>* stack_height (Suc h) \<and>* gas_pred g \<and>* stack h (ucast addr) \<and>* rest)
    (n, Misc SUICIDE)
    (stack_height (Suc h) \<and>* stack h (ucast addr) \<and>*
     not_continuing \<and>*  account_existence addr existence \<and>*
     program_counter n \<and>* action (ContractSuicide addr) \<and>* gas_pred (g - Csuicide (\<not> existence) net) \<and>* rest)"

definition memory :: "w256 \<Rightarrow> w256 \<Rightarrow> state_element set_pred" where
"memory ind w = memory_range ind (word_rsplit w)"

definition gcopy_aux :: "w256 \<Rightarrow> int" where
"gcopy_aux s = (Gcopy * (Word.uint s +( 31 :: int)) div( 32 :: int))"

definition w8_of_inst :: "inst \<Rightarrow> byte" where
"w8_of_inst inst =
    (case  index (inst_code inst)(( 0 :: nat)) of
      None =>(((word_of_int 0) ::  8 word))
    | Some a => a
    )"

inductive triple_inst_memory :: "pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
 inst_mload :
    "triple_inst_memory
      (\<langle> h \<le> 1023  \<and> g \<ge> Gverylow - Cmem memu + Cmem (M memu memaddr 32) \<and> memu \<ge> 0 \<and>
        length (word_rsplit v::byte list) = unat (32::w256)\<rangle> \<and>*
       stack h memaddr \<and>* stack_height (h+1) \<and>* program_counter n \<and>*
       memory_usage memu \<and>* memory memaddr v \<and>* gas_pred g \<and>* continuing \<and>* rest)
      (n, Memory MLOAD)
      (program_counter (n + 1) \<and>* stack_height (h + 1) \<and>* stack h v \<and>*
       memory memaddr v \<and>* memory_usage (M memu memaddr 32) \<and>*
       gas_pred (g - Gverylow + Cmem memu - Cmem (M memu memaddr 32)) \<and>*
       continuing \<and>* rest)"
| inst_mstore :
    "triple_inst_memory
      (\<langle> h \<le> 1022 \<and> g \<ge> Gverylow - Cmem memu + Cmem (M memu memaddr 32) \<and> memu \<ge> 0 \<and>
        length (word_rsplit old_v::byte list) = unat (32::w256) \<and>
        length (word_rsplit v::byte list) = unat (32::w256) \<and> memaddr \<le> -32\<rangle> \<and>*
       stack (h+1) memaddr \<and>* stack h v \<and>* stack_height (h+2) \<and>*
       program_counter n \<and>* memory_usage memu \<and>*
       memory memaddr old_v \<and>* gas_pred g \<and>* continuing \<and>* rest)
      (n, Memory MSTORE)
      (program_counter (n + 1) \<and>* stack_height h \<and>* memory memaddr v \<and>*
       gas_pred (g - Gverylow + Cmem memu - Cmem (M memu memaddr 32)) \<and>*
       memory_usage (M memu memaddr 32) \<and>* continuing \<and>* rest)"

inductive triple_inst_storage :: "network \<Rightarrow> pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
 inst_sload :
    "triple_inst_storage net
      (\<langle> h \<le> 1023 \<and> unat bn \<ge> 2463000 \<and> at_least_eip150 net \<and> g \<ge> Gsload net\<rangle>
       \<and>* block_number_pred bn \<and>* stack_height (h + 1)
       \<and>* stack h idx
       \<and>* program_counter k \<and>* storage idx w \<and>* gas_pred g \<and>*  account_existence c existence
       \<and>* continuing \<and>* rest)
      (k, Storage SLOAD)
      (program_counter (k + 1) \<and>* block_number_pred bn \<and>* stack_height (h + 1) \<and>* stack h w
       \<and>* storage idx w \<and>* gas_pred (g - Gsload net)
       \<and>*  account_existence c existence \<and>* continuing \<and>* rest)"
| inst_sstore :
    "triple_inst_storage net
    (\<langle> h \<le> 1024 \<and> Csstore old new \<le> g\<rangle> \<and>*
           stack_height (h + 2) \<and>* stack (h + 1) idx \<and>*
           stack h new \<and>* program_counter n \<and>* storage idx old \<and>*
           gas_pred g \<and>* continuing  \<and>* rest)
          (n, Storage SSTORE)
          (program_counter (n + 1) \<and>* stack_height h \<and>* storage idx new \<and>*
           gas_pred (g - Csstore old new) \<and>* continuing  \<and>* rest)"

inductive triple_inst_info :: "pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
 inst_callvalue:
    "triple_inst_info
      (\<langle> h \<le> 1023 \<and> Gbase \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height h \<and>* sent_value w \<and>*
       gas_pred g \<and>* rest)
      (n, Info CALLVALUE)
      (program_counter (n + 1) \<and>*
       continuing \<and>* sent_value w \<and>*
       stack_height (Suc h) \<and>* gas_pred (g - Gbase) \<and>*
       stack h w \<and>* rest)"
 |  inst_calldatasize:
    "triple_inst_info
      (\<langle> h \<le> 1023 \<and> Gbase \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height h \<and>* sent_data data \<and>*
       gas_pred g \<and>* rest)
      (n, Info CALLDATASIZE)
      (program_counter (n + 1) \<and>*
       continuing \<and>* sent_data data \<and>*
       stack_height (Suc h) \<and>* gas_pred (g - Gbase) \<and>*
       stack h (word256FromNat (length data)) \<and>* rest)"
| inst_caller:
    "triple_inst_info
      (\<langle> h \<le> 1023 \<and> Gbase \<le> g\<rangle> \<and>*
       continuing \<and>* program_counter n \<and>*
       stack_height h \<and>* caller c \<and>*
       gas_pred g \<and>* rest)
      (n, Info CALLER)
      (program_counter (n + 1) \<and>*
       continuing \<and>* caller c \<and>*
       stack_height (Suc h) \<and>* gas_pred (g - Gbase) \<and>*
       stack h (ucast c) \<and>* rest)"

inductive triple_inst :: "network \<Rightarrow> pred \<Rightarrow> pos_inst \<Rightarrow> pred \<Rightarrow> bool" where
  inst_arith :
    "triple_inst_arith net p (n, Arith i) q \<Longrightarrow> triple_inst net p (n, Arith i) q"
| inst_bits :
    "triple_inst_bits p (n, Bits i) q \<Longrightarrow> triple_inst net p (n, Bits i) q"
| inst_info :
    "triple_inst_info p (n, Info i) q \<Longrightarrow> triple_inst net p (n, Info i) q"
| inst_memory :
    "triple_inst_memory p (n, Memory i) q \<Longrightarrow> triple_inst net p (n, Memory i) q"
| inst_storage :
    "triple_inst_storage net p (n, Storage i) q \<Longrightarrow> triple_inst net p (n, Storage i) q"
| inst_misc :
    "triple_inst_misc net p (n, Misc i) q \<Longrightarrow> triple_inst net p (n, Misc i) q"
| inst_pc :
    "triple_inst_pc p (n, Pc i) q \<Longrightarrow> triple_inst net p (n, Pc i) q"
| inst_stack :
    "triple_inst_stack p (n, Stack i) q \<Longrightarrow> triple_inst net p (n, Stack i) q"
| inst_swap :
		"triple_inst net
			(\<langle> h \<le> 1023 \<and> Suc (unat n) \<le> h \<and> g \<ge> Gverylow\<rangle> \<and>*
			 stack_height (Suc h) \<and>* stack h w \<and>* stack (h - (unat n) - 1) v \<and>*
			 program_counter k \<and>* gas_pred g \<and>*
			 continuing \<and>* rest)
			(k, Swap n)
			(program_counter (k + 1) \<and>* gas_pred (g - Gverylow) \<and>*
			 stack_height (Suc h) \<and>* stack h v \<and>* stack (h - (unat n) - 1) w \<and>*
			 continuing \<and>* rest)"
| inst_dup :
    "triple_inst net
        (\<langle> h \<le> 1023 \<and> unat n < h \<and> Gverylow \<le> g\<rangle> \<and>*
         stack_height h \<and>*
         stack (h - unat n - 1) w \<and>*
         program_counter k \<and>*
         gas_pred g \<and>* continuing \<and>* rest)
        (k, Dup n)
        (program_counter (k + 1) \<and>*
         gas_pred (g - Gverylow) \<and>*
         stack_height (Suc h) \<and>*
         stack (h - unat n - 1) w \<and>*
         stack h w \<and>*
         continuing \<and>* rest)"
| inst_unknown :
    "triple_inst net
(\<langle> h \<le> 1024 \<and> 0 \<le> g\<rangle> \<and>*
program_counter k \<and>* stack_height h \<and>* gas_pred g \<and>* continuing \<and>* rest)
        (k, Unknown i)
        (program_counter k \<and>*
         action (ContractFail [ShouldNotHappen]) \<and>* stack_height h \<and>* gas_pred g \<and>* not_continuing \<and>*
         rest)"
| inst_strengthen_pre:
    "triple_inst net p i q \<Longrightarrow> (\<And>s. r s \<Longrightarrow> p s) \<Longrightarrow> triple_inst net r i q"
| inst_false_pre:
    "triple_inst net \<langle>False\<rangle> i post"

(* We define here the program logic for BLOCKSs *)
(* We start with Hoare triples valid for the execution of one instruction *)

inductive triple_seq :: "network \<Rightarrow> pred \<Rightarrow> pos_inst list \<Rightarrow> pred \<Rightarrow> bool" where
  seq_inst :
  "\<lbrakk>triple_inst net pre x q;
    triple_seq net q xs post \<rbrakk> \<Longrightarrow>
   triple_seq net pre (x#xs) post"
| seq_empty:
  "(\<And>s. pre s \<Longrightarrow> post s) \<Longrightarrow>
   triple_seq net pre [] post"
| seq_strengthen_pre:
  "triple_seq net p xs q \<Longrightarrow>
   (\<And>s. r s \<Longrightarrow> p s) \<Longrightarrow>
   triple_seq net r xs q"
| seq_false_pre:
  "triple_seq net \<langle>False\<rangle> xs post"

inductive triple_blocks :: "network \<Rightarrow> basic_blocks \<Rightarrow> pred \<Rightarrow> vertex \<Rightarrow> pred \<Rightarrow> bool" where
  blocks_no :
  "triple_seq net pre insts post \<Longrightarrow>
   triple_blocks net blocks pre (n, insts, Terminal) post"
| blocks_next :
  "\<lbrakk>triple_seq net pre insts (program_counter i \<and>* q);
    i = n + inst_size_list insts;
    block_lookup blocks i = Some (bi, ti);
    triple_blocks net blocks (program_counter i \<and>* q) (i, bi, ti) post\<rbrakk> \<Longrightarrow>
   triple_blocks net blocks pre (n, insts, Next) post"
| blocks_jump :
  "\<lbrakk>triple_seq net pre insts
      (\<langle> h \<le> 1023 \<and> Gmid \<le> g \<and> m \<ge> 0\<rangle> \<and>*
       program_counter (n + inst_size_list insts) \<and>* gas_pred g \<and>*
       memory_usage m \<and>* stack_height (Suc h) \<and>*
       stack h (word_of_int dest::256 word) \<and>*
       continuing \<and>* rest);
    block_lookup blocks dest = Some (bi, ti);
    bi = (dest, Pc JUMPDEST) # bbi;
    triple_blocks net blocks
      (program_counter dest \<and>* gas_pred (g - Gmid) \<and>*
       memory_usage m \<and>* stack_height h \<and>*
       continuing \<and>* rest)
      (dest, bi, ti) post\<rbrakk> \<Longrightarrow>
   triple_blocks net blocks pre (n, insts, Jump) post"
| blocks_jumpi :
  "\<lbrakk>  triple_seq net pre insts
      ((\<langle> h \<le> 1022  \<and> Ghigh \<le> g \<and> m \<ge> 0\<rangle> \<and>*
       stack_height (Suc (Suc h)) \<and>*
       stack (Suc h) (word_of_int dest::256 word) \<and>*
       stack h cond \<and>* gas_pred g \<and>*
       continuing \<and>* memory_usage m \<and>*
       program_counter (n + inst_size_list insts) \<and>* rest));
    j = n + 1 + inst_size_list insts;
    block_lookup blocks dest = Some (bi, ti);
    bi = (dest, Pc JUMPDEST) # bbi;
    block_lookup blocks j = Some (bj, tj);
    r = (stack_height h \<and>* gas_pred (g - Ghigh) \<and>*
         continuing \<and>* memory_usage m \<and>* rest);
    (cond \<noteq> 0 \<Longrightarrow> triple_blocks net blocks (r \<and>* program_counter dest) (dest, bi, ti) post);
    (cond = 0 \<Longrightarrow> triple_blocks net blocks (r \<and>* program_counter j) (j, bj, tj) post)\<rbrakk> \<Longrightarrow>
   triple_blocks net blocks pre (n, insts, Jumpi) post"
| blocks_false_pre:
  "triple_blocks net blocks \<langle>False\<rangle> i post"
| blocks_strengthen_pre:
  "triple_blocks net blocks p f q \<Longrightarrow>
   (\<And>s. r s \<Longrightarrow> p s) \<Longrightarrow>
   triple_blocks net blocks r f q"
definition triple :: "network \<Rightarrow> pred \<Rightarrow> basic_blocks \<Rightarrow> pred \<Rightarrow> bool" where
"triple net pre blocks post = triple_blocks net blocks pre (hd blocks) post"

lemma blocks_jumpi_uint:
"\<lbrakk>  triple_seq net pre insts
      ((\<langle> h \<le> 1022  \<and> Ghigh \<le> g \<and> m \<ge> 0\<rangle> \<and>*
       stack_height (Suc (Suc h)) \<and>*
       stack (Suc h) dest \<and>*
       stack h cond \<and>* gas_pred g \<and>*
       continuing \<and>* memory_usage m \<and>*
       program_counter (n + inst_size_list insts) \<and>* rest));
    j = n + 1 + inst_size_list insts;
    block_lookup blocks (uint dest) = Some (bi, ti);
    bi = (uint dest, Pc JUMPDEST) # bbi;
    block_lookup blocks j = Some (bj, tj);
    r = (stack_height h \<and>* gas_pred (g - Ghigh) \<and>*
         continuing \<and>* memory_usage m \<and>* rest);
    (cond \<noteq> 0 \<Longrightarrow> triple_blocks net blocks (r \<and>* program_counter (uint dest)) (uint dest, bi, ti) post);
    (cond = 0 \<Longrightarrow> triple_blocks net blocks (r \<and>* program_counter j) (j, bj, tj) post)\<rbrakk> \<Longrightarrow>
   triple_blocks net blocks pre (n, insts, Jumpi) post"
apply(rule blocks_jumpi)
defer
apply(assumption)+
apply(simp)
done

lemma blocks_jump_uint :
  "\<lbrakk>triple_seq net pre insts
      (\<langle> h \<le> 1023 \<and> Gmid \<le> g \<and> m \<ge> 0\<rangle> \<and>*
       program_counter (n + inst_size_list insts) \<and>* gas_pred g \<and>*
       memory_usage m \<and>* stack_height (Suc h) \<and>*
       stack h dest \<and>*
       continuing \<and>* rest);
    block_lookup blocks (uint dest) = Some (bi, ti);
    bi = (uint dest, Pc JUMPDEST) # bbi;
    triple_blocks net blocks
      (program_counter (uint dest) \<and>* gas_pred (g - Gmid) \<and>*
       memory_usage m \<and>* stack_height h \<and>*
       continuing \<and>* rest)
      (uint dest, bi, ti) post\<rbrakk> \<Longrightarrow>
   triple_blocks net blocks pre (n, insts, Jump) post"
by(rule blocks_jump; simp)

lemma inst_return_memory :
    "triple_inst_misc net
     (\<langle> h \<le> 1022 \<and> m \<ge> 0 \<and> length (word_rsplit lst::byte list) = unat v \<and> (Cmem (M m u v) - Cmem m) \<le> g \<rangle> \<and>*
      continuing \<and>* memory_usage m \<and>* memory u lst \<and>*
      program_counter n \<and>* stack_height (Suc (Suc h)) \<and>* gas_pred g \<and>*
      stack (Suc h) u \<and>* stack h v \<and>* rest)
     (n, Misc RETURN)
     (stack_height (Suc (Suc h)) \<and>* not_continuing \<and>* memory_usage (M m u v) \<and>*
      action (ContractReturn (word_rsplit lst)) \<and>* gas_pred (g - (Cmem (M m u v) - Cmem m)) \<and>*
      stack (Suc h) u \<and>* stack h v \<and>* memory u lst \<and>*
      program_counter n \<and>* rest)"
apply(simp add: memory_def)
apply(rule inst_return)
done

end


theory T_Security
  imports T_Specification T_Proofs General_Proofs Punc_Security
begin

section \<open>Security results\<close>

lemma disjointnessT:
  shows "disjointnessT \<le> disjointness_punc"
  unfolding disjointnessT_def disjointness_punc_def
  apply (rule disjointnessI)
proof -
  fix p pk sk assume p: "p \<in> supp paramsT" and pksk: "(pk, sk) \<in> supp (keygenT p)"
  have "supp (encT G pk m) \<subseteq> supp (enc () pk m)" for G m
    unfolding encT_def enc_def encrT_def by simp
  then have "(\<Union>m\<in>msg_spaceT G. supp (encT G pk m)) \<subseteq> (\<Union>m\<in>msg_space (). supp (enc () pk m))" for G
    unfolding msg_spaceT_def by (simp add: UN_mono)
  then have "Prob (fakeencT G pk) (\<Union>m\<in>msg_spaceT G. supp (encT G pk m))
    \<le>  Prob (fakeenc () pk) (\<Union>m\<in>msg_space (). supp (enc () pk m))" for G
    unfolding fakeencT_def by (simp add: Prob_mono)
  also have "\<dots> \<le> disjointness params keygen enc fakeenc msg_space"
    apply (rule disjointness_geqI[where pk=pk and sk=sk and p="()"])
    using p pksk by (auto simp: keygenT_def params_def)
  finally show "Prob (fakeencT p pk) (\<Union>m\<in>msg_spaceT p. supp (encT p pk m))
       \<le> disjointness params keygen enc fakeenc msg_space".
next
  show "paramsT \<noteq> 0"
    by (metis UNIV_not_empty finite paramsT_def suppP_empty_simp supp_uniform)
qed simp

lemma disjointnessT0:
  assumes "injective_enc params0 keygen0 enc0 msg_space0"
  shows "disjointnessT = 0"
proof -
  have "disjointnessT \<le> 0"
    using disjointnessT disjointness_punc[OF assms] by simp
  moreover have "disjointnessT \<ge> 0"
    unfolding disjointnessT_def
    apply (rule disjointness_geq0)
    by auto
  ultimately show ?thesis
    by auto
qed

end