(*  Title:       Isabelle Collections Library
    Author:      Andreas Lochbihler <andreas dot lochbihler at kit.edu>
    Maintainer:  Andreas Lochbihler <andreas dot lochbihler at kit.edu>
*)
header {* \isaheader{Array-based hash maps without explicit invariants} *}
theory ArrayHashMap
  imports ArrayHashMap_Impl
begin

(*@impl Map
  @type ('k,'v) ahm
  @abbrv ahm,a
  Array based hash maps without explicit invariant.
*)

subsection {* Abstract type definition *}

typedef ('key :: hashable, 'val) hashmap =
  "{hm :: ('key, 'val) ArrayHashMap_Impl.hashmap. ArrayHashMap_Impl.ahm_invar hm}"
  morphisms impl_of HashMap
proof
  interpret map_empty ArrayHashMap_Impl.ahm_\<alpha> ArrayHashMap_Impl.ahm_invar ArrayHashMap_Impl.ahm_empty
    by(rule ahm_empty_impl)
  show "ArrayHashMap_Impl.ahm_empty () \<in> ?hashmap"
    by(simp add: empty_correct)
qed

type_synonym ('k,'v) ahm = "('k,'v) hashmap"

lemma ahm_invar_impl_of [simp, intro]: "ArrayHashMap_Impl.ahm_invar (impl_of hm)"
using impl_of[of hm] by simp

lemma HashMap_impl_of [code abstype]: "HashMap (impl_of t) = t"
by(rule impl_of_inverse)

subsection {* Primitive operations *}

definition ahm_empty_const :: "('key :: hashable, 'val) hashmap"
where "ahm_empty_const \<equiv> (HashMap (ArrayHashMap_Impl.ahm_empty ()))"

definition ahm_empty :: "unit \<Rightarrow> ('key :: hashable, 'val) hashmap"
where "ahm_empty \<equiv> \<lambda>_. ahm_empty_const"

definition ahm_\<alpha> :: "('key :: hashable, 'val) hashmap \<Rightarrow> 'key \<Rightarrow> 'val option"
where "ahm_\<alpha> hm = ArrayHashMap_Impl.ahm_\<alpha> (impl_of hm)"

definition ahm_lookup :: "'key \<Rightarrow> ('key :: hashable, 'val) hashmap \<Rightarrow> 'val option"
where "ahm_lookup k hm = ArrayHashMap_Impl.ahm_lookup k (impl_of hm)"

definition ahm_iteratei :: "('key :: hashable, 'val) hashmap \<Rightarrow> ('key \<times> 'val, '\<sigma>) set_iterator"
where "ahm_iteratei hm = ArrayHashMap_Impl.ahm_iteratei (impl_of hm)"

definition ahm_update :: "'key \<Rightarrow> 'val \<Rightarrow> ('key :: hashable, 'val) hashmap \<Rightarrow> ('key, 'val) hashmap"
where
  "ahm_update k v hm = HashMap (ArrayHashMap_Impl.ahm_update k v (impl_of hm))"

definition ahm_delete :: "'key \<Rightarrow> ('key :: hashable, 'val) hashmap \<Rightarrow> ('key, 'val) hashmap"
where
  "ahm_delete k hm = HashMap (ArrayHashMap_Impl.ahm_delete k (impl_of hm))"

lemma impl_of_ahm_empty [code abstract]:
  "impl_of ahm_empty_const = ArrayHashMap_Impl.ahm_empty ()"
by(simp add: ahm_empty_const_def HashMap_inverse)

lemma impl_of_ahm_update [code abstract]:
  "impl_of (ahm_update k v hm) = ArrayHashMap_Impl.ahm_update k v (impl_of hm)"
by(simp add: ahm_update_def HashMap_inverse ahm_update_correct)

lemma impl_of_ahm_delete [code abstract]:
  "impl_of (ahm_delete k hm) = ArrayHashMap_Impl.ahm_delete k (impl_of hm)"
by(simp add: ahm_delete_def HashMap_inverse ahm_delete_correct)

lemma finite_dom_ahm_\<alpha>[simp]: "finite (dom (ahm_\<alpha> hm))"
  by (simp add: ahm_\<alpha>_def finite_dom_ahm_\<alpha>)

lemma ahm_empty_correct[simp]: "ahm_\<alpha> (ahm_empty ()) = Map.empty"
  by(simp add: ahm_\<alpha>_def ahm_empty_def ahm_empty_const_def HashMap_inverse)

lemma ahm_lookup_correct[simp]: "ahm_lookup k m = ahm_\<alpha> m k"
  by (simp add: ahm_lookup_def ArrayHashMap_Impl.ahm_lookup_def ahm_\<alpha>_def)

lemma ahm_update_correct[simp]: "ahm_\<alpha> (ahm_update k v hm) = (ahm_\<alpha> hm)(k \<mapsto> v)"
  by (simp add: ahm_\<alpha>_def ahm_update_def ahm_update_correct HashMap_inverse)

lemma ahm_delete_correct[simp]:
  "ahm_\<alpha> (ahm_delete k hm) = (ahm_\<alpha> hm) |` (- {k})"
  by (simp add: ahm_\<alpha>_def ahm_delete_def HashMap_inverse ahm_delete_correct)

lemma ahm_iteratei_impl[simp]: "map_iterator (ahm_iteratei m) (ahm_\<alpha> m)"
  unfolding ahm_iteratei_def ahm_\<alpha>_def
  apply (rule ahm_iteratei_correct)
  by simp

subsection {* ICF Integration *}

definition [icf_rec_def]: "ahm_basic_ops \<equiv> \<lparr>
  bmap_op_\<alpha> = ahm_\<alpha>,
  bmap_op_invar = \<lambda>_. True,
  bmap_op_empty = ahm_empty,
  bmap_op_lookup = ahm_lookup,
  bmap_op_update = ahm_update,
  bmap_op_update_dj = ahm_update, (* TODO: We could use a more efficient
    bucket update here *)
  bmap_op_delete = ahm_delete,
  bmap_op_list_it = ahm_iteratei
\<rparr>"

setup Locale_Code.open_block
interpretation ahm_basic!: StdBasicMap ahm_basic_ops
  apply unfold_locales
  apply (simp_all add: icf_rec_unf)
  done
setup Locale_Code.close_block

definition [icf_rec_def]: "ahm_ops \<equiv> ahm_basic.dflt_ops"

setup Locale_Code.open_block
interpretation ahm!: StdMap ahm_ops
  unfolding ahm_ops_def
  by (rule ahm_basic.dflt_ops_impl)
interpretation ahm!: StdMap_no_invar ahm_ops
  apply unfold_locales
  unfolding icf_rec_unf ..
setup Locale_Code.close_block

setup {* ICF_Tools.revert_abbrevs "ahm"*}

lemma pi_ahm[proper_it]:
  "proper_it' ahm_iteratei ahm_iteratei"
  unfolding ahm_iteratei_def[abs_def]
    ArrayHashMap_Impl.ahm_iteratei_def ArrayHashMap_Impl.ahm_iteratei_aux_def
  apply (rule proper_it'I)
  apply (case_tac "impl_of s")
  apply simp
  apply (rename_tac array nat)
  apply (case_tac array)
  apply simp
  by (intro icf_proper_iteratorI)

interpretation pi_ahm: proper_it_loc ahm_iteratei ahm_iteratei
  apply unfold_locales
  apply (rule pi_ahm)
  done

text {* Code generator test *}
definition test_codegen where "test_codegen \<equiv> (
  ahm.add ,
  ahm.add_dj ,
  ahm.ball ,
  ahm.bex ,
  ahm.delete ,
  ahm.empty ,
  ahm.isEmpty ,
  ahm.isSng ,
  ahm.iterate ,
  ahm.iteratei ,
  ahm.list_it ,
  ahm.lookup ,
  ahm.restrict ,
  ahm.sel ,
  ahm.size ,
  ahm.size_abort ,
  ahm.sng ,
  ahm.to_list ,
  ahm.to_map ,
  ahm.update ,
  ahm.update_dj)"

export_code test_codegen in SML

end


(*  Title:      HOL/Hoare/HeapSyntax.thy
    Author:     Tobias Nipkow
    Copyright   2002 TUM
*)

section \<open>Heap syntax\<close>

theory HeapSyntax
  imports Hoare_Logic Heap
begin

subsection "Field access and update"

syntax
  "_refupdate" :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a ref \<Rightarrow> 'b \<Rightarrow> ('a \<Rightarrow> 'b)"
   ("_/'((_ \<rightarrow> _)')" [1000,0] 900)
  "_fassign"  :: "'a ref => id => 'v => 's com"
   ("(2_^._ :=/ _)" [70,1000,65] 61)
  "_faccess"  :: "'a ref => ('a ref \<Rightarrow> 'v) => 'v"
   ("_^._" [65,1000] 65)
translations
  "f(r \<rightarrow> v)" == "f(CONST addr r := v)"
  "p^.f := e" => "f := f(p \<rightarrow> e)"
  "p^.f" => "f(CONST addr p)"

declare fun_upd_apply[simp del] fun_upd_same[simp] fun_upd_other[simp]

text "An example due to Suzuki:"

lemma "VARS v n
  {w = Ref w0 & x = Ref x0 & y = Ref y0 & z = Ref z0 &
   distinct[w0,x0,y0,z0]}
  w^.v := (1::int); w^.n := x;
  x^.v := 2; x^.n := y;
  y^.v := 3; y^.n := z;
  z^.v := 4; x^.n := z
  {w^.n^.n^.v = 4}"
by vcg_simp

end


section \<open> Syntax for reactive design contracts \<close>

theory utp_rdes_contracts
  imports utp_rdes_normal
begin

text \<open> We give an experimental syntax for reactive design contracts $[P \vdash Q | R]_R$, where $P$ is
  a precondition on undashed state variables only, $Q$ is a pericondition that can refer to the
  trace and before state but not the after state, and $R$ is a postcondition. Both $Q$ and $R$
  can refer only to the trace contribution through a HOL variable $trace$ which is bound to
  @{term "&tt"}. \<close>

definition mk_RD :: "'s upred \<Rightarrow> ('t::trace \<Rightarrow> 's upred) \<Rightarrow> ('t \<Rightarrow> 's hrel) \<Rightarrow> ('s, 't, 'a) hrel_rsp" where
"mk_RD P Q R = \<^bold>R\<^sub>s(\<lceil>P\<rceil>\<^sub>S\<^sub>< \<turnstile> \<lceil>Q(x)\<rceil>\<^sub>S\<^sub><\<lbrakk>x\<rightarrow>&tt\<rbrakk> \<diamondop> \<lceil>R(x)\<rceil>\<^sub>S\<lbrakk>x\<rightarrow>&tt\<rbrakk>)"

definition trace_pred :: "('t::trace \<Rightarrow> 's upred) \<Rightarrow> ('s, 't, '\<alpha>) hrel_rsp" where
[upred_defs]: "trace_pred P = [(P x)]\<^sub>S\<^sub><\<lbrakk>x\<rightarrow>&tt\<rbrakk>"

syntax
  "_trace_var" :: "logic"
  "_mk_RD"    :: "logic \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic" ("[_/ \<turnstile> _/ | _]\<^sub>R")
  "_trace_pred"    :: "logic \<Rightarrow> logic" ("[_]\<^sub>t")

parse_translation \<open>
let
  fun trace_var_tr [] = Syntax.free "trace"
    | trace_var_tr _  = raise Match;
in
[(@{syntax_const "_trace_var"}, K trace_var_tr)]
end
\<close>

translations
  "[P \<turnstile> Q | R]\<^sub>R" => "CONST mk_RD P (\<lambda> _trace_var. Q) (\<lambda> _trace_var. R)"
  "[P \<turnstile> Q | R]\<^sub>R" <= "CONST mk_RD P (\<lambda> x. Q) (\<lambda> y. R)"
  "[P]\<^sub>t" => "CONST trace_pred (\<lambda> _trace_var. P)"
  "[P]\<^sub>t" <= "CONST trace_pred (\<lambda> t. P)"

lemma SRD_mk_RD [closure]: "[P \<turnstile> Q(trace) | R(trace)]\<^sub>R is SRD"
  by (simp add: mk_RD_def closure unrest)

lemma preR_mk_RD [rdes]: "pre\<^sub>R([P \<turnstile> Q(trace) | R(trace) ]\<^sub>R) = R1(\<lceil>P\<rceil>\<^sub>S\<^sub><)"
  by (simp add: mk_RD_def rea_pre_RHS_design usubst unrest R2c_not R2c_lift_state_pre)

lemma trace_pred_RR_closed [closure]:
  "[P trace]\<^sub>t is RR"
  by (rel_auto)

lemma unrest_trace_pred_st' [unrest]:
  "$st\<acute> \<sharp> [P trace]\<^sub>t"
  by (rel_auto)

lemma R2c_msubst_tt: "R2c (msubst (\<lambda>x. \<lceil>Q x\<rceil>\<^sub>S) &tt) = (msubst (\<lambda>x. \<lceil>Q x\<rceil>\<^sub>S) &tt)"
  by (rel_auto)

lemma periR_mk_RD [rdes]: "peri\<^sub>R([P \<turnstile> Q(trace) | R(trace) ]\<^sub>R) = (\<lceil>P\<rceil>\<^sub>S\<^sub>< \<Rightarrow>\<^sub>r R1((\<lceil>Q(trace)\<rceil>\<^sub>S\<^sub><)\<lbrakk>trace\<rightarrow>&tt\<rbrakk>))"
  by (simp add: mk_RD_def rea_peri_RHS_design usubst unrest R2c_not R2c_lift_state_pre
      R2c_disj R2c_msubst_tt R1_disj R2c_rea_impl R1_rea_impl)

