section \<open>Additional material over the \<open>Higher_Order_Terms\<close> AFP entry\<close>

theory Terms_Extras
imports
  "../Utils/Compiler_Utils"
  Higher_Order_Terms.Pats
  "Dict_Construction.Dict_Construction"
begin

no_notation Mpat_Antiquot.mpaq_App (infixl "$$" 900)

ML_file "hol_term.ML"

primrec basic_rule :: "_ \<Rightarrow> bool" where
"basic_rule (lhs, rhs) \<longleftrightarrow>
  linear lhs \<and>
  is_const (fst (strip_comb lhs)) \<and>
  \<not> is_const lhs \<and>
  frees rhs |\<subseteq>| frees lhs"

lemma basic_ruleI[intro]:
  assumes "linear lhs"
  assumes "is_const (fst (strip_comb lhs))"
  assumes "\<not> is_const lhs"
  assumes "frees rhs |\<subseteq>| frees lhs"
  shows "basic_rule (lhs, rhs)"
using assms by simp

primrec split_rule :: "(term \<times> 'a) \<Rightarrow> (name \<times> (term list \<times> 'a))" where
"split_rule (lhs, rhs) = (let (name, args) = strip_comb lhs in (const_name name, (args, rhs)))"

fun unsplit_rule :: "(name \<times> (term list \<times> 'a)) \<Rightarrow> (term \<times> 'a)" where
"unsplit_rule (name, (args, rhs)) = (name $$ args, rhs)"

lemma split_unsplit: "split_rule (unsplit_rule t) = t"
by (induct t rule: unsplit_rule.induct) (simp add: strip_list_comb const_name_def)

lemma unsplit_split:
  assumes "basic_rule r"
  shows "unsplit_rule (split_rule r) = r"
using assms
by (cases r) (simp add: split_beta)

datatype pat = Patvar name | Patconstr name "pat list"

fun mk_pat :: "term \<Rightarrow> pat" where
"mk_pat pat = (case strip_comb pat of (Const s, args) \<Rightarrow> Patconstr s (map mk_pat args) | (Free s, []) \<Rightarrow> Patvar s)"

declare mk_pat.simps[simp del]

lemma mk_pat_simps[simp]:
  "mk_pat (name $$ args) = Patconstr name (map mk_pat args)"
  "mk_pat (Free name) = Patvar name"
apply (auto simp: mk_pat.simps strip_list_comb_const)
apply (simp add: const_term_def)
done

primrec patvars :: "pat \<Rightarrow> name fset" where
"patvars (Patvar name) = {| name |}" |
"patvars (Patconstr _ ps) = ffUnion (fset_of_list (map patvars ps))"

lemma mk_pat_frees:
  assumes "linear p"
  shows "patvars (mk_pat p) = frees p"
using assms proof (induction p rule: linear_pat_induct)
  case (comb name args)

  have "map (patvars \<circ> mk_pat) args = map frees args"
    using comb by force
  hence "fset_of_list (map (patvars \<circ> mk_pat) args) = fset_of_list (map frees args)"
    by metis
  thus ?case
    by (simp add: freess_def)
qed simp

text \<open>
  This definition might seem a little counter-intuitive. Assume we have two defining equations
  of a function, e.g.\ @{term map}:
    @{prop "map f [] = []"}
    @{prop "map f (x # xs) = f x # map f xs"}
  The pattern "matrix" is compiled right-to-left. Equal patterns are grouped together. This
  definition is needed to avoid the following situation:
    @{prop "map f [] = []"}
    @{prop "map g (x # xs) = g x # map g xs"}
  While this is logically the same as above, the problem is that @{text f} and @{text g} are
  overlapping but distinct patterns. Hence, instead of grouping them together, they stay separate.
  This leads to overlapping patterns in the target language which will produce wrong results.
  One way to deal with this is to rename problematic variables before invoking the compiler.
\<close>

fun pattern_compatible :: "term \<Rightarrow> term \<Rightarrow> bool" where
"pattern_compatible (t\<^sub>1 $ t\<^sub>2) (u\<^sub>1 $ u\<^sub>2) \<longleftrightarrow> pattern_compatible t\<^sub>1 u\<^sub>1 \<and> (t\<^sub>1 = u\<^sub>1 \<longrightarrow> pattern_compatible t\<^sub>2 u\<^sub>2)" |
"pattern_compatible t u \<longleftrightarrow> t = u \<or> non_overlapping t u"

lemmas pattern_compatible_simps[simp] =
  pattern_compatible.simps[folded app_term_def]

lemmas pattern_compatible_induct = pattern_compatible.induct[case_names app_app]

lemma pattern_compatible_refl[intro?]: "pattern_compatible t t"
by (induct t) auto

corollary pattern_compatile_reflP[intro!]: "reflp pattern_compatible"
by (auto intro: pattern_compatible_refl reflpI)

lemma pattern_compatible_cases[consumes 1]:
  assumes "pattern_compatible t u"
  obtains (eq) "t = u"
        | (non_overlapping) "non_overlapping t u"
using assms proof (induction arbitrary: thesis rule: pattern_compatible_induct)
  case (app_app t\<^sub>1 t\<^sub>2 u\<^sub>1 u\<^sub>2)

  show ?case
    proof (cases "t\<^sub>1 = u\<^sub>1 \<and> t\<^sub>2 = u\<^sub>2")
      case True
      with app_app show thesis
        by simp
    next
      case False
      from app_app have "pattern_compatible t\<^sub>1 u\<^sub>1" "t\<^sub>1 = u\<^sub>1 \<Longrightarrow> pattern_compatible t\<^sub>2 u\<^sub>2"
        by auto
      with False have "non_overlapping (t\<^sub>1 $ t\<^sub>2) (u\<^sub>1 $ u\<^sub>2)"
        using app_app by (metis non_overlapping_appI1 non_overlapping_appI2)
      thus thesis
        by (rule app_app.prems(2))
    qed
qed auto

inductive rev_accum_rel :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" for R where
nil: "rev_accum_rel R [] []" |
snoc: "rev_accum_rel R xs ys \<Longrightarrow> (xs = ys \<Longrightarrow> R x y) \<Longrightarrow> rev_accum_rel R (xs @ [x]) (ys @ [y])"

lemma rev_accum_rel_refl[intro]: "reflp R \<Longrightarrow> rev_accum_rel R xs xs"
unfolding reflp_def
by (induction xs rule: rev_induct) (auto intro: rev_accum_rel.intros)

lemma rev_accum_rel_length:
  assumes "rev_accum_rel R xs ys"
  shows "length xs = length ys"
using assms
by induct auto

context begin

private inductive_cases rev_accum_relE[consumes 1, case_names nil snoc]: "rev_accum_rel P xs ys"

lemma rev_accum_rel_butlast[intro]:
  assumes "rev_accum_rel P xs ys"
  shows "rev_accum_rel P (butlast xs) (butlast ys)"
using assms by (cases rule: rev_accum_relE) (auto intro: rev_accum_rel.intros)

lemma rev_accum_rel_snoc_eqE: "rev_accum_rel P (xs @ [a]) (xs @ [b]) \<Longrightarrow> P a b"
by (auto elim: rev_accum_relE)

end

abbreviation patterns_compatible :: "term list \<Rightarrow> term list \<Rightarrow> bool" where
"patterns_compatible \<equiv> rev_accum_rel pattern_compatible"

abbreviation patterns_compatibles :: "(term list \<times> 'a) fset \<Rightarrow> bool" where
"patterns_compatibles \<equiv> fpairwise (\<lambda>(pats\<^sub>1, _) (pats\<^sub>2, _). patterns_compatible pats\<^sub>1 pats\<^sub>2)"

