Library EPP

Require Export CC.
Require Export Merge.

Local Open Scope nat_scope.


EndPoint projection


Section EndPointProjection.

Local Ltac sup := rewrite set_union_iff; auto.
Local Ltac eq_elim t t' H := case (eq_dec t t'); intro H;
  [ rewrite <- H in *; clear t' H | idtac].
Local Ltac fail_with H := right; intro H; induction H as [B HB];
    inversion HB; eauto.

Variable Sig : Signature.

Notation Pid := (pid Sig).
Notation Var := (var Sig).
Notation Value := (value Sig).
Notation Expr := (expr Sig).
Notation BExpr := (bexpr Sig).
Notation RecVar := (recvar Sig).
Notation Ann := (ann Sig).
Notation Ev := (ev Sig).
Notation BEv := (bev Sig).

The signature for the target calculus.

Notation PR := (DecProd RecVar Pid).

Definition Sig' := Build_Signature Pid Var Value Expr BExpr PR Ann Ev BEv.

Open Scope CC.

First step: local projection.

Inductive bproj : DefSet Sig -> Choreography Sig -> Pid -> Behaviour Sig' -> Prop :=
| bproj_End D p : bproj D CC.End p (End _)
| bproj_Send D p e q x a C B : bproj D C p B ->
                               bproj D (p#e --> q$x @ a ;; C) p
                                       (@Send Sig' q e a B)
| bproj_Recv D p e q x a C B : bproj D C q B -> p <> q ->
                               bproj D (p#e --> q$x @ a ;; C) q
                                       (@Recv Sig' p x a B)
| bproj_Com D p e q x a C r B : bproj D C r B -> p <> r -> q <> r ->
                                bproj D (p#e --> q$x @ a ;; C) r B
| bproj_Pick D p l q a C B : bproj D C p B ->
                             bproj D (p --> q[l] @ a ;; C) p
                                     (@Sel Sig' q l a B)
| bproj_Left D p q a C B : bproj D C q B -> p <> q ->
                           bproj D (p --> q[left] @ a ;; C) q
                                   (@Branching Sig' p (Some (a,B)) None)
| bproj_Right D p q a C B : bproj D C q B -> p <> q ->
                            bproj D (p --> q[right] @ a ;; C) q
                                    (@Branching Sig' p None (Some (a,B)))
| bproj_Sel D p l q a C r B : bproj D C r B -> p <> r -> q <> r ->
                              bproj D (p --> q[l] @ a ;; C) r B
| bproj_Cond D p b C1 C2 B1 B2 : bproj D C1 p B1 -> bproj D C2 p B2 ->
                                 bproj D (If p ?? b Then C1 Else C2) p
                                         (@Cond Sig' b B1 B2)
| bproj_Cond' D p b C1 C2 r B1 B2 B : bproj D C1 r B1 -> bproj D C2 r B2 ->
                                      p <> r -> B1 [V] B2 == B ->
                                      bproj D (If p ?? b Then C1 Else C2) r B
| bproj_Call_in D X p : In p (fst (D X)) -> bproj D (CC.Call X) p
                                                    (@Call Sig' (X,p))
| bproj_Call_out D X p : ~In p (fst (D X)) -> bproj D (CC.Call X) p (End _)
| bproj_RT_Call_in D X ps C p : In p ps -> bproj D (RT_Call X ps C) p
                                                   (@Call Sig' (X,p))
| bproj_RT_Call_out D X ps C p B : ~In p ps -> bproj D C p B ->
                                   bproj D (RT_Call X ps C) p B.

Notation "[[ D , C | p ]] == B" := (bproj D C p B) (at level 20).

Like merge, this relation is functional...

Lemma bproj_unique : forall D C p B B',
  [[D,C | p ]] == B -> [[D,C | p]] == B' -> B = B'.

...and computable. The decidability statement is a bit stronger than usual because we will use it in later definitions.

Definition projectable_B D C p := exists B, [[D,C | p]] == B.

Lemma bproj_dec : forall D C p,
  { B | [[D,C | p]] == B } + {~projectable_B D C p}.

Projections are always well-formed.

Lemma bproj_WF : forall D C p B, no_self_comm _ C ->
  [[D,C | p]] == B -> Behaviour_WF Sig' p B.

Definition projectable_C D C ps :=
  Forall (fun p => projectable_B D C p) ps.

Definition projectable_D D :=
  forall X, projectable_C D (snd (D X)) (fst (D X)).

Definition projectable_P P :=
  projectable_C (Procedures P) (Main P) (CCP_pn P) /\
  projectable_D (Procedures P).


For tackling contradictions in the absurd cases of the definitions below.

Ltac contr_aux H := red in H; rewrite Forall_forall in H; auto.
Ltac contr H := intros; exfalso; contr_aux H.
Ltac contr2 H H' := intros; exfalso; specialize (H H'); contr_aux H.

Now we can define EPP, again in a layered manner. Definitions are interactive because of the absurd cases.
Auxiliary results about behaviour projection.

Lemma bproj_not_In : forall D r C, ~In r (CCC_pn C (Names D)) ->
  [[D,C | r]] == End _.

Lemma bproj_Call_In : forall D C p X, [[D,C | p]] == Call Sig' (X, p) ->
  consistent _ (Names D) C -> In p (fst (D X)).

Lemma bproj_disjoint : forall D e a C p, ~In p (eta_pn _ e) ->
  forall B, [[D,e @ a;; C | p]] == B -> [[D,C | p]] == B.

Lemma bproj_stable : forall D D' p C B,
  (forall X, fst (D X) = fst (D' X)) ->
  [[D,C | p]] == B -> [[D',C | p]] == B.

Lemma projectable_B_stable : forall D D' p C,
  (forall X, fst (D X) = fst (D' X)) ->
  projectable_B D p C -> projectable_B D' p C.

Open Scope SP_scope.

Proof irrelevance for EPP.

Lemma epp_C_wd : forall D C ps H H', epp_C D ps C H (==) epp_C D ps C H'.

More about EPP.

Lemma epp_C_out : forall D C ps H p, ~In p ps -> epp_C D ps C H p = End _.

Lemma epp_C_out' : forall D ps C HC p,
  ~In p (CCC_pn C (Names D)) -> epp_C D ps C HC p = End _.

Lemma epp_C_char : forall D C HP HC,
  Net (epp (D,C) HP) (==) (epp_C D (CCP_pn (D,C)) C HC).

Lemma epp_C_char' : forall ps D C HP p, In p ps ->
  [[D,C | p]] == Net (epp (D, C) HP) p.

Lemma epp_C_bproj : forall D ps C HC p, In p ps ->
  [[D,C | p]] == epp_C D ps C HC p.

Lemma epp_C_WF : forall D ps C HC, no_self_comm _ C ->
  Network_WF _ (epp_C D ps C HC).

Lemma epp_D_wd : forall D H H' X, epp_D D H X = epp_D D H' X.

Lemma epp_D_char : forall D C HP HD X p,
  Procs (epp (D,C) HP) (X,p) = epp_D D HD (X,p).

Lemma epp_D_char' : forall D C HP X p,
  CCC_pn (snd (D X)) (Names D) [C] fst (D X) ->
  [[D,snd (D X) | p]] == Procs (epp (D,C) HP) (X,p).

Lemma epp_D_char'' : forall D C HP X p HX,
   Procs (epp (D,C) HP) (X, p) = epp_C D (fst (D X)) (snd (D X)) HX p.

Lemma epp_out : forall P HP p, ~In p (CCP_pn P) ->
  Net (epp P HP) p = End _.

Sanity checks: EPP works as defined informally in the paper.

Lemma epp_C_Com_p : forall D ps C p e q x a HC HC', In p ps ->
  epp_C D ps (p # e --> q $ x @ a;;C) HC p = Send Sig' q e a (epp_C D ps C HC' p).

Lemma epp_C_Com_q : forall D ps C p e q x a HC HC', p <> q -> In q ps ->
  epp_C D ps (p # e --> q $ x @ a;;C) HC q = Recv Sig' p x a (epp_C D ps C HC' q).

Lemma epp_C_Com_r : forall D ps C p e q x a HC HC' r, p <> r -> q <> r ->
  epp_C D ps (p # e --> q $ x @ a;;C) HC r = epp_C D ps C HC' r.

Lemma epp_C_Sel_p : forall D ps C p q l a HC HC', In p ps ->
  epp_C D ps (p --> q[l] @ a;;C) HC p = Sel Sig' q l a (epp_C D ps C HC' p).

Lemma epp_C_Sel_ql : forall D ps C p q a HC HC', p <> q -> In q ps ->
  epp_C D ps (p --> q[left] @ a;;C) HC q
  = Branching Sig' p (Some (a,epp_C D ps C HC' q)) None.

Lemma epp_C_Sel_qr : forall D ps C p q a HC HC', p <> q -> In q ps ->
  epp_C D ps (p --> q[right] @ a;;C) HC q
  = Branching Sig' p None (Some (a,epp_C D ps C HC' q)).

Lemma epp_C_Sel_r : forall D ps C p q l a HC HC' r, p <> r -> q <> r ->
  epp_C D ps (p --> q[l] @ a;;C) HC r = epp_C D ps C HC' r.

Lemma epp_C_Cond_p : forall D ps p b C1 C2 HC HC1 HC2, In p ps ->
  epp_C D ps (If p ?? b Then C1 Else C2) HC p
  = Cond Sig' b (epp_C D ps C1 HC1 p) (epp_C D ps C2 HC2 p).

Lemma epp_C_Cond_r : forall D ps (p:Pid) b C1 C2 HC HC1 HC2 r, p <> r ->
  epp_C D ps C1 HC1 r [V] epp_C D ps C2 HC2 r
  == epp_C D ps (If p ?? b Then C1 Else C2) HC r.

Lemma epp_C_Call : forall D ps X p HC, In p ps -> In p (fst (D X)) ->
  epp_C D ps (CC.Call X) HC p = Call Sig' (X,p).

Lemma epp_C_Call_out : forall D ps X p HC, ~In p (fst (D X)) ->
  epp_C D ps (CC.Call X) HC p = End _.

Lemma epp_C_RT_Call : forall D ps X p ps' C HC, In p ps -> In p ps' ->
  epp_C D ps (RT_Call X ps' C) HC p = Call Sig' (X,p).

Lemma epp_C_RT_Call_out : forall D ps X p ps' C HC HC', ~In p ps' ->
  epp_C D ps (RT_Call X ps' C) HC p = epp_C D ps C HC' p.

Lemma epp_C_End : forall D ps p HC, epp_C D ps CC.End HC p = End _.

Characterizations lemmas for branching.
Inversion lemmas for conditionals.

Lemma epp_C_Cond_Send_inv : forall D ps p b C1 C2 HC HC1 HC2 r q e a B,
  epp_C D ps (If p ?? b Then C1 Else C2) HC r = Send Sig' q e a B ->
  exists B1 B2, epp_C D ps C1 HC1 r = Send Sig' q e a B1
  /\ epp_C D ps C2 HC2 r = Send Sig' q e a B2 /\ B1 [V] B2 == B.

Lemma epp_C_Cond_Recv_inv : forall D ps p b C1 C2 HC HC1 HC2 r q x a B,
  epp_C D ps (If p ?? b Then C1 Else C2) HC r = Recv Sig' q x a B ->
  exists B1 B2, epp_C D ps C1 HC1 r = Recv Sig' q x a B1
  /\ epp_C D ps C2 HC2 r = Recv Sig' q x a B2 /\ B1 [V] B2 == B.

Lemma epp_C_Cond_Sel_inv : forall D ps p b C1 C2 HC HC1 HC2 r q l a B,
  epp_C D ps (If p ?? b Then C1 Else C2) HC r = Sel Sig' q l a B ->
  exists B1 B2, epp_C D ps C1 HC1 r = Sel Sig' q l a B1
  /\ epp_C D ps C2 HC2 r = Sel Sig' q l a B2 /\ B1 [V] B2 == B.

Lemma epp_C_Cond_Branching_l_inv : forall D ps p b C1 C2 HC HC1 HC2 r q a B,
  epp_C D ps (If p ?? b Then C1 Else C2) HC r = Branching Sig' q (Some (a,B)) None ->
  exists B1 B2, epp_C D ps C1 HC1 r = Branching Sig' q (Some (a,B1)) None
  /\ epp_C D ps C2 HC2 r = Branching Sig' q (Some (a,B2)) None /\ B1 [V] B2 == B.

Lemma epp_C_Cond_Branching_r_inv : forall D ps p b C1 C2 HC HC1 HC2 r q a B,
  epp_C D ps (If p ?? b Then C1 Else C2) HC r = Branching Sig' q None (Some (a,B)) ->
  exists B1 B2, epp_C D ps C1 HC1 r = Branching Sig' q None (Some (a,B1))
  /\ epp_C D ps C2 HC2 r = Branching Sig' q None (Some (a,B2)) /\ B1 [V] B2 == B.

Lemma epp_C_Cond_Cond_inv : forall D ps p b b' C1 C2 HC HC1 HC2 r Bt Be,
  p <> r -> epp_C D ps (If p ?? b Then C1 Else C2) HC r = Cond Sig' b' Bt Be ->
  exists B1t B1e B2t B2e, epp_C D ps C1 HC1 r = Cond Sig' b' B1t B1e
                       /\ epp_C D ps C2 HC2 r = Cond Sig' b' B2t B2e
                       /\ B1t [V] B2t == Bt /\ B1e [V] B2e == Be.

Open Scope CC_scope.

Properties of projectability


Section Projectability.

Projectability is decidable - for programs, with the same proviso as well-formedness.
Inversion lemmas for projectability.
Meh.
More inversion lemmas about program projectability.

Strong projectability

The corresponding lemmas for RT_Call do not hold, and indeed projectability is not preserved by reductions, so we need a stronger notion.

Fixpoint str_proj D (C:Choreography Sig) (r:Pid) : Prop :=
match C with
| eta @ a;; C' => str_proj D C' r
| If p ?? b Then C1 Else C2 =>
     str_proj D C1 r /\ str_proj D C2 r /\ projectable_B D C r
| RT_Call X ps C =>
     str_proj D C r /\ (forall p, In p ps ->
     forall B B', [[D,snd (D X) | p]] == B -> [[D,C | p]] == B' -> B [>>] B')
| _ => True
end.

Lemma str_proj_C : forall D C r, str_proj D C r -> projectable_B D C r.

Lemma str_proj_C' : forall D C ps,
  (forall r, In r ps -> str_proj D C r) -> projectable_C D C ps.

Lemma initial_str_proj : forall C, initial C ->
  forall D ps, projectable_C D C ps -> forall r, In r ps -> str_proj D C r.

Lemma initial_str_proj' : forall D C r, initial C ->
  ~In r (CCC_pn C (Names D)) -> str_proj D C r.

Definition str_proj_P P := Program_WF P /\ projectable_D (Procedures P) /\
  forall r, str_proj (Procedures P) (Main P) r.

Lemma str_proj_P_Program_WF : forall P, str_proj_P P -> Program_WF P.

Lemma str_proj_P_str_proj : forall P, str_proj_P P ->
  forall r, str_proj (Procedures P) (Main P) r.

Lemma str_proj_P_str_proj' : forall P, str_proj_P P ->
  forall r X, str_proj (Procedures P) (CC.Procs P X) r.

Lemma str_proj_P_projectable_P : forall P,
  str_proj_P P -> projectable_P P.

Inversion lemmas for strong projectability.
Miscellaneous.

Characterization of projection


Section ProjectionChar.

Lemma CCC_To_bproj_Com_p : forall D C s C' s' p q v x,
  str_proj D C p -> <<C,s>> --[RL_Com p v q x,D]--> <<C',s'>> ->
  exists e a Bp, [[D,C | p]] == Send Sig' q e a Bp /\ [[D,C' | p]] == Bp
              /\ v = eval_on_state Ev e s p.

Lemma CCC_To_bproj_Com_q : forall D C s C' s' p q v x,
  str_proj D C q -> <<C,s>> --[RL_Com p v q x,D]--> <<C',s'>> ->
  p <> q -> exists a Bq, [[D,C | q]] == Recv Sig' p x a Bq /\ [[D,C' | q]] == Bq.

Lemma CCC_To_bproj_Com_r : forall D C s C' s' p q v x r,
  str_proj D C r -> <<C,s>> --[RL_Com p v q x,D]--> <<C',s'>> ->
  p <> r -> q <> r -> exists B, [[D,C | r]] == B /\ [[D,C' | r]] == B.

Lemma CCC_To_bproj_Sel_p : forall D C s C' s' p q l,
  str_proj D C p -> <<C,s>> --[RL_Sel p q l,D]--> <<C',s'>> ->
  exists a Bp, [[D,C | p]] == @Sel Sig' q l a Bp /\ [[D,C' | p]] == Bp.

Lemma CCC_To_bproj_Sel_ql : forall D C s C' s' p q,
  str_proj D C q -> <<C,s>> --[RL_Sel p q left,D]--> <<C',s'>> ->
  p <> q -> exists a Bq, [[D,C | q]] == @Branching Sig' p (Some (a,Bq)) None
            /\ [[D,C' | q]] == Bq.

Lemma CCC_To_bproj_Sel_qr : forall D C s C' s' p q,
  str_proj D C q -> <<C,s>> --[RL_Sel p q right,D]--> <<C',s'>> ->
  p <> q -> exists a Bq, [[D,C | q]] == @Branching Sig' p None (Some (a,Bq))
            /\ [[D,C' | q]] == Bq.

Lemma CCC_To_bproj_Sel_r : forall D C s C' s' p q l r,
  str_proj D C r -> <<C,s>> --[RL_Sel p q l,D]--> <<C',s'>> ->
  p <> r -> q <> r -> exists B, [[D,C | r]] == B /\ [[D,C' | r]] == B.

Lemma CCC_To_bproj_Cond_p : forall D C s C' s' p,
  str_proj D C p -> <<C,s>> --[RL_Cond p,D]--> <<C',s'>> ->
  exists b Bt Be, [[D,C | p]] == @Cond Sig' b Bt Be
    /\ (eval_on_state BEv b s p = true -> [[D,C' | p]] == Bt)
    /\ (eval_on_state BEv b s p = false -> [[D,C' | p]] == Be).

Lemma CCC_To_bproj_Cond_r : forall D C s C' s' p r,
  str_proj D C r -> <<C,s>> --[RL_Cond p,D]--> <<C',s'>> ->
  p <> r -> exists B B', [[D,C | r]] == B /\ [[D,C' | r]] == B' /\ B [>>] B'.

Lemma CCC_To_bproj_Call_p : forall D C s C' s' p X,
  str_proj D C p ->
  (forall Y, str_proj D (snd (D Y)) p) ->
  (forall Y, CCC_pn (snd (D Y)) (Names D) [C] fst (D Y)) ->
  <<C,s>> --[RL_Call X p,D]--> <<C',s'>> ->
  [[D,C | p]] == Call Sig' (X,p) /\
  exists B B', [[D,snd (D X) | p]] == B /\ [[D,C' | p]] == B' /\ B [>>] B'.

Lemma CCC_To_bproj_Call_r : forall D C s C' s' p X r,
  str_proj D C r ->
  (forall X, CCC_pn (snd (D X)) (Names D) [C] fst (D X)) ->
  <<C,s>> --[RL_Call X p,D]--> <<C',s'>> ->
  p <> r -> exists B, [[D,C | r]] == B /\ [[D,C' | r]] == B.

Lemma CCC_To_bproj_disjoint : forall D C s tl C' s' p,
  (forall X, CCC_pn (snd (D X)) (Names D) [C] fst (D X)) ->
  str_proj D C p ->
  disjoint_p_rl p tl -> <<C,s>> --[tl,D]--> <<C',s'>> ->
  exists B B', [[D,C | p]] == B /\ [[D,C' | p]] == B' /\ B [>>] B'.

End ProjectionChar.

Projectability of well-formed programs is preserved by transitions.
Strong projectability of well-formed programs is also preserved by reductions: this is needed for chaining applications of the EPP theorem.

Lemma CCC_To_str_proj_Com : forall D C s C' s' p v q x,
  (forall r, str_proj D C r) -> <<C,s>> --[RL_Com p v q x,D]--> <<C',s'>> ->
  forall r, str_proj D C' r.

Lemma CCC_To_str_proj_Sel : forall D C s C' s' p q l,
  (forall r, str_proj D C r) -> forall r,
  <<C,s>> --[RL_Sel p q l,D]--> <<C',s'>> -> str_proj D C' r.

Lemma CCC_To_str_proj_Cond : forall D C s C' s' p,
  (forall r, str_proj D C r) -> forall r,
  <<C,s>> --[RL_Cond p,D]--> <<C',s'>> -> str_proj D C' r.

Lemma CCC_To_str_proj_Call : forall D C s C' s' p X,
  (forall r, str_proj D C r) ->
  (forall r Y, str_proj D (snd (D Y)) r) ->
  (forall Y, CCC_pn (snd (D Y)) (Names D) [C] fst (D Y)) ->
  forall r, <<C,s>> --[RL_Call X p,D]--> <<C',s'>> -> str_proj D C' r.

Lemma CCC_To_str_proj : forall D C s C' s' t,
  (forall p, str_proj D C p) ->
  (forall p Y, str_proj D (snd (D Y)) p) ->
  (forall Y, CCC_pn (snd (D Y)) (Names D) [C] fst (D Y)) ->
  <<C,s>> --[t,D]--> <<C',s'>> -> forall p, str_proj D C' p.

Lemma CCP_To_str_proj : forall P, str_proj_P P ->
  forall s tl P' s', (P,s) --[tl]--> (P',s') -> str_proj_P P'.

Lemma CCP_ToStar_str_proj : forall P, str_proj_P P ->
  forall s tl P' s', (P,s) --[tl]-->* (P',s') -> str_proj_P P'.

Lemma CCP_ToStar_projectable: forall P, str_proj_P P ->
  forall s tl P' s', (P,s) --[tl]-->* (P',s') -> projectable_P P'.

End ProjectionLemmas.

End EndPointProjection.


Notation "[[ D , C | p ]] == B" := (bproj D C p B) (at level 20).

Ltac contr_aux H := red in H; rewrite Forall_forall in H; auto.
Ltac contr H := intros; exfalso; contr_aux H.
Ltac contr2 H H' := exfalso; specialize (H H'); contr_aux H.