lemma postR_mk_RD [rdes]: "post\<^sub>R([P \<turnstile> Q(trace) | R(trace) ]\<^sub>R) = (\<lceil>P\<rceil>\<^sub>S\<^sub>< \<Rightarrow>\<^sub>r R1((\<lceil>R(trace)\<rceil>\<^sub>S)\<lbrakk>trace\<rightarrow>&tt\<rbrakk>))"
  by (simp add: mk_RD_def rea_post_RHS_design usubst unrest R2c_not R2c_lift_state_pre
      impl_alt_def R2c_disj R2c_msubst_tt R2c_rea_impl R1_rea_impl)

text \<open> Refinement introduction law for contracts \<close>

lemma RD_contract_refine:
  assumes
    "Q is SRD" "`\<lceil>P\<^sub>1\<rceil>\<^sub>S\<^sub>< \<Rightarrow> pre\<^sub>R Q`"
    "`\<lceil>P\<^sub>1\<rceil>\<^sub>S\<^sub>< \<and> peri\<^sub>R Q \<Rightarrow> \<lceil>P\<^sub>2 x\<rceil>\<^sub>S\<^sub><\<lbrakk>x\<rightarrow>&tt\<rbrakk>`"
    "`\<lceil>P\<^sub>1\<rceil>\<^sub>S\<^sub>< \<and> post\<^sub>R Q \<Rightarrow> \<lceil>P\<^sub>3 x\<rceil>\<^sub>S\<lbrakk>x\<rightarrow>&tt\<rbrakk>`"
  shows "[P\<^sub>1 \<turnstile> P\<^sub>2(trace) | P\<^sub>3(trace)]\<^sub>R \<sqsubseteq> Q"
proof -
  have "[P\<^sub>1 \<turnstile> P\<^sub>2(trace) | P\<^sub>3(trace)]\<^sub>R \<sqsubseteq> \<^bold>R\<^sub>s(pre\<^sub>R(Q) \<turnstile> peri\<^sub>R(Q) \<diamondop> post\<^sub>R(Q))"
    using assms
    by (simp add: mk_RD_def, rule_tac srdes_tri_refine_intro, simp_all)
  thus ?thesis
    by (simp add: SRD_reactive_tri_design assms(1))
qed

end


section \<open>\isaheader{Set Implementation by Arrays}\<close>
theory ArraySetImpl
imports
  "../spec/SetSpec"
  ArrayMapImpl
  "../gen_algo/SetByMap"
  "../gen_algo/SetGA"
begin
text_raw \<open>\label{thy:ArraySetImpl}\<close>

(*@impl Set
  @type ias
  @abbrv ias,is
  Sets of natural numbers implemented by arrays.
*)

subsection "Definitions"
type_synonym ias = "(unit) iam"

setup Locale_Code.open_block
interpretation ias_sbm: OSetByOMap iam_basic_ops by unfold_locales
setup Locale_Code.close_block
definition ias_ops :: "(nat,ias) oset_ops"
  where [icf_rec_def]:
  "ias_ops \<equiv> ias_sbm.obasic.dflt_oops"

setup Locale_Code.open_block
interpretation ias: StdOSet ias_ops
  unfolding ias_ops_def by (rule ias_sbm.obasic.dflt_oops_impl)
interpretation ias: StdSet_no_invar ias_ops
  by unfold_locales (simp add: icf_rec_unf SetByMapDefs.invar_def)
setup Locale_Code.close_block

setup \<open>ICF_Tools.revert_abbrevs "ias"\<close>

lemmas ias_it_to_it_map_code_unfold[code_unfold] =
  it_to_it_map_fold'[OF pi_iam]
  it_to_it_map_fold'[OF pi_iam_rev]

lemma pi_ias[proper_it]:
  "proper_it' ias.iteratei ias.iteratei"
  "proper_it' ias.iterateoi ias.iterateoi"
  "proper_it' ias.rev_iterateoi ias.rev_iterateoi"
  unfolding ias.iteratei_def[abs_def] ias.iterateoi_def[abs_def]
    ias.rev_iterateoi_def[abs_def]
  apply (rule proper_it'I icf_proper_iteratorI)+
  done

interpretation
  pi_ias: proper_it_loc ias.iteratei ias.iteratei +
  pi_ias_o: proper_it_loc ias.iterateoi ias.iterateoi +
  pi_ias_ro: proper_it_loc ias.rev_iterateoi ias.rev_iterateoi
  apply unfold_locales by (rule pi_ias)+

definition test_codegen where "test_codegen \<equiv> (
  ias.empty,
  ias.memb,
  ias.ins,
  ias.delete,
  ias.list_it,
  ias.sng,
  ias.isEmpty,
  ias.isSng,
  ias.ball,
  ias.bex,
  ias.size,
  ias.size_abort,
  ias.union,
  ias.union_dj,
  ias.diff,
  ias.filter,
  ias.inter,
  ias.subset,
  ias.equal,
  ias.disjoint,
  ias.disjoint_witness,
  ias.sel,
  ias.to_list,
  ias.from_list,

  ias.ordered_list_it,
  ias.rev_list_it,
  ias.min,
  ias.max,
  ias.to_sorted_list,
  ias.to_rev_list
)"

export_code test_codegen checking SML

end


theory Post_Unwinding_Helper_ISSUER
  imports Post_Observation_Setup_ISSUER
begin

locale Issuer_State_Equivalence_Up_To_PID = Fixed_PID
begin

subsubsection \<open>Unwinding helper lemmas and definitions\<close>

(* Auxiliary notion: two functions are equal everywhere but on the NIC (content) of
   the value corresponding to PID *)
definition eeqButPID where
"eeqButPID psts psts1 \<equiv>
 \<forall> pid. if pid = PID then True else psts pid = psts1 pid"

lemmas eeqButPID_intro = eeqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eeqButPID_eeq[simp,intro!]: "eeqButPID psts psts"
unfolding eeqButPID_def by auto

lemma eeqButPID_sym:
assumes "eeqButPID psts psts1" shows "eeqButPID psts1 psts"
using assms unfolding eeqButPID_def by auto

lemma eeqButPID_trans:
assumes "eeqButPID psts psts1" and "eeqButPID psts1 psts2" shows "eeqButPID psts psts2"
using assms unfolding eeqButPID_def by (auto split: if_splits)

lemma eeqButPID_cong:
assumes "eeqButPID psts psts1"
and "pid = PID \<Longrightarrow> eqButT uu uu1"
and "pid \<noteq> PID \<Longrightarrow> uu = uu1"
shows "eeqButPID (psts (pid := uu)) (psts1(pid := uu1))"
using assms unfolding eeqButPID_def by (auto split: if_splits)

(*
lemma eeqButPID_eqButT:
"eeqButPID psts psts1 \<Longrightarrow> eqButT (psts PID) (psts1 PID)"
unfolding eeqButPID_def by (auto split: if_splits)
*)

lemma eeqButPID_not_PID:
"\<lbrakk>eeqButPID psts psts1; pid \<noteq> PID\<rbrakk> \<Longrightarrow> psts pid = psts1 pid"
unfolding eeqButPID_def by (auto split: if_splits)

(*
lemma eeqButPID_postSelectors:
"eeqButPID psts psts1 \<Longrightarrow>
 titlePost (psts pid) = titlePost (psts1 pid) \<and>
 imgPost (psts pid) = imgPost (psts1 pid) \<and>
 visPost (psts pid) = visPost (psts1 pid)"
unfolding eeqButPID_def by (metis eqButT.simps)
*)

lemma eeqButPID_toEq:
assumes "eeqButPID psts psts1"
shows "psts (PID := pid) =
       psts1 (PID := pid)"
using eeqButPID_not_PID[OF assms] by auto

lemma eeqButPID_update_post:
assumes "eeqButPID psts psts1"
shows "eeqButPID (psts (pid := pst)) (psts1 (pid := pst))"
using eeqButPID_not_PID[OF assms]
using assms unfolding eeqButPID_def by auto

(* lists two pairs (apiID, boolean flag) are equal save for the boolean flag: *)
fun eqButF :: "(apiID \<times> bool) list \<Rightarrow> (apiID \<times> bool) list \<Rightarrow> bool" where
"eqButF aID_bl aID_bl1 = (map fst aID_bl = map fst aID_bl1)"

lemma eqButF_eq[simp,intro!]: "eqButF aID_bl aID_bl"
by auto

lemma eqButF_sym:
assumes "eqButF aID_bl aID_bl1"
shows "eqButF aID_bl1 aID_bl"
using assms by auto

lemma eqButF_trans:
assumes "eqButF aID_bl aID_bl1" and "eqButF aID_bl1 aID_bl2"
shows "eqButF aID_bl aID_bl2"
using assms by auto

lemma eqButF_insert2:
"eqButF aID_bl aID_bl1 \<Longrightarrow>
 eqButF (insert2 aID b aID_bl) (insert2 aID b aID_bl1)"
unfolding insert2_def
by simp (smt map_eq_conv o_apply o_id prod.collapse prod.sel(1) split_conv)

(* Auxiliary notion: two functions are equal everywhere but on the second component of NIC of
   the value corresponding to PID, which is a list of pairs *)
definition eeqButPID_F where
"eeqButPID_F sw sw1 \<equiv>
 \<forall> pid. if pid = PID then eqButF (sw PID) (sw1 PID) else sw pid = sw1 pid"

lemmas eeqButPID_F_intro = eeqButPID_F_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eeqButPID_F_eeq[simp,intro!]: "eeqButPID_F sw sw"
unfolding eeqButPID_F_def by auto

lemma eeqButPID_F_sym:
assumes "eeqButPID_F sw sw1" shows "eeqButPID_F sw1 sw"
using assms eqButF_sym unfolding eeqButPID_F_def
by presburger

lemma eeqButPID_F_trans:
assumes "eeqButPID_F sw sw1" and "eeqButPID_F sw1 sw2" shows "eeqButPID_F sw sw2"
using assms unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_cong:
assumes "eeqButPID_F sw sw1"
and "PID = PID \<Longrightarrow> eqButF uu uu1"
and "pid \<noteq> PID \<Longrightarrow> uu = uu1"
shows "eeqButPID_F (sw (pid := uu)) (sw1(pid := uu1))"
using assms unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_eqButF:
"eeqButPID_F sw sw1 \<Longrightarrow> eqButF (sw PID) (sw1 PID)"
unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_not_PID:
"\<lbrakk>eeqButPID_F sw sw1; pid \<noteq> PID\<rbrakk> \<Longrightarrow> sw pid = sw1 pid"
unfolding eeqButPID_F_def by (auto split: if_splits)

lemma eeqButPID_F_postSelectors:
"eeqButPID_F sw sw1 \<Longrightarrow> map fst (sw pid) = map fst (sw1 pid)"
unfolding eeqButPID_F_def by (metis eqButF.simps)

lemma eeqButPID_F_insert2:
"eeqButPID_F sw sw1 \<Longrightarrow>
 eqButF (insert2 aID b (sw PID)) (insert2 aID b (sw1 PID))"
unfolding eeqButPID_F_def using eqButF_insert2 by metis

lemma eeqButPID_F_toEq:
assumes "eeqButPID_F sw sw1"
shows "sw (PID := map (\<lambda> (aID,_). (aID,b)) (sw PID)) =
       sw1 (PID := map (\<lambda> (aID,_). (aID,b)) (sw1 PID))"
using length_map eeqButPID_F_eqButF[OF assms] eeqButPID_F_not_PID[OF assms]
apply(auto simp: o_def split_def map_replicate_const intro!: map_prod_cong ext)
by (metis length_map)

lemma eeqButPID_F_updateShared:
assumes "eeqButPID_F sw sw1"
shows "eeqButPID_F (sw (pid := aID_b)) (sw1 (pid := aID_b))"
using eeqButPID_F_eqButF[OF assms] eeqButPID_F_not_PID[OF assms]
using assms unfolding eeqButPID_F_def by auto

(* The notion of two states being equal everywhere but on the content of
   the post associated to a given PID and the update status of the PID shareWith info: *)
definition eqButPID :: "state \<Rightarrow> state \<Rightarrow> bool" where
"eqButPID s s1 \<equiv>
 admin s = admin s1 \<and>

 pendingUReqs s = pendingUReqs s1 \<and> userReq s = userReq s1 \<and>
 userIDs s = userIDs s1 \<and> user s = user s1 \<and> pass s = pass s1 \<and>

 pendingFReqs s = pendingFReqs s1 \<and> friendReq s = friendReq s1 \<and> friendIDs s = friendIDs s1 \<and>
 sentOuterFriendIDs s = sentOuterFriendIDs s1 \<and> recvOuterFriendIDs s = recvOuterFriendIDs s1 \<and>

 postIDs s = postIDs s1 \<and> admin s = admin s1 \<and>
 eeqButPID (post s) (post s1) \<and>
 owner s = owner s1 \<and>
 vis s = vis s1 \<and>

 pendingSApiReqs s = pendingSApiReqs s1 \<and> sApiReq s = sApiReq s1 \<and>
 serverApiIDs s = serverApiIDs s1 \<and> serverPass s = serverPass s1 \<and>
 outerPostIDs s = outerPostIDs s1 \<and> outerPost s = outerPost s1 \<and>
 outerOwner s = outerOwner s1 \<and>
 outerVis s = outerVis s1 \<and>

 pendingCApiReqs s = pendingCApiReqs s1 \<and> cApiReq s = cApiReq s1 \<and>
 clientApiIDs s = clientApiIDs s1 \<and> clientPass s = clientPass s1 \<and>
 eeqButPID_F (sharedWith s) (sharedWith s1)"

lemmas eqButPID_intro = eqButPID_def[THEN meta_eq_to_obj_eq, THEN iffD2]

lemma eqButPID_refl[simp,intro!]: "eqButPID s s"
unfolding eqButPID_def by auto

lemma eqButPID_sym:
assumes "eqButPID s s1" shows "eqButPID s1 s"
using assms eeqButPID_sym eeqButPID_F_sym unfolding eqButPID_def by auto