lemma pattern_compatible_combD:
  assumes "length xs = length ys" "pattern_compatible (list_comb f xs) (list_comb f ys)"
  shows "patterns_compatible xs ys"
using assms by (induction xs ys rule: rev_induct2) (auto intro: rev_accum_rel.intros)

lemma pattern_compatible_combI[intro]:
  assumes "patterns_compatible xs ys" "pattern_compatible f g"
  shows "pattern_compatible (list_comb f xs) (list_comb g ys)"
using assms
proof (induction rule: rev_accum_rel.induct)
  case (snoc xs ys x y)

  then have "pattern_compatible (list_comb f xs) (list_comb g ys)"
    by auto

  moreover have " pattern_compatible x y" if "list_comb f xs = list_comb g ys"
    proof (rule snoc, rule list_comb_semi_inj)
      show "length xs = length ys"
        using snoc by (auto dest: rev_accum_rel_length)
    qed fact

  ultimately show ?case
    by auto
qed (auto intro: rev_accum_rel.intros)

experiment begin

\<comment> \<open>The above example can be made concrete here. In general, the following identity does not hold:\<close>

lemma "pattern_compatible t u \<longleftrightarrow> t = u \<or> non_overlapping t u"
  apply rule
   apply (erule pattern_compatible_cases; simp)
  apply (erule disjE)
   apply (metis pattern_compatible_refl)
  oops

\<comment> \<open>The counterexample:\<close>

definition "pats1 = [Free (Name ''f''), Const (Name ''nil'')]"
definition "pats2 = [Free (Name ''g''), Const (Name ''cons'') $ Free (Name ''x'') $ Free (Name ''xs'')]"

proposition "non_overlapping (list_comb c pats1) (list_comb c pats2)"
  unfolding pats1_def pats2_def
  apply (simp add: app_term_def)
  apply (rule non_overlapping_appI2)
  apply (rule non_overlapping_const_appI)
  done

proposition "\<not> patterns_compatible pats1 pats2"
  unfolding pats1_def pats2_def
  apply rule
  apply (erule rev_accum_rel.cases)
   apply simp
  apply auto
  apply (erule rev_accum_rel.cases)
   apply auto
  apply (erule rev_accum_rel.cases)
   apply auto
  apply (metis overlapping_var1I)
  done

end

abbreviation pattern_compatibles :: "(term \<times> 'a) fset \<Rightarrow> bool" where
"pattern_compatibles \<equiv> fpairwise (\<lambda>(lhs\<^sub>1, _) (lhs\<^sub>2, _). pattern_compatible lhs\<^sub>1 lhs\<^sub>2)"

corollary match_compatible_pat_eq:
  assumes "pattern_compatible t\<^sub>1 t\<^sub>2" "linear t\<^sub>1" "linear t\<^sub>2"
  assumes "match t\<^sub>1 u = Some env\<^sub>1" "match t\<^sub>2 u = Some env\<^sub>2"
  shows "t\<^sub>1 = t\<^sub>2"
using assms by (metis pattern_compatible_cases match_overlapping)

corollary match_compatible_env_eq:
  assumes "pattern_compatible t\<^sub>1 t\<^sub>2" "linear t\<^sub>1" "linear t\<^sub>2"
  assumes "match t\<^sub>1 u = Some env\<^sub>1" "match t\<^sub>2 u = Some env\<^sub>2"
  shows "env\<^sub>1 = env\<^sub>2"
using assms by (metis match_compatible_pat_eq option.inject)

corollary matchs_compatible_eq:
  assumes "patterns_compatible ts\<^sub>1 ts\<^sub>2" "linears ts\<^sub>1" "linears ts\<^sub>2"
  assumes "matchs ts\<^sub>1 us = Some env\<^sub>1" "matchs ts\<^sub>2 us = Some env\<^sub>2"
  shows "ts\<^sub>1 = ts\<^sub>2" "env\<^sub>1 = env\<^sub>2"
