Library SP

Require Export Common.
Require Import CC.

Local Open Scope nat_scope.

Module SPBase (P X V E B R:DecType) (Ev:Eval E X V V) (BEv:Eval B X V Bool).

Preamble: a lot of things just as in CC.

Module Export PSt := LState V X.
Module Export CSt := GState P V X.
Module Export TL := Transitions P V X R.

Module Bdec := DecidableType B.
Module Edec := DecidableType E.
Module Rdec := DecidableType R.

Definition Expr := E.t.
Definition Expr_dec := Edec.eqb.
Definition BExpr := B.t.
Definition BExpr_dec := Bdec.eqb.
Definition RecVar := R.t.
Definition RecVar_dec := Rdec.eqb.

Definition eval := Ev.eval.
Definition beval := BEv.eval.

Module EvSt := EvalState P E X V V Ev.
Module BEvSt := EvalState P B X V Bool BEv.

Definition eval_on_state := EvSt.eval_on_state.
Definition beval_on_state := BEvSt.eval_on_state.

Definition eval_eq := EvSt.eval_eq.
Definition eval_neq := EvSt.eval_neq.
Definition beval_eq := BEvSt.eval_eq.
Definition beval_neq := BEvSt.eval_neq.

Syntax of processes


Section Syntax.

Behaviours


Inductive Behaviour : Type :=
| End : Behaviour
| Send : Pid -> Expr -> Behaviour -> Behaviour
| Recv : Pid -> Var -> Behaviour -> Behaviour
| Sel : Pid -> Label -> Behaviour -> Behaviour
| Branching : Pid -> option Behaviour -> option Behaviour -> Behaviour
| Cond : BExpr -> Behaviour -> Behaviour -> Behaviour
| Call : RecVar -> Behaviour
.

In order to do induction on behaviours.

