Library CC

Require Export Basic.
Require Export Common.

Local Open Scope nat_scope.

The general type of Core Choreographies

This type is parameterized over sets of process identifiers, values, expressions and recursion variables. A lot of stuff is common with SP, and was defined already in Common

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

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.

Definition Store := CSt.State.

Definition set_remove_pid := set_remove' P.eq_dec.
Definition set_size_pid := set_size P.eq_dec.

Syntax of Core Choreographies.


Section Syntax.

Communication actions.

Inductive Eta : Type :=
 | Com : Pid -> Expr -> Pid -> Var -> Eta
 | Sel : Pid -> Pid -> Label -> Eta
.

Lemma eta_eq_dec : forall (eta eta':Eta), { eta = eta' } + { eta <> eta' }.

Choreographies.
A program is a pair containing all procedure definitions and the main choreography.
Procedure definitions are functions from a variable number of processes to choreographies, without free process names. We model this as a function returning a pair (list Pid)*Choreography, with the proviso that all processes occurring in the choreography must be included in the list of processes.

Definition DefSet := RecVar -> (list Pid)*Choreography.

Record Program : Type :=
  { Procedures : DefSet;
    Main : Choreography }.

Definition Vars := fun P X => fst (Procedures P X).
Definition Procs := fun P X => snd (Procedures P X).

End Syntax.

Pretty-printing rules for choreographies.

Delimit Scope CC_scope with CC.


Notation "p # e --> q $ x" := (Com p e q x) (at level 50, e at level 9) : CC_scope.
Notation "p --> q [ l ]" := (Sel p q l) (at level 50) : CC_scope.
Notation "eta ';;' C" := (Interaction eta C) (at level 60, right associativity) : CC_scope.
Notation "'If' p '??' b 'Then' C1 'Else' C2" := (Cond p b C1 C2) (at level 60) : CC_scope.

Open Scope CC_scope.

Section Syntactic_Properties.

Syntactic properties of choreographies and programs.

Lemma chor_eq_dec : forall (C C':Choreography), { C = C' } + { C <> C' }.

An initial choreography is what a programmer should write.
Fixpoint initial (C:Choreography) : Prop :=
match C with
| Interaction _ C' => initial C'
| Cond _ _ C1 C2 => initial C1 /\ initial C2
| Call _ => True
| RT_Call _ _ _ => False
| End => True
end.

Lemma initial_dec : forall C, {initial C}+{~initial C}.

Free procedure names in a choreography.
Definition set_union_rv := set_union R.eq_dec.

Fixpoint Free_RecVar (C:Choreography) : list RecVar :=
match C with
| Interaction _ C' => Free_RecVar C'
| Cond _ _ C1 C2 => set_union_rv (Free_RecVar C1) (Free_RecVar C2)
| Call Y => (Y::nil)
| RT_Call Y _ C' => set_union_rv (Y::nil) (Free_RecVar C')
| End => nil
end.

Definition X_Free (X:RecVar) (C:Choreography) : Prop :=
  In X (Free_RecVar C).

Lemma X_Free_dec : forall X C, {X_Free X C} + {~X_Free X C}.

Inversion results for bound variables.

Lemma X_Free_Eta : forall X eta C,
  X_Free X (eta;;C) -> X_Free X C.

Lemma X_Free_Cond : forall X p b C1 C2,
  X_Free X (If p ?? b Then C1 Else C2) -> {X_Free X C1} + {X_Free X C2}.

Lemma Not_X_Free_Eta : forall X eta C,
  ~X_Free X (eta;;C) -> ~X_Free X C.

Lemma Not_X_Free_Then : forall X p b C1 C2,
  ~X_Free X (If p ?? b Then C1 Else C2) -> ~X_Free X C1.

Lemma Not_X_Free_Else : forall X p b C1 C2,
  ~X_Free X (If p ?? b Then C1 Else C2) -> ~X_Free X C2.

The set of process names in a choreography.

Definition set_union_pid := set_union P.eq_dec.

Definition eta_pn (e:Eta) : list Pid :=
match e with
| Com p _ q _ => (p::q::nil)
| Sel p q _ => (p::q::nil)
end.

Fixpoint CCC_pn (C:Choreography) (Pids:RecVar -> list Pid) : list Pid :=
match C with
| Interaction eta C' => (set_union_pid (eta_pn eta) (CCC_pn C' Pids))
| Cond p _ C1 C2 => (set_union_pid (set_union_pid (p::nil) (CCC_pn C1 Pids)) (CCC_pn C2 Pids))
| Call X => Pids X
| RT_Call _ l C' => set_union_pid l (CCC_pn C' Pids)
| End => nil
end.