proof -
  fix name
  have "match (name $$ ts\<^sub>1) (name $$ us) = Some env\<^sub>1" "match (name $$ ts\<^sub>2) (name $$ us) = Some env\<^sub>2"
    using assms by auto
  moreover have "length ts\<^sub>1 = length ts\<^sub>2"
    using assms by (metis matchs_some_eq_length)
  ultimately have "pattern_compatible (name $$ ts\<^sub>1) (name $$ ts\<^sub>2)"
    using assms by (auto simp: const_term_def)
  moreover have "linear (name $$ ts\<^sub>1)" "linear (name $$ ts\<^sub>2)"
    using assms by (auto intro: linear_list_comb')
  note * = calculation

  from * have "name $$ ts\<^sub>1 = name $$ ts\<^sub>2"
    by (rule match_compatible_pat_eq) fact+
  thus "ts\<^sub>1 = ts\<^sub>2"
    by (meson list_comb_inj_second injD)

  from * show "env\<^sub>1 = env\<^sub>2"
    by (rule match_compatible_env_eq) fact+
qed

lemma compatible_find_match:
   assumes "pattern_compatibles (fset_of_list cs)" "list_all (linear \<circ> fst) cs" "is_fmap (fset_of_list cs)"
   assumes "match pat t = Some env" "(pat, rhs) \<in> set cs"
   shows "find_match cs t = Some (env, pat, rhs)"
using assms proof (induction cs arbitrary: pat rhs)
  case (Cons c cs)
  then obtain pat' rhs' where [simp]: "c = (pat', rhs')"
    by force
  have "find_match ((pat', rhs') # cs) t = Some (env, pat, rhs)"
    proof (cases "match pat' t")
      case None
      have "pattern_compatibles (fset_of_list cs)"
        using Cons
        by (force simp: fpairwise_alt_def)
      have "list_all (linear \<circ> fst) cs"
        using Cons
        by (auto simp: list_all_iff)
      have "is_fmap (fset_of_list cs)"
        using Cons
        by (meson fset_of_list_subset is_fmap_subset set_subset_Cons)
      show ?thesis
        apply (simp add: None)
        apply (rule Cons)
            apply fact+
        using Cons None by force
    next
      case (Some env')
      have "linear pat" "linear pat'"
        using Cons apply (metis Ball_set comp_apply fst_conv)
        using Cons by simp
      moreover from Cons have "pattern_compatible pat pat'"
        apply (cases "pat = pat'")
         apply (simp add: pattern_compatible_refl)
        unfolding fpairwise_alt_def
        by (force simp: fset_of_list_elem)
      ultimately have "env' = env" "pat' = pat"
        using match_compatible_env_eq match_compatible_pat_eq
        using Cons Some
        by blast+
      with Cons have "rhs' = rhs"
        using is_fmapD
        by (metis \<open>c = (pat', rhs')\<close> fset_of_list_elem list.set_intros(1))
      show ?thesis
        apply (simp add: Some)
        apply (intro conjI)
        by fact+
    qed
  thus ?case
    unfolding \<open>c = _\<close> .
qed auto

context "term" begin

definition arity_compatible :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where
"arity_compatible t\<^sub>1 t\<^sub>2 = (
  let
    (head\<^sub>1, pats\<^sub>1) = strip_comb t\<^sub>1;
    (head\<^sub>2, pats\<^sub>2) = strip_comb t\<^sub>2
  in head\<^sub>1 = head\<^sub>2 \<longrightarrow> length pats\<^sub>1 = length pats\<^sub>2
)"

abbreviation arity_compatibles :: "('a \<times> 'b) fset \<Rightarrow> bool" where
"arity_compatibles \<equiv> fpairwise (\<lambda>(lhs\<^sub>1, _) (lhs\<^sub>2, _). arity_compatible lhs\<^sub>1 lhs\<^sub>2)"

definition head :: "'a \<Rightarrow> name" where
"head t \<equiv> const_name (fst (strip_comb t))"

abbreviation heads_of :: "(term \<times> 'a) fset \<Rightarrow> name fset" where
"heads_of rs \<equiv> (head \<circ> fst) |`| rs"

end

definition arity :: "('a list \<times> 'b) fset \<Rightarrow> nat" where
"arity rs = fthe_elem' ((length \<circ> fst) |`| rs)"

lemma arityI:
  assumes "fBall rs (\<lambda>(pats, _). length pats = n)" "rs \<noteq> {||}"
  shows "arity rs = n"
proof -
  have "(length \<circ> fst) |`| rs = {| n |}"
    using assms by force
  thus ?thesis
    unfolding arity_def fthe_elem'_eq by simp
qed

end


theory Reviewer_Assignment_NCPC_Aut
imports "../Observation_Setup" Reviewer_Assignment_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection \<open>Confidentiality protection from users who are not PC members
or authors of the paper\<close>

text \<open>We verify the following property:

\ \\
A group of users UIDs learn
nothing about the reviewers assigned to a paper PID
except for the fact that they are PC members having no conflict with that paper
unless/until one of the following occurs:
\begin{itemize}
\item the user becomes a PC member in the paper's conference having no conflict
     with that paper and the conference moves to the reviewing phase,
or
\item the user becomes an author of the paper
   and the conference moves to the notification phase.
\end{itemize}
\<close>

fun T :: "(state,act,out) trans \<Rightarrow> bool" where
"T (Trans _ _ ou s') =
 (\<exists> uid \<in> UIDs.
    (\<exists> cid. PID \<in>\<in> paperIDs s' cid \<and> isPC s' cid uid \<and> pref s' uid PID \<noteq> Conflict \<and> phase s' cid \<ge> revPH)
    \<or>
    (\<exists> cid. PID \<in>\<in> paperIDs s' cid \<and> isAut s' cid uid PID \<and> phase s' cid \<ge> notifPH)
 )"

declare T.simps [simp del]

(*
The bound says that a sequence of values vl,
i.e., a sequence of pairs [(uid_1,Uids_1),...,(uid_n,Uids_n)]
representing the users uid_i appointed as reviewers and the set
of PC members Uids_i not having conflict with paper ID at the time,
cannot be distinguished from a sequence of values
vl' = [(uid'_1,Uids'_1),...,(uid'_m,Uids'_m)] provided that
-- uid'_1,...,uid'_m are all distinct
-- Uids'_1 are all equal, and they are all equal to U
-- uid'_1 is in U

where U = Uids_1. Note actually that, because in the Reviewing phase
conflicts can no longer be changed, we actually have
U = Uids_1 = ... = Uids_n, which explains the above bound.

Thus, the second component of values (which turns out be constant)
is only collected in order to be able to express the following piece of information:
"the appointed reviewers are PC members having no conflict with paper".
*)

definition B :: "value list \<Rightarrow> value list \<Rightarrow> bool" where
"B vl vl1 \<equiv>
 vl \<noteq> [] \<and>
 distinct (map fst vl1) \<and> fst ` (set vl1) \<subseteq> snd (hd vl) \<and> snd ` (set vl1) = {snd (hd vl)}"

interpretation BD_Security_IO where
istate = istate and step = step and
\<phi> = \<phi> and f = f and \<gamma> = \<gamma> and g = g and T = T and B = B
done

lemma reachNT_non_isPC_isChair:
assumes "reachNT s" and "uid \<in> UIDs"
shows
"(PID \<in>\<in> paperIDs s cid \<and> isPC s cid uid \<longrightarrow> pref s uid PID = Conflict \<or> phase s cid < revPH)
 \<and>
 (PID \<in>\<in> paperIDs s cid \<and> isChair s cid uid \<longrightarrow> pref s uid PID = Conflict \<or> phase s cid < revPH)
 \<and>
 (PID \<in>\<in> paperIDs s cid \<and> isAut s cid uid PID \<longrightarrow>
    phase s cid < notifPH)"
  using assms
  apply induct
  subgoal by (auto simp: istate_def)
  subgoal apply(intro conjI)
    subgoal by (metis (no_types, lifting) T.simps not_le_imp_less trans.collapse)
    subgoal by (metis (mono_tags, lifting) reachNT_reach T.simps isChair_isPC not_le_imp_less reach.Step trans.collapse)
    subgoal by (metis T.simps not_le_imp_less trans.collapse) .
  done

lemma T_\<phi>_\<gamma>:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "\<phi> (Trans s a ou s')"
shows "\<not> \<gamma> (Trans s a ou s')"
using reachNT_non_isPC_isChair[OF 1] 2 unfolding T.simps \<phi>_def2
by (fastforce simp: c_defs isRev_imp_isRevNth_getReviewIndex)

lemma T_\<phi>_\<gamma>_stronger:
assumes s: "reach s" and 0: "PID \<in>\<in> paperIDs s cid"
and 2: "step s a = (ou,s')" "\<phi> (Trans s a ou s')"
and 1:  "\<forall> uid \<in> UIDs. isChair s cid uid \<longrightarrow> pref s uid PID = Conflict \<or> phase s cid < revPH"
shows "\<not> \<gamma> (Trans s a ou s')"
proof-
  have "\<not> (\<exists> uid \<in> UIDs. \<exists> cid. PID \<in>\<in> paperIDs s cid \<and>
  isChair s cid uid \<and> pref s uid PID \<noteq> Conflict \<and> phase s cid \<ge> revPH)"
  using 0 1 s by (metis not_le paperIDs_equals)
  thus ?thesis using assms unfolding T.simps \<phi>_def2 by (force simp add: c_defs)
qed

lemma T_\<phi>_\<gamma>_1:
assumes s: "reachNT s" and s1: "reach s1" and PID: "PID \<in>\<in> paperIDs s cid"
and ss1: "eqExcPID2 s s1"
and step1: "step s1 a = (ou1,s1')" and \<phi>1: "\<phi> (Trans s1 a ou1 s1')"
and \<phi>: "\<not> \<phi> (Trans s a ou s')"
shows "\<not> \<gamma> (Trans s1 a ou1 s1')"
proof-
  have "\<forall> uid \<in> UIDs. isChair s cid uid \<longrightarrow> pref s uid PID = Conflict \<or> phase s cid < revPH"
  using reachNT_non_isPC_isChair[OF s] PID by auto
  hence 1: "\<forall> uid \<in> UIDs. isChair s1 cid uid \<longrightarrow> pref s1 uid PID = Conflict \<or> phase s1 cid < revPH"
  using ss1 unfolding eqExcPID2_def using eqExcRLR_imp2 by fastforce
  have PID1: "PID \<in>\<in> paperIDs s1 cid" using PID ss1 eqExcPID2_imp by auto
  show ?thesis apply(rule T_\<phi>_\<gamma>_stronger[OF s1 PID1 step1 \<phi>1]) using 1 by auto
qed

lemma notInPaperIDs_eqExLRL_roles_eq:
assumes s: "reach s" and s1: "reach s1" and PID: "\<not> PID \<in>\<in> paperIDs s cid"
and eq: "eqExcPID2 s s1"
shows "roles s cid uid = roles s1 cid uid"
proof-
  have "\<not> PID \<in>\<in> paperIDs s1 cid" using PID eq unfolding eqExcPID2_def by auto
  hence "\<not> isRev s cid uid PID \<and> \<not> isRev s1 cid uid PID" using s s1 PID by (metis isRev_paperIDs)
  thus ?thesis using eq unfolding eqExcPID2_def eqExcRLR_def
  by (metis Bex_set_list_ex filter_True isRev_def)
qed

(* major *) lemma eqExcPID2_step_out:
assumes ss1: "eqExcPID2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID \<in>\<in> paperIDs s cid" and ph: "phase s cid \<ge> revPH"
and \<phi>: "\<not> \<phi> (Trans s a ou s')" and \<phi>1: "\<not> \<phi> (Trans s1 a ou1 s1')"
and UIDs: "userOfA a \<in> UIDs"
shows "ou = ou1"
proof-
  note s = reachNT_reach[OF sT]
  have s': "reach s'" and s1': "reach s1'" by (metis reach_PairI s s1 step step1)+
  have s's1': "eqExcPID2 s' s1'" by (metis PID \<phi> eqExcPID2_step ph s ss1 step step1)
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID2_imp[OF ss1]
  note eqs' = eqExcPID2_imp1[OF ss1]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID2_def
  note simps2[simp] = eqExcRLR_imp[of s _ _ _ s1, OF s] eqExcRLR_imp[of s' _ _ _ s1']
                eqExcRLR_imp[of s _ _ _ s1'] eqExcRLR_imp[of s' _ _ _ s1]
      eqExcRLR_imp2[of s _ _ s1] eqExcRLR_imp2[of s' _ _ s1']
                eqExcRLR_imp2[of s _ _ s1'] eqExcRLR_imp2[of s' _ _ s1]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1' cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1' cid uid)" for cid uid]
      foo2 foo3
      eqExcRLR_imp_isRevRole_imp

  {fix cid uid p pid assume "a = Ract (rMyReview cid uid p pid)"
   hence ?thesis
   using step step1 eqs eqs' s s1 UIDs PID \<phi> \<phi>1 ph
    paperIDs_equals[OF s] Inv
   apply (auto simp add: isRev_getRevRole getRevRole_Some)[]
   apply (metis eqExcPID2_imp' isRev_isPC not_less option.inject pref_Conflict_isRev role.distinct role.inject ss1
                isRev_isPC not_less pref_Conflict_isRev simps2(1) simps2(8) isRev_getRevRole getRevRole_Some)+
   done
  } note this[simp]

  {fix cid uid p pid assume "a = Ract (rFinalDec cid uid p pid)"
   hence ?thesis
   apply(cases "pid = PID")
   using step step1 eqs eqs' s s1 UIDs PID \<phi> \<phi>1 ph
   paperIDs_equals[OF s] Inv using eeqExcPID_RDD by fastforce+
  } note this[simp]

  show ?thesis
    using step step1 eqs eqs' s s1 UIDs PID \<phi> \<phi>1 ph
    paperIDs_equals[OF s] Inv
    apply(cases a)
      subgoal for x1 by (cases x1; auto)
      subgoal for x2 apply(cases x2)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal apply clarsimp
          subgoal by (metis eqExcPID2_imp' isRev_pref_notConflict_isPC nat_neq_iff simps2(7) ss1)
          subgoal by (metis isRev_pref_notConflict_isPC nat_neq_iff simps2(1)) . .
      subgoal for x3 apply(cases x3)
        subgoal by auto
        subgoal by auto
        subgoal apply clarsimp
          subgoal by (metis isRev_pref_notConflict_isPC le_antisym less_imp_le_nat n_not_Suc_n simps2(1) simps2(5))
          subgoal by (metis isRev_pref_notConflict_isPC le_antisym less_imp_le_nat n_not_Suc_n simps2(1)) .
        subgoal by auto .
      subgoal for x4 apply(cases x4)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (metis eqExcPID2_RDD ss1)
        subgoal apply clarsimp
          subgoal by (metis eqExcPID2_RDD ss1)
          subgoal by auto .
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (metis eqExcPID2_imp2 less_imp_le_nat not_less_eq_eq ss1)
        subgoal by clarsimp (metis less_imp_le_nat not_less_eq_eq)
        subgoal by clarsimp (metis discussion.inject less_imp_le_nat not_less_eq_eq)
        subgoal by clarsimp (metis (mono_tags, lifting) Suc_le_lessD not_less_eq)
        subgoal by auto
        subgoal by clarsimp linarith .
      subgoal for x5 apply(cases x5)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (metis (no_types, opaque_lifting) empty_iff list.set(1)
                           notInPaperIDs_eqExLRL_roles_eq notIsPC_eqExLRL_roles_eq simps2(5) ss1)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (smt Suc_le_lessD eqExcRLR_imp filter_cong isRev_pref_notConflict_isPC not_less_eq)
        subgoal by clarsimp (metis Suc_le_lessD eqExcPID2_imp' not_less_eq ss1) .
    done
qed

definition \<Delta>1 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>1 s vl s1 vl1 \<equiv>
 (\<forall> cid. PID \<in>\<in> paperIDs s cid \<longrightarrow> phase s cid < revPH) \<and> s = s1
 \<and> B vl vl1"

definition \<Delta>2 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>2 s vl s1 vl1 \<equiv>
 \<exists> cid uid.
   PID \<in>\<in> paperIDs s cid \<and> phase s cid = revPH \<and>
   isChair s cid uid \<and> pref s uid PID \<noteq> Conflict \<and>
   eqExcPID2 s s1 \<and>
   distinct (map fst vl1) \<and>
   fst ` (set vl1) \<subseteq> {uid'. isPC s cid uid' \<and> pref s uid' PID \<noteq> Conflict} \<and>
   fst ` (set vl1) \<inter> {uid'. isRev s1 cid uid' PID} = {} \<and>
   snd ` (set vl1) \<subseteq> {{uid'. isPC s cid uid' \<and> pref s uid' PID \<noteq> Conflict}}"

definition \<Delta>3 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>3 s vl s1 vl1 \<equiv>
 \<exists> cid. PID \<in>\<in> paperIDs s cid \<and> phase s cid > revPH \<and> eqExcPID2 s s1 \<and> vl1 = []"

definition \<Delta>e :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>e s vl s1 vl1 \<equiv>
 vl \<noteq> [] \<and>
 (
  (\<exists> cid. PID \<in>\<in> paperIDs s cid \<and> phase s cid \<ge> revPH \<and>
          \<not> (\<exists> uid. isChair s cid uid \<and> pref s uid PID \<noteq> Conflict))
  \<or>
  (\<exists> cid. PID \<in>\<in> paperIDs s cid \<and> phase s cid \<ge> revPH \<and>
          snd (hd vl) \<noteq> {uid'. isPC s cid uid' \<and> pref s uid' PID \<noteq> Conflict})
  \<or>
  (\<exists> cid. PID \<in>\<in> paperIDs s cid \<and> phase s cid > revPH)
 )"

lemma istate_\<Delta>1:
assumes B: "B vl vl1"
shows "\<Delta>1 istate vl istate vl1"
using B unfolding \<Delta>1_def B_def istate_def by auto

lemma unwind_cont_\<Delta>1: "unwind_cont \<Delta>1 {\<Delta>1,\<Delta>2,\<Delta>e}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>1 s vl s1 vl1 \<or> \<Delta>2 s vl s1 vl1 \<or> \<Delta>e s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and B: "B vl vl1"
  and c_d: "distinct (map fst vl1) \<and> fst ` (set vl1) \<subseteq> snd (hd vl) \<and> snd ` (set vl1) = {snd (hd vl)}"
  and vl: "vl \<noteq> []"
  and PID_ph: "\<And> cid. PID \<in>\<in> paperIDs s cid \<Longrightarrow> phase s cid < revPH"
  using reachNT_reach unfolding \<Delta>1_def B_def by auto
  have rv: "\<And> cid. \<not> (\<exists> uid'. isRev s cid uid' PID)" using rs PID_ph
  by (metis isRev_geq_revPH isRev_paperIDs less_Suc_eq_le not_less_eq_eq)
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have \<phi>: "\<not> \<phi> ?trn"
        apply(cases a)
        subgoal for x1 apply(cases x1) using step PID_ph by (fastforce simp: c_defs)+
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using \<phi> by auto
        next
          show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
        next
          assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?\<Delta> s' vl' s' vl1"
          proof(cases "\<exists> cid. PID \<in>\<in> paperIDs s cid")
            case False note PID = False
            have PID_ph': "\<And> cid. PID \<in>\<in> paperIDs s' cid \<Longrightarrow> phase s' cid < revPH" using PID step rs
              apply(cases a)
              subgoal for _ x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for _ x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for _ x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "\<Delta>1 s' vl' s' vl1" unfolding \<Delta>1_def B_def vl' using PID_ph' c_d vl by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID \<in>\<in> paperIDs s CID" by auto
            hence ph: "phase s CID < revPH" using PID_ph by auto
            have PID': "PID \<in>\<in> paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < revPH")
              case True note ph' = True
              hence "\<Delta>1 s' vl' s' vl1" unfolding \<Delta>1_def B_def vl' using vl c_d ph' PID' apply auto
              by (metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False
              hence ph_rv': "phase s' CID = revPH \<and> \<not> (\<exists> uid'. isRev s' CID uid' PID)"
              using ph PID step rs rv
                apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs isRev_def2)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
                by auto
              show ?thesis
              proof(cases "(\<exists> uid. isChair s' CID uid \<and> pref s' uid PID \<noteq> Conflict) \<and>
                           snd (hd vl) = {uid'. isPC s' CID uid' \<and> pref s' uid' PID \<noteq> Conflict}")
                case True
                hence "\<Delta>2 s' vl' s' vl1"
                unfolding \<Delta>2_def B_def vl' using c_d ph_rv' PID' by auto
                thus ?thesis by auto
              next
                case False
                hence "\<Delta>e s' vl' s' vl1"
                unfolding \<Delta>e_def vl' using vl c_d ph_rv' PID' by auto
                thus ?thesis by auto
              qed
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_\<Delta>2: "unwind_cont \<Delta>2 {\<Delta>2,\<Delta>3,\<Delta>e}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>2 s vl s1 vl1 \<or> \<Delta>3 s vl s1 vl1 \<or> \<Delta>e s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>2 s vl s1 vl1"
  then obtain CID uid where uid: "isChair s CID uid \<and> pref s uid PID \<noteq> Conflict"
  and rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _") and ss1: "eqExcPID2 s s1"
  and PID: "PID \<in>\<in> paperIDs s CID"
  and dis: "distinct (map fst vl1)"
  and fst_isPC: "fst ` (set vl1) \<subseteq> {uid'. isPC s CID uid' \<and> pref s uid' PID \<noteq> Conflict}"
  and fst_isRev: "fst ` (set vl1) \<inter> {uid'. isRev s1 CID uid' PID} = {}"
  and snd_isPC: "snd ` (set vl1) \<subseteq> {{uid'. isPC s CID uid' \<and> pref s uid' PID \<noteq> Conflict}}"
  using reachNT_reach unfolding \<Delta>2_def by auto
  hence uid_notin: "uid \<notin> UIDs"
    using reachNT_non_isPC_isChair rsT by fastforce
  note vl1_all = dis fst_isPC fst_isRev snd_isPC
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof(cases vl1)
    case (Cons v1 vl1') note vl1 = Cons
    obtain uid' where v1: "v1 = (uid', {uid'. isPC s CID uid' \<and> pref s uid' PID \<noteq> Conflict})"
    using snd_isPC unfolding vl1 by(cases v1) auto
    hence uid': "isPC s CID uid' \<and> pref s uid' PID \<noteq> Conflict"
    and uid'1: "\<not> isRev s1 CID uid' PID"
    using fst_isPC fst_isRev unfolding vl1 by auto
    have uid1: "isChair s1 CID uid \<and> pref s1 uid PID \<noteq> Conflict"
    using ss1 uid unfolding eqExcPID2_def using eqExcRLR_imp2 by metis
    define a1 where "a1 \<equiv> Cact (cReview CID uid (pass s uid) PID uid')"
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID2 s1 s1'" using a1_def step1 cReview_step_eqExcPID2 by blast
    have ss1': "eqExcPID2 s s1'" using eqExcPID2_trans[OF ss1 s1s1'] .
    hence many_s1': "PID \<in>\<in> paperIDs s1' CID" "isChair s1' CID uid \<and> pref s1' uid PID \<noteq> Conflict"
    "phase s1' CID = revPH" "pass s1' uid = pass s uid"
    "isPC s1' CID uid' \<and> pref s1' uid' PID \<noteq> Conflict"
    using uid' uid PID ph unfolding eqExcPID2_def using eqExcRLR_imp2 apply auto by metis+
    hence more_s1': "uid \<in>\<in> userIDs s1'" "CID \<in>\<in> confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have ou1: "ou1 = outOK" using step1 unfolding a1_def apply ( simp add: c_defs)
    using more_s1' many_s1' uid'1 by (metis roles_userIDs rs1)
    have f: "f ?trn1 = v1" unfolding a1_def v1 apply simp
    using ss1 unfolding eqExcPID2_def using eqExcRLR_imp2
    by (metis eqExcRLR_set isRevRoleFor.simps(3))
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show \<phi>: "\<phi> ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 by simp
    next
      show "\<not> \<gamma> ?trn1" by (simp add: a1_def uid_notin)
    next
      have "{uid'. isRev s1' CID uid' PID} \<subseteq> insert uid' {uid'. isRev s1 CID uid' PID}"
      using step1 unfolding a1_def ou1 by (auto simp add: c_defs isRev_def2 )
      hence "fst ` set vl1' \<inter> {uid'. isRev s1' CID uid' PID} = {}"
      using fst_isRev dis unfolding vl1 v1 by auto
      hence "\<Delta>2 s vl s1' vl1'" unfolding \<Delta>2_def
      using PID ph ss1' uid using vl1_all unfolding vl1 by auto
      thus "?\<Delta> s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID \<in>\<in> paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isChair s' CID uid \<and> pref s' uid PID \<noteq> Conflict"
      using uid step rs ph PID isChair_persistent revPH_pref_persists[OF rs PID ] by auto
      have all_vl1':
      "fst ` (set vl1) \<subseteq> {uid'. isPC s' CID uid' \<and> pref s' uid' PID \<noteq> Conflict}"
      and "snd ` (set vl1) \<subseteq> {{uid'. isPC s' CID uid' \<and> pref s' uid' PID \<noteq> Conflict}}"
      using vl1_all
      apply (metis (full_types) empty_subsetI image_empty set_empty vl1)
      by (metis (lifting, no_types) empty_set image_is_empty subset_insertI vl1)
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof(cases "\<phi> ?trn")
        case False note \<phi> = False
        have vl: "vl' = vl" using c \<phi> unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID2 s' s1'" using eqExcPID2_step[OF rs ss1 step step1 PID] ph \<phi> by auto
        show ?thesis
        proof(cases "ou = outErr \<and> \<not> \<gamma> ?trn")
          case True note ou = True[THEN conjunct1] and \<gamma> = True[THEN conjunct2]
          have s': "s' = s" using step ou by (metis step_outErr_eq)
          have ?ignore proof
            show "\<not> \<gamma> ?trn" by fact
          next
            show "?\<Delta> s' vl' s1 vl1"
            proof(cases "?ph' = revPH")
              case True
              hence "\<Delta>2 s' vl' s1 vl1" using ss1 PID' uid' vl1_all unfolding \<Delta>2_def vl1 s' by auto
              thus ?thesis by auto
            next
              case False hence ph': "?ph' > revPH" using ph rs step s' by blast
              show ?thesis
              proof(cases vl')
                case Nil
                hence "\<Delta>3 s' vl' s1 vl1" using ss1 PID' ph' unfolding \<Delta>3_def vl1 s' by auto
                thus ?thesis by auto
              next
                case Cons
                hence "\<Delta>e s' vl' s1 vl1" using PID' ph' unfolding \<Delta>e_def by auto
                thus ?thesis by auto
              qed
            qed
          qed
          thus ?thesis by auto
        next
          case False note ou_\<gamma> = False
          have \<phi>1: "\<not> \<phi> ?trn1"
          using non_eqExcPID2_step_\<phi>_imp[OF rs ss1 PID _ step step1 \<phi>]
                T_\<phi>_\<gamma>_1[OF rsT rs1 PID ss1 step1 _ \<phi>] ou_\<gamma> by auto
          have ?match
          proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 vl1" unfolding consume_def using \<phi>1 by auto
          next
            show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
          next
            assume "\<gamma> ?trn" thus "g ?trn = g ?trn1"
            using eqExcPID2_step_out[OF ss1 step step1 rsT rs1 PID _ \<phi> \<phi>1] ph by simp
          next
            show "?\<Delta> s' vl' s1' vl1"
            proof(cases "?ph' = revPH")
              case True note ph' = True
              hence "\<Delta>2 s' vl' s1' vl1" using PID' s's1' uid' ph' vl1_all unfolding \<Delta>2_def vl1 by auto
              thus ?thesis by auto
            next
              case False hence ph': "?ph' > revPH" using ph rs step by (metis antisym_conv2 phase_increases)
              show ?thesis
              proof(cases vl')
                case Nil
                hence "\<Delta>3 s' vl' s1' vl1" using s's1' PID' ph' unfolding \<Delta>3_def vl1 by auto
                thus ?thesis by auto
              next
                case Cons
                hence "\<Delta>e s' vl' s1' vl1" using PID' ph' unfolding \<Delta>e_def by auto
                thus ?thesis by auto
              qed
            qed
          qed
          thus ?thesis by simp
        qed
      next
        case True note \<phi> = True
        have s's: "eqExcPID2 s' s" using eqExcPID2_sym using \<phi>_step_eqExcPID2[OF \<phi> step]  .
        have s's1: "eqExcPID2 s' s1" using eqExcPID2_trans[OF s's ss1] .
        have ?ignore proof
          show "\<not> \<gamma> ?trn" using T_\<phi>_\<gamma> \<phi> rsT step by auto
        next
          show "?\<Delta> s' vl' s1 vl1"
          proof(cases "?ph' = revPH")
            case True
            hence "\<Delta>2 s' vl' s1 vl1" using s's1 PID' uid' vl1_all unfolding \<Delta>2_def vl1 by auto
            thus ?thesis by auto
          next
            case False hence ph': "?ph' > revPH" using ph rs step by (metis antisym_conv2 phase_increases)
            show ?thesis
            proof(cases vl')
                case Nil
                hence "\<Delta>3 s' vl' s1 vl1" using s's1 PID' ph' unfolding \<Delta>3_def vl1 by auto
                thus ?thesis by auto
              next
                case Cons
                hence "\<Delta>e s' vl' s1 vl1" using PID' ph' unfolding \<Delta>e_def by auto
                thus ?thesis by auto
              qed
            qed
          qed
          thus ?thesis by auto
        qed
      qed
      thus ?thesis using vl1 by auto
    qed
qed

lemma unwind_cont_\<Delta>3: "unwind_cont \<Delta>3 {\<Delta>3,\<Delta>e}"
proof(rule, simp)
  let ?\<Delta> = "\<lambda>s vl s1 vl1. \<Delta>3 s vl s1 vl1 \<or> \<Delta>e s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>3 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID > revPH" (is "?ph > _")
  and PID: "PID \<in>\<in> paperIDs s CID" and ss1: "eqExcPID2 s s1"
  and vl1: "vl1 = []"
  using reachNT_reach unfolding \<Delta>3_def by auto
  show "iaction ?\<Delta> s vl s1 vl1 \<or>
        ((vl = [] \<longrightarrow> vl1 = []) \<and> reaction ?\<Delta> s vl s1 vl1)" (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID \<in>\<in> paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have ph': "phase s' CID > revPH" using ph rs by (meson less_le_trans local.step phase_increases)
      show "match ?\<Delta> s s1 vl1 a ou s' vl' \<or> ignore ?\<Delta> s s1 vl1 a ou s' vl'" (is "?match \<or> ?ignore")
      proof(cases "\<phi> ?trn")
        case False note \<phi> = False
        have vl': "vl' = vl" using c \<phi> unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID2 s' s1'" using eqExcPID2_step[OF rs ss1 step step1 PID] ph \<phi> by auto
        have \<phi>1: "\<not> \<phi> ?trn1" using \<phi> unfolding eqExcPID2_step_\<phi>[OF rs rs1 ss1 PID ph step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using \<phi>1 by auto
        next
          show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
        next
          assume "\<gamma> ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID2_step_out[OF ss1 step step1 rsT rs1 PID _ \<phi> \<phi>1] ph by simp
        next
          have "\<Delta>3 s' vl' s1' vl1" using ph' PID' s's1' unfolding \<Delta>3_def vl1 by auto
          thus "?\<Delta> s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      next
        case True note \<phi> = True
        have s's: "eqExcPID2 s' s" using eqExcPID2_sym[OF \<phi>_step_eqExcPID2[OF \<phi> step]] .
        have s's1: "eqExcPID2 s' s1" using eqExcPID2_trans[OF s's ss1] .
        have ?ignore proof
          show "\<not> \<gamma> ?trn" using T_\<phi>_\<gamma> \<phi> rsT step by auto
        next
          have "\<Delta>3 s' vl' s1 vl1" using s's1 PID' ph' vl1 unfolding \<Delta>3_def by auto
          thus "?\<Delta> s' vl' s1 vl1" by auto
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

(* Exit arguments: *)
definition K1exit where
"K1exit cid s \<equiv> PID \<in>\<in> paperIDs s cid \<and> phase s cid \<ge> revPH \<and>
                \<not> (\<exists> uid. isChair s cid uid \<and> pref s uid PID \<noteq> Conflict)"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
  unfolding invarNT_def
  apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K1exit_def paperIDs_equals)
      apply (metis less_eq_Suc_le less_not_refl paperIDs_equals) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K1exit_def) .
    by auto
  done

lemma noVal_K1exit: "noVal (K1exit cid) v"
  apply(rule no\<phi>_noVal)
  unfolding no\<phi>_def
  apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
      apply (auto simp add: c_defs K1exit_def)
      by (metis paperIDs_equals reachNT_reach)
    by auto
  done

definition K2exit where
"K2exit cid s v \<equiv>
 PID \<in>\<in> paperIDs s cid \<and> phase s cid \<ge> revPH \<and>
 snd v \<noteq> {uid'. isPC s cid uid' \<and> pref s uid' PID \<noteq> Conflict}"

lemma revPH_isPC_constant:
assumes s: "reach s"
and "step s a = (ou,s')"
and "pid \<in>\<in> paperIDs s cid" and "phase s cid \<ge> revPH"
shows "isPC s' cid uid' = isPC s cid uid'"
  using assms
  apply(cases a)
  subgoal for x1 apply(cases x1)
           apply (auto simp add: c_defs)
    by (metis paperIDs_confIDs)
  subgoal for x2 apply(cases x2) apply (auto simp add: u_defs) .
  subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs) .
  by auto

lemma revPH_pref_constant:
assumes s: "reach s"
and "step s a = (ou,s')"
and "pid \<in>\<in> paperIDs s cid" and "phase s cid \<ge> revPH"
shows "pref s' uid pid = pref s uid pid"
  using assms
  apply(cases a)
  subgoal for x1 apply(cases x1)
           apply (auto simp add: c_defs)
      apply (metis paperIDs_getAllPaperIDs)
     apply (metis Suc_n_not_le_n le_SucI paperIDs_equals)
    apply (metis Suc_n_not_le_n le_SucI paperIDs_equals) .
  subgoal for x2 apply(cases x2)
          apply (auto simp add: u_defs)
    apply (metis Suc_n_not_le_n paperIDs_equals) .
  subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs) .
  by auto

lemma invarNT_K2exit: "invarNT (\<lambda> s. K2exit cid s v)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
unfolding K2exit_def
by (smt Collect_cong le_trans paperIDs_mono phase_increases revPH_isPC_constant revPH_pref_constant)

(* An even more interesting invariant than the one in Review_Confidentiality/RAut:
it requires the binary version noVal2  *)
lemma noVal_K2exit: "noVal2 (K2exit cid) v"
  unfolding noVal2_def
  apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
             apply (auto simp add: c_defs K2exit_def)
      by (metis paperIDs_equals reachNT_reach)+
    by auto
  done

definition K3exit where
"K3exit cid s \<equiv> PID \<in>\<in> paperIDs s cid \<and> phase s cid > revPH"

lemma invarNT_K3exit: "invarNT (K3exit cid)"
  unfolding invarNT_def
  apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (auto simp add: c_defs K3exit_def) .
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K3exit_def) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K3exit_def) .
    by auto
  done

lemma noVal_K3exit: "noVal (K3exit cid) v"
  apply(rule no\<phi>_noVal)
  unfolding no\<phi>_def
  apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
             apply (auto simp add: c_defs K3exit_def)
      using paperIDs_equals reachNT_reach by fastforce
    by auto
  done

lemma unwind_exit_\<Delta>e: "unwind_exit \<Delta>e"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and \<Delta>e: "\<Delta>e s vl s1 vl1"
  hence vl: "vl \<noteq> []" using reachNT_reach unfolding \<Delta>e_def by auto
  then obtain CID where "K1exit CID s \<or> K2exit CID s (hd vl) \<or> K3exit CID s"
  using \<Delta>e unfolding K1exit_def K2exit_def K3exit_def \<Delta>e_def by auto
  thus "vl \<noteq> [] \<and> exit s (hd vl)" apply(simp add: vl)
  by (metis exitI2 exitI2_noVal2 invarNT_K1exit invarNT_K2exit invarNT_K3exit
            noVal_K1exit noVal_K2exit noVal_K3exit rsT)
qed

theorem secure: secure
apply(rule unwind_decomp3_secure[of \<Delta>1 \<Delta>2 \<Delta>e \<Delta>3])
using
istate_\<Delta>1
unwind_cont_\<Delta>1 unwind_cont_\<Delta>2 unwind_cont_\<Delta>3
unwind_exit_\<Delta>e
by auto

end


theory TA_More
  imports Timed_Automata TA_DBM_Operations Refine_Imperative_HOL.IICF TA_Library.Graphs
begin

chapter \<open>Mixed Additional Material on Timed Automata\<close>

text \<open>
  Additional Lemmas on Timed Automata that do not belong to a particular other part of the
  formalization.
\<close>

fun extend_cc where
  "extend_cc cc [] = cc"
| "extend_cc cc (c # cs) = GE c 0 # extend_cc cc cs"

lemma collect_clock_pairs_extend_cc:
  "collect_clock_pairs (extend_cc cc cs) = collect_clock_pairs cc \<union> {(c, 0) | c. c \<in> set cs}"
  by (induction cs) (auto simp: collect_clock_pairs_def)

definition
  "extend_ta A xs \<equiv> (trans_of A, \<lambda> l. extend_cc (inv_of A l) xs)"

(* XXX Interestingly, this does not go through without the IICF simpset *)
lemma clk_set_extend_ta:
  "clk_set (extend_ta A xs) = clk_set A \<union> set xs"
  unfolding extend_ta_def clkp_set_def inv_of_def trans_of_def
  by (auto simp: collect_clki_def collect_clock_pairs_extend_cc)

lemma extend_cc_iff:
  "u \<turnstile> extend_cc cc cs \<longleftrightarrow> u \<turnstile> cc" if "\<forall> c. u c \<ge> 0"
  using that by (induction cs) (force simp: clock_val_def)+

lemma [simp]:
  "inv_of (extend_ta A cs) l = extend_cc (inv_of A l) cs"
  unfolding extend_ta_def inv_of_def by simp

lemma reset_V:
  "\<forall> c. ([r\<rightarrow>0]u) c \<ge> 0" if "\<forall> c. u c \<ge> 0"
  using that apply safe
  subgoal for c
    by (cases "c \<in> set r") (auto simp add: reset_set1 reset_set11)
  done

lemma delay_V:
  "\<forall> c. (u \<oplus> d) c \<ge> 0" if "\<forall> c. u c \<ge> 0" "(d :: 't :: time) \<ge> 0"
  using that unfolding cval_add_def by auto

context
  notes [elim!]  = step.cases step'.cases step_t.cases step_z.cases
begin

lemma extend_ta_iff:
  "A \<turnstile> \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle> \<longleftrightarrow> extend_ta A cs \<turnstile> \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle>" if "\<forall> c. u c \<ge> 0"
  using that apply safe
     apply (force simp: extend_cc_iff reset_V intro: step_a.intros elim!: step_a.cases)
    apply (force simp add: extend_cc_iff delay_V)
   apply (cases rule: step_a.cases, assumption)
   apply (rule step.intros, rule step_a.intros)
  unfolding extend_ta_def apply (force simp: trans_of_def)
     apply assumption+
  prefer 2
  apply assumption
  subgoal
    by (metis extend_cc_iff inv_of_def prod.sel(2) reset_V)
  subgoal
    by (metis delay_V extend_cc_iff inv_of_def prod.sel(2) step_t step_t.intros)
  done
    (*  apply simp
apply (force simp add: extend_cc_iff)
   apply (auto simp add: reset_V extend_cc_iff intro: step_a.intros)
  using extend_cc_iff delay_V by fas *)

lemma steps_iffI:
  "A \<turnstile> \<langle>l, u\<rangle> \<rightarrow>* \<langle>l', u'\<rangle> \<longleftrightarrow> A' \<turnstile> \<langle>l, u\<rangle> \<rightarrow>* \<langle>l', u'\<rangle>" if
  "\<And> l u l' u'. P u \<Longrightarrow> A \<turnstile> \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle> \<longleftrightarrow> A' \<turnstile> \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle>"
  "\<And> (A :: ('a, 'c, 't :: time, 's) ta) l u l' u'. A \<turnstile> \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle> \<Longrightarrow> P u \<Longrightarrow> P u'" "P u" for
  A A' :: "('a, 'c, 't :: time, 's) ta"
  apply standard
   apply (insert that(3))
  subgoal
    by (induction A\<equiv> A _ _ _ _ rule: steps.induct) (auto simp: that(1,2))
  by (induction A\<equiv> A' _ _ _ _ rule: steps.induct) (auto simp: that(2) that(1)[symmetric])

lemma step_V:
  "\<forall> c. u' c \<ge> 0" if "A \<turnstile> \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle>" "\<forall> c. u c \<ge> 0"
  using that by (auto simp: reset_V delay_V elim: step_a.cases)

end (* End of context for aggressive elimination rules *)

lemma extend_ta_iff_steps:
  "A \<turnstile> \<langle>l, u\<rangle> \<rightarrow>* \<langle>l', u'\<rangle> \<longleftrightarrow> extend_ta A cs \<turnstile> \<langle>l, u\<rangle> \<rightarrow>* \<langle>l', u'\<rangle>" if "\<forall> c. u c \<ge> 0"
  apply (intro steps_iffI extend_ta_iff)
    apply assumption
  by (rule step_V, assumption+, rule that)

lemma collect_clkvt_alt_def:
  "collect_clkvt T = \<Union>((set o fst \<circ> snd \<circ> snd \<circ> snd) ` T)"
unfolding collect_clkvt_def by fastforce

lemma ta_collect_clkt_alt_def:
  "collect_clkt S = \<Union> (collect_clock_pairs ` (fst o snd) ` S)"
unfolding Timed_Automata.collect_clkt_def by fastforce

lemma ta_collect_clki_alt_def:
  "collect_clki I = \<Union> (collect_clock_pairs ` I ` UNIV)"
unfolding Timed_Automata.collect_clki_def by auto

lemma constraint_clk_constraint_pair:
  "constraint_clk ac = fst (constraint_pair ac)"
by (cases ac) auto

lemma collect_clks_inv_clk_set:
  "collect_clks (inv_of A l) \<subseteq> clk_set A"
  unfolding
    clkp_set_def collect_clki_def collect_clks_def collect_clock_pairs_def
  by (auto simp: constraint_clk_constraint_pair)

lemma collect_clocks_clk_set:
  assumes
    "A \<turnstile> l \<longrightarrow>\<^bsup>g,a,r\<^esup> l'"
  shows
    "collect_clks g \<subseteq> clk_set A"
  using assms unfolding clkp_set_def collect_clks_id collect_clkt_def by fastforce

lemma reset_clk_set:
  assumes
    "A \<turnstile> l \<longrightarrow>\<^bsup>g,a,r\<^esup> l'"
  shows
    "set r \<subseteq> clk_set A"
using assms by (fastforce simp: clkp_set_def collect_clkvt_def)

lemma ac_iff:
  "u1 \<turnstile>\<^sub>a ac \<longleftrightarrow> u2 \<turnstile>\<^sub>a ac" if
  "u1 (fst (constraint_pair ac)) = u2 (fst (constraint_pair ac))"
  using that by (cases ac) auto

lemma ac_iff':
  "u1 \<turnstile>\<^sub>a ac \<longleftrightarrow> u2 \<turnstile>\<^sub>a ac" if
  "u1 (constraint_clk ac) = u2 (constraint_clk ac)"
  using that by (cases ac) auto

lemma cc_iff:
  "u1 \<turnstile> cc \<longleftrightarrow> u2 \<turnstile> cc" if "\<forall> (c, d) \<in> collect_clock_pairs cc. u1 c = u2 c"
  using that
  by (auto 4 3 simp: ac_iff[of u1 _ u2] list_all_iff collect_clock_pairs_def clock_val_def)

lemma cc_iff':
  "u1 \<turnstile> cc \<longleftrightarrow> u2 \<turnstile> cc" if "\<forall> c \<in> collect_clks cc. u1 c = u2 c"
  using that
  by (auto simp: ac_iff'[of u1 _ u2] list_all_iff collect_clks_def clock_val_def)

lemma step_t_bisim:
  "\<exists> u2'. A \<turnstile> \<langle>l, u2\<rangle> \<rightarrow>\<^bsup>d\<^esup> \<langle>l', u2'\<rangle> \<and> (\<forall> c. c \<in> clk_set A \<longrightarrow> u1' c = u2' c)"
  if assms: "A \<turnstile> \<langle>l, u1\<rangle> \<rightarrow>\<^bsup>d\<^esup> \<langle>l', u1'\<rangle>" "\<forall> c. c \<in> clk_set A \<longrightarrow> u1 c = u2 c"
  using that(1)
  apply cases
  apply (subst (asm) cc_iff'[of _ _ "u2 \<oplus> d"])
  subgoal
    using collect_clks_inv_clk_set[of A l] assms(2) by (auto simp: cval_add_def)
  using assms(2) by (force simp: cval_add_def)

lemma step_a_bisim:
  "\<exists> u2'. A \<turnstile> \<langle>l, u2\<rangle> \<rightarrow>\<^bsub>a\<^esub> \<langle>l', u2'\<rangle> \<and> (\<forall> c. c \<in> clk_set A \<longrightarrow> u1' c = u2' c)"
  if assms: "A \<turnstile> \<langle>l, u1\<rangle> \<rightarrow>\<^bsub>a\<^esub> \<langle>l', u1'\<rangle>" "\<forall> c. c \<in> clk_set A \<longrightarrow> u1 c = u2 c"
  using that(1)
  apply cases
  subgoal for g r
    apply (subst (asm) cc_iff'[of _ _ "u2"])
    subgoal
      using assms(2) by (force dest: collect_clocks_clk_set)
    apply (subst (asm) (2) cc_iff'[of _ _ "[r\<rightarrow>0]u2"])
    subgoal
      apply rule
      subgoal for c
        using collect_clks_inv_clk_set[of A l'] assms(2) by (cases "c \<in> set r"; force)
      done
    apply (intro exI conjI)
     apply (rule, assumption+)
     apply (simp; fail)
    apply rule
    subgoal for c
      using collect_clks_inv_clk_set[of A l'] assms(2) by (cases "c \<in> set r"; force)
    done
  done

lemma step'_bisim:
  "\<exists> u2'. A \<turnstile>' \<langle>l, u2\<rangle> \<rightarrow> \<langle>l', u2'\<rangle> \<and> (\<forall> c. c \<in> clk_set A \<longrightarrow> u1' c = u2' c)"
  if assms: "A \<turnstile>' \<langle>l, u1\<rangle> \<rightarrow> \<langle>l', u1'\<rangle>" "\<forall> c. c \<in> clk_set A \<longrightarrow> u1 c = u2 c"
  using that(1)
  apply cases
  apply (drule step_t_bisim[OF _ that(2)])
  apply clarify
  apply (drule step_a_bisim, assumption)
  apply auto
  done

lemma ta_bisimulation:
  "Bisimulation_Invariant
  (\<lambda> (l, u) (l', u'). A \<turnstile>' \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle>)
  (\<lambda> (l, u) (l', u'). A \<turnstile>' \<langle>l, u\<rangle> \<rightarrow> \<langle>l', u'\<rangle>)
  (\<lambda> (l, u) (l', u'). l' = l \<and> (\<forall> c. c \<in> clk_set A \<longrightarrow> u c = u' c))
  (\<lambda> _. True) (\<lambda> _. True)
  "
  apply standard
  subgoal for a b a'
    by clarify (drule step'_bisim; auto)
  subgoal for a b a'
    by clarify (drule step'_bisim; auto)
  ..

end (* Theory *)