Fixpoint depth (B:Behaviour) : nat :=
match B with
 | Send p e B' => 1 + depth B'
 | Recv p x B' => 1 + depth B'
 | Sel p l B' => 1 + depth B'
 | Branching p mB mB' => 1
                         + (match mB with None => 0 | Some B => depth B end)
                         + (match mB' with None => 0 | Some B => depth B end)
 | Cond b B1 B2 => 1 + Nat.max (depth B1) (depth B2)
 | Call X => 1
 | End => 1
end.

Theorem Behaviour_ind' :
  forall P:Behaviour -> Prop,
    P End ->
    (forall p e B, P B -> P (Send p e B)) ->
    (forall p v B, P B -> P (Recv p v B)) ->
    (forall p l B, P B -> P (Sel p l B)) ->
    (forall p mB mB', (forall B, mB = Some B -> P B) ->
                      (forall B, mB' = Some B -> P B) ->
                      P (Branching p mB mB')) ->
    (forall b B1 B2, P B1 -> P B2 -> P (Cond b B1 B2)) ->
    (forall X, P (Call X)) ->
    forall B, P B.

Theorem Behaviour_rec' :
  forall P:Behaviour -> Type,
    P End ->
    (forall p e B, P B -> P (Send p e B)) ->
    (forall p v B, P B -> P (Recv p v B)) ->
    (forall p l B, P B -> P (Sel p l B)) ->
    (forall p mB mB', (forall B, mB = Some B -> P B) ->
                      (forall B, mB' = Some B -> P B) ->
                      P (Branching p mB mB')) ->
    (forall b B1 B2, P B1 -> P B2 -> P (Cond b B1 B2)) ->
    (forall X, P (Call X)) ->
    forall B, P B.

Equality of behaviours is decidable. We are using the fact that equality on labels is decidable.
Lemma Behaviour_eq_dec : forall (B B':Behaviour), {B=B'} + {B<>B'}.

Lemma Behaviour_eq_End_dec : forall (b:Behaviour), {b=End} + {b<>End}.

Networks

Networks are maps from process names to behaviours.

Definition Network := Pid -> Behaviour.

A lot of definitions are parameterised on process lists, for decidability.

Definition within_ps (ps:list Pid) (N:Network) :=
  forall p, ~In p ps -> N p = End.

Lemma within_ps_cons : forall ps N, within_ps ps N ->
  forall p, within_ps (p::ps) N.

Lemma within_ps_rev : forall ps N, within_ps ps N ->
  forall p, N p <> End -> In p ps.

Definition finite_support (N:Network) := exists ps, within_ps ps N.

Network equality


Definition Network_eq (N N':Network) : Prop := forall p, N p = N' p.

Network equality is an equivalence relation, as expected.

Lemma Network_eq_refl : reflexive _ Network_eq.

Lemma Network_eq_sym : symmetric _ Network_eq.

Lemma Network_eq_trans : transitive _ Network_eq.

Lemma Network_eq_within_ps : forall ps N N',
  within_ps ps N -> within_ps ps N' ->
  (forall p, In p ps -> N p = N' p) -> Network_eq N N'.

Programs in SP are pairs, like choreography programs in CC.

Definition DefSetB := RecVar -> Behaviour.

Record Program : Type :=
  { Procs : DefSetB;
    Net : Network }.

Lemma SP_eta : forall P, P = Build_Program (Procs P) (Net P).

Syntactic constructors for building networks as lists

Definition EmptyNet : Network := fun _ => End.

Definition Process (p:Pid) (B:Behaviour) : Network :=
  fun p' => if (Pid_dec p' p) then B else End.

Definition Par (N N':Network) :=
  fun p => if (Behaviour_eq_End_dec (N p)) then N' p else N p.

Definition Network_rm (N:Network) (p:Pid) :=
  fun r => if (Pid_dec r p) then End else N r.


Definition Network_rm_ps (N:Network) (ps:list Pid) :=
  fun r => if (in_dec P.eq_dec r ps) then End else N r.

Definition Network_res_ps (N:Network) (ps:list Pid) :=
  fun r => if (in_dec P.eq_dec r ps) then N r else End.

End Syntax.

Add Parametric Relation : Network Network_eq
  reflexivity proved by Network_eq_refl
  symmetry proved by Network_eq_sym
  transitivity proved by Network_eq_trans
  as Network_eq_rel.

Delimit Scope SP_scope with SP.


Notation "p ! e ; B" := (Send p e B) (at level 60, e at level 9, right associativity) : SP_scope.
Notation "p ? xx ; B" := (Recv p xx B) (at level 60, right associativity) : SP_scope.
Notation "p (+) l ; B" := (Sel p l B) (at level 49, l at level 9, right associativity) : SP_scope.
Notation "p '&' B1 '//' B2" := (Branching p B1 B2) (at level 60, no associativity) : SP_scope.
Notation "'If' e 'Then' B1 'Else' B2" := (Cond e B1 B2) (at level 60) : SP_scope.
Notation "'bnil'" := (End) : SP_scope.
Notation "'nnil'" := (EmptyNet) : SP_scope.

Notation "N | N'" := (Par N N') (at level 202, right associativity) : SP_scope.
Notation "p [ B ]" := (Process p B) (at level 201, no associativity) : SP_scope.
Notation "N ~~ p" := (Network_rm N p) (at level 200, no associativity) : SP_scope.

Notation "N == N'" := (Network_eq N N') (at level 100) : SP_scope.

Ltac BInduction B m1 m2 := induction B using Behaviour_ind';
  try case_eq m1; try case_eq m2.

Ltac BDInduction B B' m1 m2 m3 m4:= induction B using Behaviour_ind'; induction B' using Behaviour_ind';
  try case_eq m1; try case_eq m2; try case_eq m3; try case_eq m4.

Open Scope SP_scope.


Syntactic properties


Section SyntacticProperties.

A bunch of useful properties about networks.
Lemma EmptyNet_within_ps : forall ps, within_ps ps EmptyNet.

Lemma EmptyNet_finite_supp : finite_support EmptyNet.

Lemma Process_refl : forall p B, (p [B]) p = B.

Lemma Process_out : forall p B p', p <> p' -> (p [B]) p' = End.

Lemma Par_proj1 : forall N N' p, N p <> End -> (N | N') p = N p.

Lemma Par_proj2 : forall N N' p, N p = End -> (N | N') p = N' p.

Lemma Par_proj1' : forall N N' p, N' p = End -> (N | N') p = N p.

Lemma Par_assoc : forall N N' N'',
  Network_eq (N | (N' | N'')) ((N | N') | N'').

Useful results for networks with two processes.
Lemma Par_fst : forall p Bp q Bq, p <> q -> (p [Bp] | q [Bq]) p = Bp.

Lemma Par_snd : forall p Bp q Bq, p <> q -> (p [Bp] | q [Bq]) q = Bq.

Lemmas about subterms.

Lemma Send_neq_cont : forall p e B, Send p e B <> B.

Lemma Recv_neq_cont : forall p x B, Recv p x B <> B.

Lemma Sel_neq_cont : forall p l B, Sel p l B <> B.

Lemma Branching_l_neq_cont : forall p Bl Br, Branching p (Some Bl) Br <> Bl.

Lemma Branching_r_neq_cont : forall p Bl Br, Branching p Bl (Some Br) <> Br.

Lemma Then_neq_cont : forall b B1 B2, Cond b B1 B2 <> B1.

Lemma Else_neq_cont : forall b B1 B2, Cond b B1 B2 <> B2.

If two networks do not share any running processes, then their parallel composition is symmetric.

Definition Network_disjoint (N N':Network) :=
  forall p, N p = End \/ N' p = End.

Lemma Network_disjoint_sym : forall N N',
  Network_disjoint N N' -> Network_disjoint N' N.

Lemma Par_comm : forall N N', Network_disjoint N N' -> (N | N') == (N' | N).

Lemma Par_eq : forall N1 N2 N1' N2',
  (N1 == N1') -> (N2 == N2') -> (N1 | N2) == (N1' | N2').

Properties of removal.

Lemma Network_rm_In : forall N p, (Network_rm N p) p = End.

Lemma Network_rm_out : forall N p p', p <> p' ->
  Network_rm N p p' = N p'.

Lemma Network_rm_add :
  forall N p, N == (Network_rm N p | p [N p]).

Lemma Network_rm_within_ps : forall N p ps,
  within_ps (p::ps) N -> within_ps ps (Network_rm N p).

Lemma Network_rm_add_2_p : forall N p q Bp Bq, p <> q ->
  (Network_rm (Network_rm N p) q | p [Bp] | q [Bq]) p = Bp.

Lemma Network_rm_add_2_q : forall N p q Bp Bq, p <> q ->
  (Network_rm (Network_rm N p) q | p [Bp] | q [Bq]) q = Bq.

Lemma Network_rm_add_2_out : forall N p q r Bp Bq,
  p <> r -> q <> r ->
  (Network_rm (Network_rm N p) q | p [Bp] | q [Bq]) r = N r.

Lemma Network_rm_eq : forall N N', Network_eq N N' ->
  forall p, (Network_rm N p) == (Network_rm N' p).

Lemma Network_rm_res_ps :
  forall N ps, N == (Network_rm_ps N ps | Network_res_ps N ps).

Rewriting of networks.

Lemma Network_eq_cross'' : forall N N1 N2 p q Bp Bq,
  p <> q -> Network_eq N1 (Network_rm N p| p [Bp]) ->
  Network_eq N2 (Network_rm N q | q [Bq]) ->
  (Network_rm N2 p | p [Bp]) == (Network_rm N1 q | q [Bq]).

Lemma Network_eq_cross' : forall N N1 N2 p q r Bp Bq Br,
  p <> q -> p <> r -> q <> r ->
  Network_eq N1 (Network_rm (Network_rm N p) q | p [Bp] | q [Bq]) ->
  Network_eq N2 (Network_rm N r | r [Br]) ->
  (Network_rm (Network_rm N2 p) q | p [Bp] | q [Bq])
             == (Network_rm N1 r | r [Br]).

Lemma Network_eq_cross : forall N N1 N2 p q r s Bp Bq Br Bs,
  p <> q -> p <> r -> p <> s -> q <> r -> q <> s -> r <> s ->
  Network_eq N1 (Network_rm (Network_rm N p) q | p [Bp] | q [Bq]) ->
  Network_eq N2 (Network_rm (Network_rm N r) s | r [Br] | s [Bs]) ->
  (Network_rm (Network_rm N2 p) q | p [Bp] | q [Bq])
             == (Network_rm (Network_rm N1 r) s | r [Br] | s [Bs]).

Lemma Network_eq_within_ps_dec : forall ps N N', within_ps ps N -> within_ps ps N' ->
  { N == N' }+{~ (N == N') }.


Well-formedness

We do not know whether we need well-formedness of processes yet. Well-formedness does not check that, in branchings, all labels are distinct.

Fixpoint Behaviour_WF (p:Pid) (B:Behaviour) : Prop :=
match B with
| bnil => True
| Call _ => True
| (q ! _; B') => p <> q /\ Behaviour_WF p B'
| (q ? _; B') => p <> q /\ Behaviour_WF p B'
| (q (+) l; B') => p <> q /\ Behaviour_WF p B'
| (q & B1 // B2) => p <> q
                /\ (match B1 with None => True | Some B => Behaviour_WF p B end)
                /\ (match B2 with None => True | Some B => Behaviour_WF p B end)
| (If e Then B1 Else B2) => Behaviour_WF p B1 /\ Behaviour_WF p B2
end.

Lemma Behaviour_WF_dec : forall p B,
  {Behaviour_WF p B} + {~Behaviour_WF p B}.

Definition Network_WF (N:Network) : Prop :=
  forall p, Behaviour_WF p (N p).

Lemma Network_WF_dec : forall ps N, within_ps ps N ->
  {Network_WF N} + {~Network_WF N}.

Lemma Par_WF : forall N N', Network_WF N -> Network_WF N' ->
  Network_WF (N | N').

Lemma WF_Par1 : forall N N', Network_WF (N | N') -> Network_WF N.

Lemma WF_Par2 : forall N N', Network_disjoint N N' ->
  Network_WF (N | N') -> Network_WF N'.

Lemma Network_WF_par : forall N N', Network_disjoint N N' ->
  Network_WF (N | N') -> Network_WF N /\ Network_WF N'.

Lemma Network_WF_comm : forall N N', Network_disjoint N N' ->
  Network_WF (N | N') -> Network_WF (N' | N).


End SyntacticProperties.

Semantics of SP


Section Semantics.


Same strategy as for CC.

Inductive SP_To (Defs : DefSetB) :
  Network -> State -> RichLabel -> Network -> State -> Prop :=
 | S_Com N p e B q x B' N' s s' :
    N p = (q ! e ; B) -> N q = (p ? x ; B') ->
    let v := (eval_on_state e s p) in
    Network_eq N' ((Network_rm (Network_rm N p) q) | p[B] | q[B']) ->
    eq_state_ext s' (update s q x v) ->
    SP_To Defs N s (R_Com p v q x) N' s'
 | S_LSel N p B q Bl Br N' s s' :
    N p = (q (+) left ; B) -> N q = (p & Some Bl // Br) ->
    Network_eq N' ((Network_rm (Network_rm N p) q) | p[B] | q[Bl]) ->
    eq_state_ext s s' ->
    SP_To Defs N s (R_Sel p q left) N' s'
 | S_RSel N p B q Bl Br N' s s' :
    N p = (q (+) right ; B) -> N q = (p & Bl // Some Br) ->
    Network_eq N' ((Network_rm (Network_rm N p) q) | p[B] | q[Br]) ->
    eq_state_ext s s' ->
    SP_To Defs N s (R_Sel p q right) N' s'
 | S_Then N p b B1 B2 N' s s' :
    N p = (If b Then B1 Else B2) ->
    beval_on_state b s p = true ->
    Network_eq N' ((Network_rm N p) | p[B1]) ->
    eq_state_ext s s' ->
    SP_To Defs N s (R_Cond p) N' s'
 | S_Else N p b B1 B2 N' s s' :
    N p = (If b Then B1 Else B2) ->
    beval_on_state b s p = false ->
    Network_eq N' ((Network_rm N p) | p[B2]) ->
    eq_state_ext s s' ->
    SP_To Defs N s (R_Cond p) N' s'
 | S_Call N p X N' s s' :
    N p = Call X ->
    Network_eq N' ((Network_rm N p) | p[Defs X]) ->
    eq_state_ext s s' ->
    SP_To Defs N s (R_Call X p) N' s'.

Default reductions.

Lemma S_Com' : forall Defs N p e B q x B' s,
  N p = (q ! e ; B) -> N q = (p ? x ; B') ->
  let v := (eval_on_state e s p) in
  SP_To Defs N s (R_Com p v q x) ((Network_rm (Network_rm N p) q) | p[B] | q[B']) (update s q x v).

Lemma S_LSel' : forall Defs N p B q Bl Br s,
  N p = (q (+) left ; B) -> N q = (p & Some Bl // Br) ->
  SP_To Defs N s (R_Sel p q left) ((Network_rm (Network_rm N p) q) | p[B] | q[Bl]) s.

Lemma S_RSel' : forall Defs N p B q Bl Br s,
  N p = (q (+) right ; B) -> N q = (p & Bl // Some Br) ->
  SP_To Defs N s (R_Sel p q right) ((Network_rm (Network_rm N p) q) | p[B] | q[Br]) s.

Lemma S_Then' : forall Defs N p b B1 B2 s,
  N p = (If b Then B1 Else B2) ->
  beval_on_state b s p = true ->
  SP_To Defs N s (R_Cond p) ((Network_rm N p) | p[B1]) s.

Lemma S_Else' : forall Defs N p b B1 B2 s,
  N p = (If b Then B1 Else B2) ->
  beval_on_state b s p = false ->
  SP_To Defs N s (R_Cond p) ((Network_rm N p) | p[B2]) s.

Lemma S_Call' : forall Defs N p X s,
  N p = Call X ->
  SP_To Defs N s (R_Call X p) ((Network_rm N p) | p[Defs X]) s.

Definition Configuration : Type := Program * State.

Inductive SPP_To : Configuration -> TransitionLabel -> Configuration -> Prop :=
 | SPP_To_intro Defs N s t N' s' : SP_To Defs N s t N' s' ->
     SPP_To (Build_Program Defs N,s) (forget t) (Build_Program Defs N',s').

Inductive SPP_ToStar : Configuration -> list TransitionLabel -> Configuration -> Prop :=
 | SPT_Refl c : SPP_ToStar c nil c
 | SPT_Step c1 t c2 l c3 : SPP_To c1 t c2 -> SPP_ToStar c2 l c3 -> SPP_ToStar c1 (t::l) c3
.

End Semantics.

Notation "C --[ l ]--> C'" := (SPP_To C l C') (at level 50, left associativity) : SP_scope.
Notation "C --[ ls ]-->* C'" := (SPP_ToStar C ls C') (at level 50, left associativity) : SP_scope.

Section Determinism.

Results on determinism of the semantics.

These results are named consistently with CC.
Reductions are preserved by state equivalence...

Lemma SP_To_eq : forall Defs N tl s1 N' s2 s1' s2',
  eq_state_ext s1 s1' -> eq_state_ext s2 s2' ->
  SP_To Defs N s1 tl N' s2 -> SP_To Defs N s1' tl N' s2'.

Lemma SPP_To_eq : forall P s1 tl P' s2 s1' s2',
  eq_state_ext s1 s1' -> eq_state_ext s2 s2' ->
  (P,s1) --[tl]--> (P',s2) -> (P,s1') --[tl]--> (P',s2').

Lemma SPP_ToStar_eq : forall P s1 tl P' s2 s1' s2',
  eq_state_ext s1 s1' -> eq_state_ext s2 s2' -> tl <> nil ->
  (P,s1) --[tl]-->* (P',s2) -> (P,s1') --[tl]-->* (P',s2').

...by network equivalence...

Lemma SP_To_Network_eq : forall N1 N1' N2 SPDefs s s' t,
    (N1 == N2) -> SP_To SPDefs N1 s t N1' s' -> SP_To SPDefs N2 s t N1' s'.

Lemma SPP_To_Network_eq : forall P1 P1' P2 s s' tl,
  (Net P1 == Net P1') -> (Procs P1 = Procs P1') ->
  (P1,s) --[tl]--> (P2,s') -> (P1',s) --[tl]--> (P2,s').

Lemma SPP_ToStar_Network_eq : forall P1 P1' P2 s s' tl,
  (Net P1 == Net P1') -> (Procs P1 = Procs P1') -> tl <> nil ->
  (P1,s) --[tl]-->* (P2,s') -> (P1',s) --[tl]-->* (P2,s').

... and by extensionally equal sets of procedure definitions.
Lemma SP_To_Defs_wd : forall Defs Defs', (forall X, Defs X = Defs' X) ->
  forall N s tl N' s', SP_To Defs N s tl N' s' -> SP_To Defs' N s tl N' s'.

The set of procedure definitions never changes.

Hypothesis Defs : DefSetB.

Lemma SPP_To_Defs_stable : forall Defs' N N' tl s s',
  (Build_Program Defs N,s) --[tl]--> (Build_Program Defs' N',s') -> Defs = Defs'.

Lemma SPP_ToStar_Defs_stable : forall Defs' N N' tl s s',
  (Build_Program Defs N,s) --[tl]-->* (Build_Program Defs' N',s') -> Defs = Defs'.

Reductions and state.

Lemma SP_To_disjoint_eval : forall N s tl s' p e N',
  disjoint_p_rl p tl -> SP_To Defs N s tl N' s' ->
  eval_on_state e s p = eval_on_state e s' p.

Lemma SP_To_disjoint_beval : forall N s tl s' p b N',
  disjoint_p_rl p tl -> SP_To Defs N s tl N' s' ->
  beval_on_state b s p = beval_on_state b s' p.

Lemma SP_To_disjoint_update : forall N s tl s' p x v N',
  disjoint_p_rl p tl -> SP_To Defs N s tl N' s' ->
  SP_To Defs N (update s p x v) tl N' (update s' p x v).

Determinism of reductions given the label.
Lemma SP_To_deterministic_1 : forall N N1 N2 tl s s1 s2,
  SP_To Defs N s tl N1 s1 -> SP_To Defs N s tl N2 s2 -> N1 == N2.

Lemma SP_To_deterministic_2 : forall N N1 N2 tl s s1 s2,
  SP_To Defs N s tl N1 s1 -> SP_To Defs N s tl N2 s2 ->
  eq_state_ext s1 s2.

Lemma SP_To_deterministic : forall N N1 N2 tl1 tl2 s s1 s2,
  SP_To Defs N s tl1 N1 s1 -> SP_To Defs N s tl2 N2 s2 ->
  tl1 = tl2 -> (N1 == N2) /\ eq_state_ext s1 s2.


Ltac diff_assert p q H1 H2 H3 := assert (p <> q) as H1;
  [intro H1; rewrite H1, H2 in H3; inversion H3 | idtac].

Lemma SP_To_deterministic_4 : forall N N' tl1 tl2 s s1 s2,
  SP_To Defs N s tl1 N' s1 -> SP_To Defs N s tl2 N' s2 ->
  eq_state_ext s1 s2.

The label alone determines the resulting state.

Lemma SP_To_rl_implies_state : forall N1 s tl N1' s1 N2 N2' s2,
  SP_To Defs N1 s tl N1' s1 -> SP_To Defs N2 s tl N2' s2 ->
  eq_state_ext s1 s2.

Confluence


Lemma diamond_SP : forall N s tl1 tl2 N1 N2 s1 s2,
  SP_To Defs N s tl1 N1 s1 -> SP_To Defs N s tl2 N2 s2 ->
  tl1 <> tl2 -> exists N' s', SP_To Defs N1 s1 tl2 N' s' /\ SP_To Defs N2 s2 tl1 N' s'.

End Determinism.

Useful generalizations

Lemma SPP_To_deterministic_1 : forall P s tl P' s' P'' s'',
  (P,s) --[tl]--> (P',s') -> (P,s) --[tl]--> (P'',s'') ->
  Net P' == Net P''.

Lemma SPP_To_deterministic_2 : forall P s tl P' s' P'' s'',
  (P,s) --[tl]--> (P',s') -> (P,s) --[tl]--> (P'',s'') ->
  eq_state_ext s' s''.

Lemma SPP_ToStar_deterministic_1 : forall P s tl P' s' P'' s'',
  (P,s) --[tl]-->* (P',s') -> (P,s) --[tl]-->* (P'',s'')
  -> Net P' == Net P''.

End SPBase.