lemma eqButPID_trans:
assumes "eqButPID s s1" and "eqButPID s1 s2" shows "eqButPID s s2"
using assms eeqButPID_trans eeqButPID_F_trans unfolding eqButPID_def
by simp blast

(* Implications from eqButPID, including w.r.t. auxiliary operations: *)
lemma eqButPID_stateSelectors:
"eqButPID s s1 \<Longrightarrow>
 admin s = admin s1 \<and>

 pendingUReqs s = pendingUReqs s1 \<and> userReq s = userReq s1 \<and>
 userIDs s = userIDs s1 \<and> user s = user s1 \<and> pass s = pass s1 \<and>

 pendingFReqs s = pendingFReqs s1 \<and> friendReq s = friendReq s1 \<and> friendIDs s = friendIDs s1 \<and>
 sentOuterFriendIDs s = sentOuterFriendIDs s1 \<and> recvOuterFriendIDs s = recvOuterFriendIDs s1 \<and>

 postIDs s = postIDs s1 \<and> admin s = admin s1 \<and>
 eeqButPID (post s) (post s1) \<and>
 owner s = owner s1 \<and>
 vis s = vis s1 \<and>

 pendingSApiReqs s = pendingSApiReqs s1 \<and> sApiReq s = sApiReq s1 \<and>
 serverApiIDs s = serverApiIDs s1 \<and> serverPass s = serverPass s1 \<and>
 outerPostIDs s = outerPostIDs s1 \<and> outerPost s = outerPost s1 \<and>
 outerOwner s = outerOwner s1 \<and>
 outerVis s = outerVis s1 \<and>

 pendingCApiReqs s = pendingCApiReqs s1 \<and> cApiReq s = cApiReq s1 \<and>
 clientApiIDs s = clientApiIDs s1 \<and> clientPass s = clientPass s1 \<and>
 eeqButPID_F (sharedWith s) (sharedWith s1) \<and>

 IDsOK s = IDsOK s1"
unfolding eqButPID_def IDsOK_def[abs_def] by auto

(* lemma eqButPID_eqButT:
"eqButPID s s1 \<Longrightarrow> eqButT (post s PID) (post s1 PID)"
unfolding eqButPID_def using eeqButPID_eqButT by auto *)

lemma eqButPID_not_PID:
"eqButPID s s1 \<Longrightarrow> pid \<noteq> PID \<Longrightarrow> post s pid = post s1 pid"
unfolding eqButPID_def using eeqButPID_not_PID by auto

lemma eqButPID_eqButF:
"eqButPID s s1 \<Longrightarrow> eqButF (sharedWith s PID) (sharedWith s1 PID)"
unfolding eqButPID_def using eeqButPID_F_eqButF by auto

lemma eqButPID_not_PID_sharedWith:
"eqButPID s s1 \<Longrightarrow> pid \<noteq> PID \<Longrightarrow> sharedWith s pid = sharedWith s1 pid"
unfolding eqButPID_def using eeqButPID_F_not_PID by auto

(* lemma eqButPID_imp0:
assumes "eqButPID s s1" and 1: "pid \<noteq> PID"
shows "post s pid = post s1 pid"
proof-
  have "eeqButPID (post s) (post s1)"
  using assms using eqButPID_imp by simp
  from eeqButPID_imp(2)[OF this] 1 show ?thesis by auto
qed *)

(*
lemma eqButPID_postSelectors:
assumes "eqButPID s s1"
shows "titlePost (post s pid) = titlePost (post s1 pid) \<and>
       imgPost (post s pid) = imgPost (post s1 pid) \<and>
       visPost (post s pid) = visPost (post s1 pid)"
using assms unfolding eqButPID_def using eeqButPID_postSelectors by auto
*)

lemma eqButPID_insert2:
"eqButPID s s1 \<Longrightarrow>
 eqButF (insert2 aID b (sharedWith s PID)) (insert2 aID b (sharedWith s1 PID))"
unfolding eqButPID_def using eeqButPID_F_insert2 by metis

lemma eqButPID_actions:
assumes "eqButPID s s1"
shows "listInnerPosts s uid p = listInnerPosts s1 uid p"
using eqButPID_stateSelectors[OF assms] (* eqButPID_postSelectors[OF assms *)
by (auto simp: l_defs intro!: arg_cong2[of _ _ _ _ cmap])

(*
lemma eqButPID_setTextPost:
assumes "eqButPID s s1"
shows "setTextPost (post s PID) pst =
       setTextPost (post s1 PID) pst"
using assms unfolding eqButPID_def using eeqButPID_toEq
by (meson fun_upd_eqD)
*)

lemma eqButPID_update:
assumes "eqButPID s s1"
shows "(post s)(PID := txt) = (post s1)(PID := txt)"
using assms unfolding eqButPID_def using eeqButPID_toEq by auto

lemma eqButPID_update_post:
assumes "eqButPID s s1"
shows "eeqButPID ((post s) (pid := pst)) ((post s1) (pid := pst))"
using assms unfolding eqButPID_def using eeqButPID_update_post by auto

lemma eqButPID_setShared:
assumes "eqButPID s s1"
shows "(sharedWith s) (PID := map (\<lambda> (aID,_). (aID,b)) (sharedWith s PID)) =
       (sharedWith s1) (PID := map (\<lambda> (aID,_). (aID,b)) (sharedWith s1 PID))"
using assms unfolding eqButPID_def using eeqButPID_F_toEq by auto

lemma eqButPID_updateShared:
assumes "eqButPID s s1"
shows "eeqButPID_F ((sharedWith s) (pid := aID_b)) ((sharedWith s1) (pid := aID_b))"
using assms unfolding eqButPID_def using eeqButPID_F_updateShared by auto

lemma eqButPID_cong[simp]:
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>admin := uu1\<rparr>) (s1 \<lparr>admin := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pendingUReqs := uu1\<rparr>) (s1 \<lparr>pendingUReqs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>userReq := uu1\<rparr>) (s1 \<lparr>userReq := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>userIDs := uu1\<rparr>) (s1 \<lparr>userIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>user := uu1\<rparr>) (s1 \<lparr>user := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pass := uu1\<rparr>) (s1 \<lparr>pass := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>postIDs := uu1\<rparr>) (s1 \<lparr>postIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> eeqButPID uu1 uu2 \<Longrightarrow> eqButPID (s \<lparr>post := uu1\<rparr>) (s1 \<lparr>post := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>owner := uu1\<rparr>) (s1 \<lparr>owner := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>vis := uu1\<rparr>) (s1 \<lparr>vis := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pendingFReqs := uu1\<rparr>) (s1 \<lparr>pendingFReqs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>friendReq := uu1\<rparr>) (s1 \<lparr>friendReq := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>friendIDs := uu1\<rparr>) (s1 \<lparr>friendIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>sentOuterFriendIDs := uu1\<rparr>) (s1 \<lparr>sentOuterFriendIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>recvOuterFriendIDs := uu1\<rparr>) (s1 \<lparr>recvOuterFriendIDs := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pendingSApiReqs := uu1\<rparr>) (s1 \<lparr>pendingSApiReqs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>sApiReq := uu1\<rparr>) (s1 \<lparr>sApiReq := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>serverApiIDs := uu1\<rparr>) (s1 \<lparr>serverApiIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>serverPass := uu1\<rparr>) (s1 \<lparr>serverPass := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>outerPostIDs := uu1\<rparr>) (s1 \<lparr>outerPostIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>outerPost := uu1\<rparr>) (s1 \<lparr>outerPost := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>outerOwner := uu1\<rparr>) (s1 \<lparr>outerOwner := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>outerVis := uu1\<rparr>) (s1 \<lparr>outerVis := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>pendingCApiReqs := uu1\<rparr>) (s1 \<lparr>pendingCApiReqs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>cApiReq := uu1\<rparr>) (s1 \<lparr>cApiReq := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>clientApiIDs := uu1\<rparr>) (s1 \<lparr>clientApiIDs := uu2\<rparr>)"
"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> uu1 = uu2 \<Longrightarrow> eqButPID (s \<lparr>clientPass := uu1\<rparr>) (s1 \<lparr>clientPass := uu2\<rparr>)"

"\<And> uu1 uu2. eqButPID s s1 \<Longrightarrow> eeqButPID_F uu1 uu2 \<Longrightarrow> eqButPID (s \<lparr>sharedWith := uu1\<rparr>) (s1 \<lparr>sharedWith:= uu2\<rparr>)"
unfolding eqButPID_def by auto

(* major *) lemma eqButPID_step:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
shows "eqButPID s' s1'"
proof -
  note [simp] = all_defs eeqButPID_F_def
  note [intro!] = eqButPID_cong
  note * = step step1 ss1 eqButPID_stateSelectors[OF ss1]
           eqButPID_update[OF ss1] eqButPID_update_post[OF ss1]
           eqButPID_setShared[OF ss1] eqButPID_updateShared[OF ss1]
           eqButPID_insert2[OF ss1]
  then show ?thesis
  proof (cases a)
    case (Sact x1)
    with * show ?thesis by (cases x1) auto
  next
    case (Cact x2)
    with * show ?thesis by (cases x2) auto
  next
    case (Dact x3)
    with * show ?thesis by (cases x3) auto
  next
    case (Uact x4)
    with * show ?thesis
    proof (cases x4)
      case (uPost x21 x22 x23 x24)
      with Uact * show ?thesis by (cases "x23 = PID") auto
    next
      case (uVisPost x31 x32 x33 x34)
      with Uact * show ?thesis by (cases "x33 = PID") auto
    qed auto
  next
    case (COMact x7)
    with * show ?thesis
    proof (cases x7)
      case (comSendPost x61 x62 x63 x64)
      with COMact * show ?thesis by (cases "x64 = PID") auto
    qed auto
  qed auto
qed

end

end


theory ParsingCorrectness
imports JackParsing
begin

theorem parse_correct: "complete_jack_parser (program_to_string \<Pi>) = Some \<Pi>"
  apply (induction \<Pi>)
  by simp

end


theory Example_NetModel
imports "../TopoS_Interface" "../TopoS_Helper"
begin

text\<open>A toy example that defines a valid network security requirement model\<close>

definition default_node_properties :: "bool"
  where  "default_node_properties \<equiv> False"

fun sinvar :: "'v graph \<Rightarrow> ('v \<Rightarrow> bool) \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (e1,e2) \<in> (edges G). (nP e1) \<and> (nP e2))"

(* we will not define receiver_violation!! Works for both! *)

\<comment> \<open>The preliminaries: mostly, sinvar is monotonic\<close>
interpretation SecurityInvariant_preliminaries
where sinvar = sinvar
  apply unfold_locales
    apply(frule_tac finite_distinct_list[OF wf_graph.finiteE])
    apply(erule_tac exE)
    apply(rename_tac list_edges)
    apply(rule_tac ff="list_edges" in SecurityInvariant_withOffendingFlows.mono_imp_set_offending_flows_not_empty[OF sinvar_mono])
       apply(auto)[6]
  apply(auto simp add: SecurityInvariant_withOffendingFlows.is_offending_flows_def graph_ops)[2]
  apply(fact SecurityInvariant_withOffendingFlows.sinvar_mono_imp_is_offending_flows_mono[OF sinvar_mono])
done

\<comment> \<open>With generic target focus\<close>
interpretation Example_NetModel: SecurityInvariant
where default_node_properties = default_node_properties
and sinvar = sinvar
and receiver_violation = receiver_violation (*yep, that's a variable*)
  unfolding default_node_properties_def
  apply unfold_locales

   \<comment> \<open>Secure bydefault\<close>
   apply(simp)
   apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
       SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
       SecurityInvariant_withOffendingFlows.is_offending_flows_def)
   apply (simp add: graph_ops)
   apply (simp split: prod.split_asm prod.split)
   apply blast

 \<comment> \<open>Uniqueness\<close>
 apply(simp add:default_node_properties_def)
 apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
     SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
     SecurityInvariant_withOffendingFlows.is_offending_flows_def)
 apply (simp add: graph_ops)
 apply (simp split: prod.split_asm prod.split)
 \<comment> \<open>proof by counter example: assume False is not the unique default parameter\<close>
 apply(rule_tac x="\<lparr> nodes={vertex_1}, edges = {(vertex_1,vertex_1)} \<rparr>" in exI, simp)
 apply(rule conjI)
  apply(simp add: wf_graph_def; fail)
 apply(rule_tac x="(\<lambda> x. default_node_properties)(vertex_1 := False)" in exI, simp add:default_node_properties_def)
 apply(case_tac receiver_violation)
  apply(simp_all)
  apply(rule_tac x="{(vertex_1,vertex_1)}" in exI, simp)+
done

text\<open>And we end up with a totally useless network security requirement model. I hope this was instructive.\<close>

end


theory prop_64
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun last :: "Nat list => Nat" where
  "last (Nil2) = Z"
  | "last (Cons2 y (Nil2)) = y"
  | "last (Cons2 y (Cons2 x2 x3)) = last (Cons2 x2 x3)"
  fun append :: "'a list => 'a list => 'a list" where
  "append (Nil2) y = y"
  | "append (Cons2 z xs) y = Cons2 z (append xs y)"
  (*hipster last append *)
  theorem x0 :
    "(last (append xs (Cons2 x (Nil2)))) = x"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
end


theory ReverseWellQuasiOrder
  imports "Well_Quasi_Orders.Well_Quasi_Orders"
begin

class reverse_wqo = preorder +
  assumes good: "good (\<ge>) f"

lemma reverse_wqo_on_class [simp, intro]:
  "wqo_on (\<ge>) (UNIV :: ('a :: reverse_wqo) set)"
  using good by (auto simp: wqo_on_def transp_on_def almost_full_on_def dest: order_trans)

end