Ltac sup := unfold set_union_pid; rewrite set_union_iff; auto.

Lemma CCC_pn_mon : forall X Y, (forall Z p, In p (X Z) -> In p (Y Z)) ->
  forall C p, In p (CCC_pn C X) -> In p (CCC_pn C Y).

Definition set_incl_pid := set_incl P.eq_dec.

A choreography is well-formed if:
  • it does not contain self-communications;
  • annotations of runtime terms are not empty.
No process attempts to communicate with itself.

Fixpoint no_self_comm (C:Choreography) : Prop :=
match C with
| Interaction eta C' => match eta with
                        | Com p _ q _ => p <> q
                        | Sel p q _ => p <> q
                        end /\ no_self_comm C'
| Cond _ _ C1 C2 => no_self_comm C1 /\ no_self_comm C2
| Call _ => True
| RT_Call _ _ C' => no_self_comm C'
| End => True
end.

Lemma no_self_comm_dec : forall C, {no_self_comm C} + {~no_self_comm C}.

There are no procedure calls with empty annotations.

Fixpoint no_empty_ann (C:Choreography) : Prop :=
match C with
| Interaction eta C' => no_empty_ann C'
| Cond _ _ C1 C2 => no_empty_ann C1 /\ no_empty_ann C2
| Call _ => True
| RT_Call _ l C' => l <> nil /\ no_empty_ann C'
| End => True
end.

Lemma no_empty_ann_dec : forall C, {no_empty_ann C} + {~no_empty_ann C}.

Choreography well-formedness.
Inversion results.
A program is well-formed if there is a finite set of procedures Xs such that:
  • main and all procedures in Xs are well-formed
  • all procedures in Xs are initial
  • main and all procedures in Xs only call procedures in Xs
  • annotations in main are consistent

Fixpoint within_Xs (Xs:list RecVar) (C:Choreography) : Prop :=
match C with
| Interaction _ C' => within_Xs Xs C'
| Cond _ _ C1 C2 => within_Xs Xs C1 /\ within_Xs Xs C2
| Call X => In X Xs
| RT_Call X _ C' => In X Xs /\ within_Xs Xs C'
| End => True
end.

Lemma within_Xs_dec : forall Xs C, {within_Xs Xs C} + {~within_Xs Xs C}.

Lemma within_Xs_incl : forall C Xs Ys, (forall X, In X Xs -> In X Ys) ->
  within_Xs Xs C -> within_Xs Ys C.

Lemma within_Xs_char : forall Xs C, within_Xs Xs C ->
  forall X, X_Free X C -> In X Xs.

Fixpoint consistent (Xs:RecVar -> list Pid) (C:Choreography) : Prop :=
match C with
| Interaction _ C' => consistent Xs C'
| Cond _ _ C1 C2 => consistent Xs C1 /\ consistent Xs C2
| Call X => True
| RT_Call X l C' => set_incl_pid l (Xs X) /\ consistent Xs C'
| End => True
end.

Lemma consistent_dec : forall Xs C, {consistent Xs C} + {~consistent Xs C}.

Lemma initial_consistent : forall C, initial C -> forall Xs, consistent Xs C.

We need to consider the list of used process variables.

Definition Program_WF (Xs:list RecVar) (P:Program) : Prop :=
  Choreography_WF (Main P) /\ within_Xs Xs (Main P) /\ consistent (Vars P) (Main P) /\
  forall X, In X Xs -> Choreography_WF (Procs P X) /\ initial (Procs P X) /\
            (Vars P X) <> nil /\ within_Xs Xs (Procs P X).

Lemma Program_WF_dec : forall Xs P, {Program_WF Xs P} + {~Program_WF Xs P}.

Lemma Program_WF_Proc : forall P Xs, Program_WF Xs P ->
  forall X, In X Xs -> Choreography_WF (Procs P X).

Lemma Program_WF_Main : forall P Xs, Program_WF Xs P -> Choreography_WF (Main P).

Lemma Program_WF_consistent : forall P Xs, Program_WF Xs P ->
  consistent (Vars P) (Main P).

Lemma Program_WF_initial_Proc : forall P Xs, Program_WF Xs P ->
  forall X, In X Xs -> initial (Procs P X).

