Quelle  Agent.thy

(* 
   Title: The pi-calculus   
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Agent
  imports "HOL-Nominal.Nominal"
begin

lemma pt_id:
  fixes x :: 'a
    and a :: 'x

  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "[(a, a)] ∙ x = x"
proof -
  have "x = ([]::'x prm) ∙ x"
    
  also have "[(a, a)] ∙ x = ([]::'x prm) ∙ x"
    by(simp add: pt3[OF pt] at_ds1[OF at])
  finally show ?thesis by simp
qed

lemma pt_swap:
  fixes x :: 'a
  and a :: 'x
  and b :: 'x

  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"

  shows "[(a, b)] ∙ x = [(b, a)] ∙ x"
proof -
  show ?thesis by(simp add: pt3[OF pt] at_ds5[OF at])
qed

atom_decl name

lemmas name_fresh_abs = fresh_abs_fun_iff[OF pt_name_inst, OF at_name_inst, OF fs_name1]
lemmas name_bij = at_bij[OF at_name_inst]
lemmas name_supp_abs = abs_fun_supp[OF pt_name_inst, OF at_name_inst, OF fs_name1]
lemmas name_abs_eq = abs_fun_eq[OF pt_name_inst, OF at_name_inst]
lemmas name_supp = at_supp[OF at_name_inst]
lemmas name_calc = at_calc[OF at_name_inst]
lemmas name_fresh_fresh = pt_fresh_fresh[OF pt_name_inst, OF at_name_inst]
lemmas name_fresh_left = pt_fresh_left[OF pt_name_inst, OF at_name_inst]
lemmas name_fresh_right = pt_fresh_right[OF pt_name_inst, OF at_name_inst]
lemmas name_id[simp] = pt_id[OF pt_name_inst, OF at_name_inst]
lemmas name_swap_bij[simp] = pt_swap_bij[OF pt_name_inst, OF at_name_inst]
lemmas name_swap = pt_swap[OF pt_name_inst, OF at_name_inst]
lemmas name_rev_per = pt_rev_pi[OF pt_name_inst, OF at_name_inst]
lemmas name_per_rev = pt_pi_rev[OF pt_name_inst, OF at_name_inst]
lemmas name_exists_fresh = at_exists_fresh[OF at_name_inst, OF fs_name1]
lemmas name_perm_compose = pt_perm_compose[OF pt_name_inst, OF at_name_inst]

nominal_datatype pi = PiNil                  (‹0›)
                    | Output name name pi    (‹_{_}._› [120, 120, 110] 110)
                    | Tau pi                 (‹τ._› [120] 110)
                    | Input name "«name¬ pi" (‹_🪙._› [120, 120, 110] 110)
                    | Match name name pi     (open>[_⌢_]_›
                    | Mismatch name name pi  (‹[_≠_]_› [120, 120, 110] 110)
                    | Sum pi pi              (infixr \<open>\<oplus>\<close> 90)
                    | Par pi pi              (infixr \<open>\<parallel>\<close> 85)
                    | Res "\<guillemotleft>name\<guillemotright> pi"        (\<open><\<nu>_>_\<close> [100, 100] 100)
                    | Bang pi                (\<open>!_\<close> [110] 110)

lemmas name_fresh[simp] = at_fresh[OF at_name_inst]

lemma alphaInput:
  fixes a :: name
  and   x :: name
  and   P :: pi
  and   c :: name

  assumes A1: "c \<sharp> P"

  shows "a<x>.P = a<c>.([(x, c)] \<bullet> P)"
proof(cases "x = c")
  assume "x=c"
  thus ?thesis by(simp)
next
  assume "x \<noteq> c"
  with A1 show ?thesis
    by(simp add: pi.inject alpha name_fresh_left name_calc)
qed

lemma alphaRes:
  fixes a :: name
  and   P :: pi
  and   c :: name
  
  assumes A1: "c \<sharp> P"

  shows "<\<nu>a>P = <\<nu>c>([(a, c)] \<bullet> P)"
proof(cases "a=c")
  assume "a=c"
  thus ?thesis by simp
next
  assume "a \<noteq> c"
  with A1 show ?thesis
    by(simp add: pi.inject alpha fresh_left name_calc)
qed

(*Substitution*)

definition subst_name :: "name ==> name ==> name ==> name"   (‹_[_::=_]› [110, 110, 110] 110)
where
  "a[b::=c] ≡ if (a = b) then c else a"

declare subst_name_def[simp]

lemma subst_name_eqvt[eqvt]:
  fixes p :: "name prm"
  and   a :: name
  and   b :: name
  and   c :: name

  shows "p ∙ (a[b::=c]) = (p∙ a)[(p ∙ b)::=(p ∙ c)]"
by(autoat_name_inst


nominal_primrec (freshness_context: "(c::name, d::name)")
  subs :: "pi ==> name ==> name ==> pi" (‹_[_::=_]› [100,100,100] 100)
where
  "0[c::=d] = 0"
| "τ.(P)[c::=d] = τ.(P[c::=d])"
| "a{b}.P[c::=d] = (a[c::=d]){(b[c::=d])}.(P[c::=d])"
| "[x ≠ a; x ≠ c; x ≠ d] ==> (a<x>.P)[c::=d] = (a[c::=d])<x>.(P[c::=d])"
| "[a⌢b]P[c::=d] = [(a[c::=d])⌢(b[c::=d])](P[c::=d])"
| "[a≠b]P[c::=d] = [(a[c::=d])≠(b[c::=d])](P[c::=d])"
| "(P ⊕ Q)[c::=d] = (P[c::=d]) ⊕ (Q[c::=d])"
| "(P ∥ Q)[c::=d] = (P[c::=d]) ∥ (Q[c::=d])"
| "[x ≠ c; x ≠ d] ==> (<νx>P)[c::=d] = <νx>(P[c::=d])"
| "!P[c::=d] = !(P[c::=d])"
apply(simp_all add: abs_fresh)
apply(finite_guess)+
by(fresh_guess)+

lemma forget:
  fixes a :: name
  and   P :: pi
  and   b :: name

  assumes "a ♯ P"

  shows "P[a::=b] = P"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
  (auto simp add: name_fresh_abs)

lemma fresh_fact2[rule_format]:
  fixes P :: pi
  and   a :: name
  and   b :: name

  assumes "a ≠ b"

  shows "a ♯ P[a::=b]"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
  (auto simp add: name_fresh_abs)

lemma subst_identity[simp]:
  fixes P :: pi
  and   a :: name

  shows "P[a::=a] = P"
by(nominal_induct P avoiding: a rule: pi.strong_induct) auto

lemma renaming:
  fixes P :: pi
  and   a :: name
  and   b :: name
  and   c :: name

  assumes "c ♯ P"

  shows "P[a::=b] = ([(c, a)] ∙j∈{(LEAST i. n < i ∧ (∃i'. cs^<pi>\close and vwrite: ‹ by blast
using assms
by(nominal_induct P avoiding: a b c rule: pi.strong_induct)
  (auto simp add: name_calc name_fresh_abs)


lemma fresh_fact1:
  fixes P :: pi
  and a :: name
  and b :: name
  and c :: name

  assumes "  ♯ P"
 and "a ≠ c"

 shows "a ♯ P[b::=c]"
  assms
 (nominal_induct P avoiding: a b c rule: pi.strong_induct)
 (auto simp add: name_fresh_abs)


  eqvt_subs[eqvt]:
 fixes p :: "name prm"
 and P :: pi
 and a :: name
 and b :: name

 shows "p ∙ (P[a::=b]) = (p ∙ P)[(p ∙ a)::=(p ∙ b)]"
 (nominal_induct P avoiding: a b rule: pi.strong_induct)
 (auto simp add: name_bij)


  substInput[simp]:
 fixes x :: name
 and b :: name
 and c :: name
 and a :: name
 and P :: pi

 assumes "x ≠ b"
 and "x ≠ c"

 shows "(ax.P)[b::=c] = (a[b::=c])x.(P[b::=c])"
  -
 obtain y::name where"y ≠ a" and "y ♯ P" and "y ≠ b" and "y ≠ c"
 by(generate_fresh "name") (auto simp add: fresh_prod)
 from ‹y ♯ P› have "ax.P = ay.([(x, y)] ∙ P)" by(simp add: alphaInput)
 moreover have "(a[b::=c])x.(P[b::=c]) = (a[b::=c])y.(([(x, y)] ∙ P)[b::=c])" (is "?LHS = ?RHS")
 proof -
 from ‹y ♯ P› ‹y ≠ c› have "y ♯ P[b::=c]" by(rule fresh_fact1)
 hence "?LHS = (a[b::=c])y.([(x, y)] ∙ (P[b::=c]))" by(simp add: alphaInput)
 moreover with ‹x \                  de i ee\>i <equiv  ∧ (∃i'. cs<sup>πesup> i' =csπi\close
 by(auto simp add: eqvt_subs name_calc)
 ultimately show ?thesis by simp
 qed
 ultimately show ?thesis using ‹y ≠ a› ‹y ≠ b› ‹y ≠ c› by simp
 

  injPermSubst:
 fixes P :: pi
 and a :: name
 and b :: name

 assumes "b ♯ P"

 shows "[(a, b)] ∙ P = P[a::=b]"
  assms
 (nominal_induct P avoiding: a b rule: pi.strong_induct)
 (auto simp add: name_calc name_fresh_abs)

  substRes2:
 fixes P :: pi
 and a :: name
 and b :: name

 assumes "b ♯ P"

 shows "<\<nu>a>P = <\<nu>b>(P[a::=b])"
 (case_tac "a = b")
 assume "a = b"
 thus ?thesis by auto
 
 assume "a ≠ b"
 moreover with ‹b ♯ P› show ?thesis
 apply(simp add: pi.inject abs_fun_eq[OF pt_name_inst, OF at_name_inst])
 apply auto
 apply(simp add: renaming)
 apply(simp add: pt_swap[OF pt_name_inst, OF at_name_inst])
 apply(simp add: renaming)
 apply(simp add: pt_fresh_left[OF pt_name_inst, OF at_name_inst])
 by(force simp add: at_calc[OF at_name_inst])
 

  freshRes:
 fixes P :: pi
 and a :: name
 
 shows "a ♯ <\<nu>a>P"
 (simp add: name_fresh_abs)

  substRes3:
 fixes P :: pi
 and a :: name
 and b :: name

 assumes "b ♯ P"

 shows "(<\<nu>a>P)[a::=b] = <\<nu>b>(P[a::=b])"
  -
 have "(<\<nu>a>P)[a::=b] = <\<nu>a>P"
 using freshRes by(simp add: forget)
 thus ?thesis using ‹b ♯ P› by(simp add: substRes2)
 

  suppSubst:
 fixes P :: pi
 and a :: name
 and b :: name

 shows "supp(P[a::=b]) ⊆ insert b ((supp P) - {a})"
 (nominal_induct P avoiding: a b rule: pi.strong_induct,
 simp_all add: pi.supp name_supp_abs name_supp supp_prod)
 (ls)
 
(******** Sequential substitution *******)</sup>

primrec seqSubs :: "pi ==> (name × name) list ==> pi" (‹_[🪙]› [100,100] 100) where
  "P[<[]>] = P"
| "P[<(x#σ)>] = (P[(fst x)::=(snd x)])[<σ>]"

primrec seq_subst_name :: "name ==> (name × name) list ==> name" where
  "seq_subst_name a [] = a"
| "seq_subst_name a (x#σ) = seq_subst_name (a[(fst x)::=(snd x)]) σ"

lemma freshSeqSubstName:
  fixes x :: name
  and   a :: name
  and   s :: "(name × name) list"

  assumes "x ≠ a"
  and     "x ♯ s"

  shows "x ≠ seq_subst_name a s"
using assms
apply(induct s arbitrary: a)
apply simp
apply(case_tac "aa = fst(a)")
by (force simp add: fresh_list_cons fresh_prod)+


lemma seqSubstZero[simp]:
  fixes σ :: "(name × name) list"

  shows "0[<σ>] = 0"
by(induct σ, auto)

lemma seqSubstTau[simp]:
  fixes P :: pi
  and   σ :: "(name × name) list"

  shows "(τ.(P))[<σ>] = τ.(P[<σ>])"
by(induct σ arbitrary: P, auto)

lemma seqSubstOutput[simp]:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   σ :: "(name × name) list"
  
  shows "(a{b}.P)[<σ>] = (seq_subst_name a σ){(seq_subst_name b σ)}.(P[<σ>])"
by(induct σ arbitrary: a b P, auto)

lemma seqSubstInput[simp]:
  fixes a :: name
  and   x :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  assumes "x ♯ σ"
 
  shows "(a<x>.P)[<σ>] = (seq_subst_name a σ)<x>.(P[<σ>])"
using assms
by(induct σ arbitrary: a x P) (auto simp add: fresh_list_cons fresh_prod)

lemma seqSubstMatch[simp]:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  shows "([a⌢b]P)[<σ>] = [(seq_subst_name a σ)⌢(seq_subst_name b σ)](P[<σ>])"
by(induct σ arbitrary: a b P, auto)

lemma seqSubstMismatch[simp]:
  fixes a :: name
  and   b :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  shows "([a≠b]P)[<σ>] = [(seq_subst_name a σ)≠(seq_subst_name b σ)](P[<σ>])"
by(induct σ arbitrary: a b P, auto)

lemma seqSubstSum[simp]:
  fixes P :: pi
  andjava.lang.StringIndexOutOfBoundsException: Index 77 out of bounds for length 77
  and   σ :: "(name × name) list"

  shows "(P ⊕ Q)[<σ>] = (P[<σ>]) ⊕ (Q[<σ>])"
by(induct σ arbitrary: P Q , auto)

lemma seqSubstPar[simp]:
  fixes P :: pi
  and   Q :: pi
  and   σ :: "(name × name) list"

  shows "(P ∥ Q)[<σ>] = (P[<σ>]) ∥ (Q[<σ>])"
by(induct σ arbitrary: P Q, auto)

lemma seqSubstRes[simp]:
  fixes x :: name
  and   P :: pi
  and   σ :: "(name × name) list"

  assumes "x ♯ σ"

  shows "(<νx>P)[<σ>] = <νx>(P[<σ>])"
using assms
by(induct σ arbitrary: x P) (auto simp add: fresh_list_cons fresh_prod)

lemma seqSubstBang[simp]:
  fixes P :: pi
  and   s :: "(name × name) list"

  shows "(!P)[<σ>] = !(P[<σ>])"
by(induct σ arbitrary: P, auto)

lemma seqSubstEqvt[eqvt, simp]:
  fixes P :: pi
  and   σhavejl<penj ≤ l› using kddl jk vwrite unfolding is_ddi_def by auto
  and   p :: "name prm"

  shows "p ∙ (P[<σ>]) = (p ∙ P)[<(p ∙si>)]"
by(induct σ arbitrary: P, auto simp add: eqvt_subs)

lemma seqSubstAppend[simp]:
  fixes P  :: pi
  and   σ  :: "(name × name) list"
  and   σ' :: "(name × name) list"

  shows "P[<(σ@σ')>] = (P[<σ>])[<σ'>]"
by(induct σ arbitrary: P, auto)

lemma freshSubstChain[intro]:
  fixes P :: pi
  and   σ :: "(name × name) list"
  and   a :: name

  assumes "a ♯ P"
  and     "a ♯ σ"

  shows "a ♯ P[<σ>]"
using assms
by(induct σ arbitrary: a P, auto simp add: fresh_list_cons fresh_prod fresh_fact1)

end