(*
   Title: The pi-calculus
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Strong_Late_Sim_Pres
  imports Strong_Late_Sim
begin

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes PRelQ: "(P, Q) \<in> Rel"

  shows "\<tau>.(P) \<leadsto>[Rel] \<tau>.(Q)"
proof -
  show "\<tau>.(P) \<leadsto>[Rel] \<tau>.(Q)"
  proof(induct rule: simCases)
    case(Bound a x Q')
    have "\<tau>.(Q) \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> Q'" by fact
    hence False by auto
    thus ?case by simp
  next
    case(Free \<alpha> Q')
    have "\<tau>.(Q) \<longmapsto> \<alpha> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: tauCases)
      case cTau
      have "\<tau>.(P) \<longmapsto> \<tau> \<prec> P" by(rule Late_Semantics.Tau)
      with PRelQ show ?case by blast
    qed
  qed
qed

lemma inputPres:
  fixes P    :: pi
  and   x    :: name
  and   Q    :: pi
  and   a    :: name
  and   Rel  :: "(pi \<times> pi) set"

  assumes PRelQ: "\<forall>y. (P[x::=y], Q[x::=y]) \<in> Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P \<leadsto>[Rel] a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
  case(Bound b y Q')
  from \<open>y \<sharp> (x, a, P, Q)\<close> have "y \<noteq> x" "y \<noteq> a" "y \<sharp> P" "y \<sharp> Q" by simp+
  from \<open>a<x>.Q \<longmapsto>b\<guillemotleft>y\<guillemotright> \<prec> Q'\<close> \<open>y \<noteq> a\<close> \<open>y \<noteq> x\<close> \<open>y \<sharp> Q\<close> show ?case
  proof(induct rule: inputCases)
    case cInput

    have "a<x>.P \<longmapsto> a<x> \<prec> P" by(rule Input)
    hence "a<x>.P \<longmapsto> a<y> \<prec> ([(x, y)] \<bullet> P)" using \<open>y \<sharp> P\<close>
      by(simp add: alphaBoundResidual)

    moreover have "derivative ([(x, y)] \<bullet> P) ([(x, y)] \<bullet> Q) (InputS a) y Rel"
    proof(auto simp add: derivative_def)
      fix u
      show "(([(x, y)] \<bullet> P)[y::=u], ([(x, y)] \<bullet> Q)[y::=u]) \<in> Rel"
      proof(cases "y=u")
        assume "y = u"
        moreover have "([(y, x)] \<bullet> P, [(y, x)] \<bullet> Q) \<in> Rel"
        proof -
          from PRelQ have "(P[x::=x], Q[x::=x]) \<in> Rel" by blast
          hence "(P, Q) \<in> Rel" by simp
          with Eqvt show ?thesis by(rule eqvtRelI)
        qed
        ultimately show ?thesis by simp
      next
        assume yinequ: "y \<noteq> u"
        show ?thesis
        proof(cases "x = u")
          assume "x = u"
          moreover have "(([(y, x)] \<bullet> P)[y::=x], ([(y, x)] \<bullet> Q)[y::=x]) \<in> Rel"
          proof -
            from PRelQ have "(P[x::=y], Q[x::=y]) \<in> Rel" by blast
            with Eqvt have "([(y, x)] \<bullet> (P[x::=y]), [(y, x)] \<bullet> (Q[x::=y])) \<in> Rel"
              by(rule eqvtRelI)
            with \<open>y \<noteq> x\<close> show ?thesis
              by(simp add: eqvt_subs name_calc)
          qed
          ultimately show ?thesis by simp
        next
          assume xinequ: "x \<noteq> u"
          hence "(([(y, x)] \<bullet> P)[y::=u], ([(y, x)] \<bullet> Q)[y::=u]) \<in> Rel"
          proof -
            from PRelQ have "(P[x::=u], Q[x::=u]) \<in> Rel" by blast
            with Eqvt have "([(y, x)] \<bullet> (P[x::=u]), [(y, x)] \<bullet> (Q[x::=u])) \<in> Rel"
              by(rule eqvtRelI)
            with \<open>y \<noteq> x\<close>  xinequ yinequ show ?thesis
              by(simp add: eqvt_subs name_calc)
          qed
          thus ?thesis by simp
        qed
      qed
    qed

    ultimately show ?case by blast
  qed
next
  case(Free \<alpha> Q')
  have "a<x>.Q \<longmapsto> \<alpha> \<prec> Q'" by fact
  hence False by auto
  thus ?case by blast
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes PRelQ: "(P, Q) \<in> Rel"

  shows "a{b}.P \<leadsto>[Rel] a{b}.Q"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound c x Q')
    have "a{b}.Q \<longmapsto> c\<guillemotleft>x\<guillemotright> \<prec> Q'" by fact
    hence False by auto
    thus ?case by simp
  next
    case(Free \<alpha> Q')
    have "a{b}.Q \<longmapsto> \<alpha> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: outputCases)
      case cOutput
      have "a{b}.P \<longmapsto> a[b] \<prec> P" by(rule Late_Semantics.Output)
      with PRelQ show ?case by blast
    qed
  qed
qed

  assumes PSimQ: "P \<leadsto>[Rel] Q"
  and     "Rel \<subseteq> Rel'"

  shows "[a\<frown>b]P \<leadsto>[Rel'] [a\<frown>b]Q"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound c x Q')
    have "x \<sharp>  [a\<frown>b]P" by fact
    hence xFreshP: "x \<sharp> P" by simp
    have "[a\<frown>b]Q \<longmapsto> c\<guillemotleft>x\<guillemotright> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: matchCases)
      case cMatch
      have "Q \<longmapsto>c\<guillemotleft>x\<guillemotright> \<prec> Q'" by fact
      with PSimQ xFreshP obtain P' where PTrans: "P \<longmapsto>c\<guillemotleft>x\<guillemotright> \<prec> P'"
                                     and Pderivative: "derivative P' Q' c x Rel"
        by(blast dest: simE)

      from PTrans have "[a\<frown>a]P \<longmapsto> c\<guillemotleft>x\<guillemotright> \<prec> P'" by(rule Late_Semantics.Match)
      moreover from Pderivative \<open>Rel \<subseteq> Rel'\<close> have "derivative P' Q' c x Rel'"
        by(cases c) (auto simp add: derivative_def)
      ultimately show ?case by blast
    qed
  next
    case(Free \<alpha> Q')
    have "[a\<frown>b]Q \<longmapsto>\<alpha> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: matchCases)
      case cMatch
      have "Q \<longmapsto> \<alpha> \<prec> Q'" by fact
      with PSimQ obtain P' where PTrans: "P \<longmapsto> \<alpha> \<prec> P'"
                             and PRel: "(P', Q') \<in> Rel"
          by(blast dest: simE)
      from PTrans have "[a\<frown>a]P \<longmapsto>\<alpha> \<prec> P'" by(rule Late_Semantics.Match)
      with PRel \<open>Rel \<subseteq> Rel'\<close> show ?case by blast
    qed
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes PSimQ: "P \<leadsto>[Rel] Q"
  and     "Rel \<subseteq> Rel'"

  shows "[a\<noteq>b]P \<leadsto>[Rel'] [a\<noteq>b]Q"
proof(induct rule: simCases)
  case(Bound c x Q')
  have "x \<sharp> [a\<noteq>b]P" by fact
  hence xFreshP: "x \<sharp> P" by simp
  from \<open>[a\<noteq>b]Q \<longmapsto> c\<guillemotleft>x\<guillemotright> \<prec> Q'\<close> show ?case
  proof(induct rule: mismatchCases)
    case cMismatch
    have "Q \<longmapsto>c\<guillemotleft>x\<guillemotright> \<prec> Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P \<longmapsto>c\<guillemotleft>x\<guillemotright> \<prec> P'"
                                   and Pderivative: "derivative P' Q' c x Rel"
      by(blast dest: simE)

    from PTrans \<open>a \<noteq> b\<close> have "[a\<noteq>b]P \<longmapsto> c\<guillemotleft>x\<guillemotright> \<prec> P'" by(rule Late_Semantics.Mismatch)
    moreover from Pderivative \<open>Rel \<subseteq> Rel'\<close> have "derivative P' Q' c x Rel'"
      by(cases c) (auto simp add: derivative_def)
    ultimately show ?case by blast
  qed
next
  case(Free \<alpha> Q')
  have "[a\<noteq>b]Q \<longmapsto>\<alpha> \<prec> Q'" by fact
  thus ?case
  proof(induct rule: mismatchCases)
    case cMismatch
    have "Q \<longmapsto> \<alpha> \<prec> Q'" by fact
    with PSimQ obtain P' where PTrans: "P \<longmapsto> \<alpha> \<prec> P'"
                           and PRel: "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans \<open>a \<noteq> b\<close> have "[a\<noteq>b]P \<longmapsto>\<alpha> \<prec> P'" by(rule Late_Semantics.Mismatch)
    with PRel \<open>Rel \<subseteq> Rel'\<close> show ?case by blast
  qed
qed

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes PSimQ: "P \<leadsto>[Rel] Q"
  and     "Id \<subseteq> Rel'"
  and     "Rel \<subseteq> Rel'"

  shows "P \<oplus> R \<leadsto>[Rel'] Q \<oplus> R"
proof -
  show ?thesis
  proof(induct rule: simCases)
    case(Bound a x QR)
    have "x \<sharp> P \<oplus> R" by fact
    hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" by simp+
    have "Q \<oplus> R \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> QR" by fact
    thus ?case
    proof(induct rule: sumCases)
      case cSum1
      have "Q \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> QR" by fact
      with xFreshP PSimQ obtain P' where PTrans: "P \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> P'"
                                     and Pderivative: "derivative P' QR a x Rel"
        by(blast dest: simE)

      from PTrans have "P \<oplus> R \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> P'" by(rule Late_Semantics.Sum1)
      moreover from Pderivative \<open>Rel \<subseteq> Rel'\<close> have "derivative P' QR a x Rel'"
        by(cases a) (auto simp add: derivative_def)
      ultimately show ?case by blast
    next
      case cSum2
      from \<open>R \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> QR\<close> have "P \<oplus> R \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> QR" by(rule Sum2)
      thus ?case using \<open>Id \<subseteq> Rel'\<close> by(blast intro: derivativeReflexive)
    qed
  next
    case(Free \<alpha> QR)
    have "Q \<oplus> R \<longmapsto>\<alpha> \<prec> QR" by fact
    thus ?case
    proof(induct rule: sumCases)
      case cSum1
      have "Q \<longmapsto>\<alpha> \<prec> QR" by fact
      with PSimQ obtain P' where PTrans: "P \<longmapsto>\<alpha> \<prec> P'" and PRel: "(P', QR) \<in> Rel"
        by(blast dest: simE)
      from PTrans have "P \<oplus> R \<longmapsto>\<alpha> \<prec> P'" by(rule Late_Semantics.Sum1)
      with PRel \<open>Rel \<subseteq> Rel'\<close> show ?case by blast
    next
      case cSum2
      from \<open>R \<longmapsto>\<alpha> \<prec> QR\<close> have "P \<oplus> R \<longmapsto>\<alpha> \<prec> QR" by(rule Sum2)
      thus ?case using \<open>Id \<subseteq> Rel'\<close> by(blast intro: derivativeReflexive)
    qed
  qed
qed

lemma parCompose:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   T     :: pi
  and   Rel   :: "(pi \<times> pi) set"
  and   Rel'  :: "(pi \<times> pi) set"
  and   Rel'' :: "(pi \<times> pi) set"

  assumes PSimQ:    "P \<leadsto>[Rel] Q"
  and     RSimT:    "R \<leadsto>[Rel'] T"
  and     PRelQ:    "(P, Q) \<in> Rel"
  and     RRel'T:   "(R, T) \<in> Rel'"
  and     Par:      "\<And>P Q R T. \<lbrakk>(P, Q) \<in> Rel; (R, T) \<in> Rel'\<rbrakk> \<Longrightarrow> (P \<parallel> R, Q \<parallel> T) \<in> Rel''"
  and     Res:      "\<And>P Q a. (P, Q) \<in> Rel'' \<Longrightarrow> (<\<nu>a>P, <\<nu>a>Q) \<in> Rel''"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"
  and     EqvtRel'': "eqvt Rel''"

  shows "P \<parallel> R \<leadsto>[Rel''] Q \<parallel> T"
using EqvtRel''
proof(induct rule: simCasesCont[where C="()"])
  case(Bound a x Q')
  have "x \<sharp> P \<parallel> R" and "x \<sharp> Q \<parallel> T" by fact+
  hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" and "x \<sharp> Q" and "x \<sharp> T" by simp+
  have QTTrans: "Q \<parallel> T \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> Q'" by fact
  thus ?case using \<open>x \<sharp> Q\<close> \<open>x \<sharp> T\<close>
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    have QTrans: "Q \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> Q'" and xFreshT: "x \<sharp> T" by fact+

    from xFreshP PSimQ QTrans obtain P' where PTrans:"P \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> P'"
                                          and Pderivative: "derivative P' Q' a x Rel"
      by(blast dest: simE)
    from PTrans xFreshR have "P \<parallel> R \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> P' \<parallel> R" by(rule Late_Semantics.Par1B)
    moreover from Pderivative xFreshR xFreshT RRel'T have "derivative (P' \<parallel> R) (Q' \<parallel> T) a x Rel''"
      by(cases a, auto intro: Par simp add: derivative_def forget)
    ultimately show ?case by blast
  next
    case(cPar2 T')
    have TTrans: "T \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> T'" and xFreshQ: "x \<sharp> Q" by fact+

    from xFreshR RSimT TTrans obtain R' where RTrans:"R \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> R'"
                                          and Rderivative: "derivative R' T' a x Rel'"
      by(blast dest: simE)
    from RTrans xFreshP have ParTrans: "P \<parallel> R \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> P \<parallel> R'" by(rule Late_Semantics.Par2B)
    moreover from Rderivative xFreshP xFreshQ PRelQ have "derivative (P \<parallel> R') (Q \<parallel>  T') a x Rel''"
      by(cases a, auto intro: Par simp add: derivative_def forget)
    ultimately show ?case by blast
  qed
next
  case(Free \<alpha> QT')
  have QTTrans: "Q \<parallel> T \<longmapsto> \<alpha> \<prec> QT'" by fact
  thus ?case using PSimQ RSimT PRelQ RRel'T
  proof(induct rule: parCasesF[where C="(P, R)"])
    case(cPar1 Q')
    have RRel'T: "(R, T) \<in> Rel'" by fact
    have "P \<leadsto>[Rel] Q" and "Q \<longmapsto> \<alpha> \<prec> Q'" by fact+
    then obtain P' where PTrans: "P \<longmapsto> \<alpha> \<prec> P'" and PRel: "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans have Trans: "P \<parallel> R \<longmapsto> \<alpha> \<prec> P' \<parallel> R" by(rule Late_Semantics.Par1F)
    moreover from PRel RRel'T have "(P' \<parallel> R, Q' \<parallel> T) \<in> Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cPar2 T')
    have PRelQ: "(P, Q) \<in> Rel" by fact
    have "R \<leadsto>[Rel'] T" and "T \<longmapsto> \<alpha> \<prec> T'" by fact+
    then obtain R' where RTrans: "R \<longmapsto> \<alpha> \<prec> R'" and RRel: "(R', T') \<in> Rel'"
      by(blast dest: simE)
    from RTrans have Trans: "P \<parallel> R \<longmapsto> \<alpha> \<prec> P \<parallel> R'" by(rule Late_Semantics.Par2F)
    moreover from PRelQ RRel have "(P \<parallel> R', Q \<parallel> T') \<in> Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cComm1 Q' T' a b x)
    from \<open>x \<sharp> (P, R)\<close> have "x \<sharp> P" by simp
    with \<open>P \<leadsto>[Rel] Q\<close> \<open>Q \<longmapsto> a<x> \<prec> Q'\<close> \<open>x \<sharp> P\<close>
    obtain P' where PTrans: "P \<longmapsto>a<x> \<prec> P'"
                and Pderivative: "derivative P' Q' (InputS a) x Rel"
      by(blast dest: simE)
    from Pderivative have PRel: "(P'[x::=b], Q'[x::=b]) \<in> Rel" by(simp add: derivative_def)

    have "R \<leadsto>[Rel'] T" and "T \<longmapsto> a[b] \<prec> T'" by fact+
    then obtain R' where RTrans: "R \<longmapsto>a[b] \<prec> R'" and RRel: "(R', T') \<in> Rel'"
      by(blast dest: simE)

    from PTrans RTrans have "P \<parallel> R \<longmapsto> \<tau> \<prec> P'[x::=b] \<parallel> R'" by(rule Late_Semantics.Comm1)
    moreover from PRel RRel have "(P'[x::=b] \<parallel> R', Q'[x::=b] \<parallel> T') \<in> Rel''" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cComm2 Q' T' a b x)
    have "P \<leadsto>[Rel] Q" and "Q \<longmapsto>a[b] \<prec> Q'" by fact+
    then obtain P' where PTrans: "P \<longmapsto>a[b] \<prec> P'" and PRel: "(P', Q') \<in> Rel"
      by(blast dest: simE)

    from \<open>x \<sharp> (P, R)\<close> have "x \<sharp> R" by simp
    with \<open>R \<leadsto>[Rel'] T\<close> \<open>T \<longmapsto>a<x> \<prec> T'\<close>
    obtain R' where RTrans: "R \<longmapsto>a<x> \<prec> R'"
                and Rderivative: "derivative R' T' (InputS a) x Rel'"
      by(blast dest: simE)
    from Rderivative have RRel: "(R'[x::=b], T'[x::=b]) \<in> Rel'" by(simp add: derivative_def)

    from PTrans RTrans have "P \<parallel> R \<longmapsto> \<tau> \<prec> P' \<parallel> R'[x::=b]" by(rule Late_Semantics.Comm2)
    moreover from PRel RRel have "(P' \<parallel> R'[x::=b], Q' \<parallel> T'[x::=b]) \<in> Rel''" by(blast intro: Par)
    ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> \<tau> \<prec> P' \<and> (P', Q' \<parallel> T'[x::=b]) \<in> Rel''" by blast
  next
    case(cClose1 Q' T' a x y)
    from \<open>x \<sharp> (P, R)\<close> have "x \<sharp> P" by simp
    with \<open>P \<leadsto>[Rel] Q\<close> \<open>Q \<longmapsto>a<x> \<prec> Q'\<close>
    obtain P' where PTrans: "P \<longmapsto>a<x> \<prec> P'"
                and Pderivative: "derivative P' Q' (InputS a) x Rel"
      by(blast dest: simE)
    from Pderivative have PRel: "(P'[x::=y], Q'[x::=y]) \<in> Rel" by(simp add: derivative_def)

    from \<open>y \<sharp> (P, R)\<close> have "y \<sharp> R" and "y \<sharp> P" by simp+
    from \<open>R \<leadsto>[Rel'] T\<close> \<open>T \<longmapsto>a<\<nu>y> \<prec> T'\<close> \<open>y \<sharp> R\<close>
    obtain R' where RTrans: "R \<longmapsto>a<\<nu>y> \<prec> R'"
                and Rderivative: "derivative R' T' (BoundOutputS a) y Rel'"
      by(blast dest: simE)
    from Rderivative have RRel: "(R', T') \<in> Rel'" by(simp add: derivative_def)

    from PTrans RTrans \<open>y \<sharp> P\<close> have Trans: "P \<parallel> R \<longmapsto> \<tau> \<prec> <\<nu>y>(P'[x::=y] \<parallel> R')"
      by(rule Late_Semantics.Close1)
    moreover from PRel RRel have "(<\<nu>y>(P'[x::=y] \<parallel> R'), <\<nu>y>(Q'[x::=y] \<parallel> T')) \<in> Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  next
    case(cClose2 Q' T' a x y)
    from \<open>y \<sharp> (P, R)\<close> have "y \<sharp> P" and "y \<sharp> R" by simp+
    from \<open>P \<leadsto>[Rel] Q\<close> \<open>Q \<longmapsto>a<\<nu>y> \<prec> Q'\<close> \<open>y \<sharp> P\<close>
    obtain P' where PTrans: "P \<longmapsto>a<\<nu>y> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
      by(force dest: simE simp add: derivative_def)

    from \<open>x \<sharp> (P, R)\<close> have "x \<sharp> R" by simp+
    with \<open>R \<leadsto>[Rel'] T\<close> \<open>T \<longmapsto>a<x> \<prec> T'\<close>
    obtain R' where RTrans: "R \<longmapsto>a<x> \<prec> R'"
                and R'Rel'T': "(R'[x::=y], T'[x::=y]) \<in> Rel'"
      by(force dest: simE simp add: derivative_def)

    from PTrans RTrans \<open>y \<sharp> R\<close> have Trans: "P \<parallel> R \<longmapsto> \<tau> \<prec> <\<nu>y>(P' \<parallel> R'[x::=y])"
      by(rule Close2)
    moreover from P'RelQ' R'Rel'T' have "(<\<nu>y>(P' \<parallel> R'[x::=y]), <\<nu>y>(Q' \<parallel> T'[x::=y])) \<in> Rel''"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  qed
qed

lemma parPres:
  fixes P   :: pi
  and   Q   :: pi
  and   R   :: pi
  and   a   :: name
  and   b   :: name
  and   Rel :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes PSimQ:    "P \<leadsto>[Rel] Q"
  and     PRelQ:    "(P, Q) \<in> Rel"
  and     Par:      "\<And>P Q R. (P, Q) \<in> Rel \<Longrightarrow> (P \<parallel> R, Q \<parallel> R) \<in> Rel'"
  and     Res:      "\<And>P Q a. (P, Q) \<in> Rel' \<Longrightarrow> (<\<nu>a>P, <\<nu>a>Q) \<in> Rel'"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "P \<parallel> R \<leadsto>[Rel'] Q \<parallel> R"
proof -
  note PSimQ
  moreover have RSimR: "R \<leadsto>[Id] R" by(auto intro: reflexive)
  moreover note PRelQ moreover have "(R, R) \<in> Id" by auto
  moreover from Par have "\<And>P Q R T. \<lbrakk>(P, Q) \<in> Rel; (R, T) \<in> Id\<rbrakk> \<Longrightarrow> (P \<parallel> R, Q \<parallel> T) \<in> Rel'"
    by auto
  moreover note Res \<open>eqvt Rel\<close>
  moreover have "eqvt Id" by(auto simp add: eqvt_def)
  ultimately show ?thesis using EqvtRel' by(rule parCompose)
qed

lemma resDerivative:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: subject
  and   x    :: name
  and   y    :: name
  and   Rel  :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes Der: "derivative P Q a x Rel"
  and     Rel: "\<And>(P::pi) (Q::pi) (x::name). (P, Q) \<in> Rel \<Longrightarrow> (<\<nu>x>P, <\<nu>x>Q) \<in> Rel'"
  and     Eqv: "eqvt Rel"

  shows "derivative (<\<nu>y>P) (<\<nu>y>Q) a x Rel'"
proof -
  from Der Rel show ?thesis
  proof(cases a, auto simp add: derivative_def)
    fix u
    assume A1: "\<forall>u. (P[x::=u], Q[x::=u]) \<in> Rel"
    show "((<\<nu>y>P)[x::=u], (<\<nu>y>Q)[x::=u]) \<in> Rel'"
    proof(cases "x=y")
      assume xeqy: "x=y"

      from A1 have "(P[x::=x], Q[x::=x]) \<in> Rel" by blast
      hence L1: "(<\<nu>y>P, <\<nu>y>Q) \<in> Rel'" by(force intro: Rel)

      have "y \<sharp> <\<nu>y>P" and "y \<sharp> <\<nu>y>Q" by(simp only: freshRes)+
      hence "(<\<nu>y>P)[y::=u] = <\<nu>y>P" and "(<\<nu>y>Q)[y::=u] = <\<nu>y>Q" by(simp add: forget)+

      with L1 xeqy show ?thesis by simp
    next
      assume xineqy: "x\<noteq>y"

      show ?thesis
      proof(cases "y=u")
        assume yequ: "y=u"

        have "\<exists>(c::name). c \<sharp> (P, Q, x, y)" by(blast intro: name_exists_fresh)
        then obtain c where cFreshP: "c \<sharp> P" and cFreshQ: "c \<sharp> Q" and cineqx: "c \<noteq> x" and cineqy: "y \<noteq> c"
          by(force simp add: fresh_prod name_fresh)

        from A1 have "(P[x::=c], Q[x::=c]) \<in> Rel" by blast
        with Eqv have "([(y, c)] \<bullet> (P[x::=c]), [(y, c)] \<bullet> (Q[x::=c])) \<in> Rel" by(rule eqvtRelI)
        with xineqy cineqx cineqy have "(([(y, c)] \<bullet> P)[x::=y], ([(y, c)] \<bullet> Q)[x::=y]) \<in> Rel"
          by(simp add: eqvt_subs name_calc)
        hence "(<\<nu>c>(([(y, c)] \<bullet> P)[x::=y]), <\<nu>c>(([(y, c)] \<bullet> Q)[x::=y])) \<in> Rel'" by(rule Rel)
        with cineqx cineqy have "((<\<nu>c>(([(y, c)] \<bullet> P)))[x::=y], (<\<nu>c>(([(y, c)] \<bullet> Q)))[x::=y])\<in> Rel'" by simp
        moreover from cFreshP cFreshQ have "<\<nu>c>([(y, c)] \<bullet> P) = <\<nu>y>P" and "<\<nu>c>([(y, c)] \<bullet> Q) = <\<nu>y>Q"
          by(simp add: alphaRes)+
        ultimately show ?thesis using yequ by simp
      next
        assume yinequ: "y \<noteq> u"
        from A1 have "(P[x::=u], Q[x::=u]) \<in> Rel" by blast
        hence "(<\<nu>y>(P[x::=u]), <\<nu>y>(Q[x::=u])) \<in> Rel'" by(rule Rel)
        with xineqy yinequ show ?thesis by simp
      qed
    qed
  qed
qed

  assumes PSimQ: "P \<leadsto>[Rel] Q"
  and     ResRel: "\<And>(P::pi) (Q::pi) (x::name). (P, Q) \<in> Rel \<Longrightarrow> (<\<nu>x>P, <\<nu>x>Q) \<in> Rel'"
  and     RelRel': "Rel \<subseteq> Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "<\<nu>x>P \<leadsto>[Rel'] <\<nu>x>Q"
using EqvtRel'
proof(induct rule: resSimCases[of _ _ _ _ "(P, x)"])
  case(BoundOutput Q' a)
  have QTrans: "Q \<longmapsto>a[x] \<prec> Q'" and aineqx: "a \<noteq> x" by fact+

  from PSimQ QTrans obtain P' where PTrans: "P \<longmapsto> a[x] \<prec> P'"
                                and P'RelQ': "(P', Q') \<in> Rel"
    by(blast dest: simE)

  from PTrans aineqx have "<\<nu>x>P \<longmapsto>a<\<nu>x> \<prec> P'" by(rule Late_Semantics.Open)
  moreover from P'RelQ' RelRel' have "(P', Q') \<in> Rel'" by force
  ultimately show ?case by blast
next
  case(BoundR Q' a y)
  have QTrans: "Q \<longmapsto>a\<guillemotleft>y\<guillemotright> \<prec> Q'" and xFresha: "x \<sharp> a" by fact+
  have "y \<sharp> (P, x)" by fact
  hence yFreshP: "y \<sharp> P" and yineqx: "y \<noteq> x" by(simp add: fresh_prod)+

  from PSimQ yFreshP QTrans  obtain P' where PTrans: "P \<longmapsto>a\<guillemotleft>y\<guillemotright> \<prec> P'"
                                         and Pderivative: "derivative P' Q' a y Rel"
    by(blast dest: simE)
  from PTrans xFresha yineqx have ResTrans: "<\<nu>x>P \<longmapsto>a\<guillemotleft>y\<guillemotright> \<prec> <\<nu>x>P'"
    by(blast intro: Late_Semantics.ResB)
  moreover from Pderivative ResRel EqvtRel have "derivative (<\<nu>x>P') (<\<nu>x>Q') a y Rel'"
    by(rule resDerivative)

  ultimately show ?case by blast
next
  case(FreeR Q' \<alpha>)
  have QTrans: "Q \<longmapsto> \<alpha> \<prec> Q'" and xFreshAlpha: "(x::name) \<sharp> \<alpha>" by fact+

  from QTrans PSimQ obtain P' where PTrans: "P \<longmapsto> \<alpha> \<prec> P'"
                                and P'RelQ': "(P', Q') \<in> Rel"
    by(blast dest: simE)

  from PTrans xFreshAlpha have "<\<nu>x>P \<longmapsto>\<alpha> \<prec> <\<nu>x>P'" by(rule Late_Semantics.ResF)
  moreover from P'RelQ' have "(<\<nu>x>P', <\<nu>x>Q') \<in> Rel'" by(rule ResRel)
  ultimately show ?case by blast
qed

lemma resChainI:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi \<times> pi) set"
  and   xs  :: "name list"

  assumes PRelQ:   "P \<leadsto>[Rel] Q"
  and     eqvtRel: "eqvt Rel"
  and     Res:     "\<And>P Q x. (P, Q) \<in> Rel \<Longrightarrow> (<\<nu>x>P, <\<nu>x>Q) \<in> Rel"

  shows "(resChain xs) P \<leadsto>[Rel] (resChain xs) Q"
proof(induct xs) (* Base case *)
  from PRelQ show "resChain [] P \<leadsto>[Rel] resChain [] Q" by simp
next (* Inductive step *)
  fix x xs
  assume IH: "(resChain xs P) \<leadsto>[Rel] (resChain xs Q)"
  moreover note Res
  moreover have "Rel \<subseteq> Rel" by simp
  ultimately have "<\<nu>x>(resChain xs P) \<leadsto>[Rel] <\<nu>x>(resChain xs Q)" using eqvtRel
    by(rule_tac resPres)

  thus "resChain (x # xs) P \<leadsto>[Rel] resChain (x # xs) Q"
    by simp
qed

  shows "!P \<leadsto>[bangRel Rel] !Q"
proof -
  let ?Sim = "\<lambda>P Rs. (\<forall>a x Q'. Rs = a\<guillemotleft>x\<guillemotright> \<prec> Q' \<longrightarrow> x \<sharp> P \<longrightarrow> (\<exists>P'. P \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> P' \<and> derivative P' Q' a x (bangRel Rel))) \<and>
                     (\<forall>\<alpha> Q'. Rs = \<alpha> \<prec> Q' \<longrightarrow> (\<exists>P'. P \<longmapsto>\<alpha> \<prec> P' \<and> (P', Q') \<in> bangRel Rel))"
  from eqvtRel have EqvtBangRel: "eqvt(bangRel Rel)" by(rule eqvtBangRel)

  {
    fix Pa Rs
    assume "!Q \<longmapsto> Rs" and "(Pa, !Q) \<in> bangRel Rel"
    hence "?Sim Pa Rs" using PRelQ
    proof(nominal_induct avoiding: Pa P rule: bangInduct)
      case(cPar1B a x Q' Pa P)
      have QTrans: "Q \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> Q'" by fact
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> Pa" by fact+
      thus "?Sim Pa (a\<guillemotleft>x\<guillemotright> \<prec> (Q' \<parallel> !Q))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" by fact
        have PBRQ: "(R, !Q) \<in> bangRel Rel" by fact
        have "x \<sharp> P \<parallel> R" by fact
        hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" by simp+
        show ?case
        proof(auto simp add: residual.inject alpha')
          from PRelQ have "P \<leadsto>[Rel] Q" by(rule Sim)

          with QTrans xFreshP obtain P' where PTrans: "P \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> P'" and P'RelQ': "derivative P' Q' a x Rel"
            by(blast dest: simE)

          from PTrans xFreshR have "P \<parallel> R \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> (P' \<parallel> R)"
            by(force intro: Late_Semantics.Par1B)
          moreover from P'RelQ' PBRQ \<open>x \<sharp> Q\<close> \<open>x \<sharp> R\<close> have "derivative (P' \<parallel> R) (Q' \<parallel> !Q) a x (bangRel Rel)"
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto>a\<guillemotleft>x\<guillemotright> \<prec> P' \<and> derivative P' (Q' \<parallel> !Q) a x (bangRel Rel)" by blast
        next
          fix y
          assume "(y::name) \<sharp> Q'" and "y \<sharp> P" and "y \<sharp> R" and "y \<sharp> Q"
          from QTrans \<open>y \<sharp> Q'\<close> have "Q \<longmapsto>a\<guillemotleft>y\<guillemotright> \<prec> ([(x, y)] \<bullet> Q')"
            by(simp add: alphaBoundResidual)
          moreover from PRelQ have "P \<leadsto>[Rel] Q" by(rule Sim)
          ultimately obtain P' where PTrans: "P \<longmapsto>a\<guillemotleft>y\<guillemotright> \<prec> P'" and P'RelQ': "derivative P' ([(x, y)] \<bullet> Q') a y Rel"
            using \<open>y \<sharp> P\<close>
            by(blast dest: simE)
          from PTrans \<open>y \<sharp> R\<close> have "P \<parallel> R \<longmapsto>a\<guillemotleft>y\<guillemotright> \<prec> (P' \<parallel> R)" by(force intro: Late_Semantics.Par1B)
          moreover from P'RelQ' PBRQ \<open>y \<sharp> Q\<close> \<open>y \<sharp> R\<close> have "derivative (P' \<parallel> R) (([(x, y)] \<bullet> Q') \<parallel> !Q) a y (bangRel Rel)"
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          with \<open>x \<sharp> Q\<close> \<open>y \<sharp> Q\<close> have "derivative (P' \<parallel> R) (([(y, x)] \<bullet> Q') \<parallel> !([(y, x)] \<bullet> Q)) a y (bangRel Rel)"
            by(simp add: name_fresh_fresh name_swap)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto>a\<guillemotleft>y\<guillemotright> \<prec> P' \<and> derivative P' (([(y, x)] \<bullet> Q') \<parallel> !([(y, x)] \<bullet> Q)) a y (bangRel Rel)"
            by blast
        qed
      qed
    next
      case(cPar1F \<alpha> Q' Pa P)
      have QTrans: "Q \<longmapsto>\<alpha> \<prec> Q'" by fact
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and BR: "(R, !Q) \<in> bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P \<leadsto>[Rel] Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P \<longmapsto> \<alpha> \<prec> P'" and RRel: "(P', Q') \<in> Rel"
            by(blast dest: simE)

          from PTrans have "P \<parallel> R \<longmapsto> \<alpha> \<prec> P' \<parallel> R" by(rule Par1F)
          moreover from RRel BR have "(P' \<parallel> R, Q' \<parallel> !Q) \<in> bangRel Rel" by(rule Rel.BRPar)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> \<alpha> \<prec> P' \<and> (P', Q' \<parallel> !Q) \<in> bangRel Rel" by blast
        qed
      qed
    next
      case(cPar2B a x Q' Pa P)
      hence IH: "\<And>Pa. (Pa, !Q) \<in> bangRel Rel \<Longrightarrow> ?Sim Pa (a\<guillemotleft>x\<guillemotright> \<prec> Q')" by simp
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> Pa" by fact+
      thus "?Sim Pa (a\<guillemotleft>x\<guillemotright> \<prec> (Q \<parallel> Q'))"
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBRQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" by fact
        hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" by simp+

        from EqvtBangRel \<open>x \<sharp> Q\<close> show "?Sim (P \<parallel> R) (a\<guillemotleft>x\<guillemotright> \<prec> (Q \<parallel> Q'))"
        proof(auto simp add: residual.inject alpha' name_fresh_fresh)
          from RBRQ have "?Sim R (a\<guillemotleft>x\<guillemotright> \<prec> Q')" by(rule IH)
          with xFreshR obtain R' where RTrans: "R \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> R'" and R'BRQ': "derivative R' Q' a x (bangRel Rel)"
            by(auto simp add: residual.inject)
          from RTrans xFreshP have "P \<parallel> R \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> (P \<parallel> R')" by(auto intro: Par2B)
          moreover from PRelQ R'BRQ' \<open>x \<sharp> Q\<close> \<open>x \<sharp> P\<close> have "derivative (P \<parallel> R') (Q \<parallel> Q') a x (bangRel Rel)"
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> a\<guillemotleft>x\<guillemotright> \<prec> P' \<and> derivative P' (Q \<parallel> Q') a x (bangRel Rel)" by blast
        next
          fix y
          assume "(y::name) \<sharp> Q" and "y \<sharp> Q'" and "y \<sharp> P" and "y \<sharp> R"
          from RBRQ have "?Sim R (a\<guillemotleft>x\<guillemotright> \<prec> Q')" by(rule IH)
          with \<open>y \<sharp> Q'\<close> have "?Sim R (a\<guillemotleft>y\<guillemotright> \<prec> ([(x, y)] \<bullet> Q'))" by(simp add: alphaBoundResidual)
          with \<open>y \<sharp> R\<close> obtain R' where RTrans: "R \<longmapsto> a\<guillemotleft>y\<guillemotright> \<prec> R'" and R'BRQ': "derivative R' ([(x, y)] \<bullet> Q') a y (bangRel Rel)"
            by(auto simp add: residual.inject)
          from RTrans \<open>y \<sharp> P\<close> have "P \<parallel> R \<longmapsto> a\<guillemotleft>y\<guillemotright> \<prec> (P \<parallel> R')" by(auto intro: Par2B)
          moreover from PRelQ R'BRQ' \<open>y \<sharp> P\<close> \<open>y \<sharp> Q\<close> have "derivative (P \<parallel> R') (Q \<parallel> ([(x, y)] \<bullet> Q')) a y (bangRel Rel)"
            by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
          hence "derivative (P \<parallel> R') (Q \<parallel> ([(y, x)] \<bullet> Q')) a y (bangRel Rel)"
            by(simp add: name_swap)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> a\<guillemotleft>y\<guillemotright> \<prec> P' \<and> derivative P' (Q \<parallel> ([(y, x)] \<bullet> Q')) a y (bangRel Rel)" by blast
        qed
      qed
    next
      case(cPar2F \<alpha> Q' Pa P)
      hence IH: "\<And>Pa. (Pa, !Q) \<in> bangRel Rel \<Longrightarrow> ?Sim Pa (\<alpha> \<prec> Q')" by simp
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBRQ: "(R, !Q) \<in> bangRel Rel" by fact+
        show ?case
        proof(auto simp add: residual.inject)
          from RBRQ IH have "\<exists>R'. R \<longmapsto> \<alpha> \<prec> R' \<and> (R', Q') \<in> bangRel Rel"
            by(metis simE)
          then obtain R' where RTrans: "R \<longmapsto> \<alpha> \<prec> R'" and R'RelQ': "(R', Q') \<in> bangRel Rel"
            by blast

          from RTrans have "P \<parallel> R \<longmapsto> \<alpha> \<prec> P \<parallel> R'" by(rule Par2F)
          moreover from PRelQ R'RelQ' have "(P \<parallel> R', Q \<parallel> Q') \<in> bangRel Rel" by(rule Rel.BRPar)
          ultimately show " \<exists>P'. P \<parallel> R \<longmapsto> \<alpha> \<prec> P' \<and> (P', Q \<parallel> Q') \<in> bangRel Rel" by blast
        qed
      qed
    next
      case(cComm1 a x Q' b Q'' Pa P)
      hence IH: "\<And>Pa. (Pa, !Q) \<in> bangRel Rel \<Longrightarrow> ?Sim Pa (a[b] \<prec> Q'')" by simp
      have QTrans: "Q \<longmapsto>a<x> \<prec> Q'" by fact
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" by fact
      thus ?case using \<open>x \<sharp> Pa\<close>
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBRQ: "(R, !Q) \<in> bangRel Rel" by fact+
        from \<open>x \<sharp> P \<parallel> R\<close> have "x \<sharp> P" and "x \<sharp> R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P \<leadsto>[Rel] Q" by(rule Sim)
          with QTrans \<open>x \<sharp> P\<close> obtain P' where PTrans: "P \<longmapsto> a<x> \<prec> P'" and P'RelQ': "(P'[x::=b], Q'[x::=b]) \<in> Rel"
            by(drule_tac simE) (auto simp add: derivative_def)

          from IH RBRQ have RTrans: "\<exists>R'. R \<longmapsto> a[b] \<prec> R' \<and> (R', Q'') \<in> bangRel Rel"
            by(auto simp add: derivative_def)
          then obtain R' where RTrans: "R \<longmapsto> a[b] \<prec> R'" and R'RelQ'': "(R', Q'') \<in> bangRel Rel"
            by blast

          from PTrans RTrans have "P \<parallel> R \<longmapsto>\<tau> \<prec> P'[x::=b] \<parallel> R'" by(rule Comm1)
          moreover from P'RelQ' R'RelQ'' have "(P'[x::=b] \<parallel> R', Q'[x::=b] \<parallel> Q'') \<in> bangRel Rel" by(rule Rel.BRPar)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> \<tau> \<prec> P' \<and> (P', Q'[x::=b] \<parallel> Q'') \<in> bangRel Rel" by blast
        qed
      qed
    next
      case(cComm2 a b Q' x Q'' Pa P)
      hence IH: "\<And>Pa. (Pa, !Q) \<in> bangRel Rel \<Longrightarrow> ?Sim Pa (a<x> \<prec> Q'')" by simp
      have QTrans: "Q \<longmapsto> a[b] \<prec> Q'" by fact
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" by fact
      thus ?case using \<open>x \<sharp> Pa\<close>
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBRQ: "(R, !Q) \<in> bangRel Rel" by fact+
        from \<open>x \<sharp> P \<parallel> R\<close> have "x \<sharp> P" and "x \<sharp> R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P \<leadsto>[Rel] Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P \<longmapsto> a[b] \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
            by(blast dest: simE)

          from IH RBRQ \<open>x \<sharp> R\<close> have RTrans: "\<exists>R'. R \<longmapsto> a<x> \<prec> R' \<and> (R'[x::=b], Q''[x::=b]) \<in> bangRel Rel"
            by(fastforce simp add: derivative_def residual.inject)
          then obtain R' where RTrans: "R \<longmapsto> a<x> \<prec> R'" and R'RelQ'': "(R'[x::=b], Q''[x::=b]) \<in> bangRel Rel"
            by blast

          from PTrans RTrans have "P \<parallel> R \<longmapsto> \<tau> \<prec> P' \<parallel> R'[x::=b]" by(rule Comm2)
          moreover from P'RelQ' R'RelQ'' have "(P' \<parallel> R'[x::=b], Q' \<parallel> Q''[x::=b]) \<in> bangRel Rel" by(rule Rel.BRPar)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> \<tau> \<prec> P' \<and> (P', Q' \<parallel> (Q''[x::=b])) \<in> bangRel Rel" by blast
        qed
      qed
    next
      case(cClose1 a x Q' y Q'' Pa P)
      hence IH: "\<And>Pa. (Pa, !Q) \<in> bangRel Rel \<longrightarrow> ?Sim Pa (a<\<nu>y> \<prec> Q'')" by simp
      have QTrans: "Q \<longmapsto> a<x> \<prec> Q'" by fact
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" by fact
      moreover have xFreshPa: "x \<sharp> Pa" by fact
      ultimately show ?case using \<open>y \<sharp> Pa\<close>
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBRQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" and "y \<sharp> P \<parallel> R" by fact+
        hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" and "y \<sharp> R" and "y \<sharp> P" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P \<leadsto>[Rel] Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P \<longmapsto>a<x> \<prec> P'" and P'RelQ': "(P'[x::=y], Q'[x::=y]) \<in> Rel"
            by(fastforce dest: simE simp add: derivative_def)

           from RBRQ \<open>y \<sharp> R\<close> IH have "\<exists>R'. R \<longmapsto>a<\<nu>y> \<prec> R' \<and> (R', Q'') \<in> bangRel Rel"
             by(auto simp add: residual.inject derivative_def)
           then obtain R' where RTrans: "R \<longmapsto>a<\<nu>y> \<prec> R'" and R'RelQ'': "(R', Q'') \<in> bangRel Rel"
             by blast

           from PTrans RTrans \<open>y \<sharp> P\<close> have "P \<parallel> R \<longmapsto>\<tau> \<prec> <\<nu>y>(P'[x::=y] \<parallel> R')"
             by(rule Close1)
           moreover from P'RelQ' R'RelQ'' have "(<\<nu>y>(P'[x::=y] \<parallel> R'), <\<nu>y>(Q'[x::=y] \<parallel> Q'')) \<in> bangRel Rel"
             by(force intro: Rel.BRPar BRRes)
           ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> \<tau> \<prec> P' \<and> (P', <\<nu>y>(Q'[x::=y] \<parallel> Q'')) \<in> bangRel Rel" by blast
         qed
      qed
    next
      case(cClose2 a x Q' y Q'' Pa P)
      hence IH: "\<And>Pa. (Pa, !Q) \<in> bangRel Rel \<Longrightarrow> ?Sim Pa (a<y> \<prec> Q'')" by simp
      have QTrans: "Q \<longmapsto> a<\<nu>x> \<prec> Q'" by fact
      have "(Pa, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> Pa" and "y \<sharp> Pa" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBRQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" and "y \<sharp> P \<parallel> R" by fact+
        hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" and "y \<sharp> R" by simp+
        show ?case
        proof(auto simp add: residual.inject)
          from PRelQ have "P \<leadsto>[Rel] Q" by(rule Sim)
          with QTrans xFreshP obtain P' where PTrans: "P \<longmapsto>a<\<nu>x> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
            by(fastforce dest: simE simp add: derivative_def)

          from RBRQ IH \<open>y \<sharp> R\<close> have "\<exists>R'.  R \<longmapsto>a<y> \<prec> R' \<and> (R'[y::=x], Q''[y::=x]) \<in> bangRel Rel"
            by(fastforce simp add: derivative_def residual.inject)
          then obtain R' where RTrans: "R \<longmapsto>a<y> \<prec> R'" and R'RelQ'': "(R'[y::=x], Q''[y::=x]) \<in> bangRel Rel"
            by blast

          from PTrans RTrans xFreshR have "P \<parallel> R \<longmapsto> \<tau> \<prec> <\<nu>x>(P' \<parallel> R'[y::=x])"
            by(rule Close2)
          moreover from P'RelQ' R'RelQ'' have "(<\<nu>x>(P' \<parallel> R'[y::=x]), <\<nu>x>(Q' \<parallel> Q''[y::=x])) \<in> bangRel Rel"
            by(force intro: Rel.BRPar BRRes)
          ultimately show "\<exists>P'. P \<parallel> R \<longmapsto> \<tau> \<prec> P' \<and> (P', <\<nu>x>(Q' \<parallel> Q''[y::=x])) \<in> bangRel Rel" by blast
        qed
      qed
    next
      case(cBang Rs Pa P)
      hence IH: "\<And>Pa. (Pa, Q \<parallel> !Q) \<in> bangRel Rel \<Longrightarrow> ?Sim Pa Rs" by simp
      have "(Pa, !Q) \<in> bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q) \<in> Rel" by fact
        hence "(!P, !Q) \<in> bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P \<parallel> !P, Q \<parallel> !Q) \<in> bangRel Rel" by(rule BRPar)
        with IH have "?Sim (P \<parallel> !P) Rs" by simp
        thus ?case by(force intro: Bang)
      qed
    qed
  }

  moreover from PRelQ have "(!P, !Q) \<in> bangRel Rel" by(rule BRBang)
  ultimately show ?thesis by(auto simp add: simulation_def)
qed

end


section \<open>The Protocol\<close>

theory NS_Public imports Event begin

inductive_set ns_public :: "event list set" where
   Nil:  "[] \<in> ns_public" |
   NS1:  "\<lbrakk>evs1 \<in> ns_public; Nonce NA \<notin> used evs1\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = A, Receiver = B, Message = Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>\<rparr> # evs1 \<in> ns_public" |
   NS2:  "\<lbrakk>evs2 \<in> ns_public;  Nonce NB \<notin> used evs2;
          \<lparr>Sender = A', Receiver = B, Message = (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>)\<rparr> \<in> set evs2\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = B, Receiver = A, Message =(Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>)\<rparr> # evs2  \<in>  ns_public" |
   NS3:  "\<lbrakk>evs3 \<in> ns_public;
          \<lparr>Sender = A, Receiver = B, Message = (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>)\<rparr> \<in> set evs3;
          \<lparr>Sender = B', Receiver = A, Message = (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>)\<rparr> \<in> set evs3\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = A, Receiver = B, Message = (Crypt (pubK B) (Nonce NB))\<rparr> # evs3 \<in> ns_public" |
   Fake: "\<lbrakk>evsf \<in> ns_public;  X \<in> synth (analz (knows evsf))\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = Spy, Receiver = B, Message = X\<rparr> # evsf \<in> ns_public"

subsection "Exercise 1" (*{{{*)

(*Define the three events in Isabelle as e1, e2, and e3, using an abbreviation. {{{*)
abbreviation "e1 \<equiv> \<lparr>Sender = Friend 2, Receiver = Friend 8, Message = Crypt (pubK (Friend 8)) \<lbrace>Nonce 5, Agent (Friend 2)\<rbrace>\<rparr>"
abbreviation "e2 \<equiv> \<lparr>Sender = Friend 8, Receiver = Friend 2, Message = Crypt (pubK (Friend 2)) \<lbrace>Nonce 5, Nonce 7, Agent (Friend 8)\<rbrace>\<rparr>"
abbreviation "e3 \<equiv> \<lparr>Sender = Friend 2, Receiver = Friend 8, Message = Crypt (pubK (Friend 8)) (Nonce 7)\<rparr>"
(*}}}*)

(*Define a list ex1, which contains the three events in reverse order. {{{*)
abbreviation "ex1 \<equiv> [e3, e2, e1]"
(*}}}*)

(*Prove the following lemma e1*)
lemma e1: "[e1] \<in> ns_public" (*{{{*)
proof
  from ns_public.Nil show "[] \<in> ns_public" by simp
next
  show "Nonce 5 \<notin> used []" by simp
qed
(*}}}*)

(*Use lemma e1 to prove the following lemma e2*)
lemma e2: "[e2,e1] \<in> ns_public" (*{{{*)
proof
  from e1 show "[e1] \<in> ns_public" by simp
next
  show "Nonce 7 \<notin> used [e1]" by simp
next
  show "e1 \<in> set [e1]" by simp
qed
(*}}}*)

(*Use lemma e2 to prove the following theorem*)
theorem "ex1 \<in> ns_public" (*{{{*)
proof
  from e2 show "[e2,e1] \<in> ns_public" by simp
next
  show "e1 \<in> set [e2, e1]" by simp
next
  show "e2 \<in> set [e2, e1]" by simp
qed
(*}}}*)

(*}}}*)

subsection "Exercise 2" (*{{{*)

(*Create two additional events e4 and e5 and define the execution ex2 in terms of e1, e4, and e5 {{{*)
abbreviation "e4 \<equiv> \<lparr>Sender = Friend 8, Receiver = Friend 2, Message = Crypt (pubK (Friend 2)) \<lbrace>Nonce 5, Nonce 5, Agent (Friend 8)\<rbrace>\<rparr>"
abbreviation "e5 \<equiv> \<lparr>Sender = Friend 2, Receiver = Friend 8, Message = Crypt (pubK (Friend 8)) (Nonce 5)\<rparr>"
abbreviation "ex2 \<equiv> [e5, e4, e1]"
(*}}}*)

(*Use the same approach as in the previous exercise to try to verify that ex2
does follow the Needham-Schroeder protocol. Where does it fail? Why? {{{*)
lemma "[e4,e1] \<in> ns_public"
proof
  from e1 show "[e1] \<in> ns_public" by simp
next
  show "Nonce 5 \<notin> used [e1]" oops
(*}}}*)

(*Use the following commands to create two additional proof rules: {{{*)
inductive_cases r4: "e4 # evs \<in> ns_public"
inductive_cases r5: "e5 # evs \<in> ns_public"
(*}}}*)

(*Prove the following theorem by classical contradiction using rules r4 and r5*)
theorem "ex2 \<notin> ns_public" (*{{{*)
proof (rule ccontr)
  assume "\<not> ex2 \<notin> ns_public"
  hence "ex2 \<in> ns_public" by simp
  thus False
  proof (rule r5)
    assume "[e4, e1] \<in> ns_public"
    thus ?thesis
    proof (rule r4)
      assume "Nonce 5 \<notin> used [e1]"
      thus ?thesis by simp
    qed
  qed
qed
(*}}}*)

(*}}}*)

subsection "Exercise 3" (*{{{*)

(*Formulate a theorem spyKnowEnc which states that msg is indeed an
element of analz (knows ex1) and prove the theorem. {{{*)
theorem spyKnowEnc:
  defines "msg \<equiv> Crypt (pubK (Friend 2)) \<lbrace>Nonce 5, Nonce 7, Agent (Friend 8)\<rbrace>"
  shows "msg \<in> analz (knows ex1)" using msg_def by simp
(*}}}*)

(*Formulate a theorem spyNotAnalz which states that Nonce 5 is not an element of analz (knows ex1) and prove the theorem using lemma spyAnalz and
spyNotKnows. {{{*)
theorem spyNotAnalz:
  defines "msg \<equiv> Nonce 5"
  shows "msg \<notin> analz (knows ex1)" using msg_def by auto
(*}}}*)

(*}}}*)

subsection "Exercise 4" (*{{{*)

(*Verify in Isabelle that a spy cannot learn any private key of a honest participant for any execution of ns public:*)
theorem prikey:
assumes "A \<noteq> Spy"
shows "evs \<in> ns_public \<Longrightarrow> Key (priK A) \<notin> analz (knows evs)"
proof (induction rule: ns_public.induct)
  show "Key (priK A) \<notin> analz (knows [])" using assms by simp
next
  fix evs1 NA A' B
  assume "Key (priK A) \<notin> analz (knows evs1)"
  thus "Key (priK A) \<notin> analz (knows (\<lparr>Sender = A', Receiver = B, Message = Crypt (pubK B) \<lbrace>Nonce NA, Agent A'\<rbrace>\<rparr> # evs1))" by simp
next
  fix evs2 NB A' B NA A''
  assume "Key (priK A) \<notin> analz (knows evs2)"
  and "\<lparr>Sender = A', Receiver = B, Message = Crypt (pubK B) \<lbrace>Nonce NA, Agent A''\<rbrace>\<rparr> \<in> set evs2"
  thus "Key (priK A) \<notin> analz (knows (\<lparr>Sender = B, Receiver = A'', Message = Crypt (pubK A'') \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>\<rparr> # evs2))" by simp
next
  fix evs3 A' B NA B' NB
  assume "Key (priK A) \<notin> analz (knows evs3)"
  thus "Key (priK A) \<notin> analz (knows (\<lparr>Sender = A', Receiver = B, Message = Crypt (pubK B) (Nonce NB)\<rparr> # evs3))" by simp
next
  fix evsf X B
  assume "Key (priK A) \<notin> analz (knows evsf)"
   and "X \<in> synth (analz (knows evsf))"
  thus "Key (priK A) \<notin> analz (knows (\<lparr>Sender = Spy, Receiver = B, Message = X\<rparr> # evsf))"
    using synth_analz_insert_eq by auto
qed

(*}}}*)

subsection "Correctness of NS" (*{{{*)

declare analz_subset_parts [THEN subsetD, dest]
declare Fake_parts_insert [THEN subsetD, dest]
declare knows_Spy_partsEs [elim]

lemma no_nonce_NS1_NS2:
    "\<lbrakk>Crypt (pubK C) \<lbrace>NA', Nonce NA, Agent D\<rbrace> \<in> parts (knows evs);
      Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace> \<in> parts (knows evs);
      evs \<in> ns_public\<rbrakk>
     \<Longrightarrow> Nonce NA \<in> analz (knows evs)"
apply (erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
apply (blast intro: analz_insertI)+
done

lemma unique_NA:
     "\<lbrakk>Crypt(pubK B)  \<lbrace>Nonce NA, Agent A \<rbrace> \<in> parts(knows evs);
       Crypt(pubK B') \<lbrace>Nonce NA, Agent A'\<rbrace> \<in> parts(knows evs);
       Nonce NA \<notin> analz (knows evs); evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> A=A' \<and> B=B'"
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
apply (blast intro: analz_insertI)+
done

lemma unique_NA2:
     "\<lbrakk>Crypt(pubK B)  \<lbrace>Nonce NA, Nonce NB, Agent A\<rbrace> \<in> parts(knows evs);
       Crypt(pubK B') \<lbrace>Nonce NA', Nonce NB, Agent A'\<rbrace> \<in> parts(knows evs);
       Nonce NB \<notin> analz (knows evs); evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> A=A' \<and> NA=NA'"
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
apply (blast intro: analz_insertI)+
done

lemma honest_send_real_name:
  assumes "A \<noteq> Spy"
  shows "evs \<in> ns_public
    \<Longrightarrow> \<lparr>Sender = A, Receiver = B, Message = Crypt (pubK C) \<lbrace>Nonce NA, Agent A'\<rbrace>\<rparr> \<in> set evs
    \<Longrightarrow> A = A'"
proof (induction rule: ns_public.induct)
  case Nil
  then show ?case by simp
next
  case (Fake evsf X B)
  then show ?case using assms by simp
next
  case (NS1 evs1 NA A B)
  then show ?case using assms by fastforce
next
  case (NS2 evs2 NB A' B NA A)
  then show ?case by simp
next
  case (NS3 evs3 A B NA B' NB)
  then show ?case by simp
qed

theorem Spy_not_see_NA:
defines send_def: "send A B NA \<equiv> \<lparr>Sender = A, Receiver = B, Message = Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>\<rparr>"
assumes "A \<noteq> Spy" and "B \<noteq> Spy"
shows "\<lbrakk>evs \<in> ns_public; send A B NA \<in> set evs\<rbrakk>
       \<Longrightarrow> Nonce NA \<notin> analz (knows evs)"
proof (induction rule: ns_public.induct)
  case Nil
  then show ?case by simp
next
  case (Fake evsf X Ba)
  hence "send A B NA = \<lparr>Sender = Spy, Receiver = Ba, Message = X\<rparr> \<or> send A B NA \<in> set evsf" by simp
  with `A \<noteq> Spy` send_def have "send A B NA \<in> set evsf" by simp
  with Fake.IH have "Nonce NA \<notin> analz (knows evsf)" by simp
  thus ?case
    by (metis Fake_analz_eq Nonce_synth \<open>X \<in> synth (analz (knows evsf))\<close> knows_Says synth.Inj)
next
  case (NS1 evs1 NAa Aa Ba)
  hence "send A B NA = \<lparr>Sender = Aa, Receiver = Ba, Message = Crypt (pubK Ba) \<lbrace>Nonce NAa, Agent Aa\<rbrace>\<rparr> \<or> send A B NA \<in> set evs1" by simp
  thus ?case
  proof
    assume asmp: "send A B NA = \<lparr>Sender = Aa, Receiver = Ba, Message = Crypt (pubK Ba) \<lbrace>Nonce NAa, Agent Aa\<rbrace>\<rparr>"
    with NS1.hyps(2) have "Nonce NA \<notin> used evs1" using send_def by simp
    moreover from asmp `B \<noteq> Spy` have "Ba \<noteq> Spy" using send_def by simp
    with prikey have "Key (priK Ba) \<notin> analz (knows evs1)" using `evs1 \<in> ns_public` by simp
    hence "analz (insert (Crypt (pubK Ba) \<lbrace>Nonce NAa, Agent Aa\<rbrace>) (knows evs1)) = insert (Crypt (pubK Ba) \<lbrace>Nonce NAa, Agent Aa\<rbrace>) (analz (knows evs1))" using analz_insert_Crypt by simp
    ultimately show ?thesis by auto
  next
    assume asmp: "send A B NA \<in> set evs1"
    with NS1.hyps(2) have "NA\<noteq>NAa" by (metis Says_imp_knows_Spy parts.simps select_convs(3) send_def usedI)
    moreover from NS1.IH asmp have "Nonce NA \<notin> analz (knows evs1)" by simp
    ultimately show ?thesis by simp
  qed
next
  case (NS2 evs2 NB A' Ba NAa Aa)
  hence asmp: "send A B NA \<in> set evs2" using send_def by simp
  show ?case
  proof cases
    assume "NA = NAa"
    with NS2.IH asmp have "Nonce NAa \<notin> analz (knows evs2)" by simp
    hence "Nonce NAa \<notin> analz (knows (\<lparr>Sender = Ba, Receiver = Aa, Message = Crypt (pubK Aa) \<lbrace>Nonce NAa, Nonce NB, Agent Ba\<rbrace>\<rparr> # evs2))"
    proof cases
      assume a1: "Nonce NAa \<notin> analz (knows evs2)" and "Aa = Spy"
      with NS2.hyps(3) have a2: "\<lparr>Sender = A', Receiver = Ba, Message = Crypt (pubK Ba) \<lbrace>Nonce NAa, Agent Spy\<rbrace>\<rparr> \<in> set evs2" by simp
      hence "A'=Spy" using honest_send_real_name \<open>evs2 \<in> ns_public\<close> by blast
      moreover have "A'\<noteq>Spy" by (metis Says_imp_analz_Spy \<open>Aa = Spy\<close> \<open>NA = NAa\<close> \<open>evs2 \<in> ns_public\<close> a1 asmp assms(2) NS2.hyps(3) not_parts_not_analz select_convs(3) send_def unique_NA)
      ultimately show ?thesis by simp
    next
      assume a1: "Nonce NAa \<notin> analz (knows evs2)" and "Aa \<noteq> Spy"
      thus ?thesis using \<open>evs2 \<in> ns_public\<close> prikey by simp
    qed
    thus ?thesis using \<open>NA = NAa\<close> by simp
  next
    assume "\<not>NA = NAa"
    moreover from NS2.IH asmp have "Nonce NA \<notin> analz (knows evs2)" by simp
    moreover from NS2.hyps(2) asmp have "NA\<noteq>NB" by (metis Says_imp_knows_Spy parts.simps select_convs(3) send_def usedI)
    ultimately show ?thesis using `NA\<noteq>NB` by simp
  qed
next
  case (NS3 evs3 Aa Ba NAa B' NB)
  hence "send A B NA \<in> set evs3" by (simp add: send_def)
  with NS3.IH have "Nonce NA \<notin> analz (knows evs3)" by simp
  thus ?case
  proof cases
    assume "Nonce NA \<notin> analz (knows evs3)" and "NA = NB"
    thus ?thesis
      by (metis Says_imp_knows_Spy \<open>\<lparr>Sender = B', Receiver = Aa, Message = Crypt (pubK Aa) \<lbrace>Nonce NAa, Nonce NB, Agent Ba\<rbrace>\<rparr> \<in> set evs3\<close> \<open>evs3 \<in> ns_public\<close> \<open>send A B NA \<in> set evs3\<close> no_nonce_NS1_NS2 parts.Inj select_convs(3) send_def)
  next
    assume "Nonce NA \<notin> analz (knows evs3)" and "\<not>NA = NB"
    thus ?thesis by simp
  qed
qed

lemma knows_parts:
  assumes "Y \<notin> parts {X}"
    and "Y \<notin> analz (knows evs)"
  shows "Y \<notin> knows (\<lparr>Sender = A, Receiver = B, Message = X\<rparr> # evs)"
  using assms(1) assms(2) by auto

theorem Spy_not_see_NB:
  defines send_def: "send B A NA NB \<equiv> \<lparr>Sender = B, Receiver = A, Message = Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>\<rparr>"
  assumes "A \<noteq> Spy" and "B \<noteq> Spy"
  shows "\<lbrakk>evs \<in> ns_public; send B A NA NB \<in> set evs\<rbrakk>
  \<Longrightarrow> Nonce NB \<notin> analz (knows evs)"
proof (induction rule: ns_public.induct)
  case Nil
  then show ?case by simp
next
  case (Fake evsf X Ba)
  hence "send B A NA NB = \<lparr>Sender = Spy, Receiver = Ba, Message = X\<rparr> \<or> send B A NA NB \<in> set evsf" by simp
  with `B \<noteq> Spy` send_def have "send B A NA NB \<in> set evsf" by simp
  with Fake.IH have "Nonce NB \<notin> analz (knows evsf)" by simp
  thus ?case by (metis Fake.hyps(2) Fake_analz_eq Nonce_synth knows_Says synth.Inj)
next
  case (NS1 evs1 NAa Aa Ba)
  hence "send B A NA NB = \<lparr>Sender = Aa, Receiver = Ba, Message = Crypt (pubK Ba) \<lbrace>Nonce NAa, Agent Aa\<rbrace>\<rparr> \<or> send B A NA NB \<in> set evs1" by simp
  with `B \<noteq> Spy` send_def have "send B A NA NB \<in> set evs1" by simp
  hence "Nonce NB \<in> used evs1" using send_def by fastforce
  with NS1.hyps(2) have "\<not>NB=NAa" by auto
  hence "Nonce NB \<notin> parts ({Crypt (pubK Ba) \<lbrace>Nonce NAa, Agent Aa\<rbrace>})" by simp
  moreover from \<open>send B A NA NB \<in> set evs1\<close> have "Nonce NB \<notin> analz (knows evs1)" using NS1.IH by simp
  ultimately show ?case using knows_parts by simp
next
  case (NS2 evs2 NB' A'' B' NA' A')
  hence "send B A NA NB = \<lparr>Sender = B', Receiver = A', Message = Crypt (pubK A') \<lbrace>Nonce NA', Nonce NB', Agent B'\<rbrace>\<rparr> \<or> send B A NA NB \<in> set evs2" by simp
  then show ?case
  proof
    assume s_def: "send B A NA NB = \<lparr>Sender = B', Receiver = A', Message = Crypt (pubK A') \<lbrace>Nonce NA', Nonce NB', Agent B'\<rbrace>\<rparr>"
    hence "B \<noteq> Spy" and "A \<noteq> Spy" using assms by simp_all
    hence "analz(knows (\<lparr>Sender = B', Receiver = A', Message = Crypt (pubK A') \<lbrace>Nonce NA', Nonce NB', Agent B'\<rbrace>\<rparr> # evs2)) = insert (Crypt (pubK A') \<lbrace>Nonce NA', Nonce NB', Agent B'\<rbrace>) (analz(knows evs2))"
      using NS2.hyps(1) prikey s_def send_def by auto
    moreover from s_def have "NB = NB'" using send_def by simp
    with NS2.hyps(2) have "Nonce NB \<notin> analz(knows evs2)" by auto
    ultimately show ?thesis by simp
  next
    assume s_def: "send B A NA NB \<in> set evs2"
    moreover from \<open>send B A NA NB \<in> set evs2\<close> have IH: "Nonce NB \<notin> analz (knows evs2)" using NS2.IH by simp
    ultimately have "\<not>NB=NA'" using NS2.hyps(3) by (metis NS2.hyps(1) Says_imp_analz_Spy no_nonce_NS1_NS2 parts.Inj parts_analz select_convs(3) send_def)
    moreover from s_def have "Nonce NB \<in> used evs2" using send_def by fastforce
    with NS2.hyps(2) have "\<not>NB=NB'" by auto
    ultimately have "Nonce NB \<notin> parts {(Crypt (pubK A') \<lbrace>Nonce NA', Nonce NB', Agent B'\<rbrace>)}" by simp
    thus ?case using IH knows_parts by simp
  qed
next
  case (NS3 evs3 Aa Ba NAa Ba' NBa)
  hence "send B A NA NB = \<lparr>Sender = Aa, Receiver = Ba, Message = Crypt (pubK Ba) (Nonce NBa)\<rparr> \<or> send B A NA NB \<in> set evs3" by simp
  with `B \<noteq> Spy` send_def have "send B A NA NB \<in> set evs3" by simp
  with NS3.IH have IH: "Nonce NB \<notin> analz (knows evs3)" by simp
  show ?case
  proof cases
    assume "NB=NBa"
    show ?case
    proof cases
      assume "Ba=Spy"
      moreover have "Crypt (pubK Aa) \<lbrace>Nonce NAa, Nonce NBa, Agent Ba\<rbrace> \<in> parts(knows evs3)" using NS3.hyps(3) by auto
      with `NB=NBa` have "Ba = B"
        using NS3.hyps(1) \<open>send B A NA NB \<in> set evs3\<close> assms(3) calculation send_def unique_NA2 IH by auto
      ultimately show ?case using `B \<noteq> Spy` by simp
    next
      assume "\<not>Ba=Spy"
      thus ?case by (simp add: IH NS3.hyps(1) prikey)
    qed
  next
    assume "\<not>NB=NBa"
    thus ?case using IH by simp
  qed
qed

(*}}}*)

end