Lemma Program_WF_Main_within_Xs : forall P Xs, Program_WF Xs P ->
  within_Xs Xs (Main P).

Lemma Program_WF_Vars_In : forall P Xs, Program_WF Xs P ->
  forall X, X_Free X (Main P) -> In X Xs.

Lemma Program_WF_Vars : forall P Xs, Program_WF Xs P ->
  forall X, In X Xs -> Vars P X <> nil.

Lemma Program_WF_within_Xs : forall P Xs, Program_WF Xs P ->
  forall X, In X Xs -> within_Xs Xs (Procs P X).

Inversion results.
A program is well-annotated if every process used by a procedure is in its annotation.

Definition well_ann (P:Program) : Prop :=
  forall X, set_incl_pid (CCC_pn (Procs P X) (Vars P)) (Vars P X).

Lemma well_ann_Main_change : forall Defs C C',
  well_ann (Build_Program Defs C) -> well_ann (Build_Program Defs C').

This one is not decidable.

Semantics of CC.

The next definition and lemmas extend some lemmas in module Transitions to communication actions, which are specific to CC.
One-step and multi-step reduction. Multi-step reduction is simply a reflexive and transitive closure.

Inductive CCC_To (Defs : DefSet) :
  Choreography -> State -> RichLabel -> Choreography -> State -> Prop :=
 | C_Com p e q x C s s' : let v := (eval_on_state e s p) in
        eq_state_ext s' (update s q x v) ->
        CCC_To Defs (p # e --> q $ x;; C) s (R_Com p v q x) C s'
 | C_Sel p q l C s s':
        eq_state_ext s s' ->
        CCC_To Defs (p --> q [l];; C) s (R_Sel p q l) C s'
 | C_Then p b C1 C2 s s':
        eq_state_ext s s' -> (beval_on_state b s p = true) ->
        CCC_To Defs (If p ?? b Then C1 Else C2) s (R_Cond p) C1 s'
 | C_Else p b C1 C2 s s':
        eq_state_ext s s' -> (beval_on_state b s p = false) ->
        CCC_To Defs (If p ?? b Then C1 Else C2) s (R_Cond p) C2 s'
 | C_Delay_Eta eta C C' s s' t: disjoint_eta_rl eta t ->
        CCC_To Defs C s t C' s' ->
        CCC_To Defs (eta;; C) s t (eta;; C') s'
 | C_Delay_Cond p b C1 C2 C1' C2' s s' t: disjoint_p_rl p t ->
        CCC_To Defs C1 s t C1' s' ->
        CCC_To Defs C2 s t C2' s' ->
        CCC_To Defs (If p ?? b Then C1 Else C2) s t (If p ?? b Then C1' Else C2') s'
 | C_Delay_Call ps X C C' s s' t:
        disjoint_ps_rl ps t -> CCC_To Defs C s t C' s' ->
        CCC_To Defs (RT_Call X ps C) s t (RT_Call X ps C') s'
 | C_Call_Local p X s s': eq_state_ext s s' ->
        set_size_pid (fst (Defs X)) = 1 -> In p (fst (Defs X)) ->
        CCC_To Defs (Call X) s (R_Call X p) (snd (Defs X)) s'
 | C_Call_Start p X s s':
        eq_state_ext s s' ->
        set_size_pid (fst (Defs X)) > 1 -> In p (fst (Defs X)) ->
        CCC_To Defs
               (Call X) s
               (R_Call X p)
               (RT_Call X (set_remove_pid p (fst (Defs X))) (snd (Defs X))) s'
 | C_Call_Enter p ps X C s s':
        eq_state_ext s s' -> set_size_pid ps > 1 -> In p ps ->
        CCC_To Defs
               (RT_Call X ps C) s
               (R_Call X p)
               (RT_Call X (set_remove_pid p ps) C) s'
 | C_Call_Finish p ps X C s s':
        eq_state_ext s s' -> set_size_pid ps = 1 -> In p ps ->
        CCC_To Defs
               (RT_Call X ps C) s (R_Call X p) C s'
.

Useful for inferring a transition automatically.

Lemma C_Com' : forall Defs p e q x C s, let v := (eval_on_state e s p) in
        CCC_To Defs (p # e --> q $ x;; C) s (R_Com p v q x) C (update s q x v).

Lemma C_Sel' : forall Defs p q l C s,
  CCC_To Defs (p --> q [l];; C) s (R_Sel p q l) C s.

Lemma C_Then' : forall Defs p b C1 C2 s,
        beval_on_state b s p = true ->
        CCC_To Defs (If p ?? b Then C1 Else C2) s (R_Cond p) C1 s.

Lemma C_Else' : forall Defs p b C1 C2 s,
        beval_on_state b s p = false ->
        CCC_To Defs (If p ?? b Then C1 Else C2) s (R_Cond p) C2 s.

Lemma C_Call_Local' : forall Defs p X s,
        set_size_pid (fst (Defs X)) = 1 -> In p (fst (Defs X)) ->
        CCC_To Defs (Call X) s (R_Call X p) (snd (Defs X)) s.

Lemma C_Call_Start' : forall Defs p X s,
        set_size_pid (fst (Defs X)) > 1 -> In p (fst (Defs X)) ->
        CCC_To Defs
               (Call X) s
               (R_Call X p)
               (RT_Call X (set_remove_pid p (fst (Defs X))) (snd (Defs X))) s.

Lemma C_Call_Enter' : forall Defs p ps X C s,
        set_size_pid ps > 1 -> In p ps ->
        CCC_To Defs
               (RT_Call X ps C) s
               (R_Call X p)
               (RT_Call X (set_remove_pid p ps) C) s.

Lemma C_Call_Finish' : forall Defs p ps X C s,
        set_size_pid ps = 1 -> In p ps ->
        CCC_To Defs (RT_Call X ps C) s (R_Call X p) C s.

Definition Configuration : Type := Program * State.

Inductive CCP_To : Configuration -> TransitionLabel -> Configuration -> Prop :=
 | CCP_To_intro Defs C s t C' s' : CCC_To Defs C s t C' s' ->
     CCP_To (Build_Program Defs C,s) (forget t) (Build_Program Defs C',s').

Inductive CCP_ToStar : Configuration -> list TransitionLabel -> Configuration -> Prop :=
 | CCT_Refl c : CCP_ToStar c nil c
 | CCT_Step c1 t c2 l c3 : CCP_To c1 t c2 -> CCP_ToStar c2 l c3 -> CCP_ToStar c1 (t::l) c3
.

End Semantics_Definitions.

Notations for reductions.

Notation "c --[ tl ]--> c'" := (CCP_To c tl c') (at level 50, left associativity) : CC_scope.
Notation "c --[ ts ]-->* c'" := (CCP_ToStar c ts c') (at level 50, left associativity) : CC_scope.

Section Sanity_Checks.

Example Com_reduction : forall P p e q x C s,
  (Build_Program P (p # e --> q $ x;; C), s) --[ L_Com p (eval_on_state e s p) q ]--> (Build_Program P C, update s q x (eval_on_state e s p)).

Example Sel_reduction : forall P p q l C s,
  (Build_Program P (p --> q [l];; C), s) --[ L_Sel p q l ]--> (Build_Program P C, s).

End Sanity_Checks.

Section BigStepSemantics.

Lemma RT_Call_reduce : forall Defs X ps C s, (ps <> List.nil) ->
  exists tl, (Build_Program Defs (RT_Call X ps C),s) --[tl]-->* (Build_Program Defs C,s).

Lemma Call_reduce : forall (Defs:DefSet) X s, (fst (Defs X) <> List.nil) ->
  exists tl, (Build_Program Defs (Call X),s) --[tl]-->* (Build_Program Defs (snd (Defs X)),s).

Lemma CCT_Trans : forall c tl c' tl' c'',
  c --[tl]-->* c' -> c' --[tl']-->* c'' -> c --[tl++tl']-->* c''.

End BigStepSemantics.

Section Properties.

Main properties of the semantics

Determining the state from the label.
Reductions preserve well-formedness.

Lemma CCC_To_within_Xs : forall P s l P' s' Xs,
  Program_WF Xs P -> (P,s) --[l]--> (P',s') -> within_Xs Xs (Main P').

Lemma CCC_To_consistent : forall P s l P' s' Xs,
  Program_WF Xs P -> (P,s) --[l]--> (P',s') ->
  consistent (Vars P') (Main P').

Lemma CCC_To_Program_WF : forall P s l P' s' Xs,
  Program_WF Xs P -> (P,s) --[l]--> (P',s') -> Program_WF Xs P'.

Lemma CCC_To_CCP_WF : forall P s l P' s',
  CCP_WF P -> (P,s) --[l]--> (P',s') -> CCP_WF P'.

Lemma CCC_ToStar_CCP_WF : forall P s l P' s',
  CCP_WF P -> (P,s) --[l]-->* (P',s') -> CCP_WF P'.

Lemma CCC_To_pn : forall Defs C s tl C' s', CCC_To Defs C s tl C' s' ->
  forall p, In p (CCBase.TL.tpn tl) -> In p (CCC_pn C (fun X => fst (Defs X))).

Lemma CCC_To_pn' : forall Defs C s tl C' s', CCC_To Defs C s tl C' s' ->
  forall p, In p (CCC_pn C' (fun X => fst (Defs X))) ->
    In p (CCC_pn C (fun X => fst (Defs X)))
     \/ exists X, (In p (CCC_pn (snd (Defs X)) (fun X => fst (Defs X))) /\ X_Free X C).

Lemma CCC_To_pn'' : forall P s tl P' s',
  well_ann P -> ((P,s) --[tl]--> (P',s'))%CC ->
  forall p, In p (CCC_pn (Main P') (fun X => Vars P' X)) ->
    In p (CCC_pn (Main P) (fun X => Vars P X)).

Some more specific properties.
Deadlock-freedom by design.

Theorem progress : forall P, Main P <> End -> CCP_WF P ->
  forall s, exists tl c', (P,s) --[tl]--> c'.

Theorem deadlock_freedom : forall P, CCP_WF P ->
  forall s ts c', (P,s) --[ts]-->* c' ->
  {Main (fst c') = End} + {exists tl c'', c' --[tl]--> c''}.

End Properties.

Section Uniqueness.

Results on determinism of the semantics.

Reductions are preserved by state equivalence.
The set of procedure definitions never changes.
Reductions and state.
Determinism of reductions given the label.
Conversely: the result choreography determines the transition label and resulting state.

Lemma CCC_To_eta_reduction : forall eta C s1 s2 tl,
  CCC_To Defs (eta;;C) s1 tl C s2 ->
  (forall p e q x, eta = (p # e --> q $ x) -> tl = R_Com p (eval_on_state e s1 p) q x)
  /\
  (forall p q l, eta = (p --> q[l]) -> tl = R_Sel p q l).

Lemma CCC_To_Then_reduction : forall p b C1 C2 s1 s2 tl,
  CCC_To Defs (If p ?? b Then C1 Else C2) s1 tl C1 s2 ->
  tl = R_Cond p.

Lemma CCC_To_Else_reduction : forall p b C1 C2 s1 s2 tl,
  CCC_To Defs (If p ?? b Then C1 Else C2) s1 tl C2 s2 ->
  tl = R_Cond p.

Lemma CCC_To_Call_reduction_1 : forall p X s1 s2 tl,
  initial (snd (Defs X)) -> In p (fst (Defs X))
  -> CCC_To Defs (Call X) s1 tl (snd (Defs X)) s2
  -> tl = R_Call X p.

Lemma CCC_To_Call_reduction_2 : forall p X s1 s2 tl,
  initial (snd (Defs X)) -> In p (fst (Defs X))
  -> CCC_To Defs (Call X) s1 tl (RT_Call X (set_remove_pid p (fst (Defs X))) (snd (Defs X))) s2
  -> tl = R_Call X p.

Lemma CCC_To_Call_reduction_3 : forall C p ps X s1 s2 tl,
  In p ps ->
  CCC_To Defs (RT_Call X ps C) s1 tl (RT_Call X (set_remove_pid p ps) C) s2 ->
  tl = R_Call X p.

Fixpoint C_size (C:Choreography) :=
match C with
| Eta;; C' => S (C_size C')
| Cond _ _ C1 C2 => S (C_size C1 + C_size C2)
| RT_Call _ _ C' => S (C_size C')
| _ => 0
end.

Fixpoint subterm (C1 C2:Choreography) : Prop :=
match C2 with
| Eta;;C' => C1 = C' \/ subterm C1 C'
| Cond _ _ C1' C2' => C1 = C1' \/ C1 = C2' \/ subterm C1 C1' \/ subterm C1 C2'
| RT_Call _ _ C' => C1 = C' \/ subterm C1 C'
| _ => False
end.

Lemma subterm_size : forall C C', subterm C C' -> C_size C < C_size C'.

Lemma subterm_not_equal : forall C C', subterm C C' -> C <> C'.

Lemma CCC_To_Call_reduction_4 : forall C p ps X s1 s2 tl,
  In p ps -> CCC_To Defs (RT_Call X ps C) s1 tl C s2
  -> tl = R_Call X p.

Lemma CCC_To_deterministic_3 : forall C C' tl1 tl2 s s1 s2,
  CCC_To Defs C s tl1 C' s1 -> CCC_To Defs C s tl2 C' s2 ->
  tl1 = tl2.

Lemma CCC_To_deterministic_4 : forall C C' tl1 tl2 s s1 s2,
  CCC_To Defs C s tl1 C' s1 -> CCC_To Defs C s tl2 C' s2 ->
  eq_state_ext s1 s2.

The label alone determines the resulting state.
Currently not used, but might prove useful.

Lemma R_Com_reduce_eq : forall Defs p C v v' q q' x x' s C' s' C'' s'',
  CCC_To Defs C s (R_Com p v q x) C' s' ->
  CCC_To Defs C s (R_Com p v' q' x') C'' s'' ->
  v = v' /\ q = q' /\ x = x'.

Lemma L_Com_reduce_eq : forall Defs p C v v' q q' s C' s' C'' s'',
  (Build_Program Defs C,s) --[L_Com p v q]--> (Build_Program Defs C', s') ->
  (Build_Program Defs C,s) --[L_Com p v' q']--> (Build_Program Defs C'', s'') ->
  v = v' /\ q = q'.

Lemma R_Com_reduce_neq : forall Defs p p' C v v' q q' x x' s C' s' C'' s'',
  CCC_To Defs C s (R_Com p v q x) C' s' ->
  CCC_To Defs C s (R_Com p' v' q' x') C'' s'' ->
  p <> p' -> q <> q'.

Lemma L_Com_reduce_neq : forall Defs p p' C v v' q q' s C' s' C'' s'',
  (Build_Program Defs C,s) --[L_Com p v q]--> (Build_Program Defs C', s') ->
  (Build_Program Defs C,s) --[L_Com p' v' q']--> (Build_Program Defs C'', s'') ->
  p <> p' -> q <> q'.

Lemma R_Sel_reduce_eq : forall Defs p C q q' l l' s C' s' C'' s'',
  CCC_To Defs C s (R_Sel p q l) C' s' ->
  CCC_To Defs C s (R_Sel p q' l') C'' s'' ->
  q = q' /\ l = l'.

Lemma L_Sel_reduce_eq : forall Defs p C q q' l l' s C' s' C'' s'',
  (Build_Program Defs C,s) --[L_Sel p q l]--> (Build_Program Defs C', s') ->
  (Build_Program Defs C,s) --[L_Sel p q' l']--> (Build_Program Defs C'', s'') ->
  q = q' /\ l = l'.

Lemma R_Sel_reduce_neq : forall Defs p p' C q q' l l' s C' s' C'' s'',
  CCC_To Defs C s (R_Sel p q l) C' s' ->
  CCC_To Defs C s (R_Sel p' q' l') C'' s'' ->
  p <> p' -> q <> q'.

Lemma L_Sel_reduce_neq : forall Defs p p' C q q' l l' s C' s' C'' s'',
  (Build_Program Defs C,s) --[L_Sel p q l]--> (Build_Program Defs C', s') ->
  (Build_Program Defs C,s) --[L_Sel p' q' l']--> (Build_Program Defs C'', s'') ->
  p <> p' -> q <> q'.

End Uniqueness.

Section Confluence.

Lemma diamond_Chor : forall Defs C s tl1 tl2 C1 C2 s1 s2,
  CCC_To Defs C s tl1 C1 s1 -> CCC_To Defs C s tl2 C2 s2 ->
  tl1 <> tl2 -> exists C' s', CCC_To Defs C1 s1 tl2 C' s' /\ CCC_To Defs C2 s2 tl1 C' s'.

Lemma diamond_1 : forall c tl1 tl2 c1 c2,
  c --[ tl1 ]--> c1 -> c --[ tl2 ]--> c2 ->
  tl1 <> tl2 -> exists c', c1 --[ tl2 ]--> c' /\ c2 --[ tl1 ]--> c'.

Lemma diamond_2 : forall c tl1 tl2 c1 c2,
  c --[ tl1 ]--> c1 -> c --[ tl2 ]--> c2 ->
  {fst c1 = fst c2 /\ eq_state_ext (snd c1) (snd c2)}
  + {exists c', c1 --[ tl2 ]--> c' /\ c2 --[ tl1 ]--> c'}.

In this one we unfold the configuration because of the equivalence. Furthermore, we use logical disjunction - the labels are too weak...
Useful particular cases.