Library CCSSeqSemaphore

Require Import SfLib.
Require Import LibTactics.
Require Import BisimTheory.
Require Import NameSet.
Require Import Labels.
Require Import Util.

  Inductive proc : Set :=
    | p_nil: proc
    | p_sum: proc→proc→proc
    | p_par: proc→proc→proc
    | p_seq: proc→proc→proc
    | p_act: label→proc→proc
    | p_res: name→nat→proc→proc
    | p_rep: proc→proc
    .
  Delimit Scope proc_scope with proc.
  Bind Scope proc_scope with proc.

  Definition res_filter a la := filter (fun l⇒ if label_eq l (l_in a) then false else if label_eq l (l_out a) then false else true) la.

  Fixpoint res_count_labels a n la n' := match la with
  | nil ⇒ if eq_nat_dec n' n then true else false
  | (l_in a')::la ⇒ if name_eq a' a then match n with 0 ⇒ false | S n0 ⇒ res_count_labels a n0 la n' end else res_count_labels a n la n'
  | (l_out a')::la ⇒ if name_eq a' a then res_count_labels a (S n) la n' else res_count_labels a n la n'
  | _::la ⇒ res_count_labels a n la n'
  end.

Module SyntaxNotation.
  Export Labels.Notation.
  Export NameSet.Notation.

  Notation "p + q" := (p_sum p%proc q%proc) : proc_scope.
  Notation "p || q" := (p_par p%proc q%proc) (left associativity, at level 50) : proc_scope.
  Notation "p ;; q" := (p_seq p%proc q%proc) (left associativity, at level 40) : proc_scope.
  Notation "a '?.' p" := (p_act (l_in a) p%proc) (no associativity, at level 20, x at level 0, p at level 21, format "a ?. p") : proc_scope.
  Notation "a '!.' p" := (p_act (l_out a) p%proc) (no associativity, at level 20, x at level 0, p at level 21, format "a !. p") : proc_scope.
  Notation "a '#' n ':' p" := (p_res a n p%proc) (no associativity, at level 20, n at level 0, p at level 21, format "a # n : p") : proc_scope.
  Notation "a '#:' p" := (p_res a 0 p%proc) (no associativity, at level 20, n at level 0, p at level 21, format "a #: p") : proc_scope.
  Notation "'().' p" := (p_act l_tau p%proc) (left associativity, at level 20, p at level 21, format "'().' p") : proc_scope.
  Notation "'O'" := (p_nil) (no associativity) : proc_scope.
  Notation "p '!!'" := (p_rep p%proc) (no associativity, at level 20, format "p !!") : proc_scope.

  Module U.
    Notation "p ‖ q" := (p_par p%proc q%proc) (left associativity, at level 50) : proc_scope.
    Notation "a ̄ '!.' p" := (p_act (l_out a) p%proc) (no associativity, at level 20, x at level 0, p at level 21, format "a ̄ !. p") : proc_scope.
    Notation "a '?.' p" := (p_act (l_in a) p%proc) (no associativity, at level 20, x at level 0, p at level 21, format "a ?. p") : proc_scope.
    Notation "'τ.' p" := (p_act l_tau p%proc) (left associativity, at level 20, p at level 21, format "'τ.' p") : proc_scope.
    Notation "'υ' a ':' n ':' p" := (p_res a n p%proc) (left associativity, at level 20, p at level 21, format "υ a : n : p") : proc_scope.
    Notation "'υ' a ':' p" := (p_res a 0 p%proc) (left associativity, at level 20, p at level 21, format "υ a : p") : proc_scope.
    Notation "'Ø'" := (p_nil) (no associativity) : proc_scope.
  End U.


  Module TestNotation.
    Open Scope proc_scope.
    Goal 1*(2×3)=6. omega. Qed.
    Goal 1<2. omega. Qed.
    Goal 2>1. omega. Qed.
    Goal (true||false)%bool=true. apply orb_true_iff; auto. Qed.
    Goal (true||false)%bool=true. apply orb_true_iff; auto. Qed.
    Goal (∀ p q, p + q = p_sum p q). reflexivity. Qed.
    Goal (∀ p q, p || q = p_par p q). reflexivity. Qed.
    Goal (∀ a p, a?.p = p_act (l_in a) p). reflexivity. Qed.
    Goal (∀ a p, a!.p = p_act (l_out a) p). reflexivity. Qed.
    Goal (∀ a n p, a#n:p = p_res a n p). reflexivity. Qed.
    Goal (∀ a p, a#:p = p_res a 0 p). reflexivity. Qed.
    Goal (∀ p q r, p || q || r = (p||q)||r). reflexivity. Qed.
    Goal (∀ p q r, p + q || r = (p+q)||r). reflexivity. Qed.
    Goal (∀ a b, a!.b?.O = (a!.(b?.O))). reflexivity. Qed.
    Goal (∀ a b p, a!.b?.O || p = (a!.b?.O) || p). reflexivity. Qed.
    Goal (∀ a p, a?.O + p = (a?.O) + p). reflexivity. Qed.
    Goal (∀ a, a!.a?.O = (a!.(a?.O))). reflexivity. Qed.
  End TestNotation.
End SyntaxNotation.

Section Machine.
  Import SyntaxNotation.

  Inductive step : proc→label→proc→Prop :=
  | s_act: ∀ l p,
      step (p_act l p) l p
  | s_parL: ∀ p q l p',
      step p l p' →
      step (p || q) l (p' || q)
  | s_parR: ∀ p q l q',
      step q l q' →
      step (p || q) l (p || q')
  | s_sumL: ∀ p q l p',
      step p l p' →
      step (p + q) l p'
  | s_sumR: ∀ p q l q',
      step q l q' →
      step (p + q) l q'
  | s_seq: ∀ p q l p',
      step p l p' →
      step (p;; q) l (p';; q)
  | s_res: ∀ a n p l p',
      step p l p' →
      l ≠ l_in a → l ≠ l_out a →
      step (a#n: p) l (a#n: p')
  | s_res_count_in: ∀ a n p p',
      step p (l_in a) p' →
      step (a#(S n): p) l_tau (a#n: p')
  | s_res_count_out: ∀ a n p p',
      step p (l_out a) p' →
      step (a#n: p) l_tau (a#(S n): p')
  | s_rep: ∀ p a p',
      step (p||p!!) a p' →
      step (p!!) a p'
  
  | s_par_nil:
      step (p_nil || p_nil) l_tau p_nil
  | s_sum_nil:
      step (p_nil+p_nil) l_tau p_nil
  | s_seq_nil: ∀ p,
      step (p_nil;; p) l_tau p
  | s_res_nil: ∀ a n,
      step (a#n:p_nil) l_tau p_nil

  .

End Machine.

Module LTS.
  Definition is_halted (p:proc) := p=p_nil.

  Inductive lstep p : label→proc→Prop :=
  | lstep_in: ∀ a p',
      step p (l_in a) p' →
      lstep p (l_in a) p'
  | lstep_out: ∀ a p',
      step p (l_out a) p' →
      lstep p (l_out a) p'.

  Program Definition lts : labeled_transition_system :=
    (Build_labeled_transition_system proc label lstep (fun p p' ⇒ step p l_tau p') is_halted _ _).
  Next Obligation.
    red in H; subst p; inverts H0.
  Qed.
  Next Obligation.
    red in H; subst p; inverts H0; inverts H.
  Qed.

  Existing Instance lts.

  Export Stepping.

  Arguments tstep lts p%proc p'%proc : rename.
  Arguments lstep p%proc l%label p'%proc.
  Arguments step_star lts p%proc la%label p'%proc.
  Arguments wbisimilar lts p%proc q%proc.
  Arguments partial_contrasimilar lts p%proc q%proc.
  Arguments contrasimilar lts p%proc q%proc.
  Arguments par_bisimilar lts p%proc q%proc.

End LTS.

  Import LTS.

Module StepNotation.
  Export Labels.Notation.

  Notation "p ---> p' " := (step p%proc l_tau p'%proc) (no associativity, at level 55, p' at level 55, format "p ---> p' ").
  Notation "p - l -> p' " := (step p%proc l%label p'%proc) (no associativity, at level 55, p' at level 55, format "p - l -> p' ").

  Module U.
    Notation "p ― l → p'" := (step p%proc l%label p'%proc) (no associativity, at level 55, p' at level 55, format "p ― l → p'").
    Notation "p ⟶ p'" := (step p%proc l_tau p'%proc) (no associativity, at level 55, p' at level 55).
    Notation "p ― l1 → p' ― l2 → p'' " := (step p%proc l1%label p'%proc ∧ step p'%proc l2%label p''%proc) (at level 55, p' at next level, format "p ― l1 → p' ― l2 → p'' ").
    Notation "p ― l1 → p' ⟶ p'' " := (step p%proc l1%label p'%proc ∧ step p'%proc l_tau p''%proc) (at level 55, p' at next level, format "p ― l1 → p' ⟶ p'' ").
    Notation "p ⟶ p' ― l2 → p'' " := (step p%proc l_tau p'%proc ∧ step p'%proc l2%label p''%proc) (at level 55, p' at next level, format "p ⟶ p' ― l2 → p'' ").
    Notation "p ⟶ p' ⟶ p'' " := (step p%proc l_tau p'%proc ∧ step p'%proc l_tau p''%proc) (at level 55, p' at next level, format "p ⟶ p' ⟶ p'' ").
  End U.

End StepNotation.

Section FreeNames.
  Fixpoint fn (p:proc) : nameset := match p with
  | p_nil ⇒ NameSet.empty
  | p_sum p1 p2 ⇒ NameSet.union (fn p1) (fn p2)
  | p_par p1 p2 ⇒ NameSet.union (fn p1) (fn p2)
  | p_act l_tau p ⇒ fn p
  | p_act (l_in a) p ⇒ NameSet.add a (fn p)
  | p_act (l_out a) p ⇒ NameSet.add a (fn p)
  | p_seq p1 p2 ⇒ NameSet.union (fn p1) (fn p2)
  | p_res a n p ⇒ NameSet.remove a (fn p)
  | p_rep p ⇒ fn p
  end.

  Fixpoint bn p : nameset := match p with
  | p_nil ⇒ NameSet.empty
  | p_sum p1 p2 ⇒ NameSet.union (bn p1) (bn p2)
  | p_par p1 p2 ⇒ NameSet.union (bn p1) (bn p2)
  | p_act _ p ⇒ bn p
  | p_seq p1 p2 ⇒ NameSet.union (bn p1) (bn p2)
  | p_res a n p ⇒ NameSet.add a (bn p)
  | p_rep p ⇒ bn p
  end.

  Fixpoint fn_in (p: proc) := match p with
  | p_act (l_in a) p' ⇒ NameSet.add a (fn_in p')
  | p_act _ p' ⇒ fn_in p'
  | p_sum p1 p2 ⇒ NameSet.union (fn_in p1) (fn_in p2)
  | p_par p1 p2 ⇒ NameSet.union (fn_in p1) (fn_in p2)
  | p_seq p1 p2 ⇒ NameSet.union (fn_in p1) (fn_in p2)
  | p_res a _ p' ⇒ NameSet.remove a (fn_in p')
  | p_rep p ⇒ fn_in p
  | p_nil ⇒ NameSet.empty
  end.

  Fixpoint fn_out (p: proc) := match p with
  | p_act (l_out a) p' ⇒ NameSet.add a (fn_out p')
  | p_act _ p' ⇒ fn_out p'
  | p_sum p1 p2 ⇒ NameSet.union (fn_out p1) (fn_out p2)
  | p_par p1 p2 ⇒ NameSet.union (fn_out p1) (fn_out p2)
  | p_seq p1 p2 ⇒ NameSet.union (fn_out p1) (fn_out p2)
  | p_res a _ p' ⇒ NameSet.remove a (fn_out p')
  | p_rep p ⇒ fn_out p
  | p_nil ⇒ NameSet.empty
  end.

End FreeNames.

Module Notation.
  Export SyntaxNotation.
  Export StepNotation.
  Module U.
    Export SyntaxNotation.U.
    Export StepNotation.U.
  End U.
End Notation.

Section Stepping.
  Import Notation.
  Import Notation.U.

  Definition par_swap p:= (match p with p1||p2 ⇒ p2 || p1 | _ ⇒ p end)%proc.

  Lemma par_swap_swap: ∀ p, par_swap (par_swap p) = p.
  Proof. destruct p; reflexivity. Qed.

  Lemma step_star_parL_step: ∀ p q la p',
    step_star p la p' →
    step_star (p||q) la (p'||q).
  Proof.
    intros.
    induction H.
    - apply step_nil.
    - eapply step_lcons; eauto.
    inverts H; constructor; apply s_parL; eauto.
    - eapply step_tcons; eauto; apply s_parL; eauto.
  Qed.

  Lemma step_star_parR_step: ∀ p q la q',
    step_star q la q' →
    step_star (p||q) la (p||q').
  Proof.
    intros.
    induction H.
    - apply step_nil.
    - eapply step_lcons; eauto.
    inverts H; constructor; apply s_parR; eauto.
    - eapply step_tcons; eauto; apply s_parR; eauto.
  Qed.

  Lemma step_star_seq_app: ∀ p l p' r,
    step_star p l p' → step_star (p;;r) l (p';;r).
  Proof.
    intros.
    induction H.
    - apply step_nil.
    - eapply step_lcons; eauto. inverts H; constructor; apply s_seq; auto.
    - eapply step_tcons; eauto; apply s_seq; auto.
  Qed.

  Lemma step_star_lstep_inv: ∀ p a la p',
    step_star p (a::la) p' →
    ∃ p'0 p'1,
      step_star p nil p'0 ∧ lstep p'0 a p'1 ∧ step_star p'1 la p'.
  Proof.
    intros.
    remember (a::la) as la0.
    revert a la Heqla0.
    induction H; intros; subst.
    - discriminate.
    - inversion Heqla0; subst a0 la0. clear Heqla0.
    ∃ p p'; splits; auto.
    apply step_nil.
    - edestruct IHstep_star as [p'0[p'1[?[??]]]]; clear IHstep_star; eauto.
    ∃ p'0 p'1; splits; auto.
    eapply step_tcons; eauto.
  Qed.

  Lemma step_star_nil_resolve: ∀ la p',
    step_star p_nil la p' → la=[] ∧ p'=p_nil.
  Proof.
    intros. remember p_nil as p.
    revert Heqp.
    induction H; intros; subst; auto.
    inverts H; inverts H1. inverts H.
  Qed.

  Lemma step_star_par_unzip: ∀ p q la pq',
    step_star (p||q) la pq' →
    ∃ p' q' la1 la2,
      (pq' = p' || q' ∨ (p'=p_nil ∧ q'=p_nil ∧ pq'=p_nil))%proc ∧
      step_star p la1 p' ∧ step_star q la2 q' ∧
      (∀ r r', step_star r la1 r' → step_star (r||q) la (r'||q')) ∧
      (∀ r r', step_star r la2 r' → step_star (p||r) la (p'||r')).
  Proof.
    intros.
    remember (p||q)%proc as pq.
    revert p q Heqpq.
    induction H; intros; subst.
    - renames p0 to p.
    ∃ p q (@nil lts_L) (@nil lts_L); splits; intros; auto.
    + apply step_nil.
    + apply step_nil.
    + apply step_star_parL_step; auto.
    + apply step_star_parR_step; auto.
    - renames p0 to p, p' to pq', p'' to pq''.
    inverts H; inverts H1.
    + edestruct IHstep_star as [p''[q''[la1[la2[?[?[?[??]]]]]]]]; auto; subst; clear IHstep_star.
    ∃ p'' q'' (l_in a0::la1) la2; splits; auto.
    eapply @step_lcons; [constructor; eauto | auto].
    intros.
    edestruct step_star_lstep_inv as [r'0[r'1[?[??]]]]; eauto.
    change (l_in a0::la) with ([l_in a0]++la).
    eapply step_star_app; eauto.
    apply step_star_parL_step.
    change [l_in a0] with ([]++[l_in a0]).
    eapply step_star_app; eauto. apply single_lstep; eauto.
    intros.
    eapply step_lcons; eauto. constructor; apply s_parL; auto.
    + edestruct IHstep_star as [p''[q''[la1[la2[?[?[?[??]]]]]]]]; auto; subst; clear IHstep_star.
    ∃ p'' q'' la1 (l_in a0::la2); splits; auto.
    eapply @step_lcons; [constructor; eauto | auto].
    intros.
    eapply step_lcons; eauto. constructor; apply s_parR; auto.
    intros.
    edestruct step_star_lstep_inv as [r'0[r'1[?[??]]]]; eauto.
    change (l_in a0::la) with ([l_in a0]++la).
    eapply step_star_app; eauto.
    apply step_star_parR_step.
    change [l_in a0] with ([]++[l_in a0]).
    eapply step_star_app; eauto. apply single_lstep; eauto.
    + edestruct IHstep_star as [p''[q''[la1[la2[?[?[?[??]]]]]]]]; auto; subst; clear IHstep_star.
    ∃ p'' q'' (l_out a0::la1) la2; splits; auto.
    eapply @step_lcons; [constructor; eauto | auto].
    intros.
    edestruct step_star_lstep_inv as [r'0[r'1[?[??]]]]; eauto.
    change (l_out a0::la) with ([l_out a0]++la).
    eapply step_star_app; eauto.
    apply step_star_parL_step.
    change [l_out a0] with ([]++[l_out a0]).
    eapply step_star_app; eauto. apply single_lstep; eauto.
    intros.
    eapply step_lcons; eauto. constructor; apply s_parL; auto.
    + edestruct IHstep_star as [p''[q''[la1[la2[?[?[?[??]]]]]]]]; auto; subst; clear IHstep_star.
    ∃ p'' q'' la1 (l_out a0::la2); splits; auto.
    eapply @step_lcons; [constructor; eauto | auto].
    intros.
    eapply step_lcons; eauto. constructor; apply s_parR; auto.
    intros.
    edestruct step_star_lstep_inv as [r'0[r'1[?[??]]]]; eauto.
    change (l_out a0::la) with ([l_out a0]++la).
    eapply step_star_app; eauto.
    apply step_star_parR_step.
    change [l_out a0] with ([]++[l_out a0]).
    eapply step_star_app; eauto. apply single_lstep; eauto.
    - renames p0 to p, p' to pq', p'' to pq''.
    inverts H.
    + edestruct IHstep_star as [p''[q''[la1[la2[?[?[?[??]]]]]]]]; auto; subst; clear IHstep_star.
    ∃ p'' q'' la1 la2; splits; intros; auto.
    eapply @step_tcons; eauto. apply H5.
    eapply @step_tcons; eauto. apply s_parL; auto.
    + edestruct IHstep_star as [p''[q''[la1[la2[?[?[?[??]]]]]]]]; auto; subst; clear IHstep_star.
    ∃ p'' q'' la1 la2; splits; intros; auto.
    eapply @step_tcons; eauto. apply H5.
    eapply @step_tcons; eauto. apply s_parR; auto.
    + edestruct step_star_nil_resolve as [??]; eauto; subst la pq''.
    ∃ p_nil p_nil (@nil lts_L) (@nil lts_L); splits; intros; auto.
    apply step_star_parL_step; auto.
    apply step_star_parR_step; auto.
  Qed.

  Lemma step_star_res_nIn: ∀ a n p la p',
    step_star p la p' →
    (∀ l, In l la → l≠l_in a ∧ l≠l_out a) →
    step_star (a#n:p) la (a#n:p').
  Proof.
    intros.
    induction H.
    - apply step_nil.
    - eapply step_lcons; eauto.
    inverts H; constructor; apply s_res; eauto; apply H0; simpl; auto.
    apply IHstep_star. split; intros; apply H0; simpl; auto.
    - eapply step_tcons; eauto.
    apply s_res; eauto; congruence.
  Qed.

  Lemma step_star_res: ∀ a n p la p' la' n',
    step_star p la p' →
    la' = res_filter a la →
    res_count_labels a n la n'=true →
    step_star (a#n:p) la' (a#n':p').
  Proof.
    intros.
    revert n n' la' H0 H1.
    induction H; intros.
    - simpl in *; subst. destruct (eq_nat_dec n' n); intuition; subst; apply @step_nil.
    - simpl in ×.
    destruct a0.
    destruct (label_eq l_tau (l_in a)); try discriminate; subst. clear n0.
    inverts H.
    destruct (name_eq n0 a); subst.
    destruct n; try discriminate.
    destruct (label_eq (l_in a) (l_in a)); try congruence. clear e.
    eapply step_tcons; eauto.
    eapply s_res_count_in. inverts H; auto.
    destruct (label_eq (l_in n0) (l_in a)); try congruence.
    destruct (label_eq (l_in n0) (l_out a)); try congruence.
    eapply @step_lcons; eauto. inverts H; constructor; apply s_res; auto.
    destruct (name_eq n0 a); subst.
    destruct (label_eq (l_out a) (l_in a)); try congruence.
    destruct (label_eq (l_out a) (l_out a)); try congruence.
    inverts H.
    eapply step_tcons; eauto. apply s_res_count_out; auto.
    destruct (label_eq (l_out n0) (l_in a)); try congruence.
    destruct (label_eq (l_out n0) (l_out a)); try congruence.
    inverts H; eapply @step_lcons; eauto. constructor; apply s_res; auto.
    - eapply step_tcons; eauto. apply s_res; auto; congruence.
  Qed.

  Lemma step_star_res_inv: ∀ a n p la pp',
    step_star (a#n:p) la pp' →
    ∃ la' n' p',
      (pp'=a#n':p' ∨ (pp'=O ∧ p'=O))%proc ∧
      la = res_filter a la' ∧
      res_count_labels a n la' n' = true ∧
      step_star p la' p'.
  Proof.
    intros.
    remember (a#n:p)%proc as pp.
    revert n p Heqpp.
    induction H; intros; subst.
    - ∃ (@nil lts_L) n p0; splits; auto. simpl. destruct eq_nat_dec; congruence. apply step_nil.
    - inverts H; inverts H1; edestruct IHstep_star as [la'[n'[p'[?[?[??]]]]]]; eauto.
    + ∃ (l_in a1::la') n' p'; splits; auto.
    simpl. destruct label_eq. inverts e. false.
    destruct label_eq. inverts e; false.
    f_equal; auto.
    simpl. destruct name_eq; auto. subst a1. false.
    eapply @step_lcons; eauto; constructor; auto.
    + ∃ (l_out a1::la') n' p'; splits; auto.
    simpl. destruct label_eq. inverts e.
    destruct label_eq. inverts e; false.
    f_equal; auto.
    simpl. destruct name_eq; auto. subst a1. false.
    eapply @step_lcons; eauto; constructor; auto.
    - inverts H.
    + edestruct IHstep_star as [la'[n'[p'[?[?[??]]]]]]; clear IHstep_star; eauto.
    ∃ la' n' p'; splits; auto. eapply step_tcons; eauto. apply H4.
    + edestruct IHstep_star as [la'[n'[p'[?[?[??]]]]]]; clear IHstep_star; eauto.
    ∃ (l_in a::la') n' p'; splits; auto.
    simpl. destruct label_eq; congruence.
    simpl. destruct (name_eq a a); congruence.
    eapply @step_lcons; eauto; constructor; auto.
    + edestruct IHstep_star as [la'[n'[p'[?[?[??]]]]]]; clear IHstep_star; eauto.
    ∃ (l_out a::la') n' p'; splits; auto.
    simpl. destruct label_eq; try congruence. destruct label_eq.
    simpl. destruct (name_eq a a); congruence.
    false.
    simpl. destruct name_eq; congruence.
    eapply @step_lcons; eauto; constructor; auto.
    + edestruct step_star_nil_resolve as [??]; eauto; subst la p''.
    ∃ (@nil lts_L) n p_nil; splits; auto.
    simpl. destruct eq_nat_dec; auto.
  Qed.

  Lemma step_star_res_count_in: ∀ n p a p',
    step_star p [l_in a] p' → step_star (a#(S n):p) [] (a#n:p').
  Proof.
    intros.
    edestruct step_star_lstep_inv as [p'0[p'1[?[??]]]]; eauto. inverts H1.
    change [] with ([]++@nil lts_L).
    eapply step_star_app.
    apply step_star_res_nIn; eauto.
    eapply step_tcons.
    apply s_res_count_in; eauto.
    apply step_star_res_nIn; eauto.
  Qed.

  Lemma step_star_res_count_out: ∀ n p a p',
    step_star p [l_out a] p' → step_star (a#n:p) [] (a#(S n):p').
  Proof.
    intros.
    edestruct step_star_lstep_inv as [p'0[p'1[?[??]]]]; eauto. inverts H1.
    change [] with ([]++@nil lts_L).
    eapply step_star_app.
    apply step_star_res_nIn; eauto.
    eapply step_tcons.
    apply s_res_count_out; eauto.
    apply step_star_res_nIn; eauto.
  Qed.

  Lemma step_star_l_tau_nIn: ∀ p la p',
    step_star p la p' → ¬In l_tau la.
  Proof.
    intros.
    induction H; simpl; auto.
    inverts H; intros [?|?]; try discriminate; contradiction.
  Qed.

  Lemma step_star_parL_seq_inv: ∀ p1 p2 p3 la p',
    step_star ((p1;; p2) || p3) la p' →
    (∃ p1' p3',
      step_star (p1||p3) la (p1'||p3') ∧ p' = (p1';;p2)||p3')%proc ∨
    (∃ la1 la2 p3',
      step_star (p1||p3) la1 (p_nil || p3') ∧ step_star (p2||p3') la2 p' ∧ la=la1++la2).
  Proof.
    intros.
    remember (p1;;p2 || p3)%proc as p.
    revert p1 p2 p3 Heqp.
    induction H; intros; subst.
    - left; ∃ p1 p3; split; auto; apply step_nil.
    - inverts H; inverts H1; [ inverts H5 | | inverts H5 | ].
    + edestruct IHstep_star as [ [p1'[p3'[??]]] | [la1[la2[p3'[?[??]]]]] ]; eauto; clear IHstep_star; subst.
    left; ∃ p1' p3'; split; auto. eapply step_lcons; eauto; constructor; apply s_parL; auto.
    right; ∃ (l_in a0::la1) la2 p3'; splits; auto. eapply @step_lcons; eauto; constructor; apply s_parL; auto.
    + edestruct IHstep_star as [ [p1'[p3'[??]]] | [la1[la2[p3'[?[??]]]]] ]; eauto; clear IHstep_star; subst.
    left; ∃ p1' p3'; split; auto. eapply step_lcons; eauto; constructor; apply s_parR; auto.
    right; ∃ (l_in a0::la1) la2 p3'; splits; auto. eapply @step_lcons; eauto; constructor; apply s_parR; auto.
    + edestruct IHstep_star as [ [p1'[p3'[??]]] | [la1[la2[p3'[?[??]]]]] ]; eauto; clear IHstep_star; subst.
    left; ∃ p1' p3'; split; auto. eapply step_lcons; eauto; constructor; apply s_parL; auto.
    right; ∃ (l_out a0::la1) la2 p3'; splits; auto. eapply @step_lcons; eauto; constructor; apply s_parL; auto.
    + edestruct IHstep_star as [ [p1'[p3'[??]]] | [la1[la2[p3'[?[??]]]]] ]; eauto; clear IHstep_star; subst.
    left; ∃ p1' p3'; split; auto. eapply step_lcons; eauto; constructor; apply s_parR; auto.
    right; ∃ (l_out a0::la1) la2 p3'; splits; auto. eapply @step_lcons; eauto; constructor; apply s_parR; auto.
    - inverts H; [ inverts H5 | ].
    + edestruct IHstep_star as [ [p1'[p3'[??]]] | [la1[la2[p3'[?[??]]]]] ]; eauto; clear IHstep_star; subst.
    left; ∃ p1' p3'; split; auto. eapply step_tcons; eauto; apply s_parL; auto.
    right; ∃ la1 la2 p3'; splits; auto. eapply @step_tcons; eauto; apply s_parL; auto.
    + right; ∃ (@nil lts_L) la p3; splits; auto; apply step_nil.
    + edestruct IHstep_star as [ [p1'[p3'[??]]] | [la1[la2[p3'[?[??]]]]] ]; eauto; clear IHstep_star; subst.
    left; ∃ p1' p3'; split; auto. eapply step_tcons; eauto; apply s_parR; auto.
    right; ∃ la1 la2 p3'; splits; auto. eapply @step_tcons; eauto; apply s_parR; auto.
  Qed.

  Lemma step_star_par_swap': ∀ p1 p2 la p',
    step_star (p1||p2) la p' →
    step_star (p2||p1) la (par_swap p').
  Proof.
    intros.
    remember (p1||p2)%proc as p.
    revert p1 p2 Heqp.
    induction H; intros; subst.
    - apply step_nil.
    - inverts H; (inverts H1; eapply step_lcons; eauto; constructor; [apply s_parR|apply s_parL]); auto.
    - inverts H; eapply step_tcons; eauto; [ apply s_parR | apply s_parL | apply s_par_nil | ]; auto.
    edestruct step_star_nil_resolve as [??]; eauto; subst la p''; apply step_nil.
  Qed.

  Lemma step_star_par_swap: ∀ p1 p2 la p',
    step_star (p1||p2) la (par_swap p') →
    step_star (p2||p1) la p'.
  Proof.
    intros. apply step_star_par_swap' in H. rewrite par_swap_swap in H. auto.
  Qed.

  Lemma step_star_parR_seq_inv: ∀ p1 p2 p3 la p',
    step_star (p1 || p2;; p3) la p' →
    (∃ p1' p2',
      step_star (p1 || p2) la (p1' || p2') ∧ p' = p1' || p2';;p3)%proc ∨
    (∃ la1 la2 p1',
      step_star (p1 || p2) la1 (p1' || p_nil) ∧ step_star (p1'||p3) la2 p' ∧ la=la1++la2).
  Proof.
    intros.
    apply step_star_par_swap' in H.
    edestruct step_star_parL_seq_inv as [ [p2'[p1'[??]]] | [la1[la2[p1'[?[??]]]]] ]; eauto; subst.
    apply step_star_par_swap' in H0.
    left; ∃ p1' p2'; split; auto.
    destruct p'; inverts H1; reflexivity.
    apply step_star_par_swap' in H0.
    right; ∃ la1 la2 p1'; splits; auto.
    apply step_star_par_swap' in H1.
    destruct p'; auto.
  Qed.

  Lemma step_star_par_unzip': ∀ p1 p2 la p1' p2',
    step_star (p1||p2) la (p1'||p2') →
    ∃ lp la1 la2,
      step_star p1 la1 p1' ∧ step_star p2 la2 p2' ∧ la=interleaving lp la1 la2 ∧ (length lp = length la1 + length la2)%nat.
  Proof.
    intros.
    remember (p1||p2)%proc as p; remember (p1'||p2')%proc as p'.
    revert p1 p2 p1' p2' Heqp Heqp'.
    induction H; intros; subst.
    - inverts Heqp'.
    ∃ (@nil (unit+unit)) (@nil label) (@nil label); splits; auto; apply @step_nil.
    - inverts H; inverts H1.
    + edestruct IHstep_star as [lp[la1[la2[?[?[??]]]]]]; eauto.
    ∃ (inl tt::lp) (l_in a0::la1) la2; splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. f_equal; auto.
    + edestruct IHstep_star as [lp[la1[la2[?[?[??]]]]]]; eauto.
    ∃ (inr tt::lp) la1 (l_in a0::la2); splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. rewrite H3; simpl. omega.
    + edestruct IHstep_star as [lp[la1[la2[?[?[??]]]]]]; eauto.
    ∃ (inl tt::lp) (l_out a0::la1) la2; splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. f_equal; auto.
    + edestruct IHstep_star as [lp[la1[la2[?[?[??]]]]]]; eauto.
    ∃ (inr tt::lp) la1 (l_out a0::la2); splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. rewrite H3; simpl. omega.
    - inverts H.
    + edestruct IHstep_star as [lp[la1[la2[?[?[??]]]]]]; eauto.
    ∃ lp la1 la2; splits; auto. eapply @step_tcons; eauto; apply H5.
    + edestruct IHstep_star as [lp[la1[la2[?[?[??]]]]]]; eauto.
    ∃ lp la1 la2; splits; auto. eapply @step_tcons; eauto; apply H5.
    + false; clear IHstep_star. edestruct step_star_nil_resolve as [??]; eauto; discriminate.
  Qed.

  Lemma step_star_par_zip': ∀ lp p1 p2 la la1 la2 p1' p2',
    step_star p1 la1 p1' → step_star p2 la2 p2' →
    la = interleaving lp la1 la2 →
    step_star (p1||p2) la (p1'||p2').
  Proof.
    induction lp; intros.
    - simpl in *; subst.
    eapply step_star_app.
    apply step_star_parL_step; eauto.
    apply step_star_parR_step; eauto.
    - destruct a as [?|?]; destruct u; [destruct la1|destruct la2]; simpl in H1; subst.
    + rewrite<- (app_nil_r la2).
    eapply step_star_app.
    apply step_star_parR_step; eauto.
    apply step_star_parL_step; eauto.
    + edestruct step_star_lstep_inv with (p:=p1) as [p1'0[p1'1[?[??]]]]; eauto.
    change (l::interleaving lp la1 la2) with ([l]++interleaving lp la1 la2).
    eapply step_star_app; eauto.
    change [l] with ([]++[l]).
    eapply step_lsnoc; eauto. apply step_star_parL_step; eauto.
    inverts H2; constructor; apply s_parL; auto.
    + rewrite<- (app_nil_r la1).
    eapply step_star_app.
    apply step_star_parL_step; eauto.
    apply step_star_parR_step; eauto.
    + edestruct step_star_lstep_inv with (p:=p2) as [p2'0[p2'1[?[??]]]]; eauto.
    change (l::interleaving lp la1 la2) with ([l]++interleaving lp la1 la2).
    eapply step_star_app; eauto.
    change [l] with ([]++[l]).
    eapply step_lsnoc; eauto. apply step_star_parR_step; eauto.
    inverts H2; constructor; apply s_parR; auto.
  Qed.

  Lemma step_star_parL_seq_app: ∀ r p q la p' q',
    step_star (p||q) la (p'||q') → step_star (p;;r||q) la (p';;r||q').
  Proof.
    intros.
    edestruct step_star_par_unzip as [p'_[q'_[la1[la2[?[?[?[??]]]]]]]]; eauto.
    destruct H0 as [? | [_[_ ?]] ]; [| discriminate].
    inverts H0. renames p'_ to p', q'_ to q'.
    eapply H3.
    apply step_star_seq_app; auto.
  Qed.

  Lemma step_star_parR_seq_app: ∀ r p q la p' q',
    step_star (p||q) la (p'||q') → step_star (p||q;;r) la (p'||q';;r).
  Proof. intros; apply step_star_par_swap; apply step_star_parL_seq_app; auto; apply step_star_par_swap; auto. Qed.

  Lemma step_star_par_seq_inv: ∀ p1 p2 p3 p4 la pp',
    step_star (p1;;p3 || p2;;p4) la pp' →
    (∃ p1' p2',
      step_star (p1||p2) la (p1'||p2') ∧
      pp' = (p1';;p3||p2';;p4))%proc ∨
    (∃ la1 p2' la2,
      step_star (p1||p2) la1 (p_nil||p2') ∧
      step_star (p3||p2';;p4) la2 pp' ∧
      la = la1++la2) ∨
    (∃ la1 p1' la2,
      step_star (p1||p2) la1 (p1'||p_nil) ∧
      step_star (p1';;p3||p4) la2 pp' ∧
      la = la1++la2).
  Proof.
    introv Hss; intros.
    edestruct step_star_parL_seq_inv as [ [p1'[p24'[Hss' ?]]] | [la1[la2[p24'[Hss1[Hss2 ?]]]]] ]; eauto;
      clear Hss; try rename Hss' into Hss; subst.
    × edestruct step_star_parR_seq_inv as [ [p1''[p2''[Hss' ?]]] | [la1[la2[p1''[Hss1[Hss2 ?]]]]] ]; eauto;
      clear Hss; try rename Hss' into Hss.
    + inverts H. eauto.
    + right; right. ∃ la1 p1'' la2; splits; auto.
    apply step_star_parL_seq_app; auto.
    × edestruct step_star_parR_seq_inv as [ [p1''[p2''[Hss' ?]]] | [la1a[la1b[p1''[Hss1a[Hss2b ?]]]]] ]; eauto;
      clear Hss1; try rename Hss' into Hss1.
    + inverts H. right; left. jauto.
    + right; right. ∃ la1a p1'' (la1b++la2); splits; auto.
    eapply step_star_app.
    apply step_star_parL_seq_app; eauto.
    eapply step_tcons; eauto.
    apply s_parL; apply s_seq_nil.
    subst. rewrite app_assoc; reflexivity.
  Qed.

  Lemma step_star_par_swap_nil: ∀ p la,
    step_star p la p_nil → step_star (par_swap p) la p_nil.
  Proof.
    intros.
    remember (p_nil) as p'.
    revert Heqp'.
    induction H; intros; subst.
    - apply step_nil.
    - destruct p; simpl; auto; try solve [eapply @step_lcons; eauto].
    clear H0.
    eapply @step_lcons; eauto.
    inverts H; inverts H0; constructor; try solve [apply s_parR; auto|apply s_parL; auto].
    - destruct p; simpl; auto; try solve [eapply @step_tcons; eauto].
    clear H0.
    eapply @step_tcons; eauto.
    inverts H; try first [apply s_parR|apply s_parL|apply s_par_nil]; auto.
  Qed.

  Lemma step_star_par_swap_nil': ∀ p la,
    step_star (par_swap p) la p_nil → step_star p la p_nil.
  Proof.
    intros; apply step_star_par_swap_nil in H; auto; rewrite par_swap_swap in H; auto.
  Qed.

  Lemma step_star_seq_inv: ∀ p q la pq',
    step_star (p;;q) la pq' →
    (∃ p', step_star p la p' ∧ pq' = p_seq p' q)
    ∨ (∃ la1 la2, step_star p la1 p_nil ∧ step_star q la2 pq' ∧ la=la1++la2).
  Proof.
    intros.
    remember (p_seq p q) as pp.
    revert p Heqpp.
    induction H; intros; subst.
    × left; ∃ p0; split; auto; apply step_nil.
    × inverts H; inverts H1.
    + edestruct IHstep_star as [[p'[??]]|[la1[la2[?[??]]]]]; eauto; subst; clear IHstep_star.
    - left; ∃ p'; split; auto. eapply step_lcons; eauto; constructor; auto.
    - right; ∃ (l_in a0::la1) la2; splits; auto. eapply @step_lcons; eauto. constructor; auto.
    + edestruct IHstep_star as [[p'[??]]|[la1[la2[?[??]]]]]; eauto; subst; clear IHstep_star.
    - left; ∃ p'; split; auto. eapply step_lcons; eauto; constructor; auto.
    - right; ∃ (l_out a0::la1) la2; splits; auto. eapply @step_lcons; eauto. constructor; auto.
    × inverts H.
    + edestruct IHstep_star as [[p'[??]]|[la1[la2[?[??]]]]]; eauto; subst; clear IHstep_star.
    - left; ∃ p'; split; auto. eapply step_tcons; eauto. apply H5.
    - right; ∃ la1 la2; splits; auto. eapply @step_tcons; eauto. apply H5.
    + right; ∃ (@nil lts_L) la; splits; auto. apply step_nil.
  Qed.

End Stepping.

Section FreeNameLemmas.
  Import Notation.
  Import Notation.U.

  Lemma fn_in_out_equiv: ∀ p,
    NameSet.Equal (fn p) (NameSet.union (fn_in p) (fn_out p)).
  Proof.
    intros.
    cut (∀ ab cd a b c d, NameSet.Equal ab (NameSet.union a b) → NameSet.Equal cd (NameSet.union c d) → NameSet.Equal (NameSet.union ab cd) (NameSet.union (NameSet.union a c) (NameSet.union b d))); intros.
    induction p; intros; simpl; eauto.
    × setoid_rewrite NameSetProps.union_subset_equal; reflexivity.
    × destruct l; auto.
    setoid_rewrite NameSetProps.union_add; setoid_rewrite IHp; reflexivity.
    setoid_rewrite NameSetProps.union_sym; setoid_rewrite NameSetProps.union_add;
      setoid_rewrite NameSetProps.union_sym; setoid_rewrite IHp; reflexivity.
    × apply NameSet_union_remove; auto.
    × setoid_rewrite NameSetProps.union_sym at 3.
    setoid_rewrite NameSetProps.union_assoc.
    setoid_rewrite<- NameSetProps.union_assoc at 2.
    setoid_rewrite<- H.
    setoid_rewrite NameSetProps.union_sym at 3.
    setoid_rewrite<- NameSetProps.union_assoc.
    setoid_rewrite<- H0.
    setoid_rewrite NameSetProps.union_sym at 1.
    reflexivity.
  Qed.

  Lemma fn_in_subset_step: ∀ p la p',
    step p la p' →
    NameSet.Subset (fn_in p') (fn_in p).
  Proof.
    intros.
    induction H; simpl.
    - destruct l.
    + reflexivity.
    + apply NameSetProps.subset_add_2; reflexivity.
    + reflexivity.
    - apply NameSetProps.union_subset_4; auto.
    - apply NameSetProps.union_subset_5; auto.
    - etransitivity. apply NameSetProps.union_subset_1. apply NameSetProps.union_subset_4; auto.
    - etransitivity. apply NameSetProps.union_subset_2. apply NameSetProps.union_subset_5; auto.
    - apply NameSetProps.union_subset_4; auto.
    - setoid_rewrite IHstep. reflexivity.
    - setoid_rewrite IHstep. reflexivity.
    - setoid_rewrite IHstep. reflexivity.
    - etransitivity.
    apply IHstep.
    simpl; apply NameSetProps.union_subset_3; reflexivity.
    - apply NameSetProps.union_subset_2; auto.
    - apply NameSetProps.union_subset_2; auto.
    - apply NameSetProps.union_subset_2; auto.
    - setoid_rewrite NameSetProps.remove_equal. reflexivity. setoid_rewrite NameSetFacts.empty_iff. intro; false.
  Qed.

  Lemma fn_out_subset_step: ∀ p la p',
    step p la p' →
    NameSet.Subset (fn_out p') (fn_out p).
  Proof.
    intros.
    induction H; simpl.
    - destruct l.
    + reflexivity.
    + reflexivity.
    + apply NameSetProps.subset_add_2; reflexivity.
    - apply NameSetProps.union_subset_4; auto.
    - apply NameSetProps.union_subset_5; auto.
    - etransitivity. apply NameSetProps.union_subset_1. apply NameSetProps.union_subset_4; auto.
    - etransitivity. apply NameSetProps.union_subset_2. apply NameSetProps.union_subset_5; auto.
    - apply NameSetProps.union_subset_4; auto.
    - setoid_rewrite IHstep. reflexivity.
    - setoid_rewrite IHstep. reflexivity.
    - setoid_rewrite IHstep. reflexivity.
    - etransitivity.
    apply IHstep.
    simpl; apply NameSetProps.union_subset_3; reflexivity.
    - apply NameSetProps.union_subset_2; auto.
    - apply NameSetProps.union_subset_2; auto.
    - apply NameSetProps.union_subset_2; auto.
    - setoid_rewrite NameSetProps.remove_equal. reflexivity. setoid_rewrite NameSetFacts.empty_iff. intro; false.
  Qed.

  Lemma fn_subset_step: ∀ p la p',
    step p la p' →
    NameSet.Subset (fn p') (fn p).
  Proof.
    intros.
    setoid_rewrite fn_in_out_equiv.
    apply NameSetProps.union_subset_3.
    etransitivity.
    eapply fn_in_subset_step; eauto.
    apply NameSetProps.union_subset_1.
    etransitivity.
    eapply fn_out_subset_step; eauto.
    apply NameSetProps.union_subset_2.
  Qed.

  Lemma fn_in_subset_step_star: ∀ p la p',
    step_star p la p' →
    NameSet.Subset (fn_in p') (fn_in p).
  Proof.
    intros; induction H.
    - reflexivity.
    - inverts H; rewrite IHstep_star; eapply fn_in_subset_step; eauto.
    - rewrite IHstep_star; eapply fn_in_subset_step; eauto; apply H.
  Qed.

  Lemma fn_out_subset_step_star: ∀ p la p',
    step_star p la p' →
    NameSet.Subset (fn_out p') (fn_out p).
  Proof.
    intros; induction H.
    - reflexivity.
    - inverts H; rewrite IHstep_star; eapply fn_out_subset_step; eauto.
    - rewrite IHstep_star; eapply fn_out_subset_step; eauto; apply H.
  Qed.

  Lemma fn_subset_step_star: ∀ p la p',
    step_star p la p' →
    NameSet.Subset (fn p') (fn p).
  Proof.
    intros; induction H.
    - reflexivity.
    - inverts H; rewrite IHstep_star; eapply fn_subset_step; eauto.
    - rewrite IHstep_star; eapply fn_subset_step; eauto; apply H.
  Qed.

  Lemma fn_in_step_In: ∀ a p p',
    step p (l_in a) p' →
    NameSet.In a (fn_in p).
  Proof.
    intros.
    remember (l_in a) as l.
    revert Heql.
    induction H; simpl; intros; subst; try solve [discriminate|apply NameSet.union_spec; auto].
    apply NameSetProps.Dec.F.add_iff; auto.
    apply NameSetProps.Dec.F.remove_2; auto.
    intro; false.
    simpl in ×.
    edestruct NameSetProps.Dec.F.union_1 as [?|?]; eauto.
  Qed.

  Lemma fn_out_step_In: ∀ a p p',
    step p (l_out a) p' →
    NameSet.In a (fn_out p).
  Proof.
    intros.
    remember (l_out a) as l.
    revert Heql.
    induction H; simpl; intros; subst; try solve [discriminate|apply NameSet.union_spec; auto].
    apply NameSetProps.Dec.F.add_iff; auto.
    apply NameSetProps.Dec.F.remove_2; auto. intro; false.
    simpl in ×.
    edestruct NameSetProps.Dec.F.union_1 as [?|?]; eauto.
  Qed.

  Lemma fn_in_step_star_In: ∀ a p la p',
    step_star p la p' →
    In (l_in a) la →
    NameSet.In a (fn_in p).
  Proof.
    intros.
    revert a H0.
    induction H; intros.
    - intuition.
    - destruct H1 as [?|?]; subst.
    inverts H; eapply fn_in_step_In; eauto.
    inverts H; apply fn_in_subset_step in H2; eauto.
    - apply fn_in_subset_step_star in H0.
    eapply fn_in_subset_step. apply H. eauto.
  Qed.

  Lemma fn_out_step_star_In: ∀ a p la p',
    step_star p la p' →
    In (l_out a) la →
    NameSet.In a (fn_out p).
  Proof.
    intros.
    revert a H0.
    induction H; intros.
    - intuition.
    - destruct H1 as [?|?]; subst.
    inverts H; eapply fn_out_step_In; eauto.
    inverts H; apply fn_out_subset_step in H2; eauto.
    - apply fn_out_subset_step_star in H0.
    eapply fn_out_subset_step. apply H. eauto.
  Qed.

  Lemma fn_step_star_In: ∀ a p la p',
    step_star p la p' →
    (In (l_in a) la ∨ In (l_out a) la) →
    NameSet.In a (fn p).
  Proof.
    intros.
    setoid_rewrite fn_in_out_equiv.
    destruct H0.
    + apply NameSetProps.FM.union_2. eapply fn_in_step_star_In; eauto.
    + apply NameSetProps.FM.union_3. eapply fn_out_step_star_In; eauto.
  Qed.

  Lemma fn_subset_step_star_parL_In: ∀ a p1 p2 la p1' p2',
    step_star (p1||p2) la (p1'||p2') →
    NameSet.In a (fn p2') →
    NameSet.In a (fn p2).
  Proof.
    intros.
    edestruct step_star_par_unzip as [p1''[p2''[la1[la2[?[?[?[??]]]]]]]]; eauto.
    destruct H1 as [?|[?[??]]]; subst.
    inverts H1.
    eapply NameSetProps.in_subset; eauto.
    eapply fn_subset_step_star; eauto.
    discriminate.
  Qed.

  Lemma fn_subset_step_star_parR_In: ∀ a p1 p2 la p1' p2',
    step_star (p1||p2) la (p1'||p2') →
    NameSet.In a (fn p1') →
    NameSet.In a (fn p1).
  Proof.
    intros.
    edestruct step_star_par_unzip as [p1''[p2''[la1[la2[?[?[?[??]]]]]]]]; eauto.
    destruct H1 as [?|[?[??]]]; subst.
    inverts H1.
    eapply NameSetProps.in_subset; eauto.
    eapply fn_subset_step_star; eauto.
    discriminate.
  Qed.

  Lemma fn_in_subset_step_star_parL: ∀ p1 p2 la p1' p2',
    step_star (p1||p2) la (p1'||p2') → NameSet.Subset (fn_in p1') (fn_in p1).
  Proof.
    intros.
    edestruct step_star_par_unzip' as [lp[la1[la2[?[?[??]]]]]]; eauto.
    eapply fn_in_subset_step_star; eauto.
  Qed.
  Lemma fn_in_subset_step_star_parR: ∀ p1 p2 la p1' p2',
    step_star (p1||p2) la (p1'||p2') → NameSet.Subset (fn_in p2') (fn_in p2).
  Proof.
    intros.
    edestruct step_star_par_unzip' as [lp[la1[la2[?[?[??]]]]]]; eauto.
    eapply fn_in_subset_step_star; eauto.
  Qed.

End FreeNameLemmas.

Section HiddenProc.
  Import Notation.
  Import Notation.U.

  Definition hidden_fn A p := ∀ a, NameSet.In a (fn p) → In a A.

  Lemma hidden_fn_seq1: ∀ A p1 p2,
    hidden_fn A (p1;;p2) → hidden_fn A p1.
  Proof. unfold hidden_fn; intros; apply H; apply NameSetProps.Dec.F.union_2; apply H0. Qed.

  Lemma hidden_fn_seq2: ∀ A p1 p2,
    hidden_fn A (p1;;p2) → hidden_fn A p2.
  Proof. unfold hidden_fn; intros; apply H; apply NameSetProps.Dec.F.union_3; apply H0. Qed.

  Lemma hidden_fn_step_star: ∀ A p la p',
    hidden_fn A p → step_star p la p' → hidden_fn A p'.
  Proof. unfold hidden_fn; intros; apply fn_subset_step_star in H0; auto. Qed.

  Lemma hidden_fn_step_star_parR: ∀ A p1 p2 la p1' p2',
    hidden_fn A p1 → step_star (p1||p2) la (p1'||p2') → hidden_fn A p1'.
  Proof. unfold hidden_fn; intros; apply fn_subset_step_star_parR_In with (a:=a) in H0; auto. Qed.

  Lemma hidden_fn_step_star_parL: ∀ A p1 p2 la p1' p2',
    hidden_fn A p2 → step_star (p1||p2) la (p1'||p2') → hidden_fn A p2'.
  Proof. unfold hidden_fn; intros; apply fn_subset_step_star_parL_In with (a:=a) in H0; auto. Qed.

  Lemma hidden_fn_seq3: ∀ A p1 p2,
    hidden_fn A p1 → hidden_fn A p2 → hidden_fn A (p1;; p2).
  Proof. unfold hidden_fn; simpl; intros; edestruct NameSetProps.Dec.F.union_1 as [?|?]; eauto. Qed.

End HiddenProc.

Section ResListFilter.
  Require Import Permutation.

  Definition res_list_filter A la := fold_right (fun a la' ⇒ res_filter a la') la A.

  Lemma res_list_filter_nil2: ∀ A,
    res_list_filter A nil = nil.
  Proof. induction A; simpl; auto; rewrite IHA; reflexivity. Qed.

  Lemma res_filter_app2: ∀ a la1 la2,
    res_filter a (la1++la2) = res_filter a la1 ++ res_filter a la2.
  Proof.
    induction la1; simpl; intros; auto.
    destruct label_eq; subst; eauto.
    destruct label_eq; subst; eauto.
    simpl. congruence.
  Qed.

  Lemma res_filter_In_filter: ∀ a la,
    (∀ l, In l la → (l=l_in a ∨ l=l_out a)) →
    res_filter a la = [].
  Proof.
    induction la; simpl; intros; auto.
    destruct label_eq; subst; auto.
    destruct label_eq; subst; auto.
    false.
    edestruct H as [?|?]; eauto; subst.
  Qed.

  Lemma res_filter_nIn: ∀ a la,
    ¬In (l_in a) la →
    ¬In (l_out a) la →
    res_filter a la = la.
  Proof.
    induction la; simpl; intros; auto.
    destruct label_eq; subst.
    false; apply H; left; auto.
    destruct label_eq; subst.
    false; apply H0; left; auto.
    f_equal; apply IHla.
    intro; apply H; right; auto.
    intro; apply H0; right; auto.
  Qed.

  Lemma res_list_filter_nIn: ∀ A la,
    (∀ a, In (l_in a) la → In a A → False) →
    (∀ a, In (l_out a) la → In a A → False) →
    res_list_filter A la = la.
  Proof.
    induction A; simpl; intros; auto.
    rewrite IHA; intros; eauto.
    apply res_filter_nIn.
    intro; eapply H; eauto.
    intro; eapply H0; eauto.
  Qed.

  Lemma in_res_filter: ∀ a l la,
    In l (res_filter a la) → l≠l_in a ∧ l≠l_out a ∧ In l la.
  Proof.
    induction la; simpl; auto.
    destruct label_eq; [| destruct label_eq]; intros; subst; auto.
    destruct IHla as [?[??]]; auto.
    destruct IHla as [?[??]]; auto.
    destruct H; subst.
    splits; auto.
    destruct IHla as [?[??]]; auto.
  Qed.

  Lemma res_filter_cons2: ∀ a l la,
    res_filter a (l::la) = match l with
      | l_tau ⇒ l::res_filter a la
      | l_in b | l_out b ⇒ if name_eq b a then res_filter b la else l::res_filter a la
      end.
  Proof.
    intros. simpl.
    destruct label_eq; subst.
    destruct name_eq; auto. false.
    destruct label_eq. subst.
    destruct name_eq; auto. false.
    destruct l; auto.
    destruct name_eq; auto; subst. false.
    destruct name_eq; auto; subst. false.
  Qed.

  Lemma res_list_filter_cons2: ∀ l1 l l2,
    res_list_filter l1 (l::l2) = match l with
      | l_tau ⇒ l::res_list_filter l1 l2
      | l_in a | l_out a ⇒ if in_dec name_eq a l1 then res_list_filter l1 l2 else l::res_list_filter l1 l2
      end.
  Proof.
    induction l1; intros; simpl.
    destruct l; reflexivity.
    rewrite IHl1; clear IHl1. simpl.
    destruct l.
    - rewrite res_filter_cons2; auto.
    - destruct name_eq; subst.
    destruct in_dec; auto.
    rewrite res_filter_cons2; auto.
    destruct name_eq; subst; auto; false.
    destruct in_dec; auto.
    rewrite res_filter_cons2; auto.
    destruct name_eq; subst; auto; false.
    - destruct name_eq; subst.
    destruct in_dec; auto.
    rewrite res_filter_cons2; auto.
    destruct name_eq; subst; auto; false.
    destruct in_dec; auto.
    rewrite res_filter_cons2; auto.
    destruct name_eq; subst; auto; false.
  Qed.

  Lemma res_list_filter_app2: ∀ A la1 la2,
    res_list_filter A (la1++la2) = res_list_filter A la1 ++ res_list_filter A la2.
  Proof.
    induction A; simpl; intros; auto.
    rewrite IHA.
    rewrite res_filter_app2; eauto.
  Qed.

  Lemma res_list_filter_cons2': ∀ A l la,
    res_list_filter A (l::la) = res_list_filter A [l] ++ res_list_filter A la.
  Proof. intros; change (l::la) with ([l]++la); apply res_list_filter_app2. Qed.

  Lemma res_filter_cons2': ∀ a l la,
    res_filter a (l::la) = res_filter a [l] ++ res_filter a la.
  Proof. intros; change (l::la) with ([l]++la); apply res_filter_app2. Qed.

  Lemma in_res_list_filter: ∀ l A la,
    In l (res_list_filter A la) →
    (∀ a, In a A → l≠l_in a ∧ l≠l_out a) ∧ In l la.
  Proof.
    induction A; simpl; intros; auto.
    edestruct in_res_filter as [?[??]]; eauto.
    edestruct IHA as [??]; eauto.
    split; auto. intros ? [?|?]; subst; auto.
  Qed.

  Lemma res_filter_comm: ∀ la a1 a2,
    res_filter a1 (res_filter a2 la) = res_filter a2 (res_filter a1 la).
  Proof.
    induction la; intros; auto.
    change (a::la) with ([a]++la).
    repeat rewrite res_filter_app2.
    rewrite IHla.
    f_equal.
    simpl.
    repeat (destruct label_eq; subst; simpl; auto; try congruence).
  Qed.

  Lemma res_list_filter_perm: ∀ A1 A2 la,
    Permutation A1 A2 →
    res_list_filter A1 la = res_list_filter A2 la.
  Proof.
    intros.
    induction H; simpl; auto; try congruence.
    rewrite res_filter_comm; auto.
  Qed.

  Lemma res_list_filter_app: ∀ A1 A2 la,
    res_list_filter (A1++A2) la = res_list_filter A1 (res_list_filter A2 la).
  Proof. induction A1; simpl; intros; auto; congruence. Qed.

  Lemma res_list_filter_rev: ∀ a A la,
    res_list_filter (a::A) la = res_list_filter A (res_filter a la).
  Proof.
    intros.
    change (a::A) with ([a]++A).
    rewrite res_list_filter_perm with (A2:=A++[a]).
    rewrite res_list_filter_app.
    reflexivity.
    apply Permutation_app_comm.
  Qed.

  Lemma res_list_filter_tau: ∀ A,
    res_list_filter A [l_tau] = [l_tau].
  Proof.
    induction A; simpl; intros; auto.
    rewrite IHA; simpl; auto.
    destruct label_eq; auto.
    false.
    destruct label_eq; auto.
    false.
  Qed.

  Lemma res_list_filter_In_filter: ∀ A la,
    ¬In l_tau la →
    (∀ a, In (l_in a) la → In a A) →
    (∀ a, In (l_out a) la → In a A) →
    res_list_filter A la = [].
  Proof.
    induction A; intros; auto.
    - destruct la; auto. false. destruct l.
    eapply H; left; auto.
    eapply (H0 n); left; eauto.
    eapply (H1 n); left; eauto.
    - rewrite res_list_filter_rev.
    rewrite IHA; intros; auto.
    intro. apply in_res_filter in H2. destruct H2 as [?[??]]; contradiction.
    edestruct in_res_filter as [?[??]]; eauto.
    destruct (H0 a0) as [?|?]; subst; auto.
    false.
    edestruct in_res_filter as [?[??]]; eauto.
    destruct (H1 a0) as [?|?]; subst; auto.
    false.
  Qed.

  Lemma res_list_filter_interleaving_fn2: ∀ lp A la2a la2b,
    ¬In l_tau la2a →
    ¬In l_tau la2b →
    (∀ a, In (l_in a) la2b → In a A) →
    (∀ a, In (l_out a) la2b → In a A) →
    res_list_filter A (interleaving lp la2a la2b) = res_list_filter A la2a.
  Proof.
    induction lp; intros.
    - simpl.
    rewrite res_list_filter_app2.
    rewrite (res_list_filter_In_filter A la2b); auto.
    apply app_nil_r.
    - destruct a; destruct u.
    destruct la2a.
    simpl. rewrite res_list_filter_In_filter; auto. rewrite res_list_filter_nil2; auto.
    simpl. rewrite res_list_filter_cons2'.
    pattern (res_list_filter A (l::la2a)).
    rewrite res_list_filter_cons2'.
    f_equal.
    eauto.
    eapply IHlp; eauto.
    intro; apply H; right; auto.
    destruct la2b.
    rewrite interleaving_r_nil; reflexivity.
    simpl. rewrite res_list_filter_cons2'.
    rewrite (res_list_filter_In_filter A [l]); simpl; intros.
    eapply IHlp; intros; eauto.
    intro; apply H0; right; auto.
    apply H1; right; auto.
    apply H2; right; auto.
    intuition; subst. apply H0; left; auto.
    intuition; subst. apply H1; left; auto.
    intuition; subst. apply H2; left; auto.
  Qed.

  Lemma res_list_filter_single_inv: ∀ A l,
    (res_list_filter A [l] = [l] ∧ (∀ a, In a A → l≠l_in a ∧ l≠l_out a))
    ∨ (res_list_filter A [l] = [] ∧ ∃ a, In a A ∧ (l=l_in a∨l=l_out a)).
  Proof.
    induction A; intros; auto.
    rewrite res_list_filter_cons2.
    rewrite res_list_filter_nil2.
    destruct l.
    left; intuition; false.
    destruct in_dec. right; eauto.
    left; intuition; inverts H0; auto.
    destruct in_dec. right; eauto.
    left; intuition; inverts H0; auto.
  Qed.

  Lemma res_list_filter_count_occ: ∀ A la l,
    (∀ a, In a A → l≠l_in a ∧ l≠l_out a) →
    count_occ label_eq (res_list_filter A la) l = count_occ label_eq la l.
  Proof.
    induction la; simpl; intros; auto.
    rewrite res_list_filter_nil2. reflexivity.
    rewrite res_list_filter_cons2.
    destruct label_eq. subst a.
    destruct l; simpl.
    destruct label_eq; [| false].
    f_equal; auto.
    destruct in_dec.
    apply H in i; destruct i; false.
    simpl.
    destruct label_eq.
    f_equal; auto.
    false.
    destruct in_dec.
    apply H in i; destruct i; false.
    simpl.
    destruct label_eq.
    f_equal; auto.
    false.
    destruct a.
    simpl.
    destruct label_eq; [false |]; auto.
    destruct in_dec; auto. simpl. destruct label_eq; auto; false.
    destruct in_dec; auto. simpl. destruct label_eq; auto; false.
  Qed.

  Lemma res_list_filter_interleaving: ∀ A lp la1 la2,
    ∃ lp',
    res_list_filter A (interleaving lp la1 la2) = interleaving lp' (res_list_filter A la1) (res_list_filter A la2).
  Proof.
    induction lp; simpl; intros.
    × ∃ (@nil (unit+unit)); rewrite res_list_filter_app2; reflexivity.
    × destruct a; destruct u.
    + destruct la1.
    - ∃ (@nil (unit+unit)). rewrite res_list_filter_nil2. rewrite interleaving_l_nil. reflexivity.
    - rewrite res_list_filter_cons2'.
    rewrite (res_list_filter_cons2' _ _ la1).
    destruct (IHlp la1 la2) as [lp' ?]; clear IHlp.
    destruct (res_list_filter_single_inv A l) as [[??]|[??]].
    rewrite H0.
    ∃ (inl tt::lp'); simpl. f_equal; auto.
    rewrite H0.
    ∃ lp'; simpl. auto.
    + destruct la2.
    - ∃ (@nil (unit+unit)). rewrite res_list_filter_nil2. rewrite interleaving_r_nil. reflexivity.
    - rewrite res_list_filter_cons2'.
    rewrite (res_list_filter_cons2' _ _ la2).
    destruct (IHlp la1 la2) as [lp' ?]; clear IHlp.
    destruct (res_list_filter_single_inv A l) as [[??]|[??]].
    rewrite H0.
    ∃ (inr tt::lp'); simpl. f_equal; auto.
    rewrite H0.
    ∃ lp'; simpl. auto.
  Qed.

End ResListFilter.

Section ResCountLabels.
  Import Notation.
  Import Notation.U.

  Lemma res_count_labels_app2: ∀ a la1 n la2 n',
    res_count_labels a n (la1++la2) n' = true →
    ∃ n'0,
      res_count_labels a n la1 n'0 = true ∧
      res_count_labels a n'0 la2 n' = true.
  Proof.
    induction la1; intros.
    ∃ n; simpl; split; auto. destruct eq_nat_dec; congruence.
    destruct a0; simpl in ×.
    - eauto.
    - destruct (name_eq n0 a). subst n0. destruct n. false.
    edestruct IHla1 as [n'0[??]]; clear IHla1; eauto.
    edestruct IHla1 as [n'0[??]]; clear IHla1; eauto.
    - destruct (name_eq n0 a). subst n0.
    edestruct IHla1 as [n'0[??]]; clear IHla1; eauto.
    edestruct IHla1 as [n'0[??]]; clear IHla1; eauto.
  Qed.

  Lemma res_count_labels_app2': ∀ a la1 n la2 n' n'0,
    res_count_labels a n la1 n'0 = true →
    res_count_labels a n'0 la2 n' = true →
    res_count_labels a n (la1++la2) n' = true.
  Proof.
    induction la1; simpl; intros.
    destruct (eq_nat_dec n'0 n); subst; auto. false.
    destruct a0. eauto.
    destruct name_eq; subst; eauto.
    destruct n; eauto.
    destruct name_eq; subst; eauto.
  Qed.

  Lemma res_count_labels_nil2: ∀ a n n',
    res_count_labels a n nil n' = true → n'=n.
  Proof. unfold res_count_labels; intros; destruct eq_nat_dec; auto; false. Qed.

  Lemma res_count_labels_nil2': ∀ a n,
    res_count_labels a n nil n = true.
  Proof. unfold res_count_labels; intros; destruct eq_nat_dec; auto. Qed.

  Lemma res_count_labels_cons_com: ∀ a n l1 l2 la n',
    res_count_labels a n (l1::l2::la) n' = true →
    (l2=l_in a → n>0) →
    res_count_labels a n (l2::l1::la) n' = true.
  Proof.
    unfold res_count_labels; introv Hres Hin; intros.
    destruct l1; destruct l2; auto; destruct name_eq; subst; auto; destruct n; auto; try discriminate.
    destruct name_eq; subst; auto.
    false; specialize (Hin (refl_equal _)); omega.
  Qed.

  Lemma res_count_labels_nIn: ∀ a n la n',
    res_count_labels a n la n' = true →
    ¬In (l_in a) la →
    ¬In (l_out a) la →
    n' = n.
  Proof.
    induction la; simpl; intros; auto.
    destruct eq_nat_dec; subst; auto; false.
    destruct a0.
    eapply IHla; intros; auto.
    destruct name_eq; subst; auto.
    destruct name_eq; subst; auto.
  Qed.

  Lemma res_count_labels_nIn': ∀ la a n n',
    res_count_labels a n la n' = true →
    ¬In (a?)%label la →
    n' = (n + count_occ label_eq la (l_out a))%nat.
  Proof.
    induction la; simpl; intros.
    destruct eq_nat_dec; subst; auto; false.
    apply Decidable.not_or in H0.
    destruct H0.
    destruct a.
    × eapply IHla in H; eauto. subst n'.
    destruct label_eq; auto. false.
    × destruct name_eq; subst.
    false.
    destruct label_eq; auto. false.
    × destruct name_eq; subst; destruct label_eq; auto.
    eapply IHla in H; auto.
    omega.
    inverts e. false.
  Qed.

  Lemma res_count_labels_incr: ∀ a la n n' d,
    res_count_labels a n la n' = true →
    res_count_labels a (d+n) la (d+n') = true.
  Proof.
    induction la; simpl; intros; auto.
    destruct eq_nat_dec; subst.
    destruct eq_nat_dec; subst; auto. false.
    destruct a0. auto.
    destruct name_eq; subst; auto.
    destruct n. false.
    replace (d+ S n)%nat with (S (d+n))%nat; try omega.
    auto.
    destruct name_eq; subst; auto.
    replace (S (d+n))%nat with (d + (S n))%nat; try omega.
    auto.
  Qed.

  Lemma res_count_labels_nIn'': ∀ a n la n',
    ¬In (l_in a) la →
    (n' = n + count_occ label_eq la (l_out a))%nat →
    res_count_labels a n la n' = true.
  Proof.
    induction la; simpl; intros; auto.
    replace n' with n in *; try omega.
    destruct eq_nat_dec; auto; false.
    apply Decidable.not_or in H. destruct H.
    destruct label_eq; subst.
    destruct name_eq; auto.
    change (S n) with (1+n)%nat.
    replace (n + S (count_occ label_eq la (l_out a)))%nat with (1+(n + count_occ label_eq la (l_out a)))%nat; try omega.
    apply res_count_labels_incr.
    apply IHla; auto.
    destruct a0; auto.
    destruct name_eq; subst; auto.
    destruct name_eq; subst; auto.
  Qed.

  Lemma res_count_labels_le_com: ∀ la1 a n l n' n0 n0',
    res_count_labels a n [l] n' = true →
    res_count_labels a n0 la1 n0' = true →
    (∀ a : name, In (a?)%label la1 → l ≠ (a?)%label) →
    n0 ≤ n →
    ∃ n00 n00',
    n00 ≤ n' ∧ res_count_labels a n00 la1 n00' = true.
  Proof.
    intros.
    destruct (label_eq l (l_in a)); subst.
    × specialize (H1 a).
    simpl in H. destruct name_eq; [| false]. destruct n; [false |].
    destruct eq_nat_dec; [subst|false].
    ∃ 0 (0 + count_occ label_eq la1 (l_out a))%nat; split.
    omega.
    apply res_count_labels_nIn''; auto.
    intro; eapply H1; auto.
    × destruct l; simpl in H.
    + destruct eq_nat_dec; [subst|false]. ∃ n0 n0'; split; auto.
    + destruct name_eq; subst. false.
    destruct eq_nat_dec; [subst|false].
    ∃ n0 n0'; split; auto.
    + destruct name_eq; subst.
    destruct eq_nat_dec; [subst|false].
    ∃ n0 n0'; split; auto.
    destruct eq_nat_dec; [subst|false].
    ∃ n0 n0'; split; auto.
  Qed.

  Lemma res_count_labels_nIn''': ∀ a n la,
    ¬In (l_in a) la → ¬In (l_out a) la →
    res_count_labels a n la n = true.
  Proof.
    induction la; simpl; intros.
    destruct eq_nat_dec; auto.
    apply Decidable.not_or in H; apply Decidable.not_or in H0.
    destruct H; destruct H0.
    destruct a0; auto; destruct name_eq; subst; auto.
  Qed.

  Lemma res_count_labels_fun: ∀ a la n n1 n2,
    res_count_labels a n la n1 = true →
    res_count_labels a n la n2 = true →
    n2 = n1.
  Proof.
    induction la; simpl; intros.
    destruct eq_nat_dec; destruct eq_nat_dec; subst; auto; false.
    destruct a0; eauto.
    destruct name_eq; subst; eauto; destruct n; [false | eauto].
    destruct name_eq; subst; eauto.
  Qed.

  Lemma res_count_labels_exists_min: ∀ a la n n',
    res_count_labels a n la n' = true →
    ∃ n0 n0',
      res_count_labels a n0 la n0' = true ∧
      (∀ n n', res_count_labels a n la n' = true → ∃ d, n=n0+d ∧ n'=n0'+d)%nat.
  Proof.
    induction la; simpl in *; intros.
    × destruct eq_nat_dec; subst; [| false].
    ∃ 0 0; split; intros.
    destruct eq_nat_dec; auto.
    destruct eq_nat_dec; subst; [| false].
    ∃ n0; split; omega.
    × destruct a0; eauto.
    + destruct name_eq; subst; eauto.
    destruct n; [false |].
    edestruct IHla as [n0[n0'[??]]]; clear IHla; eauto.
    ∃ (S n0) n0'; simpl; split; auto.
    intros n1 n1'. intros.
    destruct n1; [false |].
    apply H1 in H2; destruct H2 as [d[??]].
    subst.
    ∃ d; split; auto.
    + destruct name_eq; subst; eauto.
    edestruct IHla as [n0[n0'[??]]]; clear IHla; eauto.
    destruct n0.
    - ∃ 0 (1+n0')%nat; split; intros; auto.
    change 1 with (1+0)%nat.
    apply res_count_labels_incr; auto.
    ∃ n0; split; auto.
    apply H1 in H2; destruct H2 as [d[??]].
    simpl in ×. subst.
    omega.
    - ∃ n0 n0'; split; auto.
    intros n1 n1'; intros.
    apply H1 in H2; destruct H2 as [d[??]].
    inverts H2. subst.
    ∃ d; split; auto.
  Qed.

  Lemma res_count_labels_positive_app_com2: ∀ la1 a n l la2 n' n0 n0',
    res_count_labels a n (l::la1++la2) n' = true →
    (∀ a, In (l_in a) la1 → l≠l_in a ∧ ¬In (l_in a) la2) →
    res_count_labels a n0 la1 n0' = true →
    n0 ≤ n →
    res_count_labels a n (la1 ++ l::la2) n' = true.
  Proof.
    induction la1; intros; auto.
    change (l::(a::la1)++la2) with (l::a::la1++la2) in H.
    apply res_count_labels_cons_com in H; auto.
    × change (a::l::la1++la2) with ([a]++(l::la1++la2)) in H.
    apply res_count_labels_app2 in H.
    destruct H as [n'0[??]].
    change ((a::la1)++l::la2) with ([a]++(la1++l::la2)).
    eapply res_count_labels_app2'.
    apply H.
    change (a::la1) with ([a]++la1) in H1.
    apply res_count_labels_app2 in H1.
    destruct H1 as [n0'0[??]].
    apply IHla1 with (n0:=n0'0) (n0':=n0'); clear IHla1; auto.
    intros. apply H0; auto. right; auto.
    destruct (NPeano.Nat.le_exists_sub _ _ H2) as [d[? _]]; subst.
    apply res_count_labels_incr with (d:=d) in H1.
    generalize (res_count_labels_fun _ _ _ _ _ H1 H); intros; subst.
    omega.
    × clear IHla1. intros. subst a.
    destruct (H0 a0) as [??]; auto; clear H0.
    left; auto.
    simpl in ×.
    destruct name_eq; [| false].
    destruct n0; [false |].
    omega.
  Qed.

  Lemma res_count_labels_interleaving1: ∀ a lp n0 n0' n la1 la2 n',
    res_count_labels a n (interleaving lp la1 la2) n' = true →
    (∀ a, In (l_in a) la1 → In (l_in a) la2 → False) →
    res_count_labels a n0 la1 n0' = true →
    n0 ≤ n →
    res_count_labels a n (la1++la2) n' = true.
  Proof.
    induction lp; simpl; intros; auto.
    destruct a0; destruct u.
    × destruct la1; auto.
    change (l::interleaving lp la1 la2) with ([l]++interleaving lp la1 la2) in H.
    apply res_count_labels_app2 in H.
    destruct H as [n'0[??]].
    change ((l::la1)++la2) with ([l]++(la1++la2)).
    eapply res_count_labels_app2'; eauto.
    destruct la2.
    + rewrite app_nil_r.
    rewrite interleaving_r_nil in H3. auto.
    + change (l::la1) with ([l]++la1) in H1.
    apply res_count_labels_app2 in H1.
    destruct H1 as [n0'0[??]].
    eapply IHlp with (n0:=n0'0) (n0':=n0'); clear IHlp; intros; auto.
    apply (H0 a0); auto. right; auto.
    simpl in ×.
    destruct l.
    - destruct eq_nat_dec; destruct eq_nat_dec; subst; try solve [false|auto].
    - destruct name_eq; subst.
    destruct n0; [false|]. destruct n; [false |].
    destruct eq_nat_dec; destruct eq_nat_dec; subst; try solve [false|auto].
    omega.
    destruct eq_nat_dec; destruct eq_nat_dec; subst; try solve [false|auto].
    - destruct name_eq; subst.
    destruct eq_nat_dec; destruct eq_nat_dec; subst; try solve [false|auto].
    omega.
    destruct eq_nat_dec; destruct eq_nat_dec; subst; try solve [false|auto].
    × destruct la2.
    + rewrite app_nil_r. auto.
    + change (l::interleaving lp la1 la2) with ([l]++interleaving lp la1 la2) in H.
    apply res_count_labels_app2 in H.
    destruct H as [n'0[??]].
    eapply res_count_labels_positive_app_com2; eauto.
    change (l::la1++la2) with ([l]++la1++la2).
    apply res_count_labels_app2' with n'0; auto.
    apply res_count_labels_le_com with (n0:=n0) (n0':=n0') (la1:=la1) in H; auto.
    destruct H as [n00[n00'[??]]].
    eapply IHlp with (n0:=n00) (n0':=n00'); clear IHlp; eauto.
    intros. eapply H0; eauto. right; auto.
    intros. intro; subst; apply (H0 a0); auto. left; auto.
    intros; split; intro; subst. apply (H0 a0); auto. left; auto. apply (H0 a0); auto. right; auto.
  Qed.

  Lemma res_count_labels_com: ∀ a la1 n n1' la2 n2',
    res_count_labels a n la1 n1' = true →
    res_count_labels a n la2 n2' = true →
    (∀ a, In (l_in a) la1 → In (l_in a) la2 → False) →
    ∃ n''',
      res_count_labels a n2' la1 n''' = true ∧ res_count_labels a n1' la2 n''' = true.
  Proof.
    intros.
    destruct (in_dec label_eq (l_in a) la1).
    × assert (¬In (l_in a) la2) by (intro; apply (H1 a); auto).
    generalize (res_count_labels_nIn' _ _ _ _ H0 H2); intros.
    subst n2'.
    ∃ (n1'+count_occ label_eq la2 (l_out a))%nat; split.
    rewrite (plus_comm n).
    rewrite (plus_comm n1').
    apply res_count_labels_incr; auto.
    assert (res_count_labels a n (la2++la1) (n1'+count_occ label_eq la2 (l_out a)) = true).
      apply res_count_labels_app2' with (n+count_occ label_eq la2 (l_out a))%nat; auto.
      rewrite (plus_comm n); rewrite (plus_comm n1').
      apply res_count_labels_incr; auto.
    rewrite<- interleaving_app in H3.
    apply res_count_labels_nIn''; auto.
    × apply res_count_labels_nIn' in H; auto. subst.
    ∃ (n2'+count_occ label_eq la1 (l_out a))%nat; split.
    apply res_count_labels_nIn''; auto.
    rewrite (plus_comm n).
    rewrite (plus_comm n2').
    apply res_count_labels_incr; auto.
  Qed.

End ResCountLabels.

Section ResList.
  Import Notation.
  Import Notation.U.

  Definition p_res_list AN p:= fold_right (fun an p' ⇒ let '(a,n):=an in a#n:p')%proc p AN.

  Lemma p_res_list_nil: ∀ AN p,
    p_res_list AN p = p_nil → p=p_nil.
  Proof.
    induction AN; intros; simpl in *; auto.
    destruct a. congruence.
  Qed.

  Lemma s_res_list: ∀ AN p l p',
    (∀ a, l = l_in a → ¬In a (fst (split AN))) →
    (∀ a, l = l_out a → ¬In a (fst (split AN))) →
    step p l p' →
    step (p_res_list AN p) l (p_res_list AN p').
  Proof.
    induction AN; intros; auto.
    destruct a. simpl.
    apply s_res.
    apply IHAN; eauto.
    intros; subst; intro; eapply H; eauto. simpl. destruct (split AN); simpl in *; auto.
    intros; subst; intro; eapply H0; eauto. simpl. destruct (split AN); simpl in *; auto.
    intro. subst. eapply H; eauto. simpl. destruct (split AN); simpl; auto.
    intro. subst. eapply H0; eauto. simpl. destruct (split AN); simpl; auto.
  Qed.

  Lemma p_res_list_app: ∀ p AN AN',
    p_res_list (AN++AN') p = p_res_list AN (p_res_list AN' p).
  Proof. induction AN; intros; auto; destruct a as [a n]; simpl; congruence. Qed.

  Lemma fn_In_res_list1: ∀ a AN p,
    NameSet.In a (fn (p_res_list AN p)) → NameSet.In a (fn p) ∧ ¬In a (fst (split AN)).
  Proof.
    induction AN; simpl; intros; auto.
    destruct a0. simpl in H.
    destruct (IHAN p) as [??].
    eapply NameSetProps.Dec.F.remove_3; eauto.
    split; auto.
    rewrite fst_split.
    apply NameSetProps.Dec.F.remove_iff in H.
    destruct H.
    intros [?|?]; subst; false.
  Qed.

  Lemma fn_p_res_list: ∀ AN p,
    NameSet.Equal (fn (p_res_list AN p)) (NameSet.diff (fn p) (fold_right (fun a ns ⇒ NameSet.add a ns) NameSet.empty (fst (split AN)))).
  Proof.
    intros.
    revert p.
    induction AN; intros; simpl; try reflexivity.
    rewrite NameSetProps.empty_diff_2; auto. reflexivity.
    destruct a. simpl in ×.
    rewrite<- (split_combine' AN) at 2.
    rewrite combine_split.
    simpl.
    setoid_rewrite NameSet_diff_add.
    rewrite<- IHAN.
    reflexivity.
    rewrite split_length_l. rewrite split_length_r.
    reflexivity.
  Qed.

  Lemma step_star_hidden: ∀ AN p la p',
    step_star (p_res_list AN p) la p' →
    hidden_fn (fst (split AN)) p →
    la = [].
  Proof.
    unfold hidden_fn; intros.
    destruct la; auto. false.
    destruct l.
    eapply step_star_l_tau_nIn; eauto. left; auto.
    apply fn_step_star_In with (a:=n) in H; eauto.
    apply fn_In_res_list1 in H.
    destruct H.
    apply H1; apply H0; auto.
    left; left; auto.
    apply fn_step_star_In with (a:=n) in H; eauto.
    apply fn_In_res_list1 in H.
    destruct H.
    apply H1; apply H0; auto.
    right; left; auto.
  Qed.

  Lemma p_res_list_inv: ∀ AN1 p1 AN2 p2,
    p_res_list AN1 p1 = p_res_list AN2 p2 →
    ∃ AN,
      (p1 = p_res_list AN p2 ∧ AN2 = AN1++AN) ∨
      (p2 = p_res_list AN p1 ∧ AN1 = AN2++AN).
  Proof.
    intros.
    revert p1 p2 AN2 H.
    induction AN1; intros; destruct AN2; simpl in *; subst.
    - ∃ (@nil (name×nat)); simpl; auto.
    - destruct p. eexists; left; split; auto; simpl; auto.
    - destruct a. eexists; right; split; auto; simpl; auto.
    - destruct a; destruct p. inverts H.
    edestruct IHAN1 as [AN[[??]|[??]]]; eauto.
    + subst. eexists; left; split; auto; simpl; auto.
    + subst. eexists; right; split; auto; simpl; auto.
  Qed.

  Lemma p_res_list_inv': ∀ AN1 p1 AN2 p2,
    p_res_list AN1 p1 = p_res_list AN2 p2 →
    length AN2 = length AN1 →
    p2=p1 ∧ AN2 = AN1.
  Proof.
    intros; edestruct p_res_list_inv as [AN ?]; eauto;
      destruct H1 as [[??]|[??]]; subst; rewrite app_length in H0; (destruct AN; simpl in *; [| false;omega]);
      rewrite app_nil_r; auto.
  Qed.

  Lemma step_star_res_list_nil: ∀ AN,
    step_star (p_res_list AN p_nil) nil p_nil.
  Proof.
    induction AN; simpl; intros.
    apply @step_nil.
    destruct a.
    eapply step_tsnoc.
    eapply step_star_res.
    apply IHAN.
    reflexivity.
    apply res_count_labels_nil2'.
    apply s_res_nil.
  Qed.

  Lemma step_star_res_list_nIn: ∀ A N p la p',
    step_star p la p' →
    (∀ l a, In l la → In a A → l≠l_in a ∧ l≠l_out a) →
    step_star (p_res_list (combine A N) p) la (p_res_list (combine A N) p').
  Proof.
    induction A; intros; simpl in *; auto.
    destruct N; simpl in *; auto.
    eapply step_star_res_nIn; eauto.
  Qed.

  Lemma p_res_list_eq: ∀ AN1 p1 AN2 p2,
    (∀ a n p, p1 ≠ p_res a n p ∧ p2 ≠ p_res a n p) →
    p_res_list AN1 p1 = p_res_list AN2 p2 → AN2=AN1 ∧ p2=p1.
  Proof.
    induction AN1; intros; auto.
    destruct AN2; simpl in *; auto.
    destruct p; subst.
    false; edestruct H as [? _]. apply H0; reflexivity.
    destruct AN2; simpl in ×.
    destruct a. subst.
    false; edestruct H as [_ ?]. apply H0; reflexivity.
    destruct a; destruct p.
    inverts H0.
    edestruct IHAN1 as [??]; eauto; subst AN2 p2.
    auto.
  Qed.

  Lemma step_res_list_par_seq_app: ∀ p3 p4 AN p1 p2 l AN' p1' p2',
    step (p_res_list AN (p1||p2)) l (p_res_list AN' (p1'||p2')) →
    step (p_res_list AN (p1;;p3||p2;;p4)) l (p_res_list AN' (p1';;p3||p2';;p4)).
  Proof.
    induction AN; intros; simpl in ×.
    × destruct AN'; simpl in ×. inverts H.
    apply s_parL; apply s_seq; auto.
    apply s_parR; apply s_seq; auto.
    destruct p. inverts H.
    × destruct a. destruct AN'; simpl in ×. false; inverts H.
    destruct p. inverts H.
    apply s_res; auto.
    apply s_res_count_in; auto.
    apply s_res_count_out; auto.
  Qed.

End ResList.

Section ResListCountLabels.
  Import Notation.
  Import Notation.U.

  Fixpoint res_list_count_labels A N la N' := match A, N, N' with
  | a::A, n::N, n'::N' ⇒ res_count_labels a n (res_list_filter A la) n' && res_list_count_labels A N la N'
  | nil, nil, nil ⇒ true
  | _, _, _ ⇒ false
  end.

  Definition res_list_count_labels_min A N la N':=
    res_list_count_labels A N la N' = true ∧
    ∀ N0 N0', res_list_count_labels A N0 la N0' = true → ∃ D, length D = length A ∧ N0 = list_plus N D ∧ N0' = list_plus N' D.

  Definition step_res_list_label_wf (A: list name) l l' :=
    ((∃ a, In a A ∧ l=l_tau ∧ (l'=l_in a ∨ l'=l_out a)) ∨ (l'=l ∧ ∀ a, In a A → l'≠l_in a ∧ l'≠l_out a)).

  Lemma res_list_count_labels_length: ∀ A N la N',
    res_list_count_labels A N la N' = true →
    length N = length A ∧ length N' = length A.
  Proof.
    induction A; destruct N; destruct N'; simpl; intros; try solve [false]; auto.
    apply andb_true_iff in H; destruct H as [??].
    apply IHA in H0.
    destruct H0; split; congruence.
  Qed.

  Lemma res_list_count_labels_app: ∀ A1 A2 N1 N2 la N1' N2',
    length N1 = length A1 → length N1' = length A1 →
    res_list_count_labels (A1++A2) (N1++N2) la (N1'++N2')
    = res_list_count_labels A2 N2 la N2' && res_list_count_labels A1 N1 (res_list_filter A2 la) N1'.
  Proof.
    induction A1; intros.
    - simpl.
    destruct N1. destruct N1'.
    rewrite andb_true_r; reflexivity.
    false; simpl in *; omega.
    false; simpl in *; omega.
    - destruct N1.
    false; simpl in *; omega.
    destruct N1'.
    false; simpl in *; omega.
    simpl in ×.
    rewrite IHA1; auto.
    repeat rewrite andb_assoc.
    f_equal.
    rewrite andb_comm.
    f_equal.
    rewrite res_list_filter_app; reflexivity.
  Qed.

  Lemma res_list_count_labels_app2: ∀ A N la1 la2 N',
    res_list_count_labels A N (la1++la2) N' = true →
    ∃ N'0,
      res_list_count_labels A N la1 N'0 = true ∧ res_list_count_labels A N'0 la2 N' = true.
  Proof.
    induction A; destruct N; destruct N'; simpl; intros; try solve [false].
    - ∃ (@nil nat); split; auto.
    - apply andb_true_iff in H. destruct H as [??].
    edestruct IHA as [N'0[??]]; eauto.
    rewrite res_list_filter_app2 in H.
    edestruct res_count_labels_app2 as [n'0[??]]; eauto.
    ∃ (n'0::N'0); splits; auto.
    apply andb_true_iff; split; auto.
    apply andb_true_iff; split; auto.
  Qed.

  Lemma res_list_count_labels_app2': ∀ A N la1 la2 N' N'0,
    res_list_count_labels A N la1 N'0 = true →
    res_list_count_labels A N'0 la2 N' = true →
    res_list_count_labels A N (la1++la2) N' = true.
  Proof.
    induction A; destruct N; destruct N'0; destruct N'; simpl; intros; try solve [false]; auto.
    apply andb_true_iff in H.
    apply andb_true_iff in H0.
    destruct H; destruct H0.
    apply andb_true_iff.
    rewrite res_list_filter_app2.
    rewrite IHA with (N'0:=N'0); auto.
    split; auto.
    rewrite res_count_labels_app2' with (n'0:=n0); auto.
  Qed.

  Lemma res_list_count_labels_nil2: ∀ A N,
    length N = length A →
    res_list_count_labels A N nil N = true.
  Proof.
    induction A; destruct N; simpl; intros; auto; try solve [false].
    rewrite res_list_filter_nil2.
    apply andb_true_iff.
    split; auto.
    apply res_count_labels_nil2'.
  Qed.

  Lemma res_list_count_labels_single: ∀ A N l N',
    res_list_count_labels A N [l] N' = true →
    (∃ A1 a A2 N1 n N2 n',
      A = A1++[a]++A2 ∧ N = N1++[n]++N2 ∧ N' = N1++[n']++N2 ∧
      length N1 = length A1 ∧ ¬In a A2 ∧
      ((l=l_in a ∧ n=S n') ∨ (l=l_out a ∧ S n = n'))) ∨
    (N'=N ∧ ∀ a, In a A → l≠l_in a ∧ l≠l_out a).
  Proof.
    induction A; destruct N; destruct N'; intros; simpl in *; try solve [false; omega].
    - right; split; eauto.
    - apply andb_true_iff in H. destruct H as [??].
    edestruct IHA as [ [A1[b[A2[N1[n'[N2[n''[?[?[?[?[??]]]]]]]]]]]] | [??] ]; clear IHA; eauto.
    + subst. repeat rewrite app_length in ×. simpl in ×.
    rewrite res_list_filter_app in H.
    change (b::A2) with ([b]++A2) in H; rewrite res_list_filter_app in H.
    rewrite res_list_filter_cons2 in H. rewrite res_list_filter_nil2 in H.
    simpl in H.
    destruct H6 as [[??]|[??]]; subst.
    simpl in ×.
    destruct (in_dec name_eq b A2); simpl in *; [false |].
    destruct (label_eq (l_in b) (l_in b)); [| false].
    rewrite res_list_filter_nil2 in H. simpl in H.
    destruct (eq_nat_dec n0 n); try discriminate. subst n0.
    left; ∃ (a::A1) b A2 (n::N1); ∃ (S n'') N2 n''; splits; auto.
    simpl; congruence.
    destruct (in_dec name_eq b A2); simpl in *; [false |].
    destruct (label_eq (l_out b) (l_in b)); [false |].
    destruct (label_eq (l_out b) (l_out b)); [| false].
    rewrite res_list_filter_nil2 in H. simpl in H.
    destruct (eq_nat_dec n0 n); try discriminate. subst n0.
    left; ∃ (a::A1) b A2 (n::N1); ∃ n' N2 (S n'); splits; auto.
    simpl; congruence.
    + subst. repeat rewrite app_length in ×.
    rewrite res_list_filter_cons2 in H. rewrite res_list_filter_nil2 in ×.
    destruct l; simpl in ×.
    destruct (eq_nat_dec n0 n); try discriminate.
    subst n0.
    right; split; intros; auto.
    destruct H1; subst; auto. split; intro; discriminate.
    destruct (in_dec name_eq n1 A). simpl in H.
    destruct (eq_nat_dec n0 n); try discriminate. subst n0.
    apply H2 in i.
    destruct i; false.
    simpl in H.
    destruct (name_eq n1 a). subst n1.
    destruct n; try discriminate.
    destruct (eq_nat_dec n0 n); try discriminate. subst n0.
    left; ∃ (@nil name) a A (@nil nat) (S n); ∃ N n; splits; auto.
    destruct (eq_nat_dec n0 n); try discriminate. subst n0.
    right; split; intros; auto. destruct H1; subst. split; intro; subst; false. split; intro; false.
    destruct (in_dec name_eq n1 A).
    apply H2 in i. destruct i; false.
    simpl in H. destruct (name_eq n1 a). subst; auto.
    destruct (eq_nat_dec n0 (S n)); subst.
    left; ∃ (@nil name) a A (@nil nat) n; ∃ N (S n); splits; auto.
    false.
    destruct (eq_nat_dec n0 n); try discriminate. subst n0.
    right; split; intros; auto. destruct H1; subst. split; intro; false. split; intro; false.
  Qed.

  Lemma res_list_count_labels_nil2': ∀ A N N',
    res_list_count_labels A N nil N' = true →
    N' = N.
  Proof.
    induction A; destruct N; destruct N'; simpl; intros; try solve [false; omega]; auto.
    apply andb_true_iff in H. destruct H.
    rewrite res_list_filter_nil2 in H. simpl in H. destruct (eq_nat_dec n0 n); try discriminate. subst n0.
    f_equal; auto.
  Qed.

  Lemma res_list_count_labels_nIn: ∀ A N la N',
    res_list_count_labels A N la N' = true →
    (∀ a, In a A → ¬In (l_in a) la ∧ ¬In (l_out a) la) →
    N'=N.
  Proof.
    induction A; destruct N; destruct N'; simpl; intros; auto; try solve [false].
    apply andb_true_iff in H; destruct H as [??].
    lapply (H0 a); intros; auto. destruct H2 as [??].
    rewrite res_list_filter_nIn in H; intros.
    apply res_count_labels_nIn in H; auto.
    subst n0; f_equal; eauto.
    destruct (H0 a0) as [? _]; auto; contradiction.
    destruct (H0 a0) as [_ ?]; auto; contradiction.
  Qed.

  Lemma res_list_count_labels_single': ∀ A1 a A2 N1 n N2 l N1' n' N2',
    res_list_count_labels (A1++a::A2) (N1++n::N2) [l] (N1'++n'::N2') = true →
    length N1 = length A1 →
    length N1' = length A1 →
    ¬In a A2 →
    (l=l_in a → S n' = n ∧ N1'=N1 ∧ N2'=N2) ∧ (l=l_out a → n' = S n ∧ N1'=N1 ∧ N2'=N2) ∧ (l=l_tau → n'=n ∧ N1'=N1 ∧ N2'=N2).
  Proof.
    intros.
    cut (∀ {A:Type} (a:A) l, a::l =[a]++l); intros Hcons; auto.
    rewrite (Hcons _ a) in H.
    rewrite (Hcons _ n) in H.
    rewrite (Hcons _ n') in H.
    clear Hcons.
    rewrite res_list_count_labels_app in H; auto.
    rewrite res_list_count_labels_app in H; auto.
    apply andb_true_iff in H; destruct H as [? ?].
    apply andb_true_iff in H; destruct H as [? ?].
    splits; intros; subst.
    × rewrite res_list_filter_nIn in H4.
    rewrite res_list_filter_In_filter in H3.
    apply res_list_count_labels_nil2' in H3; auto. subst.
    simpl in ×. destruct name_eq. destruct n. false.
    destruct eq_nat_dec; subst; auto.
    splits; auto.
    intros.
    apply res_list_count_labels_nIn in H; auto.
    intros. split; intro H7; destruct H7; subst; false.
    false. false.
    intro H7; destruct H7; false.
    intros ? H5; destruct H5; inverts H5; subst; left; auto.
    intros ? H5; destruct H5; inverts H5; subst; left; auto.
    intros ? H5 ?; destruct H5; subst; [inverts H5 |]; contradiction.
    intros ? H5 ?; destruct H5; subst; [inverts H5 |]; contradiction.
    × rewrite res_list_filter_nIn in H4.
    rewrite res_list_filter_In_filter in H3.
    apply res_list_count_labels_nil2' in H3; auto. subst.
    simpl in ×. destruct name_eq.
    destruct eq_nat_dec; subst; auto.
    splits; auto.
    intros.
    apply res_list_count_labels_nIn in H; auto.
    intros. split; intro H7; destruct H7; subst; false.
    false. false.
    intro H7; destruct H7; false.
    intros ? H5; destruct H5; inverts H5; subst; left; auto.
    intros ? H5; destruct H5; inverts H5; subst; left; auto.
    intros ? H5 ?; destruct H5; subst; [inverts H5 |]; contradiction.
    intros ? H5 ?; destruct H5; subst; [inverts H5 |]; contradiction.
    × rewrite res_list_filter_nIn in H4.
    rewrite res_list_filter_tau in H3.
    apply res_list_count_labels_single in H3; auto.
    destruct H3 as [ [_[?[_[_[?[_[?[_[_[_[_[_ ?]]]]]]]]]]]] | [? _] ].
    destruct H3 as [[??]|[??]]; discriminate.
    subst N1'.
    simpl in ×.
    destruct eq_nat_dec; subst; auto.
    splits; auto.
    intros.
    apply res_list_count_labels_single in H; auto.
    destruct H as [ [_[?[_[_[?[_[?[_[_[_[_[_ ?]]]]]]]]]]]] | [? _] ].
    destruct H as [[??]|[??]]; discriminate.
    subst N2'. auto.
    false.
    intros ? H5; destruct H5; inverts H5; subst; left; auto.
    intros ? H5; destruct H5; inverts H5; subst; left; auto.
  Qed.

  Lemma res_list_count_labels_incr: ∀ A N la N' D,
    res_list_count_labels A N la N' = true →
    length D ≥ length N →
    res_list_count_labels A (list_plus D N) la (list_plus D N') = true.
  Proof.
    induction A; destruct N; destruct N'; simpl; intros; try solve [false].
    rewrite list_plus_nil_r. auto.
    apply andb_true_iff in H; destruct H as [??].
    destruct D. simpl in H0; false. omega.
    simpl.
    apply andb_true_iff.
    split; auto.
    apply res_count_labels_incr; auto.
    apply IHA; auto.
    simpl in H0; omega.
  Qed.

  Lemma res_list_count_labels_list_le: ∀ A N l N' N0 N0',
    res_list_count_labels A N [l] N' = true →
    res_list_count_labels A N0 [l] N0' = true →
    list_le N0 N →
    list_le N0' N'.
  Proof.
    intros.
    apply res_list_count_labels_single in H.
    destruct H as [ [A1[a[A2[N1[n[N2[n'[?[?[?[?[??]]]]]]]]]]]] | [??] ].
    subst A N N'.
    destruct (app_split3 (length A1) N0) as [N01[n0[N02[??]]]].
      { apply res_list_count_labels_length in H0.
      destruct H0 as [? _]. rewrite app_length in ×. simpl in ×. omega. }
    subst N0.
    destruct (app_split3 (length A1) N0') as [N01'[n0'[N02'[??]]]].
      { apply res_list_count_labels_length in H0. destruct H0. rewrite app_length in ×. simpl in ×. omega. }
    subst N0'.
    apply res_list_count_labels_single' in H0; auto.
    destruct H0 as [?[??]].
    assert (N01'=N01 ∧ N02'=N02).
      { destruct H6 as [[??]|[??]]; subst; intuition. }
    destruct H8; subst.
    apply list_le_app1 in H1. destruct H1.
    apply list_le_app1 in H8; auto. destruct H8.
    apply list_le_app2; auto.
    apply list_le_app2; auto.
    apply list_le_single; apply list_le_single in H8.
    destruct H6 as [[??]|[??]]; subst; intuition.
    congruence.
    congruence.
    subst N'.
    apply res_list_count_labels_single in H0.
    destruct H0 as [ [A1[a[A2[N01[n0[N02[n0'[?[?[?[?[??]]]]]]]]]]]] | [??] ].
    subst A N0 N0'.
    destruct (H2 a) as [??].
    apply in_app_iff. right. apply in_app_iff. left. left; auto.
    destruct H6 as [[??]|[??]]; subst; false.
    subst N0'.
    apply H1.
  Qed.

  Lemma res_list_count_labels_nIn1: ∀ A1 a A2 N1 n N2 la N1' n' N2',
    res_list_count_labels (A1++[a]++A2) (N1++[n]++N2) la (N1'++[n']++N2') =true →
    length N1 = length A1 → length N1' = length A1 →
    ¬In (l_in a) la →
    n'=(n + count_occ label_eq (res_list_filter A2 la) (l_out a))%nat ∧ ∀ x, res_list_count_labels (A1++[a]++A2) (N1++[x]++N2) la (N1'++[x+count_occ label_eq (res_list_filter A2 la) (l_out a)]%nat++N2') = true.
  Proof.
    intros.
    rewrite res_list_count_labels_app in H; auto.
    rewrite res_list_count_labels_app in H; auto.
    do 2 rewrite andb_true_iff in H.
    destruct H as [[??]?].
    simpl in H3; apply andb_true_iff in H3. destruct H3 as [? _].
    apply res_count_labels_nIn' in H3.
    subst n'.
    split; auto.
    intros.
    repeat rewrite res_list_count_labels_app; auto.
    simpl.
    do 3 rewrite andb_true_iff.
    split; auto.
    split; auto.
    split; auto.
    apply res_count_labels_nIn''; auto.
    intro; apply H2.
    apply in_res_list_filter in H3. apply H3.
    intro; apply H2.
    apply in_res_list_filter in H5. apply H5.
  Qed.

  Lemma res_list_count_labels_list_le_com: ∀ la1 A N l N' N0 N0',
    res_list_count_labels A N [l] N' = true →
    res_list_count_labels A N0 la1 N0' = true →
    (∀ a : name, In (l_in a) la1 → l ≠ l_in a) →
    list_le N0 N →
    ∃ N00 N00',
      list_le N00 N' ∧ res_list_count_labels A N00 la1 N00' = true.
  Proof.
    induction A; destruct N; destruct N'; destruct N0; destruct N0'; simpl; intros; try solve [false].
    ∃ (@nil nat) (@nil nat); split; auto.
    rewrite andb_true_iff in ×.
    destruct H. destruct H0.
    apply list_le_cons1 in H2; destruct H2 as [??].
    edestruct IHA as [N00[N00'[??]]]; eauto.
    destruct (res_list_filter_single_inv A l) as [[??]|[??]].
    × rewrite H8 in ×.
    edestruct res_count_labels_le_com with (l:=l) as [n00[n00'[??]]].
    apply H. apply H0.
    intros. apply in_res_list_filter in H10. apply H1. apply H10.
    apply H2.
    ∃ (n00::N00) (n00'::N00'); split.
    apply list_le_cons2; auto.
    apply andb_true_iff; split; auto.
    × rewrite H8 in ×. apply res_count_labels_nil2 in H. subst n0.
    destruct H9 as [a'[??]].
    ∃ (n1::N00) (n2::N00'); split.
    apply list_le_cons2; auto.
    apply andb_true_iff; split; auto.
  Qed.

  Lemma res_list_count_labels_nIn': ∀ A N la,
    (∀ a, In a A → ¬In (l_in a) la ∧ ¬In (l_out a) la) →
    length N = length A →
    res_list_count_labels A N la N = true.
  Proof.
    induction A; destruct N; simpl; intros; auto; try solve [false].
    inverts H0.
    destruct (H a) as [??]; auto.
    apply andb_true_iff; split; eauto.
    rewrite res_list_filter_nIn; intros.
    apply res_count_labels_nIn'''; auto.
    destruct (H a0) as [??]; auto.
    destruct (H a0) as [??]; auto.
  Qed.

  Lemma res_list_count_labels_exists_min: ∀ A N la N',
    res_list_count_labels A N la N' = true →
    ∃ N0 N0',
      res_list_count_labels_min A N0 la N0'.
  Proof.
    induction A; destruct N; destruct N'; simpl; intros; try solve [false]; auto.
    × ∃ (@nil nat) (@nil nat); split; intros; auto.
    apply res_list_count_labels_length in H0; destruct H0.
    destruct N0; destruct N0'; simpl in *; try solve [false].
    ∃ (@nil nat); simpl; splits; auto.
    × apply andb_true_iff in H. destruct H.
    apply res_count_labels_exists_min in H; destruct H as [n00[n00'[??]]].
    apply IHA in H0; destruct H0 as [N0[N0'[??]]]; clear IHA.
    ∃ (n00::N0) (n00'::N0'); split; intros; auto.
    simpl. apply andb_true_iff; split; auto.
    simpl in H3.
    destruct N1; [false |].
    destruct N0'0; [false |].
    apply andb_true_iff in H3. destruct H3.
    apply H2 in H4; destruct H4 as [D[?[??]]].
    apply H1 in H3; destruct H3 as [d[??]].
    subst.
    ∃ (d::D); splits; simpl; auto.
  Qed.

  Lemma res_list_count_labels_interleaving1: ∀ lp A N0 N0' N la1 la2 N',
    res_list_count_labels A N (interleaving lp la1 la2) N' = true →
    (∀ a, In (l_in a) la1 → In (l_in a) la2 → False) →
    (res_list_count_labels A N0 la1 N0' = true) →
    list_le N0 N →
    res_list_count_labels A N (la1++la2) N' = true.
  Proof.
    induction A; destruct N0; destruct N0'; destruct N; destruct N'; simpl; intros; try solve [false]; auto.
    rewrite andb_true_iff in ×.
    destruct H1. destruct H.
    split.
    × rewrite res_list_filter_app2.
    apply list_le_cons1 in H2. destruct H2 as [??].
    destruct (res_list_filter_interleaving A lp la1 la2) as [lp' ?].
    rewrite H6 in H.
    eapply res_count_labels_interleaving1; eauto.
    intros a0 ? ?; apply (H0 a0); eapply in_res_list_filter; eauto.
    × apply list_le_cons1 in H2; destruct H2. eauto.
  Qed.

  Lemma res_list_count_labels_com: ∀ A la1 N N' la2 N'',
    res_list_count_labels A N la1 N' = true →
    res_list_count_labels A N la2 N'' = true →
    (∀ a, In (l_in a) la1 → In (l_in a) la2 → False) →
    ∃ N''',
      res_list_count_labels A N'' la1 N''' = true ∧ res_list_count_labels A N' la2 N''' = true.
  Proof.
    induction A; destruct N; destruct N'; destruct N''; simpl; intros; try solve [false].
    × ∃ (@nil nat); split; auto.
    × rewrite andb_true_iff in ×.
    destruct H as [??]; destruct H0 as [??].
    edestruct IHA with (la1:=la1) (la2:=la2) as [N'''[??]]; eauto.
    edestruct res_count_labels_com with (la1:=res_list_filter A la1) (la2:=res_list_filter A la2) as [n'''[??]]; eauto.
    intros a0 ? ?; apply (H1 a0); auto; eapply in_res_list_filter; eauto.
    ∃ (n'''::N'''); split; auto; apply andb_true_iff; split; auto.
  Qed.

  Lemma res_list_count_labels_cons: ∀ a A n N la n' N',
    length N' = length A →
    res_list_count_labels (a::A) (n::N) la (n'::N') =
    res_count_labels a n (res_list_filter A la) n' &&
    res_list_count_labels A N la N'.
  Proof. intros; reflexivity. Qed.

  Lemma res_list_count_labels_nIn'': ∀ A N la,
    (∀ a, In a A → ¬In (l_in a) la) →
    length N = length A →
    ¬In l_tau la →
    ∃ N',
      res_list_count_labels A N la N' = true.
  Proof.
    induction A; intros.
    × ∃ (@nil nat). destruct N; auto. inverts H0.
    × destruct N; inverts H0.
    edestruct IHA with (la:=la) as [N' ?]; clear IHA; eauto.
    intros; eauto. apply H. right; auto.
    ∃ (n + count_occ label_eq (res_list_filter A la) (l_out a)::N')%nat.
    rewrite res_list_count_labels_cons.
    apply andb_true_iff; split; auto.
    apply res_count_labels_nIn''; auto.
    intro. edestruct in_res_list_filter as [??]; eauto.
    eapply H; eauto. left; auto.
    edestruct res_list_count_labels_length; eauto.
  Qed.

End ResListCountLabels.

Section ResListCountLabelsStepping.
  Import Notation.
  Import Notation.U.

  Lemma step_res_list_inv: ∀ AN p l pp',
    step (p_res_list AN p) l pp' →
    (∃ l' AN' p',
      step p l' p' ∧
      pp' = p_res_list AN' p' ∧
      fst (split AN') = fst (split AN) ∧
      step_res_list_label_wf (fst (split AN)) l l' ∧
      res_list_count_labels (fst (split AN)) (snd (split AN)) [l'] (snd (split AN')) = true) ∨
    (∃ AN1 AN2,
      p=p_nil ∧
      l = l_tau ∧
      AN = AN1++AN2 ∧
      AN2 ≠ nil ∧
      pp' = p_res_list AN1 p_nil).
  Proof.
    unfold step_res_list_label_wf; induction AN; intros; simpl in ×.
    × left; ∃ l (@nil (name×nat)) pp'; splits; auto.
    × destruct a. inverts H.
    - edestruct IHAN as [ [l'[AN'[p'_[?[?[?[??]]]]]]] | [AN1[AN2[?[?[?[??]]]]]] ]; clear IHAN; eauto.
    + subst p'; rename p'_ into p'.
    left; ∃ l' ((n,n0)::AN') p'; splits; auto.
    simpl; do 2 rewrite fst_split.
    congruence.
    destruct H2 as [ [a[?[??]]] | [??] ]; subst.
    left; ∃ a; splits; auto. rewrite fst_split. right; auto.
    right; split; intros; eauto. rewrite fst_split in H0. destruct H0; subst; eauto.
    simpl. do 2 rewrite snd_split. rewrite fst_split.
    simpl. apply andb_true_iff.
    split; auto.
    rewrite res_list_filter_cons2.
    rewrite res_list_filter_nil2.
    destruct H2 as [ [a[?[?[?|?]]]] | [??] ]; subst.
    destruct in_dec; [| false; apply n1; auto].
    apply res_count_labels_nil2'.
    destruct in_dec; [| false; apply n1; auto].
    apply res_count_labels_nil2'.
    destruct l. simpl; destruct eq_nat_dec; auto; false.
    destruct in_dec. apply res_count_labels_nil2'.
    simpl. destruct name_eq; subst. false.
    simpl; destruct eq_nat_dec; auto; false.
    destruct in_dec. apply res_count_labels_nil2'.
    simpl. destruct name_eq; subst. false.
    simpl; destruct eq_nat_dec; auto; false.
    + subst. right; ∃ ((n,n0)::AN1) AN2; splits; auto.
    - edestruct IHAN as [ [l'[AN'[p'_[?[?[?[??]]]]]]] | [AN1[AN2[?[?[??]]]]] ]; clear IHAN; eauto.
    + subst p'; rename p'_ into p'.
    left; ∃ l' ((n,n1)::AN') p'; splits; auto.
    simpl; do 2 rewrite fst_split.
    congruence.
    destruct H2 as [ [a[?[??]]] | [??] ]; subst.
    left; ∃ a; splits; auto. rewrite fst_split. right; auto.
    rewrite fst_split.
    left; ∃ n; splits; auto. left; auto.
    rewrite fst_split. simpl; do 2 rewrite snd_split.
    simpl. apply andb_true_iff.
    split; auto.
    rewrite res_list_filter_cons2.
    rewrite res_list_filter_nil2.
    destruct H2 as [ [a[?[?[?|?]]]] | [??] ]; subst.
    false. false.
    destruct in_dec.
    apply H2 in i. destruct i. false.
    simpl.
    destruct name_eq. destruct eq_nat_dec; auto; false. false.
    + false.
    - edestruct IHAN as [ [l'[AN'[p'_[?[?[?[??]]]]]]] | [AN1[AN2[?[?[??]]]]] ]; clear IHAN; eauto.
    + subst p'; rename p'_ into p'.
    left; ∃ l' ((n,S n0)::AN') p'; splits; auto.
    simpl; do 2 rewrite fst_split. congruence.
    rewrite fst_split. left.
    destruct H2 as [ [a[?[??]]] | [??] ]; subst.
    ∃ a; splits; auto. right; auto.
    ∃ n; splits; auto. left; auto.
    rewrite fst_split. simpl; do 2 rewrite snd_split.
    simpl. apply andb_true_iff.
    split; auto.
    rewrite res_list_filter_cons2.
    rewrite res_list_filter_nil2.
    destruct H2 as [ [a[?[?[?|?]]]] | [??] ]; subst.
    false. false.
    destruct in_dec.
    apply H2 in i. destruct i. false.
    simpl.
    destruct name_eq. destruct eq_nat_dec; auto; false. false.
    + false.
    - clear IHAN.
    destruct AN; simpl in *; subst.
    right; ∃ (@nil (name×nat)) [(n,n0)]; splits; auto.
    intro; false.
    destruct p0. false.
  Qed.

  Lemma step_star_res_list_inv': ∀ A N p la pp',
    step_star (p_res_list (combine A N) p) la pp' →
    length N = length A →
    ∃ la' N' p',
      step_star p la' p' ∧
      la = res_list_filter A la' ∧
      res_list_count_labels A N la' N' = true ∧
      (pp' = p_res_list (combine A N') p'
      ∨
      (∃ A1 A2 N1' N2',
        p' = p_nil ∧ pp' = p_res_list (combine A1 N1') p_nil ∧ A = A1++A2 ∧
        N' = N1'++N2' ∧ length N1'=length A1 ∧ length A2>0)).
  Proof.
    introv Hss.
    remember (p_res_list (combine A N) p) as pp.
    revert A N p Heqpp.
    induction Hss; intros; subst; auto.
    × ∃ (@nil lts_L) N p0; splits; auto.
    apply step_nil. symmetry; apply res_list_filter_nil2.
    apply res_list_count_labels_nil2; auto.
    × rename p' into pp'.
    edestruct step_res_list_inv as [ [l'[AN'[p'[?[?[?[??]]]]]]] | [AN1[AN2[?[?[?[??]]]]]] ]; eauto.
    inverts H; eauto.
    + subst.
    edestruct IHHss with (A:=fst (split AN')) (N:=snd (split AN')) as [la'[N'[p'0[?[?[??]]]]]]; clear IHHss; eauto.
    rewrite split_combine'; reflexivity.
    rewrite split_length_l; rewrite split_length_r; reflexivity.
    rewrite combine_split in *; auto. simpl in ×.
    subst.
    destruct H4 as [ [b[?[??]]] | [??] ]; subst.
    inverts H.
    ∃ (a::la') N' p'0; splits; auto.
    eapply @step_lcons; eauto.
    inverts H; constructor; auto.
    rewrite res_list_filter_cons2.
    inverts H; destruct in_dec; auto; false; apply H4 in i; intuition.
    change (a::la') with ([a]++la').
    eapply res_list_count_labels_app2'; eauto.
    + subst. inverts H.
    × rename p' into pp'.
    edestruct step_res_list_inv as [ [l'[AN'[p'[?[?[?[??]]]]]]] | [AN1[AN2[?[?[?[??]]]]]] ]; eauto.
    apply H.
    + subst.
    edestruct IHHss with (A:=fst (split AN')) (N:=snd (split AN')) as [la'[N'[p'0[?[?[??]]]]]]; clear IHHss; eauto.
    rewrite split_combine'; reflexivity.
    rewrite split_length_l; rewrite split_length_r; reflexivity.
    rewrite combine_split in *; auto. simpl in ×.
    subst.
    destruct H4 as [ [b[?[??]]] | [??] ]; subst.
    ∃ (l'::la') N' p'0; splits; auto.
    destruct H6; subst; eapply @step_lcons; eauto; constructor; auto.
    rewrite res_list_filter_cons2.
    destruct H6; subst; destruct in_dec; auto; contradiction.
    change (l'::la') with ([l']++la').
    eapply res_list_count_labels_app2'; eauto.
    ∃ (la') N' p'0; splits; auto.
    eapply @step_tcons; eauto. apply H1.
    apply res_list_count_labels_single in H5.
    destruct H5 as [ [?[?[?[?[?[?[?[_[_[_[_[_ [[??]|[??]] ]]]]]]]]]]]] | [??] ]; try discriminate.
    subst. auto.
    + subst.
    edestruct IHHss with (A:=fst (split AN1)) (N:=snd (split AN1)) as [la'[N'[p'0[?[?[??]]]]]]; clear IHHss; eauto.
    rewrite split_combine'; reflexivity.
    rewrite split_length_l; rewrite split_length_r; reflexivity.
    inverts H1; try solve [inverts H8; inverts H1].
    rewrite res_list_filter_nil2 in H5.
    subst.
    ∃ (@nil lts_L) N p_nil; splits; auto.
    apply step_nil. symmetry; apply res_list_filter_nil2.
    apply res_list_count_labels_nil2; auto.
    right.
    apply f_equal with (f:= fun a ⇒ split a) in H3.
    apply res_list_count_labels_nil2' in H6; auto.
    subst.
    destruct H7 as [? | [A1[A2[N1'[N2'[?[?[?[?[??]]]]]]]]] ]; subst; auto.
    ∃ (fst (split AN1)) (fst (split AN2)) (snd (split AN1)) (snd (split AN2)); splits; auto.
    rewrite fst_split_app. rewrite<- H3.
    rewrite combine_split; auto.
    rewrite snd_split_app. rewrite<- H3.
    rewrite combine_split; auto.
    rewrite split_length_l; rewrite split_length_r; reflexivity.
    rewrite split_length_l; destruct AN2; simpl in *; try solve [false]. omega.
    ∃ A1 (A2++fst (split AN2)) N1' (N2' ++ snd (split AN2)); splits; auto.
    rewrite app_assoc. rewrite<- H6.
    rewrite fst_split_app. rewrite <- H3.
    rewrite combine_split; auto.
    rewrite app_assoc. rewrite<- H7.
    rewrite snd_split_app. rewrite <- H3.
    rewrite combine_split; auto.
    rewrite app_length. omega.
  Qed.

  Lemma step_res_list_inv'': ∀ AN AN' p l p',
    step (p_res_list AN p) l (p_res_list AN' p') →
    length AN=length AN' →
    ∃ l',
      step p l' p' ∧
      fst (split AN') = fst (split AN) ∧
      step_res_list_label_wf (fst (split AN)) l l' ∧
      res_list_count_labels (fst (split AN)) (snd (split AN)) [l'] (snd (split AN')) = true.
  Proof.
    unfold step_res_list_label_wf; intros.
    edestruct step_res_list_inv as [ [l'[AN'_[p'_[?[?[?[??]]]]]]] | [AN1[AN2[?[?[?[??]]]]]] ]; eauto.
    + edestruct (p_res_list_inv' AN' p' AN'_ p'_) as [??]; eauto.
    rewrite<- H0. do 2 rewrite<- split_length_l. congruence.
    subst.
    ∃ l'; splits; auto.
    + false; subst.
    destruct AN2. false.
    rewrite app_length in H0.
    edestruct (p_res_list_inv AN' p' AN1 p_nil) as [AN[[??]|[??]]]; eauto.
    subst.
    rewrite app_length in H0.
    destruct AN.
    simpl in ×. repeat rewrite app_nil_r in ×.
    false; omega.
    simpl in ×.
    false; omega.
    destruct AN. inverts H1.
    simpl in ×. repeat rewrite app_nil_r in ×. subst.
    false; omega.
    destruct p0.
    inverts H1.
  Qed.

  Lemma step_star_res_list_inv'': ∀ AN AN' p la p',
    step_star (p_res_list AN p) la (p_res_list AN' p') →
    length AN=length AN' →
    ∃ la',
      step_star p la' p' ∧
      fst (split AN') = fst (split AN) ∧
      la = res_list_filter (fst (split AN)) la' ∧
      res_list_count_labels (fst (split AN)) (snd (split AN)) la' (snd (split AN')) = true.
  Proof.
    induction AN; intros; simpl in ×.
    × destruct AN'; simpl in *; [| false; omega].
    ∃ la; splits; auto.
    × destruct AN'. false; omega. simpl in H0.
    inverts H0.
    destruct a. destruct p0. simpl in ×.
    edestruct step_star_res_inv as [la'[n'[pp'[?[?[??]]]]]]; eauto.
    destruct H0 as [?|[??]]; subst.
    - inverts H0.
    edestruct IHAN as [la''[?[?[??]]]]; eauto. subst.
    ∃ la''; splits; auto.
    destruct (split AN'). destruct (split AN). simpl in *; congruence.
    simpl in ×.
    destruct (split AN); simpl. reflexivity.
    destruct (split AN); destruct (split AN'); simpl in ×.
    apply andb_true_intro; auto.
    - false; inverts H0.
  Qed.

  Lemma step_star_res_list: ∀ A N p la p' la' N',
    step_star p la p' →
    la' = res_list_filter A la →
    res_list_count_labels A N la N'=true →
    step_star (p_res_list (combine A N) p) la' (p_res_list (combine A N') p').
  Proof.
    induction A; intros.
    - simpl in *; subst; auto.
    - simpl in ×.
    destruct N. false; omega.
    destruct N'. false; omega.
    simpl in ×.
    rewrite andb_true_iff in H1.
    destruct H1.
    eapply step_star_res; eauto.
  Qed.

  Lemma step_star_res_list': ∀ AN p la p' la' AN',
    step_star p la p' →
    fst (split AN) = fst (split AN') →
    la' = res_list_filter (fst (split AN)) la →
    res_list_count_labels (fst (split AN)) (snd (split AN)) la (snd (split AN'))=true →
    step_star (p_res_list AN p) la' (p_res_list AN' p').
  Proof.
    intros.
    rewrite<- (split_combine' AN).
    rewrite<- (split_combine' AN').
    rewrite H0.
    eapply step_star_res_list; eauto.
    congruence.
    congruence.
  Qed.

  Lemma step_star_res_list_par_swap_nil: ∀ AN p la,
    step_star (p_res_list AN p) la p_nil →
    step_star (p_res_list AN (par_swap p)) la p_nil.
  Proof.
    intros.
    edestruct step_star_res_list_inv' as [la'[N'[p'[?[?[??]]]]]]; eauto.
    rewrite split_combine'. apply H.
    rewrite split_length_l. rewrite split_length_r. reflexivity.
    destruct H3 as [? | [A1[A2[N1'[N2'[?[?[?[?[??]]]]]]]]] ]; subst.
    × destruct AN; simpl in *; subst; [| false].
    apply step_star_par_swap_nil; auto.
    destruct p0.
    rewrite fst_split in H2.
    rewrite snd_split in H2.
    rewrite fst_split in H3.
    rewrite fst_split in H.
    simpl in ×.
    destruct N'; false.
    × destruct A1; destruct N1'; simpl in *; try solve [false].
    rewrite<- (app_nil_r (res_list_filter _ _)).
    eapply step_star_app.
    eapply step_star_res_list' with (AN':=combine (fst (split AN)) N2'); eauto.
    apply step_star_par_swap_nil. auto.
    rewrite combine_split; auto.
    apply res_list_count_labels_length in H2; destruct H2; auto.
    rewrite combine_split; auto.
    apply res_list_count_labels_length in H2; destruct H2; auto.
    apply step_star_res_list_nil.
  Qed.

  Lemma step_star_res_list_seq_app: ∀ AN AN' p la p' q,
    step_star (p_res_list AN p) la (p_res_list AN' p') →
    length AN' = length AN →
    step_star (p_res_list AN (p;;q)) la (p_res_list AN' (p';;q)).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    subst.
    rewrite<- (split_combine' AN).
    rewrite<- (split_combine' AN').
    rewrite H2.
    eapply step_star_res_list; eauto.
    eapply step_star_seq_app; eauto.
    rewrite split_combine'; reflexivity.
  Qed.

  Lemma step_star_res_list_par_swap: ∀ AN AN' p1 p2 la pp',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' pp') →
    length AN' = length AN →
    step_star (p_res_list AN (p2||p1)) la (p_res_list AN' (par_swap pp')).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    subst.
    rewrite<- (split_combine' AN).
    rewrite<- (split_combine' AN').
    rewrite H2.
    eapply step_star_res_list; eauto.
    apply step_star_par_swap; rewrite par_swap_swap; auto.
    rewrite split_combine'; reflexivity.
  Qed.

  Lemma step_star_res_list_par_swap': ∀ AN AN' p1 p2 la pp',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (par_swap pp')) →
    length AN' = length AN →
    step_star (p_res_list AN (p2||p1)) la (p_res_list AN' pp').
  Proof.
    intros; apply step_star_res_list_par_swap in H; auto; rewrite par_swap_swap in H; auto.
  Qed.

  Lemma step_star_res_list_par_swap_nil': ∀ AN p la,
    step_star (p_res_list AN (par_swap p)) la p_nil → step_star (p_res_list AN p) la p_nil.
  Proof.
    intros; apply step_star_res_list_par_swap_nil in H; auto; rewrite par_swap_swap in H; auto.
  Qed.

  Lemma step_star_res_list_parL_step: ∀ p2 AN p1 la AN' p1',
    step_star (p_res_list AN p1) la (p_res_list AN' p1') →
    length AN' = length AN →
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2)).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    eapply step_star_res_list'; eauto.
    apply step_star_parL_step; auto.
  Qed.

  Lemma step_star_res_list_parR_step: ∀ p1 AN p2 la AN' p2',
    step_star (p_res_list AN p2) la (p_res_list AN' p2') →
    length AN' = length AN →
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1||p2')).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    eapply step_star_res_list'; eauto.
    apply step_star_parR_step; auto.
  Qed.

  Lemma step_res_list: ∀ AN p l l' AN' p',
    step p l p' →
    fst (split AN') = fst (split AN) →
    step_res_list_label_wf (fst (split AN)) l' l →
    res_list_count_labels (fst (split AN)) (snd (split AN)) [l] (snd (split AN')) = true →
    step (p_res_list AN p) l' (p_res_list AN' p').
  Proof.
    unfold step_res_list_label_wf; induction AN; intros.
    × destruct AN'; simpl in ×.
    destruct H1 as [ [a[? _]] | [? _] ]; [false | subst l'; auto].
    destruct p0. rewrite fst_split in H0. false.
    × destruct AN'; simpl in ×.
    destruct a. rewrite fst_split in H0. false.
    destruct a; destruct p0.
    do 2 rewrite snd_split in H2.
    rewrite fst_split in H2.
    rewrite fst_split in H1.
    do 2 rewrite fst_split in H0.
    inverts H0.
    simpl in H2. apply andb_true_iff in H2. destruct H2.
    rewrite res_list_filter_cons2 in H0. rewrite res_list_filter_nil2 in H0.
    destruct H1 as [ [a[?[??]]] | [??] ]; subst.
    assert (res_count_labels n n0 (if in_dec name_eq a (fst (split AN)) then [] else [l]) n2 = true).
      destruct H4; subst; auto.
    clear H0.
    destruct (in_dec name_eq a (fst (split AN))).
    simpl in H3.
    destruct (eq_nat_dec n2 n0); try discriminate. subst n2.
    apply s_res; try solve [intro; discriminate].
    eapply IHAN; eauto.
    simpl in H3.
    destruct H4; subst.
    destruct (name_eq a n). subst.
    destruct n0; try discriminate.
    destruct (eq_nat_dec n2 n0); try discriminate.
    subst n2.
    apply s_res_count_in.
    eapply IHAN; eauto.
    right; split; intros; auto. split; intro Hh; inverts Hh; subst; contradiction.
    destruct H1; subst; false. contradiction.
    destruct (name_eq a n). subst.
    destruct (eq_nat_dec n2 (S n0)); try discriminate.
    subst n2.
    apply s_res_count_out.
    eapply IHAN; eauto.
    right; split; intros; auto. split; intro Hh; inverts Hh; subst; contradiction.
    destruct H1; subst; false. contradiction.
    destruct (H3 n) as [??]. left; auto.
    destruct l'.
    simpl in H0.
    destruct (eq_nat_dec n2 n0); try discriminate. subst n2.
    apply s_res; try solve [intro; false].
    eapply IHAN; eauto.
    right; split; intros; eauto. split; intro; discriminate.
    destruct (in_dec name_eq n1 (fst (split AN))).
    destruct (H3 n1) as [??]. right; auto.
    false.
    simpl in H0.
    destruct (name_eq n1 n); subst. false.
    destruct (eq_nat_dec n2 n0); try discriminate. subst n2.
    apply s_res; auto.
    eapply IHAN; eauto.
    right; split; intros; auto. split; intro Hh; inverts Hh; contradiction.
    destruct (in_dec name_eq n1 (fst (split AN))).
    destruct (H3 n1) as [??]. right; auto. false.
    simpl in H0.
    destruct (name_eq n1 n). subst n1.
    false.
    destruct (eq_nat_dec n2 n0); try discriminate. subst n2.
    apply s_res; auto.
    eapply IHAN; eauto.
    right; split; intros; auto. split; intro Hh; inverts Hh; subst; contradiction.
  Qed.

  Lemma res_list_count_labels_fun: ∀ A N la N'1 N'2,
    res_list_count_labels A N la N'1 = true →
    res_list_count_labels A N la N'2 = true →
    N'2 = N'1.
  Proof.
    induction A; destruct N; destruct N'1; destruct N'2; simpl; intros; try solve [false]; auto.
    rewrite andb_true_iff in ×.
    destruct H as [??]; destruct H0 as [??].
    f_equal; eauto.
    eapply res_count_labels_fun; eauto.
  Qed.

End ResListCountLabelsStepping.

Section ResListFN.
  Import Notation.
  Import Notation.U.

  Lemma fn_subset_step_star_p_res_list_In: ∀ a AN p la AN' p',
    step_star (p_res_list AN p) la (p_res_list AN' p') →
    length AN' = length AN →
    NameSet.In a (fn p') →
    NameSet.In a (fn p).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    eapply NameSetProps.in_subset; eauto.
    eapply fn_subset_step_star; eauto.
  Qed.

  Lemma fn_subset_step_star_res_list_parL_In: ∀ a AN p1 p2 la AN' p1' p2',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    length AN' = length AN →
    NameSet.In a (fn p1') →
    NameSet.In a (fn p1).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    eapply fn_subset_step_star_parR_In; eauto.
  Qed.

  Lemma fn_subset_step_star_res_list_parR_In: ∀ a AN p1 p2 la AN' p1' p2',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    length AN' = length AN →
    NameSet.In a (fn p2') →
    NameSet.In a (fn p2).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    eapply fn_subset_step_star_parL_In; eauto.
  Qed.

  Lemma fn_in_subset_step_star_res_list_parL: ∀ AN p1 p2 la AN' p1' p2',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    length AN' = length AN →
    NameSet.Subset (fn_in p1') (fn_in p1).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    eapply fn_in_subset_step_star_parL; eauto.
  Qed.

  Lemma fn_in_subset_step_star_res_list_parR: ∀ AN p1 p2 la AN' p1' p2',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    length AN' = length AN →
    NameSet.Subset (fn_in p2') (fn_in p2).
  Proof.
    intros.
    edestruct step_star_res_list_inv'' as [la'[?[?[??]]]]; eauto.
    eapply fn_in_subset_step_star_parR; eauto.
  Qed.

  Lemma hidden_fn_step_star_res_list_parR: ∀ AN p1 p2 la AN' p1' p2',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    length AN' = length AN →
    hidden_fn (fst (split AN)) p2 →
    hidden_fn (fst (split AN)) p2'.
  Proof. unfold hidden_fn; intros; apply H1; eapply fn_subset_step_star_res_list_parR_In; eauto. Qed.

  Lemma hidden_fn_step_star_res_list_parL: ∀ AN p1 p2 la AN' p1' p2',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    length AN' = length AN →
    hidden_fn (fst (split AN)) p1 →
    hidden_fn (fst (split AN)) p1'.
  Proof. unfold hidden_fn; intros; apply H1; eapply fn_subset_step_star_res_list_parL_In; eauto. Qed.

End ResListFN.

Add Parametric Relation : lts_S wbisimilar
    reflexivity proved by (wbisim_refl lts)
    symmetry proved by (wbisim_symm lts)
    transitivity proved by (wbisim_trans lts)
    as wbisimilar_rel.

Add Parametric Relation : lts_S contrasimilar
    reflexivity proved by (csim_refl lts)
    symmetry proved by (csim_symm lts)
    transitivity proved by (csim_trans lts)
    as contrasimilar_rel.

Section Algebraic.
  Import Notation.
  Import Notation.U.
  Open Scope proc.

  Lemma wbisim_nil_seq: ∀ p,
    wbisimilar (p_nil;; p) p.
  Proof.
    intros.
    apply wbisim_step.
    - intros; false.
    - intros. apply single_tstep. apply s_seq_nil.
    - intros. inverts H. inverts H4. ∃ p'; split. apply step_nil. reflexivity.
    - intros. ∃ q'; split. eapply step_tcons. apply s_seq_nil. apply single_tstep; eauto. reflexivity.
    - intros. inverts H; inverts H0; inverts H4.
    - intros. ∃ q'; split. eapply step_tcons. apply s_seq_nil. apply single_lstep; eauto. reflexivity.
  Qed.

  Lemma wbisim_seq_nil: ∀ p,
    wbisimilar (p;; p_nil) p.
  Proof.
    intros.
    ∃ (fun p q ⇒ p=q;;p_nil ∨ (p=p_nil∧q=p_nil)).
    split; auto.
    clear p.
    splits; intros q p [?|[??]]; intros; subst.
    × false.
    × apply step_nil.
    × inverts H0. apply single_tstep; apply s_seq_nil.
    × apply step_nil.
    × split; intros.
    - inverts H.
    ∃ p'0; split; auto. apply single_tstep; auto.
    ∃ p_nil; split; auto. apply step_nil.
    - inverts H; inverts H0; ∃ p'0; split; auto; apply single_lstep; constructor; eauto.
    × split; intros; inverts H; inverts H0.
    × unfold inv; split; [intros q' | intros a q']; intros.
    - ∃ (q';;p_nil); split; auto. apply single_tstep; apply s_seq; auto.
    - ∃ (q';;p_nil); split; auto. apply single_lstep. inverts H; constructor; apply s_seq; auto.
    × split; intros; inverts H; inverts H0.
  Qed.

  Lemma sbisim_seq_assoc: ∀ p q r,
    sbisimilar (p;; (q;; r)) (p;; q;; r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p, pp=p;;(q;;r) ∧ qq=p;;q;;r) ∨ qq=pp).
    split; eauto.
    clear p.
    splits; intros pp qq [ [p[??]] | ? ]; subst; unfold inv in *; intros.
    × false.
    × reflexivity.
    × false.
    × reflexivity.
    × split; intros.
    + inverts H.
    eexists; split. apply s_seq; apply s_seq; eauto. eauto.
    eexists; split; eauto. apply s_seq; apply s_seq_nil.
    + inverts H; inverts H0.
    eexists; split. constructor; apply s_seq; apply s_seq; eauto. eauto.
    eexists; split. constructor; apply s_seq; apply s_seq; eauto. eauto.
    × split; intros.
    + ∃ p'; split; auto.
    + ∃ p'; split; auto.
    × split; intros.
    + inverts H. inverts H4.
    - eexists; split. apply s_seq; eauto. eauto.
    - eexists; split; eauto. apply s_seq_nil.
    + inverts H; inverts H0; inverts H4.
    - eexists; split. constructor; apply s_seq; eauto. eauto.
    - eexists; split. constructor; apply s_seq; eauto. eauto.
    × split; intros.
    + ∃ p'; split; auto.
    + ∃ p'; split; auto.
  Qed.
  Lemma wbisim_seq_assoc: ∀ p q r,
    wbisimilar (p;; (q;; r)) (p;; q;; r).
  Proof. intros; apply sbisim_wbisim; apply sbisim_seq_assoc. Qed.

  Lemma sbisim_par_swap: ∀ p q,
    sbisimilar (p||q) (q||p).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=p||q ∧ qq=q||p) ∨ (pp=p_nil ∧ qq=p_nil))%proc.
    split; eauto.
    clear p q.
    apply strong_bisimulation_symm; intros pp qq [ [p[q[??]]] | [??] ]; subst; unfold inv; intros.
    × false.
    × reflexivity.
    × split; intros.
    - inverts H.
    + ∃ (q||p'0)%proc; split; eauto; eapply s_parR; eauto.
    + ∃ (q'||p)%proc; split; eauto; eapply s_parL; eauto.
    + ∃ p_nil; split; eauto. apply s_par_nil.
    - inverts H; inverts H0.
    + ∃ (q||p'0)%proc; split; eauto; constructor; eapply s_parR; eauto.
    + ∃ (q'||p)%proc; split; eauto; constructor; eapply s_parL; eauto.
    + ∃ (q||p'0)%proc; split; eauto; constructor; eapply s_parR; eauto.
    + ∃ (q'||p)%proc; split; eauto; constructor; eapply s_parL; eauto.
    × split; intros; inverts H; inverts H0.
    × eauto.
    × auto.
  Qed.

  Lemma wbisim_par_swap: ∀ p q,
    wbisimilar (p||q) (q||p).
  Proof. intros; apply sbisim_wbisim; apply sbisim_par_swap. Qed.

  Lemma wbisim_par_nil1: ∀ p,
    wbisimilar (p||O) p.
  Proof.
    intros.
    ∃ (fun p q ⇒ p=q||O ∨ (p=p_nil ∧ q=p_nil))%proc.
    split; auto.
    clear p.
    splits; (intros p q [? | [??]]; intros; [ subst; try rename q into p | subst p q]; unfold inv in *).
    × false.
    × apply step_nil.
    × simpl in H0; red in H0. subst p. apply single_tstep; apply s_par_nil.
    × apply step_nil.
    × split; intros.
    - inverts H.
    rename p'0 into p'.
    ∃ p'; split; auto. apply single_tstep; auto.
    inverts H4.
    ∃ p_nil; split; auto. apply step_nil.
    - inverts H; inverts H0; try rename p'0 into p'.
    ∃ p'; split; auto; apply single_lstep; constructor; auto.
    inverts H4.
    ∃ p'; split; auto; apply single_lstep; constructor; auto.
    inverts H4.
    × split; intros; inverts H; inverts H0.
    × split; intros.
    - ∃ (p'||O)%proc; split; auto. apply single_tstep; apply s_parL; auto.
    - inverts H.
    ∃ (p'||O)%proc; split; auto; apply single_lstep; constructor; apply s_parL; auto.
    ∃ (p'||O)%proc; split; auto; apply single_lstep; constructor; apply s_parL; auto.
    × splits; intros; try solve [inverts H; inverts H0 | apply step_nil].
  Qed.

  Lemma wbisim_par_nil2: ∀ p,
    wbisimilar (O||p) p.
  Proof. intros; eapply wbisim_trans. apply wbisim_par_swap. apply wbisim_par_nil1. Qed.

  Lemma wbisim_par_assoc: ∀ p q r,
    wbisimilar (p||(q||r)) ((p||q)||r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q r, pp=p||(q||r) ∧ qq=(p||q)||r) ∨ wbisimilar pp qq)%proc.
    split; iauto.
    clear p q r.
    splits; (intros pp qq [ [p[q[r[??]]]] | ?]; intros; [subst | renames pp to p, qq to q]; unfold inv in *).
    × false.
    × apply halted_wbisim1; auto.
    × false.
    × apply halted_wbisim2; auto.
    × split; intros.
    - inverts H; try renames p'0 to p'; try renames q' to qr'.
    + ∃ (p'||q||r); split; iauto. apply single_tstep; apply s_parL; apply s_parL; auto.
    + inverts H4; try rename q' into r'; try rename p' into q'.
     ∃ (p||q'||r); split; iauto. apply single_tstep. apply s_parL; apply s_parR; auto.
     ∃ (p||q||r'); split; iauto. apply single_tstep. apply s_parR; auto.
     ∃ (p||p_nil||p_nil); split. apply step_nil.
     right. symmetry. apply wbisim_par_nil1.
    - inverts H.
    + rename p' into pqr'. inverts H0.
    ∃ (p'||q||r); split; iauto. apply single_lstep; constructor; apply s_parL; apply s_parL; auto.
    rename q' into qr'. inverts H4.
    rename p' into q'. ∃ (p||q'||r); split; iauto. apply single_lstep; constructor; apply s_parL; apply s_parR; auto.
    rename q' into r'. ∃ (p||q||r'); split; iauto. apply single_lstep; constructor; apply s_parR; auto.
    + rename p' into pqr'. inverts H0.
    ∃ (p'||q||r); split; iauto. apply single_lstep; constructor; apply s_parL; apply s_parL; auto.
    rename q' into qr'. inverts H4.
    rename p' into q'. ∃ (p||q'||r); split; iauto. apply single_lstep; constructor; apply s_parL; apply s_parR; auto.
    rename q' into r'. ∃ (p||q||r'); split; iauto. apply single_lstep; constructor; apply s_parR; auto.
    × split; intros.
    - edestruct tstep_wbisim1 as [q'[??]]; eauto.
    - edestruct lstep_wbisim1 as [q'[??]]; eauto.
    × split; intros.
    - inverts H; try renames p'0 to p'; try renames q' to qr'.
    + rename p' into pq'.
    inverts H4.
     ∃ (p'||(q||r)); split; iauto. apply single_tstep. apply s_parL; auto.
     ∃ (p||(q'||r)); split; iauto. apply single_tstep. apply s_parR; apply s_parL; auto.
     ∃ (p_nil||(p_nil||r)); split. apply step_nil. right. apply wbisim_par_nil2.
    + rename qr' into r'. ∃ (p||(q||r')); split; iauto. apply single_tstep; apply s_parR; apply s_parR; auto.
    - inverts H.
    + rename p' into pqr'. inverts H0.
    rename p' into pq'. inverts H4.
    ∃ (p'||(q||r)); split; iauto. apply single_lstep; constructor; apply s_parL; auto.
    ∃ (p||(q'||r)); split; iauto. apply single_lstep; constructor; apply s_parR; apply s_parL; auto.
    rename q' into r'. ∃ (p||(q||r')); split; iauto. apply single_lstep; constructor; apply s_parR; apply s_parR; auto.
    + rename p' into pqr'. inverts H0.
    rename p' into pq'. inverts H4.
    ∃ (p'||(q||r)); split; iauto. apply single_lstep; constructor; apply s_parL; auto.
    ∃ (p||(q'||r)); split; iauto. apply single_lstep; constructor; apply s_parR; apply s_parL; auto.
    rename q' into r'. ∃ (p||(q||r')); split; iauto. apply single_lstep; constructor; apply s_parR; apply s_parR; auto.
    × split; intros.
    - edestruct tstep_wbisim2 as [q'[??]]; eauto.
    - edestruct lstep_wbisim2 as [q'[??]]; eauto.
  Qed.

  Lemma sbisim_sum_comm: ∀ p q,
    sbisimilar (p+q) (q+p).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=p+q ∧ qq=q+p) ∨ pp=qq).
    split; iauto.
    clear p q.
    apply strong_bisimulation_symm; (intros pp qq [ [p[q[??]]] | ?]; [subst pp qq | subst qq; rename pp into p]; unfold inv in *; intros).
    × false.
    × reflexivity.
    × split; intros.
    - inverts H.
    ∃ p'; split; auto. apply s_sumR; auto.
    ∃ p'; split; auto. apply s_sumL; auto.
    ∃ p_nil; split; auto; apply s_sum_nil.
    - inverts H; inverts H0; ∃ p'; split; auto; constructor.
    apply s_sumR; auto.
    apply s_sumL; auto.
    apply s_sumR; auto.
    apply s_sumL; auto.
    × split; intros.
    - ∃ p'; split; auto.
    - ∃ p'; split; auto.
    × jauto.
    × auto.
  Qed.

  Lemma wbisim_sum_comm: ∀ p q,
    wbisimilar (p+q) (q+p).
  Proof. intros; apply sbisim_wbisim; apply sbisim_sum_comm. Qed.

  Lemma wbisim_intro_tau: ∀ p,
    wbisimilar (().p) p.
  Proof.
    intros.
    ∃ (fun p q ⇒ p=().q ∨ wbisimilar p q).
    split; auto.
    clear p.
    splits; intros p q [?|?]; subst; intros; unfold inv in ×.
    × false.
    × apply halted_wbisim1; auto.
    × apply single_tstep; apply s_act.
    × apply halted_wbisim2; auto.
    × split; intros.
    - inverts H. ∃ p'; split. apply step_nil. right; apply wbisim_refl.
    - inverts H; inverts H0.
    × split; intros.
    - edestruct tstep_wbisim1 as [q'[??]]; eauto.
    - edestruct lstep_wbisim1 as [q'[??]]; eauto.
    × split; intros.
    - ∃ p'; split. eapply step_tcons. apply s_act. apply single_tstep; auto. right; apply wbisim_refl.
    - ∃ p'; split. eapply step_tcons. apply s_act. apply single_lstep; auto. right; apply wbisim_refl.
    × split; intros.
    - edestruct tstep_wbisim2 as [q'[??]]; eauto.
    - edestruct lstep_wbisim2 as [q'[??]]; eauto.
  Qed.

  Lemma wbisim_res_nil: ∀ a n,
    wbisimilar (a#n:O) O.
  Proof.
    intros.
    apply wbisim_step; intros; try solve [false]; try (eexists; split; [| apply wbisim_refl] ).
    × apply single_tstep; constructor.
    × inverts H. inverts H3. inverts H4. inverts H4. apply step_nil.
    × inverts H.
    × inverts H; inverts H0; inverts H3.
    × inverts H; inverts H0.
  Qed.

  Lemma wbisim_res_comm: ∀ a n m b p,
    a ≠ b →
    wbisimilar (a#n:b#m:p) (b#m:a#n:p).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ a n m b p, a≠b ∧ pp=a#n:b#m:p ∧ qq=b#m:a#n:p) ∨ wbisimilar pp qq).
    split; [| left; jauto].
    clear a m n b p H.
    apply weak_bisimulation_symm;
      (intros pp qq [ [a[n[m[b[p[Hab[??]]]]]]] | ?]; [subst pp qq | renames pp to p, qq to q]; intros; unfold inv in *).
    × false.
    × apply halted_wbisim1; auto.
    × split; intros.
    - inverts H. inverts H3.
    + ∃ (b#m:a#n:p'); split.
    apply single_tstep; apply s_res; auto; apply s_res; auto.
    left; jauto.
    + renames n0 to m.
    ∃ (b#m:a#n:p'); split.
    apply single_tstep; apply s_res_count_in. apply s_res; auto; congruence.
    left; jauto.
    + ∃ (b#(S m):a#n:p'); split.
    apply single_tstep; apply s_res_count_out. apply s_res; auto; congruence.
    left; jauto.
    + ∃ p_nil; split.
    eapply step_tcons. apply s_res; try congruence. apply s_res_nil; congruence.
    apply single_tstep. apply s_res_nil.
    right. apply wbisim_res_nil.
    + inverts H4. rename n0 into n.
    ∃ (b#m:a#n:p'); split.
    apply single_tstep; apply s_res; try congruence. apply s_res_count_in; auto; congruence.
    left; jauto.
    + inverts H4.
    ∃ (b#m:a#(S n):p'); split.
    apply single_tstep; apply s_res; try congruence. apply s_res_count_out; auto; congruence.
    left; jauto.
    - inverts H.
    + inverts H0. inverts H3.
    ∃ (b#m:a#n:p'); split.
    apply single_lstep; constructor. apply s_res; try congruence. apply s_res; try congruence.
    left; jauto.
    + inverts H0. inverts H3.
    ∃ (b#m:a#n:p'); split.
    apply single_lstep; constructor. apply s_res; try congruence. apply s_res; try congruence.
    left; jauto.
    × split; intros.
    - edestruct tstep_wbisim1 as [q'[??]]; eauto.
    - edestruct lstep_wbisim1 as [q'[??]]; eauto.
    × left; ∃ b m n a p; splits; auto.
    × right; symmetry; auto.
  Qed.

  Lemma wbisim_res_act_comm: ∀ a n l p,
    l ≠ l_in a → l≠ l_out a →
    wbisimilar (a#n: p_act l p) (p_act l (a#n:p)).
  Proof.
    intros.
    apply wbisim_step; intros; try solve [false].
    × inverts H1. inverts H5.
    + eexists; split; [| apply wbisim_refl]. apply single_tstep; constructor.
    + inverts H6. false.
    + inverts H6. false.
    × inverts H1.
    + eexists; split; [| apply wbisim_refl]. apply single_tstep; repeat constructor; auto.
    × inverts H1; inverts H2; inverts H5.
    + eexists; split; [| apply wbisim_refl]. apply single_lstep; repeat constructor.
    + eexists; split; [| apply wbisim_refl]. apply single_lstep; repeat constructor.
    × inverts H1; inverts H2.
    + eexists; split; [| apply wbisim_refl]. apply single_lstep; repeat constructor; intro HH; inverts HH; false.
    + eexists; split; [| apply wbisim_refl]. apply single_lstep; repeat constructor; intro HH; inverts HH; false.
  Qed.

  Lemma wbisim_res_in_comm: ∀ a n b p,
    a ≠ b →
    wbisimilar (a#n:b?.p) (b?.a#n:p).
  Proof. intros; apply wbisim_res_act_comm; congruence. Qed.

  Lemma wbisim_res_out_comm: ∀ a n b p,
    a ≠ b →
    wbisimilar (a#n:b!.p) (b!.a#n:p).
  Proof. intros; apply wbisim_res_act_comm; congruence. Qed.


  Inductive rep_step_result p' p : proc→Prop :=
  | rep_step_result0: rep_step_result p' p (p' || p!!)
  | rep_step_result1: ∀ p'p,
    rep_step_result p' p p'p →
    rep_step_result p' p (p||p'p).

  Lemma proc_eq_dec: ∀ (p1 p2: proc), {p1=p2}+{p1≠p2}.
  Proof. intros. repeat decide equality. Qed.

  Fixpoint get_step_rep_p' p pp' := match pp' with
  | p1 || p2 ⇒ if proc_eq_dec p2 (p!!) then p1 else get_step_rep_p' p p2
  | p ⇒ p
  end.

  Lemma rep_step_result_get: ∀ p p' pp',
    rep_step_result p' p pp' → p' = get_step_rep_p' p pp'.
  Proof.
    intros.
    induction H; simpl.
    destruct proc_eq_dec; auto. false.
    subst.
    destruct proc_eq_dec; auto. subst.
    inverts H.
  Qed.

  Lemma step_rep_inv: ∀ p a pp',
    step (p!!) a pp' →
    step p a (get_step_rep_p' p pp') ∧ rep_step_result (get_step_rep_p' p pp') p pp'.
  Proof.
    intros.
    revert p H.
    induction pp'; intros; inverts H; inverts H1; simpl in ×.
    × destruct proc_eq_dec; try discriminate.
    split; auto. apply rep_step_result0.
    false.
    × destruct proc_eq_dec. subst.
    clear -H3; false.
    inverts H3. inverts H0.
    edestruct IHpp'2 as [??]; eauto.
    split; auto.
    apply rep_step_result1; auto.
  Qed.

  Inductive step__ : proc→label→proc→Prop :=
  | s_act__: ∀ l p,
      step__ (p_act l p) l p
  | s_parL__: ∀ p q l p',
      step__ p l p' →
      step__ (p || q) l (p' || q)
  | s_parR__: ∀ p q l q',
      step__ q l q' →
      step__ (p || q) l (p || q')
  | s_sumL__: ∀ p q l p',
      step__ p l p' →
      step__ (p + q) l p'
  | s_sumR__: ∀ p q l q',
      step__ q l q' →
      step__ (p + q) l q'
  | s_seq__: ∀ p q l p',
      step__ p l p' →
      step__ (p;; q) l (p';; q)
  | s_res__: ∀ a n p l p',
      step__ p l p' →
      l ≠ l_in a → l ≠ l_out a →
      step__ (a#n: p) l (a#n: p')
  | s_res_count_in__: ∀ a n p p',
      step__ p (l_in a) p' →
      step__ (a#(S n): p) l_tau (a#n: p')
  | s_res_count_out__: ∀ a n p p',
      step__ p (l_out a) p' →
      step__ (a#n: p) l_tau (a#(S n): p')
  | s_rep__: ∀ p a p' pp',
      step__ p a p' →
      rep_step_result p' p pp' →
      step__ (p!!) a pp'
  
  | s_par_nil__:
      step__ (p_nil || p_nil) l_tau p_nil
  | s_sum_nil__:
      step__ (p_nil+p_nil) l_tau p_nil
  | s_seq_nil__: ∀ p,
      step__ (p_nil;; p) l_tau p
  | s_res_nil__: ∀ a n,
      step__ (a#n:p_nil) l_tau p_nil

  .

  Lemma step_rep_result: ∀ l p' p pp',
    step p l p' → rep_step_result p' p pp' → step (p!!) l pp'.
  Proof.
    intros.
    induction H0.
    apply s_rep. apply s_parL; auto.
    apply s_rep; auto.
    apply s_parR; auto.
  Qed.

  Lemma step_step__: ∀ p l p',
    step p l p' ↔ step__ p l p'.
  Proof.
    split; intros.
    × induction H; intros; try solve [constructor; auto].
    apply s_sumR__; auto.
    inverts IHstep.
    apply s_rep__ with p'0; auto.
    apply rep_step_result0; auto.
    inverts H4.
    apply s_rep__ with p'; auto.
    apply rep_step_result1; auto.
    apply s_sum_nil__.
    × induction H; intros; try solve [constructor; auto].
    apply s_sumR; auto.
    eapply step_rep_result; eauto.
    apply s_sum_nil.
  Qed.

  Definition step_ind' (P : proc → label → proc → Prop)
  (H0: ∀ (l : label) (p : proc), P (p_act l p) l p)
  (H1: ∀ (p q : proc) (l : label) (p' : proc),
   step p l p' → P p l p' → P (p || q) l (p' || q))
  (H2: ∀ (p q : proc) (l : label) (q' : proc),
   step q l q' → P q l q' → P (p || q) l (p || q'))
  (H3: ∀ (p q : proc) (l : label) (p' : proc),
   step p l p' → P p l p' → P (p + q) l p')
  (H4: ∀ (p q : proc) (l : label) (q' : proc),
   step q l q' → P q l q' → P (p + q) l q')
  (H5: ∀ (p q : proc) (l : label) (p' : proc),
   step p l p' → P p l p' → P (p;; q) l (p';; q))
  (H6: ∀ (a : name) (n : nat) (p : proc) (l : label) (p' : proc),
   step p l p' →
   P p l p' → l ≠ (l_in a) → l ≠ (l_out a) → P (a#n:p) l (a#n:p'))
  (H7: ∀ (a : name) (n : nat) (p p' : proc),
   step p (l_in a) p' → P p (l_in a) p' → P (p_res a (S n) p) l_tau (a#n:p'))
  (H8: ∀ (a : name) (n : nat) (p p' : proc),
   step p (l_out a) p' → P p (l_out a) p' → P (a#n:p) l_tau (p_res a (S n) p'))
  (H9: ∀ (p : proc) (a : label) (p' : proc) pp',
   step p a p' → P p a p' → rep_step_result p' p pp' → P (p!!) a pp')
  (H10: P (O || O) l_tau O)
  (H11: P (O + O) l_tau O)
  (H12: ∀ p : proc, P (O;; p) l_tau p)
  (H13: ∀ (a : name) (n : nat), P (a#n:Ø) l_tau Ø):
  (∀ p a p' (H: step p a p'), P p a p').
  Proof.
    intros.
    apply step___ind; intros; eauto; try solve [apply step_step__ in H14; eauto].
    apply step_step__; auto.
  Qed.

  Lemma sbisim_par_rep: ∀ p,
    sbisimilar (p || p!!) (p!!).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (pp=p||p!! ∧ qq=p!!) ∨ (pp=qq)).
    split; auto.
    splits; intros pp qq [[??]|?]; intros; subst.
    × false.
    × reflexivity.
    × false.
    × reflexivity.
    × split; intros; ∃ p'; split; auto.
    - apply s_rep; auto.
    - inverts H; constructor; apply s_rep; auto.
    × split; intros; ∃ p'; split; auto.
    × unfold inv; split; intros; ∃ p'; split; auto.
    - inverts H; auto.
    - inverts H; inverts H0; constructor; auto.
    × unfold inv; split; intros; ∃ p'; split; auto.
  Qed.

  Lemma wbisim_par_rep: ∀ p,
    wbisimilar (p || p!!) (p!!).
  Proof. intros; apply sbisim_wbisim; apply sbisim_par_rep. Qed.

  Lemma wbisim_sum_nilL: ∀ p,
    wbisimilar (O+p) p.
  Proof.
    intros.
    ∃ (fun p q ⇒ p=O+q ∨ q=p).
    split; auto.
    clear p.
    splits; intros p q [?|?]; intros; unfold inv in *; subst.
    × false.
    × apply step_nil.
    × simpl in H0. red in H0. subst. apply single_tstep. apply s_sum_nil.
    × apply step_nil.
    × split; intros.
    + inverts H. inverts H4.
    ∃ p'; split; auto. apply single_tstep; auto.
    ∃ O; split; auto. apply step_nil.
    + inverts H; inverts H0.
    - inverts H4.
    - ∃ p'; split; auto. apply single_lstep; auto. constructor; auto.
    - inverts H4.
    - ∃ p'; split; auto. apply single_lstep; constructor; auto.
    × split; intros.
    + ∃ p'; split; auto. apply single_tstep; auto.
    + ∃ p'; split; auto. apply single_lstep; auto.
    × split; intros.
    + ∃ p'; split; auto. apply single_tstep; apply s_sumR; auto.
    + ∃ p'; split; auto. apply single_lstep. inverts H; constructor; apply s_sumR; auto.
    × split; intros.
    + ∃ p'; split; auto. apply single_tstep; auto.
    + ∃ p'; split; auto. apply single_lstep; auto.
  Qed.
  Lemma wbisim_sum_nilR: ∀ p,
    wbisimilar (p+O) p.
  Proof. intros; rewrite wbisim_sum_comm; apply wbisim_sum_nilL. Qed.

  Lemma wbisim_res_tau_sum: ∀ a n p q,
    wbisimilar (p_res a n (().p+().q)) ((().p_res a n p)+(().p_res a n q)).
  Proof.
    intros.
    apply wbisim_step; intros.
    × false.
    × false.
    × inverts H.
    + inverts H3; inverts H4.
    ∃ (a#n:p'0); split. apply single_tstep. apply s_sumL; apply s_act; apply s_res; auto. apply wbisim_refl.
    ∃ (a#n:p'0); split. apply single_tstep. apply s_sumR; apply s_act; apply s_res; auto. apply wbisim_refl.
    + inverts H4; inverts H3.
    + inverts H4; inverts H3.
    × inverts H.
    inverts H4.
    ∃ (a#n:p); split. apply single_tstep. apply s_res; auto. apply s_sumL; apply s_act. intro; false. intro; false. apply wbisim_refl.
    inverts H4.
    ∃ (a#n:q); split. apply single_tstep. apply s_res; auto. apply s_sumR; apply s_act. intro; false. intro; false. apply wbisim_refl.
    × inverts H; inverts H0; inverts H3; inverts H4.
    × inverts H; inverts H0; inverts H4; inverts H2.
  Qed.

  Lemma wbisim_res_in: ∀ a n p,
    wbisimilar (p_res a (S n) (a?.p)) (p_res a n p).
  Proof.
    intros.
    apply wbisim_step; intros.
    × false.
    × false.
    × inverts H.
    + inverts H3; inverts H4.
    + inverts H4.
    eexists; split. apply step_nil. apply wbisim_refl.
    + inverts H4.
    × inverts H.
    ∃ (a#n:p'); split. eapply step_tcons. apply s_res_count_in. apply s_act. apply single_tstep. apply s_res; auto. apply wbisim_refl.
    ∃ (a#n0:p'); split. eapply step_tcons. apply s_res_count_in. apply s_act. apply single_tstep. apply s_res_count_in; auto. apply wbisim_refl.
    ∃ (a#(S n):p'); split. eapply step_tcons. apply s_res_count_in. apply s_act. apply single_tstep. apply s_res_count_out; auto. apply wbisim_refl.
    ∃ O; split. eapply step_tcons. apply s_res_count_in. apply s_act. apply single_tstep. apply s_res_nil. apply wbisim_refl.
    × inverts H; inverts H0; inverts H3. false.
    × inverts H; inverts H0.
    ∃ (a#n:p'); split. eapply step_tcons. apply s_res_count_in. apply s_act. apply single_lstep; constructor; apply s_res; auto. apply wbisim_refl.
    ∃ (a#n:p'); split. eapply step_tcons. apply s_res_count_in. apply s_act. apply single_lstep; constructor; apply s_res; auto. apply wbisim_refl.
  Qed.

  Lemma wbisim_res_out: ∀ a n p,
    wbisimilar (p_res a n (a!.p)) (p_res a (S n) p).
  Proof.
    intros.
    apply wbisim_step; intros.
    × false.
    × false.
    × inverts H.
    + inverts H3; inverts H4.
    + inverts H4; inverts H3.
    + inverts H4.
    eexists; split. apply step_nil. apply wbisim_refl.
    × inverts H.
    ∃ (a#(S n):p'); split. eapply step_tcons. apply s_res_count_out. apply s_act. apply single_tstep. apply s_res; auto. apply wbisim_refl.
    ∃ (a#n:p'); split. eapply step_tcons. apply s_res_count_out. apply s_act. apply single_tstep. apply s_res_count_in; auto. apply wbisim_refl.
    ∃ (a#(S (S n)):p'); split. eapply step_tcons. apply s_res_count_out. apply s_act. apply single_tstep. apply s_res_count_out; auto. apply wbisim_refl.
    ∃ O; split. eapply step_tcons. apply s_res_count_out. apply s_act. apply single_tstep. apply s_res_nil. apply wbisim_refl.
    × inverts H; inverts H0; inverts H3. false.
    × inverts H; inverts H0.
    ∃ (a#(S n):p'); split. eapply step_tcons. apply s_res_count_out. apply s_act. apply single_lstep; constructor; apply s_res; auto. apply wbisim_refl.
    ∃ (a#(S n):p'); split. eapply step_tcons. apply s_res_count_out. apply s_act. apply single_lstep; constructor; apply s_res; auto. apply wbisim_refl.
  Qed.

  Lemma wbisim_sum_dup: ∀ p,
    wbisimilar (p+p) p.
  Proof.
    intros.
    apply wbisim_step; intros; try solve [false].
    × simpl in H; red in H; subst p. apply single_tstep. apply s_sum_nil.
    × ∃ p'; split; [ | apply wbisim_refl].
    inverts H. apply single_tstep; auto. apply single_tstep; auto. apply step_nil.
    × ∃ q'; split; [ | apply wbisim_refl].
    apply single_tstep; apply s_sumL; auto.
    × ∃ p'; split; [ | apply wbisim_refl].
    inverts H; inverts H0; apply single_lstep; constructor; auto.
    × ∃ q'; split; [ | apply wbisim_refl].
    apply single_lstep; inverts H; constructor; apply s_sumL; auto.
  Qed.

End Algebraic.

Section ContrasimulationAlgebraic.
  Import Notation.
  Import Notation.U.

  Lemma csim_par_swap: ∀ p q,
    contrasimilar (p||q) (q||p).
  Proof. intros; apply wbisim_csim; apply wbisim_par_swap. Qed.

  Lemma csim_par_nil1: ∀ p,
    contrasimilar (p||O) p.
  Proof. intros; apply wbisim_csim; apply wbisim_par_nil1. Qed.

  Lemma csim_par_nil2: ∀ p,
    contrasimilar (O||p) p.
  Proof. intros; apply wbisim_csim; apply wbisim_par_nil2. Qed.

  Lemma csim_seq_assoc: ∀ p q r,
    contrasimilar (p;;(q;;r)) ((p;;q);;r).
  Proof. intros; apply wbisim_csim; apply wbisim_seq_assoc. Qed.

  Lemma csim_par_assoc: ∀ p q r,
    contrasimilar (p||(q||r)) ((p||q)||r).
  Proof. intros; apply wbisim_csim; apply wbisim_par_assoc. Qed.

  Lemma csim_sum_comm: ∀ p q,
    contrasimilar (p+q) (q+p).
  Proof. intros; apply wbisim_csim; apply wbisim_sum_comm; auto. Qed.

  Lemma csim_intro_tau: ∀ p,
    contrasimilar (().p) p.
  Proof. intros; apply wbisim_csim; apply wbisim_intro_tau; auto. Qed.

End ContrasimulationAlgebraic.

Section Congruence.
  Import Notation.
  Import Notation.U.
  Open Scope proc.

  Hint Unfold tstep.

  Lemma wbisim_seq1: ∀ p q r,
    wbisimilar p q →
    wbisimilar (p;; r) (q;; r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=p;;r∧qq=q;;r ∧ wbisimilar p q) ∨ qq=pp).
    split; [| left; eauto].
    clear p q H.
    apply weak_bisimulation_symm; (intros pp qq [ [p[q[?[??]]]] | ?]; subst; [| rename pp into p]); intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × split; intros.
    - inverts H.
    edestruct tstep_wbisim1 as [q'[??]]; eauto. apply H5.
    ∃ (q';;r); split. apply step_star_seq_app; auto. left; eauto.
    ∃ p'; split; auto.
    change [] with ([]++@nil lts_L).
    eapply step_star_app.
    apply step_star_seq_app. apply halted_wbisim1; eauto. reflexivity.
    apply single_tstep; apply s_seq_nil.
    - inverts H; inverts H0.
    edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (q';;r); split. apply step_star_seq_app; auto. left; eauto.
    edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (q';;r); split. apply step_star_seq_app; auto. left; eauto.
    × split; intros.
    - ∃ p'; split; eauto. apply single_tstep; auto.
    - ∃ p'; split; eauto. apply single_lstep; auto.
    × left; ∃ q p; splits; auto. symmetry; auto.
    × auto.
  Qed.

  Lemma wbisim_seq2: ∀ p q r,
    wbisimilar p q →
    wbisimilar (r;; p) (r;; q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q r, pp=r;;p∧qq=r;;q ∧ wbisimilar p q) ∨ wbisimilar pp qq).
    split; [| left; jauto].
    clear p q r H.
    apply weak_bisimulation_symm; (intros pp qq [ [p[q[r[?[??]]]]] | ?]; subst); intros; unfold inv in ×.
    × false.
    × apply halted_wbisim1; auto.
    × split; intros.
    - inverts H.
    ∃ (p'0;;q); split. apply single_tstep; apply s_seq; auto. left; jauto.
    ∃ q; split; auto. apply single_tstep; apply s_seq_nil.
    - inverts H; inverts H0.
    ∃ (p'0;;q); split. apply single_lstep; constructor; apply s_seq; auto. left; jauto.
    ∃ (p'0;;q); split. apply single_lstep; constructor; apply s_seq; auto. left; jauto.
    × split; intros.
    - edestruct tstep_wbisim1 as [q'[??]]; eauto.
    - edestruct lstep_wbisim1 as [q'[??]]; eauto.
    × left; ∃ q p r; splits; auto. symmetry; auto.
    × right; symmetry; auto.
  Qed.

  Lemma wbisim_seq: ∀ p1 p2 q1 q2,
    wbisimilar p1 q1 → wbisimilar p2 q2 →
    wbisimilar (p1;;p2) (q1;;q2).
  Proof. intros; etransitivity; [eapply wbisim_seq1; eauto | apply wbisim_seq2; auto]. Qed.

  Lemma sbisim_parL: ∀ p q r,
    sbisimilar p q →
    sbisimilar (p||r) (q||r).
  Proof.
    intros.
    ∃ (fun pr qr ⇒ (∃ p q r, pr=p||r ∧ qr=q||r ∧ sbisimilar p q) ∨ (pr=O ∧ qr=O)).
    split; [| left; jauto].
    clear p q r H.
    apply strong_bisimulation_symm; (intros pr qr [ [p[q[r[?[??]]]]] | [??]]; subst); intros; unfold inv in ×.
    × false.
    × auto.
    × split; intros.
    - inverts H.
    + renames p'0 to p'.
    edestruct tstep_sbisim1 as [q'[??]]; eauto. apply H5.
    ∃ (q'||r); split. apply s_parL; auto. left; jauto.
    + renames q' to r'.
    ∃ (q||r'); split. apply s_parR; auto. left; jauto.
    + ∃ p_nil; split; auto.
    apply halted_sbisim1 in H1. subst.
    apply s_par_nil. reflexivity.
    - inverts H; inverts H0.
    + edestruct lstep_sbisim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (q'||r); split. inverts H; constructor; apply s_parL; auto. left; jauto.
    + renames q' to r'. ∃ (q||r'); split. constructor. apply s_parR; auto. left; jauto.
    + edestruct lstep_sbisim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (q'||r); split. inverts H; constructor; apply s_parL; auto. left; jauto.
    + renames q' to r'. ∃ (q||r'); split. constructor. apply s_parR; auto. left; jauto.
    × split; intros; inverts H; inverts H0.
    × left; ∃ q p r; splits; auto. apply sbisim_symm; auto.
    × auto.
  Qed.

  Lemma sbisim_parR: ∀ p q r,
    sbisimilar p q →
    sbisimilar (r||p) (r||q).
  Proof.
    intros.
    eapply sbisim_trans.
    apply sbisim_par_swap.
    eapply sbisim_trans.
    apply sbisim_parL; eauto.
    apply sbisim_par_swap.
  Qed.

  Lemma sbisim_par: ∀ p q r s,
    sbisimilar p q →
    sbisimilar r s →
    sbisimilar (p||r) (q||s).
  Proof. intros; eapply sbisim_trans. apply sbisim_parL; eauto. eapply sbisim_parR; eauto. Qed.

  Lemma wbisim_parL: ∀ p q r,
    wbisimilar p q →
    wbisimilar (p||r) (q||r).
  Proof.
    intros.
    ∃ (fun pr qr ⇒ (∃ p q r, pr=p||r ∧ qr=q||r ∧ wbisimilar p q) ∨ (pr=O ∧ qr=O)).
    split; [| left; jauto].
    clear p q r H.
    apply weak_bisimulation_symm; (intros pr qr [ [p[q[r[?[??]]]]] | [??]]; subst); intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × split; intros.
    - inverts H.
    + renames p'0 to p'.
    edestruct tstep_wbisim1 as [q'[??]]; eauto. apply H5.
    ∃ (q'||r); split. apply step_star_parL_step; auto. left; jauto.
    + renames q' to r'.
    ∃ (q||r'); split. apply single_tstep; apply s_parR; auto. left; jauto.
    + ∃ p_nil; split; auto.
    change [] with ([]++@nil lts_L).
    eapply step_star_app. apply step_star_parL_step. apply halted_wbisim1; eauto. reflexivity.
    apply single_tstep. apply s_par_nil.
    - inverts H; inverts H0.
    + edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (q'||r); split. apply step_star_parL_step; auto. left; jauto.
    + renames q' to r'. ∃ (q||r'); split. apply single_lstep; constructor. apply s_parR; auto. left; jauto.
    + edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (q'||r); split. apply step_star_parL_step; auto. left; jauto.
    + renames q' to r'. ∃ (q||r'); split. apply single_lstep; constructor. apply s_parR; auto. left; jauto.
    × split; intros; inverts H; inverts H0.
    × left; ∃ q p r; splits; auto. symmetry; auto.
    × auto.
  Qed.

  Lemma wbisim_parR: ∀ p q r,
    wbisimilar p q →
    wbisimilar (r||p) (r||q).
  Proof.
    intros.
    eapply wbisim_trans.
    apply wbisim_par_swap.
    eapply wbisim_trans.
    apply wbisim_parL; eauto.
    apply wbisim_par_swap.
  Qed.

  Lemma wbisim_par: ∀ p q r s,
    wbisimilar p q →
    wbisimilar r s →
    wbisimilar (p||r) (q||s).
  Proof. intros; eapply wbisim_trans. apply wbisim_parL; eauto. eapply wbisim_parR; eauto. Qed.

  Lemma wbisim_res: ∀ a n p q,
    wbisimilar p q → wbisimilar (a#n:p) (a#n:q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ n p q, pp=a#n:p ∧ qq=a#n:q ∧ wbisimilar p q) ∨ (pp=O∧qq=O)).
    split; [| left; jauto].
    clear n p q H.
    apply weak_bisimulation_symm; (intros pp qq [ [n[p[q[?[??]]]]] | [??] ]; subst); intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × split; intros.
    - inverts H.
    + rename p'0 into p'.
    edestruct tstep_wbisim1 as [q'[??]]; eauto. apply H4.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_nIn; auto.
    + renames p'0 to p', n0 to n.
    edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_count_in; auto.
    + renames p'0 to p'.
    edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (a#(S n):q'); split; [| left; jauto].
    apply step_star_res_count_out; auto.
    + ∃ O; split; auto.
    eapply step_tsnoc. apply step_star_res_nIn. apply halted_wbisim1; eauto. reflexivity.
    intros ? [ ].
    apply s_res_nil.
    - inverts H; inverts H0.
    + rename p'0 into p'.
    edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_nIn; auto. intros. inverts H2. auto. inverts H3.
    + rename p'0 into p'.
    edestruct lstep_wbisim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_nIn; auto. intros. inverts H2. auto. inverts H3.
    × split; intros; inverts H; inverts H0.
    × left; ∃ n q p; splits; auto. symmetry; auto.
    × auto.
  Qed.

  Lemma wbisim_res_list: ∀ AN p q,
    wbisimilar p q → wbisimilar (p_res_list AN p) (p_res_list AN q).
  Proof.
    induction AN; intros; auto. destruct a; simpl.
    apply wbisim_res; eauto.
  Qed.

  Lemma wbisim_stable_sum: ∀ p q r,
    wbisimilar p q →
    stable lts p → stable lts q →
    wbisimilar (p+r) (q+r).
  Proof.
    intros.
    apply wbisim_step; intros; try solve [false].
    × inverts H2. false; eapply H0. apply H7.
    ∃ p'; split. apply single_tstep; apply s_sumR; auto. apply wbisim_refl.
    ∃ (q+O); split. apply step_nil. rewrite wbisim_sum_nilR. auto.
    × inverts H2. false; eapply H1. apply H7.
    ∃ q'; split. apply single_tstep; apply s_sumR; auto. apply wbisim_refl.
    ∃ (p+O); split. apply step_nil. rewrite wbisim_sum_nilR. auto.
    × assert (lstep p a p' ∨ lstep r a p').
      inverts H2; (inverts H3; [left|right]; constructor; auto).
    clear H2; destruct H3.
    + edestruct lstep_wbisim1 as [q'[??]]; eauto.
    ∃ q'; split; auto.
    inverts H3.
    eapply step_lcons; eauto. inverts H8; constructor; apply s_sumL; eauto.
    eapply step_tcons; eauto. apply s_sumL; auto.
    + ∃ p'; split. apply single_lstep; inverts H2; constructor; apply s_sumR; auto. apply wbisim_refl.
    × assert (lstep q a q' ∨ lstep r a q').
      inverts H2; (inverts H3; [left|right]; constructor; auto).
    clear H2; destruct H3.
    + edestruct lstep_wbisim2 as [p'[??]]; eauto.
    ∃ p'; split; auto.
    inverts H3.
    eapply step_lcons; eauto. inverts H8; constructor; apply s_sumL; eauto.
    eapply step_tcons; eauto. apply s_sumL; auto.
    + ∃ q'; split. apply single_lstep; inverts H2; constructor; apply s_sumR; auto. apply wbisim_refl.
  Qed.

  Lemma wbisim_internal_sum: ∀ p q r,
    wbisimilar p q →
    wbisimilar (().p+r) (().q+r).
  Proof.
    intros.
    apply wbisim_step; intros; try solve [false].
    × inverts H0. inverts H5.
    eexists; split; eauto. apply single_tstep; apply s_sumL; constructor.
    ∃ p'; split. apply single_tstep; apply s_sumR; auto. apply wbisim_refl.
    × inverts H0. inverts H5.
    eexists; split; eauto. apply single_tstep; apply s_sumL; constructor.
    ∃ q'; split. apply single_tstep; apply s_sumR; auto. apply wbisim_refl.
    × inverts H0; inverts H1.
    inverts H5.
    ∃ p'; split. apply single_lstep; constructor; apply s_sumR; auto. apply wbisim_refl.
    inverts H5.
    ∃ p'; split. apply single_lstep; constructor; apply s_sumR; auto. apply wbisim_refl.
    × inverts H0; inverts H1.
    inverts H5.
    ∃ q'; split. apply single_lstep; constructor; apply s_sumR; auto. apply wbisim_refl.
    inverts H5.
    ∃ q'; split. apply single_lstep; constructor; apply s_sumR; auto. apply wbisim_refl.
  Qed.

  Lemma wbisim_act: ∀ l p q,
    wbisimilar p q → wbisimilar (p_act l p) (p_act l q).
  Proof.
    intros.
    apply wbisim_step; intros; try solve [false].
    × inverts H0. ∃ q; split; auto. apply single_tstep; constructor.
    × inverts H0. ∃ p; split; auto. apply single_tstep; constructor.
    × ∃ q; split. apply single_lstep; inverts H0; inverts H1; repeat constructor.
    inverts H0; inverts H1; auto.
    × ∃ p; split. apply single_lstep; inverts H0; inverts H1; repeat constructor.
    inverts H0; inverts H1; auto.
  Qed.

  Lemma interleaving_nil: ∀ lp la1 la2,
    [] = interleaving lp la1 la2 → la1=[] ∧ la2=(@nil lts_L).
  Proof.
    intros.
    destruct lp; simpl in H; [| destruct s; destruct u];
      destruct la1; destruct la2; simpl in H; try discriminate; auto.
  Qed.

  Lemma In_combine_swap: ∀ (A B:Type) (x:A) (y:B) l1 l2,
    In (x,y) (combine l1 l2) → In (y,x) (combine l2 l1).
  Proof.
    induction l1; destruct l2; simpl; intros; auto.
    destruct H; eauto.
    inverts H; eauto.
  Qed.

  Lemma Forall2_symm: ∀ A (R: A→A→Prop) lp lq,
    (∀ a b, R a b → R b a) →
    Forall2 R lp lq → Forall2 R lq lp.
  Proof. intros; induction H0; constructor; eauto. Qed.

  Lemma Forall2_list_rep: ∀ (A B: Type) (R: A→B→Prop) x y n,
    R x y → Forall2 R (list_rep n x) (list_rep n y).
  Proof. intros; induction n; simpl; constructor; auto. Qed.

  Definition par_list lp p := fold_right (fun q r ⇒ q||r) p lp.

  Fixpoint list_rep {A:Type} n (p:A) : list A := match n with
  | 0 ⇒ nil
  | S n ⇒ p::list_rep n p
  end.

  Definition esim_list := Forall2 eventually_similar.
  Definition wbisim_list := Forall2 wbisimilar.

  Lemma wbisim_list_cons: ∀ p lp q lq,
    wbisimilar p q → wbisim_list lp lq → wbisim_list (p::lp) (q::lq).
  Proof. intros; eapply Forall2_cons; eauto. Qed.

  Lemma wbisim_list_app: ∀ lp1 lp2 lq1 lq2,
    wbisim_list lp1 lq1 → wbisim_list lp2 lq2 → wbisim_list (lp1++lp2) (lq1++lq2).
  Proof. intros; eapply Forall2_app; eauto. Qed.

  Lemma wbisim_list_nil: wbisim_list [] [].
  Proof. intros; apply Forall2_nil. Qed.

  Lemma wbisim_list_single: ∀ p q,
    wbisim_list [p] [q] ↔ wbisimilar p q.
  Proof. split; intros. inverts H; auto. constructor; auto. Qed.

  Lemma wbisim_list_same_split: ∀ lp1 lp2 lq,
    wbisim_list (lp1++lp2) lq → ∃ lq1 lq2, lq=lq1++lq2 ∧ wbisim_list lp1 lq1 ∧ wbisim_list lp2 lq2.
  Proof. intros; edestruct Forall2_app_inv_l as [lq1[lq2[?[??]]]]; eauto. Qed.

  Lemma wbisim_list_symm: ∀ lp lq,
    wbisim_list lp lq → wbisim_list lq lp.
  Proof. intros; apply Forall2_symm; auto; apply wbisim_symm. Qed.

  Lemma esim_list_cons: ∀ p lp q lq,
    eventually_similar p q → esim_list lp lq → esim_list (p::lp) (q::lq).
  Proof. intros; apply Forall2_cons; eauto. Qed.

  Lemma esim_list_app: ∀ lp1 lp2 lq1 lq2,
    esim_list lp1 lq1 → esim_list lp2 lq2 → esim_list (lp1++lp2) (lq1++lq2).
  Proof. intros; apply Forall2_app; eauto. Qed.

  Lemma esim_list_nil: esim_list [] [].
  Proof. apply Forall2_nil. Qed.

  Lemma esim_list_single: ∀ p q,
    esim_list [p] [q] ↔ eventually_similar p q.
  Proof. split; intros. inverts H; auto. apply Forall2_cons; eauto. Qed.

  Lemma esim_list_same_split: ∀ lp1 lp2 lq,
    esim_list (lp1++lp2) lq → ∃ lq1 lq2, lq=lq1++lq2 ∧ esim_list lp1 lq1 ∧ esim_list lp2 lq2.
  Proof. intros; edestruct Forall2_app_inv_l as [lq1[lq2[?[??]]]]; eauto. Qed.

  Lemma rep_step_result_list_rep: ∀ p' p pp',
    rep_step_result p' p pp' →
    ∃ n,
    pp' = par_list (list_rep n p++[p']) (p!!).
  Proof.
    intros.
    induction H.
    × ∃ 0; reflexivity.
    × destruct IHrep_step_result as [n ?].
    ∃ (S n); simpl; congruence.
  Qed.

  Lemma list_rep_snoc: ∀ (A:Type) (p:A) n,
    list_rep (S n) p = list_rep n p ++ [p].
  Proof. induction n; simpl in *; intros; congruence. Qed.

  Lemma list_rep_mid: ∀ (A:Type) (p:A) n1 n2,
    list_rep (S (n1+n2)) p = list_rep n1 p ++ [p] ++ list_rep n2 p.
  Proof. induction n1; simpl in *; intros; congruence. Qed.

  Lemma par_list_not_halted1: ∀ lp p, ¬is_halted p → ¬is_halted (par_list lp p).
  Proof. destruct lp; simpl; intros; intro; false. Qed.

  Lemma par_list_app: ∀ lp1 lp2 p,
    par_list (lp1++lp2) p = par_list lp1 (par_list lp2 p).
  Proof. apply fold_right_app. Qed.

  Lemma step_par_list_inv: ∀ lp p l pp',
    step (par_list lp p) l pp' →
    ¬is_halted p →
    (∃ p', step p l p' ∧ pp' = par_list lp p') ∨
    (∃ lp1 q lp2 q',
     lp = lp1 ++ [q] ++ lp2 ∧
     step q l q' ∧ pp' = par_list (lp1 ++ [q'] ++ lp2) p).
  Proof.
    induction lp; simpl; intros; eauto.
    inverts H.
    × right; ∃ (@nil proc) a lp p'; splits; auto.
    × renames q' to pp''.
    edestruct IHlp as [ [p'[??]] | [lp1[q[lp2[q'[?[??]]]]]] ]; eauto.
    - left; ∃ p'; split; auto. congruence.
    - subst; right; ∃ (a::lp1) q lp2 q'; splits; auto.
    × destruct lp; simpl in H3. subst; false. inverts H3.
  Qed.

  Lemma step_rep_inv': ∀ p l pp',
    step (p!!) l pp' →
    ∃ n p',
      step p l p' ∧ pp' = par_list (list_rep n p++[p']) (p!!).
  Proof.
    intros.
    edestruct step_rep_inv; eauto.
    edestruct rep_step_result_list_rep as [n ?]; eauto.
  Qed.

  Lemma par_list_rep_nterm: ∀ lp p la pp',
    step_star (par_list lp (p!!)) la pp' → ¬is_halted pp'.
  Proof.
    intros.
    remember (par_list lp (p!!)) as pp.
    revert lp Heqpp.
    induction H; intros; subst.
    × destruct lp; simpl; intro; false.
    × renames p' to pp'.
    edestruct step_par_list_inv as [ [pp''[??]] | [lp1[r[lp2[r'[?[??]]]]]] ]; eauto.
    inverts H; eauto.
    intro; false.
    subst pp'.
    edestruct step_rep_inv' as [n[p'[??]]]; eauto.
    apply (IHstep_star (lp++list_rep n p++[p'])).
    subst pp''.
    repeat rewrite par_list_app. reflexivity.
    × renames p' to pp'.
    edestruct step_par_list_inv as [ [pp''[??]] | [lp1[r[lp2[r'[?[??]]]]]] ]; eauto.
    apply H.
    intro; false.
    subst pp'.
    edestruct step_rep_inv' as [n[p'[??]]]; eauto.
    apply (IHstep_star (lp++list_rep n p++[p'])).
    subst pp''.
    repeat rewrite par_list_app. reflexivity.
  Qed.

  Lemma par_nterm: ∀ p la pp',
    step_star (p!!) la pp' → ¬is_halted pp'.
  Proof. intros; eapply (par_list_rep_nterm nil); eauto. Qed.

  Lemma list_rep_length: ∀ (A:Type) (p:A) n,
    length (list_rep n p) = n.
  Proof. induction n; simpl; intros; auto. Qed.

  Lemma step_par_list1_app_l: ∀ lp1 lp2 p l lp1',
    (∀ q, step (par_list lp1 q) l (par_list lp1' q)) →
    step (par_list (lp1++lp2) p) l (par_list (lp1'++lp2) p).
  Proof. intros; repeat rewrite par_list_app; eauto. Qed.

  Lemma step_par_list1_app_r: ∀ lp1 lp2 p l lp2',
    step (par_list lp2 p) l (par_list lp2' p) →
    step (par_list (lp1++lp2) p) l (par_list (lp1++lp2') p).
  Proof. induction lp1; simpl; intros; auto; apply s_parR; auto. Qed.

  Lemma step_par_list1_cons: ∀ r lp p l r',
    step r l r' →
    step (par_list (r::lp) p) l (par_list (r'::lp) p).
  Proof. simpl; intros; apply s_parL; auto. Qed.

  Lemma step_par_list1: ∀ lp1 r lp2 p l r',
    step r l r' →
    step (par_list (lp1++[r]++lp2) p) l (par_list (lp1++[r']++lp2) p).
  Proof.
    induction lp1; simpl; intros.
    apply s_parL; auto.
    apply s_parR.
    change (r::lp2) with ([r]++lp2).
    change (r'::lp2) with ([r']++lp2).
    auto.
  Qed.

  Lemma step_par_list2: ∀ lp p l p',
    step p l p' →
    step (par_list lp p) l (par_list lp p').
  Proof.
    induction lp; simpl; intros; eauto.
    apply s_parR; auto.
  Qed.

  Lemma step_star_par_list1: ∀ lp1 r lp2 p la r',
    step_star r la r' →
    step_star (par_list (lp1++[r]++lp2) p) la (par_list (lp1++[r']++lp2) p).
  Proof.
    intros.
    induction H.
    × apply step_nil.
    × eapply step_lcons; eauto. inverts H; constructor; apply step_par_list1; eauto.
    × eapply step_tcons; eauto. apply step_par_list1; eauto.
  Qed.

  Lemma step_star_par_list2: ∀ lp p l p',
    step_star p l p' →
    step_star (par_list lp p) l (par_list lp p').
  Proof.
    intros.
    induction H.
    × apply step_nil.
    × eapply step_lcons; eauto. inverts H; constructor; apply step_par_list2; eauto.
    × eapply step_tcons; eauto. apply step_par_list2; eauto.
  Qed.

  Lemma sbisim_par_list: ∀ lp p q,
    sbisimilar p q → sbisimilar (par_list lp p) (par_list lp q).
  Proof.
    intros.
    induction lp; simpl; auto.
    apply sbisim_parR; auto.
  Qed.

  Lemma step_star_par_list_unzip: ∀ lp p la pp',
    step_star (par_list lp p) la pp' →
    (∀ la p', step_star p la p' → ¬is_halted p') →
    ∃ lip la1 la2 lp1' p',
      (∀ q, step_star (par_list lp q) la1 (par_list lp1' q)) ∧
      step_star p la2 p' ∧
      pp' = par_list lp1' p' ∧
      la = interleaving lip la1 la2.
  Proof.
    intros.
    remember (par_list lp p) as pp.
    revert lp p H0 Heqpp.
    induction H; intros; subst.
    × renames p0 to p.
    ∃ (@nil (unit+unit)) (@nil label) (@nil label) lp p; splits; intros; auto; apply @step_nil.
    × renames p0 to p, p' to pp', p'' to pp''.
    edestruct step_par_list_inv as [ [p'[??]] | [lp1[q[lp2[q'[?[??]]]]]] ]; eauto.
    inverts H; eauto.
    eapply H1; apply step_nil.
    - subst.
    edestruct (IHstep_star lp p') as [lip[la1[la2[lp1'[p''[?[?[??]]]]]]]]; eauto; clear IHstep_star.
    intros; eapply H1; inverts H.
    eapply step_lcons with (a:=l_in a0); eauto; constructor; apply H2.
    eapply step_lcons with (a:=l_out a0); eauto; constructor; apply H2.
    subst pp'' la.
    ∃ (inr tt::lip) la1 (a::la2) lp1' p''; splits; auto.
    eapply step_lcons; eauto. inverts H; constructor; eauto.
    - subst lp pp'.
    edestruct (IHstep_star (lp1++[q']++lp2) p) as [lip[la1[la2[lp1'[p''[?[?[??]]]]]]]]; eauto; clear IHstep_star.
    subst pp'' la.
    ∃ (inl tt::lip) (a::la1) la2 lp1' p''; splits; auto.
    intros; eapply step_lcons; eauto.
    inverts H; constructor; apply step_par_list1; auto.
    × renames p0 to p, p' to pp', p'' to pp''.
    edestruct step_par_list_inv as [ [p'[??]] | [lp1[q[lp2[q'[?[??]]]]]] ]; eauto.
    apply H.
    eapply H1; apply step_nil.
    - subst pp'.
    edestruct (IHstep_star lp p') as [lip[la1[la2[lp1'[p''[?[?[??]]]]]]]]; eauto; clear IHstep_star.
    intros; eapply H1. eapply step_tcons; eauto. apply H2.
    subst pp'' la.
    ∃ lip la1 la2 lp1' p''; splits; auto.
    eapply step_tcons; eauto. apply H2.
    - subst lp pp'.
    edestruct (IHstep_star (lp1++[q']++lp2) p) as [lip[la1[la2[lp1'[p''[?[?[??]]]]]]]]; eauto; clear IHstep_star.
    subst pp'' la.
    ∃ lip la1 la2 lp1' p''; splits; auto.
    intros; eapply step_tcons; eauto.
    apply step_par_list1; auto.
  Qed.

  Lemma sbisim_nterm_par_assoc: ∀ p q r,
    (∀ la q', step_star q la q' → ¬is_halted q') →
    sbisimilar (p || (q || r)) ((p||q)||r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ ∃ p q r, pp=p||(q||r) ∧ qq=(p||q)||r ∧ (∀ la q', step_star q la q' → ¬is_halted q')).
    split; [| ∃ p q r; splits; intros; auto; eapply H; eauto].
    clear p q r H.
    splits; intros pp qq [p[q[r[?[??]]]]]; unfold inv; intros; subst pp qq.
    × false.
    × false.
    × split; intros.
    - inverts H; [| inverts H5].
    + renames p'0 to p'. ∃ (p' || q || r); split.
    apply s_parL; apply s_parL; auto.
    ∃ p' q r; splits; intros; auto.
    eapply H1; eauto.
    + renames p' to q'. ∃ (p || q' || r); split.
    apply s_parL; apply s_parR; auto.
    ∃ p q' r; splits; intros; auto.
    eapply H1. eapply step_tcons; eauto. apply H4.
    + renames q'0 to r'. ∃ (p || q || r'); split.
    apply s_parR; auto.
    ∃ p q r'; splits; intros; auto.
    eapply H1; eauto.
    + false; eapply H1. apply step_nil. reflexivity.
    - inverts H; (inverts H0; [| inverts H5]).
    + renames p'0 to p'. ∃ (p' || q || r); split.
    constructor; apply s_parL; apply s_parL; auto.
    ∃ p' q r; splits; intros; auto.
    eapply H1; eauto.
    + renames p' to q'. ∃ (p || q' || r); split.
    constructor; apply s_parL; apply s_parR; auto.
    ∃ p q' r; splits; intros; auto.
    eapply H1. eapply step_lcons; eauto. constructor; eauto.
    + renames q'0 to r'. ∃ (p || q || r'); split.
    constructor; apply s_parR; auto.
    ∃ p q r'; splits; intros; auto.
    eapply H1; eauto.
    + renames p'0 to p'. ∃ (p' || q || r); split.
    constructor; apply s_parL; apply s_parL; auto.
    ∃ p' q r; splits; intros; auto.
    eapply H1; eauto.
    + renames p' to q'. ∃ (p || q' || r); split.
    constructor; apply s_parL; apply s_parR; auto.
    ∃ p q' r; splits; intros; auto.
    eapply H1. eapply step_lcons; eauto. constructor 2; eauto.
    + renames q'0 to r'. ∃ (p || q || r'); split.
    constructor; apply s_parR; auto.
    ∃ p q r'; splits; intros; auto.
    eapply H1; eauto.
    × split; intros.
    - inverts H; [inverts H5 | ].
    + ∃ (p' || (q || r)); split.
    apply s_parL; auto.
    ∃ p' q r; splits; intros; auto.
    eapply H1; eauto.
    + ∃ (p || (q' || r)); split.
    apply s_parR; apply s_parL; auto.
    ∃ p q' r; splits; intros; auto.
    eapply H1. eapply step_tcons; eauto. apply H4.
    + false; eapply H1. apply step_nil. reflexivity.
    + renames q' to r'. ∃ (p || (q || r')); split.
    apply s_parR; apply s_parR; auto.
    ∃ p q r'; splits; intros; auto.
    eapply H1; eauto.
    - inverts H; (inverts H0; [inverts H5 | ]).
    + ∃ (p' || (q || r)); split.
    constructor; apply s_parL; auto.
    ∃ p' q r; splits; intros; auto.
    eapply H1; eauto.
    + ∃ (p || (q' || r)); split.
    constructor; apply s_parR; apply s_parL; auto.
    ∃ p q' r; splits; intros; auto.
    eapply H1. eapply step_lcons; eauto. constructor; eauto.
    + renames q' to r'. ∃ (p || (q || r')); split.
    constructor; apply s_parR; apply s_parR; auto.
    ∃ p q r'; splits; intros; auto.
    eapply H1; eauto.
    + ∃ (p' || (q || r)); split.
    constructor; apply s_parL; auto.
    ∃ p' q r; splits; intros; auto.
    eapply H1; eauto.
    + ∃ (p || (q' || r)); split.
    constructor; apply s_parR; apply s_parL; auto.
    ∃ p q' r; splits; intros; auto.
    eapply H1. eapply step_lcons; eauto. constructor 2; eauto.
    + renames q' to r'. ∃ (p || (q || r')); split.
    constructor; apply s_parR; apply s_parR; auto.
    ∃ p q r'; splits; intros; auto.
    eapply H1; eauto.
  Qed.

  Lemma sbisim_par_list_rep: ∀ lp p,
    sbisimilar (par_list (p::lp) (p!!)) (par_list lp (p!!)).
  Proof.
    intros lp p; induction lp; simpl in *; intros.
    apply sbisim_par_rep.
    renames a to q.
    eapply sbisim_trans.
    apply sbisim_parR. apply sbisim_par_swap.
    eapply sbisim_trans.
    apply sbisim_nterm_par_assoc.
    apply par_list_rep_nterm.
    eapply sbisim_trans.
    apply sbisim_parL; eauto.
    apply sbisim_par_swap.
  Qed.

  Lemma sbisim_list_rep_par_list: ∀ p n,
      sbisimilar (p!!) (par_list (list_rep n p) (p!!)).
  Proof.
    induction n; intros.
    apply sbisim_refl.
    eapply sbisim_trans; eauto.
    apply sbisim_symm.
    apply sbisim_par_list_rep.
  Qed.

  Lemma sbisim_list_rep_par_list': ∀ p lp n,
      sbisimilar (par_list lp (p!!)) (par_list (list_rep n p++lp) (p!!)).
  Proof.
    induction n; intros.
    apply sbisim_refl.
    eapply sbisim_trans; eauto.
    apply sbisim_symm.
    apply sbisim_par_list_rep.
  Qed.

  Lemma step_star_rep_par_list: ∀ lp p la pp',
    step_star (par_list lp (p!!)) la pp' →
    ∃ n lp',
      (∀ q, step_star (par_list (lp++list_rep n p) q) la (par_list lp' q)) ∧
      pp' = (par_list lp' (p!!)) ∧
      length lp' = length (lp++list_rep n p).
  Proof.
    intros.
    remember (par_list lp (p!!)) as pp.
    revert lp Heqpp.
    induction H; intros; subst.
    × ∃ 0 lp; simpl; splits; intros.
    rewrite app_nil_r. apply @step_nil. reflexivity. rewrite app_length. auto.
    × renames p' to pp', p'' to pp''.
    edestruct step_par_list_inv as [ [ppp'[??]] | [lp1'[q[lp2'[q'[?[??]]]]]] ]; eauto.
    inverts H; eauto.
    eapply par_nterm. apply step_nil.
    - subst pp'.
    edestruct step_rep_inv; eauto.
    edestruct rep_step_result_list_rep as [n ?]; eauto.
    remember (get_step_rep_p' p ppp') as p'.
    clear Heqp'.
    subst ppp'.
    edestruct (IHstep_star (lp++list_rep n p++[p'])) as [n'[lp'[?[??]]]]; eauto; clear IHstep_star.
    repeat rewrite par_list_app. reflexivity.
    subst pp''.
    ∃ (S (n+n')) lp'; splits; auto.
    intros.
    eapply step_lcons; eauto.
    repeat rewrite<- app_assoc.
    rewrite (list_rep_mid _ p n n').
    inverts H; constructor; do 2 apply step_par_list1_app_r; apply step_par_list1_cons; auto.
    rewrite H6.
    repeat rewrite app_length; repeat rewrite list_rep_length. simpl. omega.
    - subst lp pp'.
    edestruct IHstep_star as [n[lp'[?[??]]]]; eauto; clear IHstep_star.
    subst pp''.
    ∃ n lp'; splits; intros; auto.
    eapply step_lcons; eauto.
    repeat rewrite<- app_assoc.
    inverts H; constructor; apply step_par_list1; auto.
    rewrite H4. repeat rewrite app_length; reflexivity.
    × renames p' to pp', p'' to pp''.
    edestruct step_par_list_inv as [ [ppp'[??]] | [lp1'[q[lp2'[q'[?[??]]]]]] ]; eauto.
    apply H.
    eapply par_nterm. apply step_nil.
    - subst pp'.
    edestruct step_rep_inv; eauto.
    edestruct rep_step_result_list_rep as [n ?]; eauto.
    remember (get_step_rep_p' p ppp') as p'.
    clear Heqp'.
    subst ppp'.
    edestruct (IHstep_star (lp++list_rep n p++[p'])) as [n'[lp'[?[??]]]]; eauto; clear IHstep_star.
    repeat rewrite par_list_app. reflexivity.
    subst pp''.
    ∃ (S (n+n')) lp'; splits; auto.
    intros.
    eapply step_tcons; eauto.
    repeat rewrite<- app_assoc.
    rewrite (list_rep_mid _ p n n').
    do 2 apply step_par_list1_app_r; apply step_par_list1_cons; auto.
    rewrite H6.
    repeat rewrite app_length; repeat rewrite list_rep_length. simpl. omega.
    - subst lp pp'.
    edestruct IHstep_star as [n[lp'[?[??]]]]; eauto; clear IHstep_star.
    subst pp''.
    ∃ n lp'; splits; intros; auto.
    eapply step_tcons; eauto.
    repeat rewrite<- app_assoc.
    apply step_par_list1; auto.
    rewrite H4. repeat rewrite app_length; reflexivity.
  Qed.

  Lemma sbisim_rep_step_result: ∀ p' p pp',
    rep_step_result p' p pp' → sbisimilar pp' (p'||p!!).
  Proof.
    intros.
    edestruct rep_step_result_list_rep as [n ?]; eauto.
    subst.
    eapply sbisim_trans.
    apply sbisim_symm.
    apply sbisim_list_rep_par_list'.
    apply sbisim_refl.
  Qed.

  Lemma step_star_par_unzip'': ∀ p1 p2 la p',
    step_star (p1||p2) la p' →
    ∃ p1' p2' lp la1 la2,
      (p' = p1'||p2' ∨ (p1'=O ∧ p2'=O ∧ p'=O)) ∧
      step_star p1 la1 p1' ∧ step_star p2 la2 p2' ∧
      la=interleaving lp la1 la2 ∧ (length lp = length la1 + length la2)%nat.
  Proof.
    intros.
    remember (p1||p2)%proc as p.
    revert p1 p2 Heqp.
    induction H; intros; subst.
    - ∃ p1 p2 (@nil (unit+unit)) (@nil label) (@nil label); splits; auto; apply @step_nil.
    - inverts H; inverts H1.
    + edestruct IHstep_star as [p1'[p2'[lp[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    ∃ p1' p2' (inl tt::lp) (l_in a0::la1) la2; splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. f_equal; auto.
    + edestruct IHstep_star as [p1'[p2'[lp[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    ∃ p1' p2' (inr tt::lp) la1 (l_in a0::la2); splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. rewrite H4; simpl. omega.
    + edestruct IHstep_star as [p1'[p2'[lp[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    ∃ p1' p2' (inl tt::lp) (l_out a0::la1) la2; splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. f_equal; auto.
    + edestruct IHstep_star as [p1'[p2'[lp[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    ∃ p1' p2' (inr tt::lp) la1 (l_out a0::la2); splits; auto.
    eapply @step_lcons; eauto; constructor; eauto. subst; reflexivity.
    simpl. rewrite H4; simpl. omega.
    - inverts H.
    + edestruct IHstep_star as [p1'[p2'[lp[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    ∃ p1' p2' lp la1 la2; splits; auto. eapply @step_tcons; eauto; apply H5.
    + edestruct IHstep_star as [p1'[p2'[lp[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    ∃ p1' p2' lp la1 la2; splits; auto. eapply @step_tcons; eauto; apply H5.
    + clear IHstep_star.
    edestruct step_star_nil_resolve as [?]; eauto; subst la p''.
    ∃ O O (@nil (unit+unit)) (@nil lts_L) (@nil lts_L); splits; auto.
  Qed.

  Lemma step_par_rep_resolve: ∀ lp p l pp',
    step (par_list lp (p!!)) l pp' →
    (∃ p', step (p!!) l p' ∧ pp' = par_list lp p')
    ∨ (∃ lp1 q lp2 q', lp = lp1++[q]++lp2 ∧ step q l q' ∧ pp'=par_list (lp1++[q']++lp2) (p!!)).
  Proof.
    intro lp.
    rewrite<- (rev_involutive lp).
    pattern (rev lp).
    apply rev_list_ind; simpl; intros.
    × edestruct step_rep_inv; eauto.
    × clear lp. renames l to lp. rewrite rev_app_distr in ×.
    simpl in ×.
    rewrite rev_involutive in ×.
    inverts H0.
    right. ∃ (@nil lts_S) a lp p'; splits; auto.
    edestruct H as [ [pp'[??]] | [lp1[q[lp2[q''[?[??]]]]]] ]; eauto.
    subst.
    left; ∃ pp'; split; auto.
    subst.
    right; ∃ (a::lp1) q lp2 q''; splits; auto.
    false. clear -H3.
    destruct lp; simpl in H3; discriminate.
  Qed.

  Lemma tstep_rep_wbisim1_par_list: ∀ lp p lq q pp',
    tstep (par_list lp (p!!)) pp' →
    wbisimilar p q →
    wbisim_list lp lq →
    ∃ lp' lq' qq',
      step_star (par_list lq (q!!)) nil qq' ∧
      pp' = (par_list lp' (p!!)) ∧
      sbisimilar qq' (par_list lq' (q!!)) ∧
      wbisim_list lp' lq'.
  Proof.
    intros.
    edestruct step_par_list_inv as [ [p'[??]] | [lp1[r[lp2[r'[?[??]]]]]] ]; eauto.
    apply H.
    intro; false.
    × subst.
    edestruct step_rep_inv' as [n[p'_[??]]]; eauto.
    subst p'.
    renames p'_ to p'.
    edestruct tstep_wbisim1 with (p:=p) as [q'[??]]; eauto. apply H3.
    inverts H4.
    - renames q' to q.
    ∃ (lp++list_rep n p ++ [p']) (lq++list_rep (S n) q) (par_list lq (q!!)); splits; auto.
    apply step_nil.
    repeat rewrite par_list_app. reflexivity.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_list_rep_par_list.
    rewrite list_rep_snoc.
    apply wbisim_list_app; auto.
    apply wbisim_list_app; auto.
    apply Forall2_list_rep; auto.
    apply wbisim_list_single; auto.
    - ∃ (lp++list_rep n p ++ [p']) (lq++list_rep n q++[q']) (par_list lq (q'||q!!)); splits; auto.
    apply step_star_par_list2.
    eapply step_tcons; eauto. apply s_rep. apply s_parL. apply H6.
    apply step_star_parL_step; auto.
    repeat rewrite par_list_app. reflexivity.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_list_rep_par_list' with (lp:=[q']).
    apply wbisim_list_app; auto.
    apply wbisim_list_app; auto.
    apply Forall2_list_rep; auto.
    apply wbisim_list_single; auto.
    × subst lp pp'.
    edestruct wbisim_list_same_split as [lq1[slq2[?[??]]]]; eauto; subst lq.
    clear H1.
    edestruct wbisim_list_same_split as [s[lq2[?[??]]]]; eauto; subst slq2.
    clear H5.
    destruct s. inverts H2.
    destruct s; [ | solve [inverts H2; inverts H10] ].
    apply wbisim_list_single in H2.
    edestruct tstep_wbisim1 with (p:=r) as [l'[??]]; eauto. apply H3.
    clear H2.
    ∃ (lp1++[r']++lp2) (lq1++[l']++lq2) (par_list (lq1++[l']++lq2) (q!!)); splits; auto.
    apply step_star_par_list1; auto.
    apply sbisim_refl.
    apply wbisim_list_app; auto.
    apply wbisim_list_app; auto.
    apply wbisim_list_single; auto.
  Qed.

  Lemma lstep_rep_wbisim1_par_list: ∀ lp p lq q l pp',
    lstep (par_list lp (p!!)) l pp' →
    wbisimilar p q →
    wbisim_list lp lq →
    ∃ lp' lq' qq',
      step_star (par_list lq (q!!)) [l] qq' ∧
      pp' = (par_list lp' (p!!)) ∧
      sbisimilar qq' (par_list lq' (q!!)) ∧
      wbisim_list lp' lq'.
  Proof.
    intros.
    edestruct step_par_list_inv as [ [p'[??]] | [lp1[r[lp2[r'[?[??]]]]]] ]; eauto.
    inverts H; eauto.
    intro; false.
    × subst.
    edestruct step_rep_inv' as [n[p'_[??]]]; eauto.
    subst p'. renames p'_ to p'.
    edestruct lstep_wbisim1 with (a:=l) (p:=p) as [q'[??]]; eauto. inverts H; constructor; eauto.
    ∃ (lp++list_rep n p ++ [p']) (lq++list_rep n q++[q']) (par_list lq (q'||q!!)); splits; auto.
    apply step_star_par_list2.
    edestruct step_star_lstep_inv as [q'0[q'1[?[??]]]]; eauto.
    inverts H6.
    eapply @step_lcons; eauto. inverts H7; constructor; apply s_rep; apply s_parL; eauto.
    apply step_star_parL_step; auto.
    eapply step_tcons; eauto. apply s_rep. apply s_parL. apply H9.
    apply step_star_parL_step.
    change [l] with ([]++[l]). eapply step_star_app; eauto. eapply @step_lcons; eauto.
    repeat rewrite par_list_app. reflexivity.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_list_rep_par_list' with (lp:=[q']).
    apply wbisim_list_app; auto.
    apply wbisim_list_app; auto.
    apply Forall2_list_rep; auto.
    apply wbisim_list_single; auto.
    × subst lp pp'.
    edestruct wbisim_list_same_split as [lq1[slq2[?[??]]]]; eauto; subst lq.
    clear H1.
    edestruct wbisim_list_same_split as [s[lq2[?[??]]]]; eauto; subst slq2.
    clear H5.
    destruct s. inverts H2.
    destruct s; [ | solve [inverts H2; inverts H10] ].
    apply wbisim_list_single in H2.
    edestruct lstep_wbisim1 with (a:=l) (p:=r) as [l'[??]]; eauto.
    inverts H; constructor; eauto.
    clear H2.
    ∃ (lp1++[r']++lp2) (lq1++[l']++lq2) (par_list (lq1++[l']++lq2) (q!!)); splits; auto.
    apply step_star_par_list1; auto.
    apply sbisim_refl.
    apply wbisim_list_app; auto.
    apply wbisim_list_app; auto.
    apply wbisim_list_single; auto.
  Qed.

  Lemma wbisim_rep: ∀ p q,
    wbisimilar p q → wbisimilar (p_rep p) (p_rep q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ ∃ p q lp lq, sbisimilar pp (par_list lp (p!!)) ∧ sbisimilar qq (par_list lq (q!!)) ∧ wbisim_list lp lq ∧ wbisimilar p q).
    split.
    clear p q H.
    apply weak_bisimulation_symm; (intros pp qq [p[q[lp[lq[?[?[? H]]]]]]]; subst); intros; unfold inv in ×.
    × false.
    apply halted_sbisim1 in H0; auto; subst.
    eapply (par_list_not_halted1 lp (p!!)); eauto. intro; false.
    × split; intros.
    - renames p' to pp'.
    edestruct tstep_sbisim1 as [pp''[??]]; eauto.
    clear pp H0 H3.
    edestruct tstep_rep_wbisim1_par_list as [lp'[lq'[qq'[?[?[??]]]]]]; eauto.
    subst pp''.
    edestruct step_star_sbisim2 with (p:=qq) as [qq''[??]]; eauto.
    ∃ qq''; split; auto.
    ∃ p q lp' lq'; repeat rewrite par_list_app; splits; auto.
    eapply sbisim_trans; eauto.
    - renames p' to pp'.
    edestruct lstep_sbisim1 as [pp''[??]]; eauto.
    clear pp H0 H3.
    edestruct lstep_rep_wbisim1_par_list as [lp'[lq'[qq'[?[?[??]]]]]]; eauto.
    subst pp''.
    edestruct step_star_sbisim2 with (p:=qq) as [qq''[??]]; eauto.
    ∃ qq''; split; auto.
    ∃ p q lp' lq'; repeat rewrite par_list_app; splits; auto.
    eapply sbisim_trans; eauto.
    × ∃ q p lq lp; splits; auto.
    apply wbisim_list_symm; auto.
    apply wbisim_symm; auto.
    × ∃ p q (@nil lts_S) (@nil lts_S); simpl; splits; auto.
    apply sbisim_refl.
    apply sbisim_refl.
    apply wbisim_list_nil.
  Qed.

End Congruence.

Section EventualSimulationCompositionality.
  Import Notation.
  Import Notation.U.
  Open Scope proc.

  Hint Unfold tstep.

  Lemma esim_seq1: ∀ p q r,
    eventually_similar p q →
    eventually_similar (p;; r) (q;; r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=p;;r∧qq=q;;r ∧ eventually_similar p q) ∨ qq=pp).
    splits; [ | | | | left; eauto]; clear p q H;
      (intros pp qq [ [p[q[?[??]]]] | ?]; subst; [| try rename pp into p]); intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × false.
    × apply step_nil.
    × split; intros.
    - inverts H.
    edestruct tstep_esim1 as [q'[??]]; eauto. apply H5.
    ∃ (q';;r); split. apply step_star_seq_app; auto. left; eauto.
    ∃ p'; split; auto.
    change [] with ([]++@nil lts_L).
    eapply step_star_app.
    apply step_star_seq_app. apply halted_esim1; eauto. reflexivity.
    apply single_tstep; apply s_seq_nil.
    - inverts H; inverts H0.
    edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (q';;r); split. apply step_star_seq_app; auto. left; eauto.
    edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (q';;r); split. apply step_star_seq_app; auto. left; eauto.
    × split; intros.
    - ∃ p'; split; eauto. apply single_tstep; auto.
    - ∃ p'; split; eauto. apply single_lstep; auto.
    × renames p' to q'.
    edestruct step_star_seq_inv as [ [q''[??]] | [la1[la2[?[??]]]] ]; eauto.
    + subst q'.
    edestruct step_star_esim2 with (q:=q) as [p'''[q'''[?[??]]]]; eauto.
    ∃ (q''';; r) (p''';; r); splits; iauto;
      eapply step_star_seq_app; auto.
    + subst.
    ∃ q' q'; splits; eauto.
    apply step_nil.
    eapply step_star_app; eauto.
    eapply step_tsnoc.
    apply step_star_seq_app.
    eapply halted_converge_esim2; eauto.
    reflexivity.
    apply s_seq_nil.
    × ∃ p' p'; splits; auto. apply step_nil.
  Qed.

  Lemma esim_seq2: ∀ p q r,
    eventually_similar p q →
    eventually_similar (r;; p) (r;; q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q r, pp=r;;p∧qq=r;;q ∧ eventually_similar p q) ∨ eventually_similar pp qq).
    splits; [ | | | | left; jauto]; clear p q r H;
      (intros pp qq [ [p[q[r[?[??]]]]] | ?]; subst); intros; unfold inv in ×.
    × false.
    × apply halted_esim1; auto.
    × false.
    × apply halted_esim2; auto.
    × split; intros.
    - inverts H.
    ∃ (p'0;;q); split. apply single_tstep; apply s_seq; auto. left; jauto.
    ∃ q; split; auto. apply single_tstep; apply s_seq_nil.
    - inverts H; inverts H0.
    ∃ (p'0;;q); split. apply single_lstep; constructor; apply s_seq; auto. left; jauto.
    ∃ (p'0;;q); split. apply single_lstep; constructor; apply s_seq; auto. left; jauto.
    × split; intros.
    - edestruct tstep_esim1 as [q'[??]]; eauto.
    - edestruct lstep_esim1 as [q'[??]]; eauto.
    × edestruct step_star_seq_inv as [ [r'[??]] | [la1[la2[?[??]]]] ]; eauto.
    + subst p'.
    ∃ (r';; q) (r';; p); splits.
    apply step_nil.
    apply step_star_seq_app; auto.
    left; ∃ p q r'; splits; auto.
    + subst la. renames p' to q'.
    edestruct step_star_esim2 with (q:=q) as [p''[q''[?[??]]]]; eauto.
    ∃ q'' p''; splits; eauto.
    eapply step_star_app; eauto.
    eapply step_tsnoc.
    apply step_star_seq_app; eauto.
    apply s_seq_nil.
    × edestruct step_star_esim2 as [q''[p''[?[??]]]]; jauto.
  Qed.

  Lemma esim_seq: ∀ p1 p2 q1 q2,
    eventually_similar p1 q1 →
    eventually_similar p2 q2 →
    eventually_similar (p1;;p2) (q1;;q2).
  Proof. intros; eapply esim_trans; [eapply esim_seq1; eauto | apply esim_seq2; auto]. Qed.

  Lemma esim_parL: ∀ p q r,
    eventually_similar p q →
    eventually_similar (p||r) (q||r).
  Proof.
    intros.
    ∃ (fun pr qr ⇒ (∃ p q r, pr=p||r ∧ qr=q||r ∧ eventually_similar p q) ∨ (pr=O ∧ qr=O)).
    splits; [| | | | left; jauto]; clear p q r H;
      (intros pr qr [ [p[q[r[?[??]]]]] | [??]]; subst); intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × false.
    × apply step_nil.
    × split; intros.
    - inverts H.
    + renames p'0 to p'.
    edestruct tstep_esim1 as [q'[??]]; eauto. apply H5.
    ∃ (q'||r); split. apply step_star_parL_step; auto. left; jauto.
    + renames q' to r'.
    ∃ (q||r'); split. apply single_tstep; apply s_parR; auto. left; jauto.
    + ∃ p_nil; split; auto.
    change [] with ([]++@nil lts_L).
    eapply step_star_app. apply step_star_parL_step. apply halted_esim1; eauto. reflexivity.
    apply single_tstep. apply s_par_nil.
    - inverts H; inverts H0.
    + edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (q'||r); split. apply step_star_parL_step; auto. left; jauto.
    + renames q' to r'. ∃ (q||r'); split. apply single_lstep; constructor. apply s_parR; auto. left; jauto.
    + edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (q'||r); split. apply step_star_parL_step; auto. left; jauto.
    + renames q' to r'. ∃ (q||r'); split. apply single_lstep; constructor. apply s_parR; auto. left; jauto.
    × split; intros; inverts H; inverts H0.
    × renames p' to pr'.
    edestruct step_star_par_unzip as [q'[r'[la1[la2[?[?[?[??]]]]]]]]; eauto; substs.
    edestruct step_star_esim2 with (q:=q) as [p''[q''[?[??]]]]; eauto.
    destruct H0 as [?|[?[??]]]; subst.
    ∃ (q''||r') (p''||r'); splits; eauto.
    apply step_star_parL_step; auto.
    left; jauto.
    ∃ O O; splits; auto.
    apply step_nil.
    rewrite<- (app_nil_r la).
    eapply step_star_app; eauto.
    apply step_star_nil_resolve in H7. destruct H7 as [??]; subst q''.
    eapply step_tsnoc; eauto.
    apply step_star_parL_step; eauto.
    apply halted_esim2; eauto. reflexivity.
    apply s_par_nil.
    × edestruct step_star_nil_resolve as [??]; eauto; subst la p'; jauto.
  Qed.

  Lemma esim_parR: ∀ p q r,
    eventually_similar p q →
    eventually_similar (r||p) (r||q).
  Proof.
    intros.
    eapply esim_trans.
    apply wbisim_esim.
    apply wbisim_par_swap.
    eapply esim_trans.
    apply esim_parL; eauto.
    apply wbisim_esim.
    apply wbisim_par_swap.
  Qed.

  Lemma esim_par: ∀ p q r s,
    eventually_similar p q →
    eventually_similar r s →
    eventually_similar (p||r) (q||s).
  Proof. intros; eapply esim_trans. apply esim_parL; eauto. eapply esim_parR; eauto. Qed.

  Lemma esim_res: ∀ a n p q,
    eventually_similar p q → eventually_similar (a#n:p) (a#n:q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ n p q, pp=a#n:p ∧ qq=a#n:q ∧ eventually_similar p q) ∨ (pp=O∧qq=O)).
    splits; [| | | | left; jauto]; clear n p q H;
      (intros pp qq [ [n[p[q[?[??]]]]] | [??] ]; subst); intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × false.
    × apply step_nil.
    × split; intros.
    - inverts H.
    + rename p'0 into p'.
    edestruct tstep_esim1 as [q'[??]]; eauto. apply H4.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_nIn; auto.
    + renames p'0 to p', n0 to n.
    edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_count_in; auto.
    + renames p'0 to p'.
    edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (a#(S n):q'); split; [| left; jauto].
    apply step_star_res_count_out; auto.
    + ∃ O; split; auto.
    eapply step_tsnoc. apply step_star_res_nIn. apply halted_esim1; eauto. reflexivity.
    intros ? [ ].
    apply s_res_nil.
    - inverts H; inverts H0.
    + rename p'0 into p'.
    edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_in; eauto.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_nIn; auto. intros. inverts H2. auto. inverts H3.
    + rename p'0 into p'.
    edestruct lstep_esim1 as [q'[??]]; eauto. apply lstep_out; eauto.
    ∃ (a#n:q'); split; [| left; jauto].
    apply step_star_res_nIn; auto. intros. inverts H2. auto. inverts H3.
    × split; intros; inverts H; inverts H0.
    × rename p' into qq'; edestruct step_star_res_inv as [la'[n'[q'[?[?[??]]]]]]; eauto.
    edestruct step_star_esim2 as [p''[q''[?[??]]]]; eauto.
    destruct H0 as [?|[??]]; subst.
    ∃ (a#n':q'') (a#n':p''); splits; eauto.
    eapply step_star_res; eauto.
    apply res_count_labels_nil2'.
    eapply step_star_res; eauto.
    left; ∃ n' p'' q''; splits; auto.
    apply step_star_nil_resolve in H6; destruct H6 as [??]; subst q''.
    ∃ O O; splits; eauto.
    apply step_nil.
    rewrite<- (app_nil_r (res_filter _ _)).
    eapply step_star_app.
    eapply step_star_res; eauto.
    change [] with ([]++@nil lts_L).
    eapply step_star_app.
    eapply step_tsnoc.
    apply step_star_res_nIn; eauto.
    eapply halted_esim2; eauto. reflexivity.
    apply s_res_nil. apply step_nil.
    × edestruct step_star_nil_resolve as [??]; eauto; subst la p'. jauto.
  Qed.

  Lemma esim_res_list: ∀ AN p q,
    eventually_similar p q → eventually_similar (p_res_list AN p) (p_res_list AN q).
  Proof.
    induction AN; intros; auto. destruct a; simpl.
    apply esim_res; eauto.
  Qed.

  Lemma esim_stable_sum: ∀ p q r,
    eventually_similar p q →
    stable lts p → stable lts q →
    eventually_similar (p+r) (q+r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒
      (∃ p q r, stable lts p ∧ stable lts q ∧ pp=p+r ∧ qq=q+r ∧ eventually_similar p q) ∨
      eventually_similar pp qq).
    splits; [| | | | left; jauto];
      try (clear p q r H H0 H1; intros pp qq [ [p[q[r[?[?[?[??]]]]]]] | ? ]); subst; intros; unfold inv in ×.
    × false.
    × apply halted_esim1; auto.
    × false.
    × apply halted_esim2; auto.
    × split; intros.
    - inverts H1.
    + false; eapply H; apply H7.
    + renames p' to r'.
    ∃ r'; split.
    apply single_tstep; apply s_sumR; auto.
    right; apply esim_refl.
    + apply halted_esim1 in H3.
    ∃ O; split.
    inverts H3. apply single_tstep; apply s_sum_nil. eapply step_tcons; eauto. apply s_sumL; auto.
    right; apply esim_refl.
    reflexivity.
    - inverts H1; inverts H2.
    + edestruct lstep_esim1 as [q'[??]]; eauto. constructor; apply H7.
    ∃ q'; split; eauto.
    edestruct step_star_lstep_inv as [q'0[q'1[?[??]]]]; eauto.
    inverts H4.
    eapply step_lcons; eauto. constructor; apply s_sumL; auto.
    inverts H5; auto.
    eapply step_tcons with p'0; eauto. apply s_sumL; auto.
    setoid_rewrite<- (@app_nil_l lts_L).
    eapply step_star_app; eauto.
    eapply step_lcons; eauto.
    + renames p' to r'.
    ∃ r'; split.
    apply single_lstep. constructor; apply s_sumR; auto.
    right; apply esim_refl.
    + edestruct lstep_esim1 as [q'[??]]; eauto. constructor 2; apply H7.
    ∃ q'; split; eauto.
    edestruct step_star_lstep_inv as [q'0[q'1[?[??]]]]; eauto.
    inverts H4.
    eapply step_lcons; eauto. constructor; apply s_sumL; auto.
    inverts H5; auto.
    eapply step_tcons with p'0; eauto. apply s_sumL; auto.
    setoid_rewrite<- (@app_nil_l lts_L).
    eapply step_star_app; eauto.
    eapply step_lcons; eauto.
    + renames p' to r'.
    ∃ r'; split.
    apply single_lstep. constructor; apply s_sumR; auto.
    right; apply esim_refl.
    × split; intros.
    - edestruct tstep_esim1 as [q'[??]]; eauto.
    - edestruct lstep_esim1 as [q'[??]]; eauto.
    × inverts H1.
    - ∃ (q+r) (p+r); splits.
    apply step_nil.
    apply step_nil.
    left; ∃ p q r; splits; auto.
    - renames p'0 to q'0, p' to q'.
    assert (lstep q a q'0 ∨ lstep r a q'0).
      { inverts H2; (inverts H1; [left|right]; constructor; auto). }
    destruct H1 as [?|?].
    + edestruct step_star_esim2 with (q:=q) as [p''[q''[?[??]]]]; eauto.
    eapply step_lcons; eauto.
    ∃ q'' p''; splits; eauto.
    inverts H5.
    inverts H11; eapply step_lcons; eauto; constructor; apply s_sumL; eauto.
    eapply step_tcons; eauto.
    apply s_sumL; auto.
    + ∃ q' q'; splits.
    apply step_nil.
    inverts H1; eapply step_lcons; eauto; constructor; apply s_sumR; auto.
    right; apply esim_refl.
    - inverts H2.
    + false. eapply H0. apply H8.
    + ∃ p' p'; splits.
    apply step_nil.
    eapply step_tcons; eauto. apply s_sumR; auto.
    right; apply esim_refl.
    + edestruct step_star_nil_resolve as [??]; eauto; subst la p'.
    ∃ O O; splits.
    apply step_nil.
    apply halted_esim2 in H3.
    inverts H3.
    apply single_tstep; apply s_sum_nil.
    false; eapply H; apply H1.
    reflexivity.
    right; apply esim_refl.
    × edestruct step_star_esim2 as [q''[p''[?[??]]]]; jauto.
    × ∃ p q r; splits; auto.
  Qed.

  Lemma esim_internal_sum: ∀ p q r,
    eventually_similar p q →
    eventually_similar (().p+r) (().q+r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=().p+r ∧ qq=().q+r ∧ eventually_similar p q) ∨ eventually_similar pp qq).
    splits; iauto;
      try (clear p q H; intros pp qq [ [p[q[?[??]]]] | ?]; subst); intros; unfold inv in ×.
    × false.
    × apply halted_esim1; auto.
    × false.
    × apply halted_esim2; auto.
    × split; intros.
    - inverts H. inverts H5.
    eexists; split; eauto. apply single_tstep; apply s_sumL; constructor.
    ∃ p'; split. apply single_tstep; apply s_sumR; auto. right; apply esim_refl.
    - inverts H; inverts H0.
    + inverts H5.
    + ∃ p'; split. apply single_lstep; constructor; apply s_sumR; auto. right; apply esim_refl.
    + inverts H5.
    + ∃ p'; split. apply single_lstep; constructor; apply s_sumR; auto. right; apply esim_refl.
    × split; intros.
    - edestruct tstep_esim1 as [q'[??]]; eauto.
    - edestruct lstep_esim1 as [q'[??]]; eauto.
    × inverts H.
    + ∃ (().q + r) (().p + r); splits. apply step_nil. apply step_nil. left; ∃ p q; splits; auto.
    + inverts H0; inverts H.
    inverts H6.
    ∃ p' p'; splits. apply step_nil. eapply step_lcons; eauto; constructor; apply s_sumR; auto. right; apply esim_refl.
    inverts H6.
    ∃ p' p'; splits. apply step_nil. eapply step_lcons; eauto; constructor; apply s_sumR; auto. right; apply esim_refl.
    + inverts H0.
    - inverts H6. renames p'0 to q, p' to q'.
    edestruct step_star_esim2 as [p''[q''[?[??]]]]; eauto.
    ∃ q'' p''; splits; eauto.
    eapply step_tcons; eauto. apply s_sumL; apply s_act.
    - ∃ p' p'; splits. apply step_nil. eapply step_tcons; eauto; apply s_sumR; auto. right; apply esim_refl.
    × edestruct step_star_esim2 as [p''[q''[?[??]]]]; jauto.
  Qed.

  Lemma esim_act: ∀ l p q,
    eventually_similar p q → eventually_similar (p_act l p) (p_act l q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=p_act l p ∧ qq=p_act l q ∧ eventually_similar p q) ∨ eventually_similar pp qq).
    splits; [ | | | | left; jauto]; clear p q H; intros pp qq [ [p[q[?[??]]]] | ?]; subst; intros; unfold inv in ×.
    × false.
    × eapply halted_esim1; eauto.
    × false.
    × eapply halted_esim2; eauto.
    × split; intros.
    - inverts H. ∃ q; split; auto. apply single_tstep; constructor.
    - inverts H; inverts H0.
    + ∃ q; split; auto. apply single_lstep; do 2 constructor.
    + ∃ q; split; auto. apply single_lstep; do 2 constructor.
    × split; intros.
    - edestruct tstep_esim1 as [q'[??]]; eauto.
    - edestruct lstep_esim1 as [q'[??]]; eauto.
    × inverts H.
    - ∃ (p_act l q) (p_act l p); splits.
    apply step_nil.
    apply step_nil.
    left; ∃ p q; splits; auto.
    - renames p'0 to q'0, p' to q'.
    inverts H0; inverts H;
      (edestruct step_star_esim2 as [p''[q''[?[??]]]]; eauto;
      (∃ q'' p''; splits; eauto; eapply step_lcons; eauto; do 2 constructor)).
    - inverts H0.
    edestruct step_star_esim2 as [p''[q''[?[??]]]]; eauto.
    ∃ q'' p''; splits; auto; eapply step_tcons; eauto. constructor.
    × edestruct step_star_esim2 as [q''[p''[?[??]]]]; jauto.
  Qed.

  Lemma step_star_par_list_esim2: ∀ r1 r2 lp lq la lq',
    step_star (par_list lq O) la (par_list lq' O) →
    esim_list lp lq →
    length lq' = length lq →
    ∃ lp'' lq'',
      step_star (par_list lp r1) la (par_list lp'' r1) ∧
      step_star (par_list lq' r2) nil (par_list lq'' r2) ∧
      length lq'' = length lq ∧
      esim_list lp'' lq''.
  Proof.
    induction lp; destruct lq; intros; inverts H0.
    × simpl in ×.
    edestruct step_star_nil_resolve; eauto.
    destruct lq'; try discriminate. subst la.
    ∃ (@nil proc) (@nil proc); simpl; splits; auto.
    apply @step_nil. apply @step_nil. apply esim_list_nil.
    × simpl in ×.
    renames p to q, a to p.
    edestruct step_star_par_unzip'' as [q'[lq2'[lip[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    destruct H0 as [?|[?[??]]].
    - destruct lq'; inverts H0.
    clear H.
    edestruct IHlp as [lp''[lq''[?[?[??]]]]]; eauto; clear IHlp.
    edestruct step_star_esim2 with (q:=q) as [p''[q''[?[??]]]]; eauto.
    ∃ (p''::lp'') (q''::lq''); splits; auto.
    eapply step_star_par_zip'; eauto.
    eapply step_star_par_zip' with (lp:=nil); eauto.
    simpl; congruence.
    apply esim_list_cons; auto.
    - false. subst. destruct lq'; inverts H1. inverts H9.
  Qed.

  Lemma step_star_rep_esim2_par_list: ∀ lp p lq q la qq',
    step_star (par_list lq (q!!)) la qq' →
    eventually_similar p q →
    esim_list lp lq →
    ∃ lp' lq' pp'' qq'',
      step_star (par_list lp (p!!)) la pp'' ∧
      step_star qq' nil qq'' ∧
      sbisimilar pp'' (par_list lp' (p!!)) ∧
      qq'' = (par_list lq' (q!!)) ∧
      esim_list lp' lq'.
  Proof.
    intros.
    edestruct step_star_rep_par_list as [n[lq'[?[??]]]]; eauto.
    subst qq'.
    edestruct step_star_par_list_esim2 with (r1:=p!!) (r2:=q!!) as [lp''[lq''[?[?[??]]]]]; eauto.
    apply esim_list_app; eauto.
    apply Forall2_list_rep; eauto.
    edestruct step_star_sbisim1 with (p:=(par_list (lp++list_rep n p) (p!!))) (q:=par_list lp (p!!)) as [pp''[??]]; eauto.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_symm; apply sbisim_list_rep_par_list.
    ∃ lp'' lq'' pp'' (par_list lq'' (q!!)); splits; auto.
    apply sbisim_symm; auto.
  Qed.

  Lemma tstep_rep_esim1_par_list: ∀ lp p lq q pp',
    tstep (par_list lp (p!!)) pp' →
    eventually_similar p q →
    esim_list lp lq →
    ∃ lp' lq' qq',
      step_star (par_list lq (q!!)) nil qq' ∧
      pp' = (par_list lp' (p!!)) ∧
      sbisimilar qq' (par_list lq' (q!!)) ∧
      esim_list lp' lq'.
  Proof.
    intros.
    edestruct step_par_list_inv as [ [p'[??]] | [lp1[r[lp2[r'[?[??]]]]]] ]; eauto.
    apply H.
    eapply par_nterm; eauto. apply step_nil.
    × subst.
    edestruct step_rep_inv; eauto.
    apply rep_step_result_list_rep in H4.
    destruct H4 as [n ?].
    remember (get_step_rep_p' p p') as p'_.
    rewrite H4 in ×.
    clear p' H4 Heqp'_; renames p'_ to p'.
    edestruct tstep_esim1 with (p:=p) as [q'[??]]; eauto. apply H3.
    inverts H4.
    - renames q' to q.
    ∃ (lp++list_rep n p ++ [p']) (lq++list_rep (S n) q) (par_list lq (q!!)); splits; auto.
    apply step_nil.
    repeat rewrite par_list_app. reflexivity.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_list_rep_par_list.
    rewrite list_rep_snoc.
    apply esim_list_app; auto.
    apply esim_list_app; auto.
    apply Forall2_list_rep; auto.
    apply esim_list_single; auto.
    - ∃ (lp++list_rep n p ++ [p']) (lq++list_rep n q++[q']) (par_list lq (q'||q!!)); splits; auto.
    apply step_star_par_list2.
    eapply step_tcons; eauto. apply s_rep. apply s_parL. apply H6.
    apply step_star_parL_step; auto.
    repeat rewrite par_list_app. reflexivity.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_list_rep_par_list' with (lp:=[q']).
    apply esim_list_app; auto.
    apply esim_list_app; auto.
    apply Forall2_list_rep; auto.
    apply esim_list_single; auto.
    × subst lp pp'.
    edestruct esim_list_same_split as [lq1[slq2[?[??]]]]; eauto; subst lq.
    clear H1.
    edestruct esim_list_same_split as [s[lq2[?[??]]]]; eauto; subst slq2.
    clear H5.
    destruct s. inverts H2.
    destruct s; [ | solve [inverts H2; inverts H10] ].
    apply esim_list_single in H2.
    edestruct tstep_esim1 with (p:=r) as [l'[??]]; eauto. apply H3.
    clear H2.
    ∃ (lp1++[r']++lp2) (lq1++[l']++lq2) (par_list (lq1++[l']++lq2) (q!!)); splits; auto.
    apply step_star_par_list1; auto.
    apply sbisim_refl.
    apply esim_list_app; auto.
    apply esim_list_app; auto.
    apply esim_list_single; auto.
  Qed.

  Lemma lstep_rep_esim1_par_list: ∀ lp p lq q l pp',
    lstep (par_list lp (p!!)) l pp' →
    eventually_similar p q →
    esim_list lp lq →
    ∃ lp' lq' qq',
      step_star (par_list lq (q!!)) [l] qq' ∧
      pp' = (par_list lp' (p!!)) ∧
      sbisimilar qq' (par_list lq' (q!!)) ∧
      esim_list lp' lq'.
  Proof.
    intros.
    edestruct step_par_list_inv as [ [p'[??]] | [lp1[r[lp2[r'[?[??]]]]]] ]; eauto.
    inverts H; eauto.
    eapply par_nterm; eauto. apply step_nil.
    × subst.
    edestruct step_rep_inv; eauto.
    apply rep_step_result_list_rep in H4.
    destruct H4 as [n ?].
    remember (get_step_rep_p' p p') as p'_.
    rewrite H4 in ×.
    clear p' H4 Heqp'_; renames p'_ to p'.
    edestruct lstep_esim1 with (a:=l) (p:=p) as [q'[??]]; eauto. inverts H; constructor; eauto.
    ∃ (lp++list_rep n p ++ [p']) (lq++list_rep n q++[q']) (par_list lq (q'||q!!)); splits; auto.
    apply step_star_par_list2.
    edestruct step_star_lstep_inv as [q'0[q'1[?[??]]]]; eauto.
    inverts H6.
    eapply @step_lcons; eauto. inverts H7; constructor; apply s_rep; apply s_parL; eauto.
    apply step_star_parL_step; auto.
    eapply step_tcons; eauto. apply s_rep. apply s_parL. apply H9.
    apply step_star_parL_step.
    change [l] with ([]++[l]). eapply step_star_app; eauto. eapply @step_lcons; eauto.
    repeat rewrite par_list_app. reflexivity.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_list_rep_par_list' with (lp:=[q']).
    apply esim_list_app; auto.
    apply esim_list_app; auto.
    apply Forall2_list_rep; auto.
    apply esim_list_single; auto.
    × subst lp pp'.
    edestruct esim_list_same_split as [lq1[slq2[?[??]]]]; eauto; subst lq.
    clear H1.
    edestruct esim_list_same_split as [s[lq2[?[??]]]]; eauto; subst slq2.
    clear H5.
    destruct s. inverts H2.
    destruct s; [ | solve [inverts H2; inverts H10] ].
    apply esim_list_single in H2.
    edestruct lstep_esim1 with (a:=l) (p:=r) as [l'[??]]; eauto.
    inverts H; constructor; eauto.
    clear H2.
    ∃ (lp1++[r']++lp2) (lq1++[l']++lq2) (par_list (lq1++[l']++lq2) (q!!)); splits; auto.
    apply step_star_par_list1; auto.
    apply sbisim_refl.
    apply esim_list_app; auto.
    apply esim_list_app; auto.
    apply esim_list_single; auto.
  Qed.

  Lemma esim_rep: ∀ p q,
    eventually_similar p q → eventually_similar (p_rep p) (p_rep q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ ∃ lp lq, sbisimilar pp (par_list lp (p!!)) ∧ sbisimilar qq (par_list lq (q!!)) ∧ esim_list lp lq).
    splits; try (intros pp qq [lp[lq[?[??]]]]; subst; intros; unfold inv in *).
    × false.
    apply halted_sbisim1 in H0; auto; subst.
    eapply (par_list_not_halted1 lp (p!!)); eauto. intro; false.
    × false.
    apply halted_sbisim1 in H1; auto; subst.
    eapply (par_list_not_halted1 lq (q!!)); eauto. intro; false.
    × split; intros.
    - renames p' to pp'.
    edestruct tstep_sbisim1 as [pp''[??]]; eauto.
    clear pp H0 H3.
    edestruct tstep_rep_esim1_par_list with (p:=p) (q:=q) as [lp'[lq'[qq'[?[?[??]]]]]]; eauto.
    subst pp''.
    edestruct step_star_sbisim2 with (p:=qq) as [qq''[??]]; eauto.
    ∃ qq''; split; auto.
    ∃ lp' lq'; repeat rewrite par_list_app; splits; auto.
    eapply sbisim_trans; eauto.
    - renames p' to pp'.
    edestruct lstep_sbisim1 as [pp''[??]]; eauto.
    clear pp H0 H3.
    edestruct lstep_rep_esim1_par_list with (p:=p) (q:=q) as [lp'[lq'[qq'[?[?[??]]]]]]; eauto.
    subst pp''.
    edestruct step_star_sbisim2 with (p:=qq) as [qq''[??]]; eauto.
    ∃ qq''; split; auto.
    ∃ lp' lq'; repeat rewrite par_list_app; splits; auto.
    eapply sbisim_trans; eauto.
    × renames pp to qqq, qq to pp, qqq to qq, p' to qq'.
    edestruct step_star_sbisim1 as [qq''[??]]; eauto.
    clear qq H1 H3.
    edestruct step_star_rep_esim2_par_list as [lp'[lq'[pp'''[qq'''[?[?[?[??]]]]]]]]; eauto.
    subst qq'''.
    edestruct step_star_sbisim2 with (p:=qq') (q:=qq'') as [qq''''[??]]; eauto.
    edestruct step_star_sbisim2 with (p:=pp)as [pp''''[??]]; eauto.
    ∃ qq'''' pp''''; splits; auto.
    ∃ lp' lq'; splits; auto.
    eapply sbisim_trans; eauto.
    × ∃ (@nil lts_S) (@nil lts_S); simpl; splits; auto.
    apply sbisim_refl.
    apply sbisim_refl.
    apply esim_list_nil.
  Qed.

End EventualSimulationCompositionality.

Section ContrasimulationCongruence.
  Import Notation.
  Import Notation.U.
  Open Scope proc.

  Lemma csim_seq1: ∀ p q r,
    contrasimilar p q →
    contrasimilar (p;; r) (q;; r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=p;;r∧qq=q;;r ∧ partial_contrasimilar p q) ∨ qq=pp).
    splits; try (clear p q H; intros pp qq [ [p[q[?[??]]]] | ? ]; subst; [| rename pp into p]; intros; unfold inv in *).
    × false.
    × apply step_nil.
    × edestruct step_star_seq_inv as [ [p''[??]] | [la1[la2[?[??]]]] ]; eauto.
    + subst p'.
    edestruct step_star_pcsim with (p:=p) as [q''[??]]; eauto.
    ∃ (q'';; r); split; iauto.
    eapply step_star_seq_app; auto.
    + subst.
    ∃ p'; split; eauto.
    eapply step_star_app; eauto.
    eapply step_tsnoc.
    apply step_star_seq_app.
    eapply halted_converge_pcsim; eauto.
    reflexivity.
    apply s_seq_nil.
    × ∃ p'; auto.
    × left; ∃ p q; splits; auto. apply csim_pcsim1; auto.
    × left; ∃ q p; splits; auto. apply csim_pcsim2; auto.
  Qed.

  Lemma csim_seq2: ∀ p q r,
    contrasimilar p q →
    contrasimilar (r;; p) (r;; q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q r, pp=r;;p∧qq=r;;q ∧ contrasimilar p q) ∨ partial_contrasimilar pp qq).
    splits; try (clear p q r H; intros pp qq [ [p[q[r[?[??]]]]] | ?]; subst); intros; unfold inv in ×.
    × false.
    × apply halted_pcsim1; auto.
    × edestruct step_star_seq_inv as [ [r'[??]] | [la1[la2[?[??]]]] ]; eauto.
    + subst p'.
    ∃ (r';; q); split. apply step_star_seq_app; auto. left; ∃ q p r'; splits; auto. symmetry; auto.
    + subst la.
    edestruct step_star_pcsim with (p:=p) as [q'[??]]; eauto.
    apply csim_pcsim1; eauto.
    ∃ q'; split; eauto.
    eapply step_star_app; eauto.
    eapply step_tsnoc.
    apply step_star_seq_app; eauto.
    apply s_seq_nil.
    × edestruct step_star_pcsim as [q'[??]]; eauto.
    × left; jauto.
    × apply csim_symm in H; left; jauto.
  Qed.

  Lemma csim_seq: ∀ p1 p2 q1 q2,
    contrasimilar p1 q1 → contrasimilar p2 q2 →
    contrasimilar (p1;;p2) (q1;;q2).
  Proof. intros; etransitivity; [eapply csim_seq1; eauto | apply csim_seq2; auto]. Qed.

  Lemma pcsim_parL: ∀ p q r,
    partial_contrasimilar p q →
    partial_contrasimilar (p||r) (q||r).
  Proof.
    intros.
    ∃ (fun pr qr ⇒ (∃ p q r, pr = p||r ∧ qr=q||r ∧ partial_contrasimilar p q) ∨ (pr=O∧qr=O)).
    splits; [| | left; jauto];
      clear p q r H; intros pr qr [ [p[q[r[?[??]]]]] | [??] ]; subst; intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × renames p' to pr'.
    edestruct step_star_par_unzip as [p'[r'[la1[la2[?[?[?[??]]]]]]]]; eauto; substs.
    edestruct step_star_pcsim with (p:=p) as [q'[??]]; eauto.
    destruct H0 as [?|[?[??]]]; subst.
    ∃ (q'||r'); split; eauto. left; jauto.
    ∃ O; split; auto.
    rewrite<- (app_nil_r la).
    eapply step_star_app; eauto.
    eapply step_tsnoc; eauto.
    apply step_star_parL_step; eauto.
    apply halted_pcsim2; eauto. reflexivity.
    apply s_par_nil.
    × edestruct step_star_nil_resolve as [??]; eauto.
  Qed.

  Lemma pcsim_parR: ∀ p q r,
    partial_contrasimilar p q →
    partial_contrasimilar (r||p) (r||q).
  Proof.
    intros.
    change [] with (([]++[])++@nil lts_L).
    eapply pcsim_trans.
    apply wbisim_pcsim; apply wbisim_par_swap.
    eapply pcsim_trans.
    apply pcsim_parL; eauto.
    apply wbisim_pcsim; apply wbisim_par_swap.
  Qed.

  Lemma csim_parL: ∀ p q r,
    contrasimilar p q →
    contrasimilar (p||r) (q||r).
  Proof. intros; apply pcsim_csim; apply pcsim_parL; [apply csim_pcsim1 | apply csim_pcsim2]; auto. Qed.

  Lemma csim_parR: ∀ p q r,
    contrasimilar p q →
    contrasimilar (r||p) (r||q).
  Proof. intros; apply pcsim_csim; apply pcsim_parR; [apply csim_pcsim1 | apply csim_pcsim2]; auto. Qed.

  Lemma csim_par: ∀ p q r s,
    contrasimilar p q →
    contrasimilar r s →
    contrasimilar (p||r) (q||s).
  Proof. intros; eapply csim_trans. apply csim_parL; eauto. apply csim_parR; auto. Qed.

  Lemma pcsim_act: ∀ l p q,
    contrasimilar p q → partial_contrasimilar (p_act l p) (p_act l q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=p_act l p ∧ qq=p_act l q ∧ contrasimilar p q) ∨ partial_contrasimilar pp qq).
    splits; [ | | left; jauto]; clear p q H; intros pp qq [ [p[q[?[??]]]] | ?]; subst; intros; unfold inv in ×.
    × false.
    × eapply halted_pcsim1; eauto.
    × inverts H.
    - ∃ (p_act l q); split.
    apply step_nil.
    left; ∃ q p; splits; auto; apply csim_symm; auto.
    - inverts H0; inverts H;
      (edestruct step_star_pcsim as [q'[??]]; eauto;
        [apply csim_pcsim1; eauto
        | ∃ q'; split; auto; eapply step_lcons; eauto; constructor; constructor]).
    - inverts H0.
    edestruct step_star_pcsim as [q'[??]].
    eauto.
    apply csim_pcsim1; eauto.
    ∃ q'; split; auto; eapply step_tcons; eauto. constructor.
    × edestruct step_star_pcsim as [q'[??]]; eauto.
  Qed.

  Lemma pcsim_tau: ∀ p q,
    partial_contrasimilar (().p) (().q) ↔ partial_contrasimilar p q.
  Proof.
    split; intros.
    × change [] with (([]++[])++@nil lts_L).
    eapply pcsim_trans.
    apply wbisim_pcsim; apply wbisim_symm; apply wbisim_intro_tau.
    eapply pcsim_trans.
    apply H.
    apply wbisim_pcsim; apply wbisim_intro_tau.
    × change [] with (([]++[])++@nil lts_L).
    eapply pcsim_trans.
    apply wbisim_pcsim; apply wbisim_intro_tau.
    eapply pcsim_trans.
    apply H.
    apply wbisim_pcsim; apply wbisim_symm; apply wbisim_intro_tau.
  Qed.

  Lemma pcsim_in: ∀ a p q,
    contrasimilar p q → partial_contrasimilar (a?.p) (a?.q).
  Proof. intros; apply pcsim_act; auto. Qed.

  Lemma csim_act: ∀ l p q,
    contrasimilar p q → contrasimilar (p_act l p) (p_act l q).
  Proof.
    intros; apply pcsim_csim; apply pcsim_act; auto. symmetry; auto.
  Qed.

  Lemma csim_in: ∀ a p q,
    contrasimilar p q → contrasimilar (a?.p) (a?.q).
  Proof. intros; apply pcsim_csim; apply pcsim_in; auto; apply csim_symm; auto. Qed.

  Lemma pcsim_out: ∀ a p q,
    contrasimilar p q → partial_contrasimilar (a!.p) (a!.q).
  Proof. intros; apply pcsim_act; auto. Qed.

  Lemma csim_out: ∀ a p q,
    contrasimilar p q → contrasimilar (a!.p) (a!.q).
  Proof. intros; apply pcsim_csim; apply pcsim_out; auto; apply csim_symm; auto. Qed.

  Lemma pcsim_res: ∀ a n p q,
    partial_contrasimilar p q → partial_contrasimilar (a#n:p) (a#n:q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ n p q, pp=a#n:p ∧ qq=a#n:q ∧ partial_contrasimilar p q) ∨ (pp=O∧qq=O)).
    splits; [ | | left; jauto]; clear n p q H; intros pp qq [ [n[p[q[?[??]]]]] | [??] ]; subst; intros; unfold inv in ×.
    × false.
    × apply step_nil.
    × rename p' into pp'; edestruct step_star_res_inv as [la'[n'[p'[?[?[??]]]]]]; eauto.
    edestruct step_star_pcsim as [q'[??]]; eauto.
    destruct H0 as [?|[??]]; subst.
    ∃ (a#n':q'); split; eauto.
    eapply step_star_res; eauto.
    left; ∃ n' q' p'; splits; auto.
    ∃ O; split; eauto.
    rewrite<- (app_nil_r (res_filter _ _)).
    eapply step_star_app.
    eapply step_star_res; eauto.
    change [] with ([]++@nil lts_L).
    eapply step_star_app.
    eapply step_tsnoc.
    apply step_star_res_nIn; eauto.
    eapply halted_pcsim2; eauto. reflexivity.
    apply s_res_nil. apply step_nil.
    × edestruct step_star_nil_resolve as [??]; eauto.
  Qed.

  Lemma csim_res: ∀ a n p q,
    contrasimilar p q → contrasimilar (a#n:p) (a#n:q).
  Proof. intros; apply pcsim_csim; apply pcsim_res; auto; [ apply csim_pcsim1 | apply csim_pcsim2 ]; auto. Qed.

  Lemma csim_stable_sum: ∀ p q r,
    contrasimilar p q →
    stable lts p → stable lts q →
    contrasimilar (p+r) (q+r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒
      (∃ p q r, stable lts p ∧ stable lts q ∧ pp=p+r ∧ qq=q+r ∧ contrasimilar p q) ∨
      partial_contrasimilar pp qq).
    splits; [| | left; jauto |];
      try (clear p q r H H0 H1; intros pp qq [ [p[q[r[?[?[?[??]]]]]]] | ? ]; subst); intros; unfold inv in ×.
    × false.
    × apply halted_pcsim1; auto.
    × inverts H1.
    - ∃ (q+r); split.
    apply step_nil.
    left; ∃ q p r; splits; auto.
    apply csim_symm; auto.
    - assert (lstep p a p'0 ∨ lstep r a p'0).
      { inverts H2; (inverts H1; [left|right]; constructor; auto). }
    destruct H1 as [?|?].
    + edestruct step_star_pcsim as [q'[??]].
    eapply step_lcons; eauto.
    apply csim_pcsim1; eauto.
    ∃ q'; split; eauto.
    inverts H5.
    inverts H10; eapply step_lcons; eauto; constructor; apply s_sumL; eauto.
    eapply step_tcons; eauto.
    apply s_sumL; auto.
    + ∃ p'; split.
    inverts H1; eapply step_lcons; eauto; constructor; apply s_sumR; auto.
    right; apply pcsim_refl.
    - inverts H2.
    + false. eapply H. apply H8.
    + ∃ p'; split.
    eapply step_tcons; eauto. apply s_sumR; auto.
    right; apply pcsim_refl.
    + edestruct step_star_nil_resolve as [??]; eauto; subst la p'.
    ∃ p_nil; split.
    apply csim_pcsim1 in H3.
    apply halted_pcsim1 in H3.
    inverts H3.
    apply single_tstep; apply s_sum_nil.
    false; eapply H0; apply H1.
    reflexivity.
    right; apply pcsim_refl.
    × edestruct step_star_pcsim as [q'[??]]; eauto.
    × ∃ p q r; splits; auto.
    × left; ∃ q p r; splits; auto. apply csim_symm; auto.
  Qed.

  Lemma csim_internal_sum: ∀ p q r,
    contrasimilar p q →
    contrasimilar (().p+r) (().q+r).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ (∃ p q, pp=().p+r ∧ qq=().q+r ∧ contrasimilar p q) ∨ partial_contrasimilar pp qq).
    splits; iauto;
      try (clear p q H; intros pp qq [ [p[q[?[??]]]] | ?]; subst); intros; unfold inv in ×.
    × false.
    × apply halted_pcsim1; auto.
    × inverts H.
    + ∃ (().q + r); split. apply step_nil. left; ∃ q p; splits; auto. symmetry; auto.
    + inverts H0; inverts H.
    inverts H6.
    ∃ p'; split. eapply step_lcons; eauto; constructor; apply s_sumR; auto. right; apply pcsim_refl.
    inverts H6.
    ∃ p'; split. eapply step_lcons; eauto; constructor; apply s_sumR; auto. right; apply pcsim_refl.
    + inverts H0.
    - inverts H6.
    edestruct step_star_pcsim with (q:=q) as [q'[??]]; eauto.
    apply csim_pcsim1; auto.
    ∃ q'; split; auto. eapply step_tcons; eauto. apply s_sumL; apply s_act.
    - ∃ p'; split. eapply step_tcons; eauto; apply s_sumR; auto. right; apply pcsim_refl.
    × edestruct step_star_pcsim as [q'[??]]; eauto.
    × left; ∃ q p; splits; auto. symmetry; auto.
  Qed.

  Lemma csim_res_list: ∀ AN p q,
    contrasimilar p q → contrasimilar (p_res_list AN p) (p_res_list AN q).
  Proof.
    induction AN; intros; auto. destruct a; simpl.
    apply csim_res; eauto.
  Qed.

  Definition pcsim_list := Forall2 partial_contrasimilar.

  Lemma step_star_par_list_pcsim: ∀ r lp lq la lp',
    step_star (par_list lp O) la (par_list lp' O) →
    pcsim_list lp lq →
    length lp' = length lp →
    ∃ lq',
      step_star (par_list lq r) la (par_list lq' r) ∧
      length lq' = length lq ∧
      pcsim_list lq' lp'.
  Proof.
    induction lp; destruct lq; intros; inverts H0.
    × simpl in ×.
    edestruct step_star_nil_resolve; eauto.
    destruct lp'; try discriminate. subst la.
    ∃ (@nil proc); simpl; splits; auto.
    apply @step_nil. apply Forall2_nil.
    × simpl in ×.
    renames a to p.
    edestruct step_star_par_unzip'' as [p'[lq2'[lip[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    destruct H0 as [?|[?[??]]].
    - destruct lp'; inverts H0.
    clear H.
    edestruct IHlp as [lq'[?[??]]]; eauto; clear IHlp.
    edestruct step_star_pcsim with (p:=p) as [q'[??]]; eauto.
    ∃ (q'::lq'); splits; auto.
    eapply step_star_par_zip'; eauto.
    simpl; congruence.
    apply Forall2_cons; auto.
    - false. subst. destruct lp'; inverts H1. inverts H9.
  Qed.

  Lemma step_star_rep_pcsim_par_list: ∀ lp p lq q la pp',
    step_star (par_list lp (p!!)) la pp' →
    partial_contrasimilar p q →
    pcsim_list lp lq →
    ∃ lp' lq' qq',
      step_star (par_list lq (q!!)) la qq' ∧
      sbisimilar qq' (par_list lq' (q!!)) ∧
      pp' = (par_list lp' (p!!)) ∧
      pcsim_list lq' lp'.
  Proof.
    intros.
    edestruct step_star_rep_par_list as [n[lp'[?[??]]]]; eauto.
    subst pp'.
    edestruct step_star_par_list_pcsim with (r:=q!!) as [lq'[?[??]]]; eauto.
    apply Forall2_app; eauto.
    apply Forall2_list_rep; eauto.
    edestruct step_star_sbisim1 with (p:=(par_list (lq++list_rep n q) (q!!))) (q:=par_list lq (q!!)) as [qq'[??]]; eauto.
    rewrite par_list_app.
    apply sbisim_par_list.
    apply sbisim_symm; apply sbisim_list_rep_par_list.
    ∃ lp' lq' qq'; splits; auto.
    apply sbisim_symm; auto.
  Qed.

  Lemma pcsim_rep: ∀ p q,
    contrasimilar p q → partial_contrasimilar (p_rep p) (p_rep q).
  Proof.
    intros.
    ∃ (fun pp qq ⇒ ∃ p q lp lq, sbisimilar pp (par_list lp (p!!)) ∧ sbisimilar qq (par_list lq (q!!)) ∧ contrasimilar p q ∧ pcsim_list lp lq).
    splits; try (clear p q H; intros pp qq [p[q[lp[lq[?[?[??]]]]]]]; subst; intros).
    × false.
    apply halted_sbisim1 in H; auto; subst.
    eapply (par_list_not_halted1 lp (p!!)); eauto. intro; false.
    × renames p' to pp'.
    edestruct step_star_sbisim1 with (p:=pp) as [pp''[??]]; eauto.
    clear pp H H3.
    edestruct step_star_rep_pcsim_par_list as [lp'[lq'[qq'''[?[?[??]]]]]]; eauto.
    apply csim_pcsim1; eauto.
    subst pp''.
    edestruct step_star_sbisim2 with (p:=qq) as [qq''''[??]]; eauto.
    ∃ qq''''; splits; auto.
    ∃ q p lq' lp'; splits; auto.
    eapply sbisim_trans; eauto.
    apply csim_symm; auto.
    × ∃ p q (@nil lts_S) (@nil lts_S); simpl; splits; auto.
    apply sbisim_refl.
    apply sbisim_refl.
    apply Forall2_nil.
  Qed.

  Lemma csim_rep: ∀ p q,
    contrasimilar p q → contrasimilar (p_rep p) (p_rep q).
  Proof. intros; apply pcsim_csim; apply pcsim_rep; [| apply csim_symm]; auto. Qed.

End ContrasimulationCongruence.

Module Morphisms.
  Require Import Setoid.
  Require Export Morphisms.
  Export SetoidTactics.
  Require Export SetoidClass.

  Program Instance CBisimCsSetoid : Setoid lts_S :=
      { equiv:= contrasimilar }.
  Program Instance WBisimCsSetoid : Setoid lts_S :=
      { equiv:= wbisimilar }.

  Add Parametric Relation (lts: labeled_transition_system) : lts_S eventually_similar
   reflexivity proved by (esim_refl lts)
   transitivity proved by (esim_trans lts)
  as esim_relation.

  Add Parametric Morphism: (wbisimilar)
  with signature equiv ==> equiv ==> equiv
  as wbisim_m.
  Proof.
    split; intros;
      cut (x==x0); intros; eauto;
      cut (y==y0); intros; eauto.
    rewrite<- H; rewrite<- H0; auto.
    rewrite H; rewrite H0; auto.
  Qed.

  Add Parametric Morphism: p_par
  with signature wbisimilar ==> wbisimilar ==> wbisimilar
  as wbisim_par_m.
  Proof. intros; apply wbisim_par; auto. Qed.

  Add Parametric Morphism: p_seq
  with signature wbisimilar ==> wbisimilar ==> wbisimilar
  as wbisim_seq_m.
  Proof. intros; apply wbisim_seq; auto. Qed.

  Add Parametric Morphism: p_res
  with signature eq ==> eq ==> wbisimilar ==> wbisimilar
  as wbisim_res_m.
  Proof. intros; apply wbisim_res; auto. Qed.

  Add Parametric Morphism: p_res_list
  with signature eq ==> wbisimilar ==> wbisimilar
  as wbisim_res_list_m.
  Proof. intros; apply wbisim_res_list; auto. Qed.

  Definition p_ssumL l p q := p_sum (p_act l p) q.
  Definition p_ssumR l p q := p_sum p (p_act l q).
  Definition p_ssum l1 p l2 q := p_sum (p_act l1 p) (p_act l2 q).
  Lemma eq_ssumL: ∀ l p q, p_sum (p_act l p) q = p_ssumL l p q.
  Proof. reflexivity. Qed.
  Lemma eq_ssumR: ∀ l p q, p_sum p (p_act l q) = p_ssumR l p q.
  Proof. reflexivity. Qed.
  Lemma eq_ssum: ∀ l1 l2 p q, p_sum (p_act l1 p) (p_act l2 q) = p_ssum l1 p l2 q.
  Proof. reflexivity. Qed.

  Add Parametric Morphism: p_ssumL
  with signature eq ==> wbisimilar ==> eq ==> wbisimilar
  as wbisim_ssumL_m.
  Proof.
    intros; repeat rewrite<- eq_ssumL.
    destruct y.
    × apply wbisim_internal_sum; eauto.
    × apply wbisim_stable_sum. apply wbisim_act; eauto.
    intro; introv HH; inverts HH.
    intro; introv HH; inverts HH.
    × apply wbisim_stable_sum. apply wbisim_act; eauto.
    intro; introv HH; inverts HH.
    intro; introv HH; inverts HH.
  Qed.

  Add Parametric Morphism: p_ssumR
  with signature eq ==> eq ==> wbisimilar ==> wbisimilar
  as wbisim_ssumR_m.
  Proof. intros; repeat rewrite<- eq_ssumR; setoid_rewrite wbisim_sum_comm; apply wbisim_ssumL_m; auto. Qed.

  Add Parametric Morphism: p_ssum
  with signature eq ==> wbisimilar ==> eq ==> wbisimilar ==> wbisimilar
  as wbisim_ssum.
  Proof.
    intros.
    eapply transitivity.
    apply wbisim_ssumL_m; eauto.
    apply wbisim_ssumR_m; eauto.
  Qed.

  Add Parametric Morphism: p_act
  with signature eq ==> wbisimilar ==> wbisimilar
  as wbisim_act.
  Proof. intros; apply wbisim_act; eauto. Qed.

  Add Parametric Morphism: (eventually_similar)
  with signature eventually_similar --> eventually_similar ++> Basics.impl
  as esim_m.
  Proof.
    repeat intro.
    eapply esim_trans; eauto.
    eapply esim_trans; eauto.
  Qed.

  Add Parametric Morphism: (eventually_similar)
  with signature wbisimilar ==> wbisimilar ==> iff
  as wbisim_esim_m.
  Proof.
    split; intros.
    apply wbisim_symm, wbisim_esim in H.
    apply wbisim_esim in H0.
    eapply esim_trans; eauto.
    eapply esim_trans; eauto.
    apply wbisim_esim in H.
    apply wbisim_symm, wbisim_esim in H0.
    eapply esim_trans; eauto.
    eapply esim_trans; eauto.
  Qed.

  Add Parametric Morphism: p_par
  with signature eventually_similar ++> eventually_similar ++> eventually_similar
  as esim_par_m.
  Proof. intros; apply esim_par; auto. Qed.

  Add Parametric Morphism: p_seq
  with signature eventually_similar ++> eventually_similar ++> eventually_similar
  as esim_seq_m.
  Proof. intros; apply esim_seq; auto. Qed.

  Add Parametric Morphism: p_res
  with signature eq ==> eq ==> eventually_similar ++> eventually_similar
  as esim_res_m.
  Proof. intros; apply esim_res; auto. Qed.

  Add Parametric Morphism: p_res_list
  with signature eq ==> eventually_similar ++> eventually_similar
  as esim_res_list_m.
  Proof. intros; apply esim_res_list; auto. Qed.

  Add Parametric Morphism: p_act
  with signature eq ==> eventually_similar ++> eventually_similar
  as esim_act_m.
  Proof. intros; apply esim_act; auto. Qed.

  Add Parametric Morphism: p_ssumL
  with signature eq ==> eventually_similar ++> eq ==> eventually_similar
  as esim_ssumL_m.
  Proof.
    intros; repeat rewrite<- eq_ssumL.
    destruct y.
    × apply esim_internal_sum; eauto.
    × apply esim_stable_sum. apply esim_act; eauto.
    intro; introv HH; inverts HH.
    intro; introv HH; inverts HH.
    × apply esim_stable_sum. apply esim_act; eauto.
    intro; introv HH; inverts HH.
    intro; introv HH; inverts HH.
  Qed.

  Add Parametric Morphism: p_ssumR
  with signature eq ==> eq ==> eventually_similar ++> eventually_similar
  as esim_ssumR_m.
  Proof. intros; repeat rewrite<- eq_ssumR; setoid_rewrite wbisim_sum_comm; apply esim_ssumL_m; auto. Qed.

  Add Parametric Morphism: p_ssum
  with signature eq ==> eventually_similar ++> eq ==> eventually_similar ++> eventually_similar
  as esim_ssum.
  Proof.
    intros.
    eapply transitivity.
    apply esim_ssumL_m; eauto.
    apply esim_ssumR_m; eauto.
  Qed.

  Add Parametric Morphism: (contrasimilar)
  with signature contrasimilar ==> contrasimilar ==> equiv
  as csim_m.
  Proof.
    split; intros;
      cut (contrasimilar x x0); intros; eauto;
      cut (contrasimilar y y0); intros; eauto.
    rewrite<- H; rewrite<- H0; auto.
    rewrite H; rewrite H0; auto.
  Qed.

  Add Parametric Morphism: (contrasimilar)
  with signature eventually_similar ++> eventually_similar ++> equiv
  as esim_csim_m.
  Proof.
    split; intros.
    apply esim_ebisim2, ebisim_csim in H.
    apply esim_ebisim1, ebisim_csim in H0.
    eapply csim_trans; eauto.
    eapply csim_trans; eauto.
    apply esim_ebisim1, ebisim_csim in H.
    apply esim_ebisim2, ebisim_csim in H0.
    eapply csim_trans; eauto.
    eapply csim_trans; eauto.
  Qed.

  Add Parametric Morphism: (contrasimilar)
  with signature wbisimilar ==> wbisimilar ==> equiv
  as wbisim_csim_m.
  Proof.
    split; intros; apply wbisim_csim in H; apply wbisim_csim in H0.
    rewrite<- H; rewrite<- H0; auto.
    rewrite H; rewrite H0; auto.
  Qed.

  Add Parametric Morphism: p_par
  with signature contrasimilar ==> contrasimilar ==> contrasimilar
  as csim_par_m.
  Proof. intros; apply csim_par; auto. Qed.

  Add Parametric Morphism: p_seq
  with signature contrasimilar ==> contrasimilar ==> contrasimilar
  as csim_seq_m.
  Proof. intros; apply csim_seq; auto. Qed.

  Add Parametric Morphism: p_res
  with signature eq ==> eq ==> contrasimilar ==> contrasimilar
  as csim_res_m.
  Proof. intros; apply csim_res; auto. Qed.

  Add Parametric Morphism: p_res_list
  with signature eq ==> contrasimilar ==> contrasimilar
  as csim_res_list_m.
  Proof. intros; apply csim_res_list; auto. Qed.

  Add Parametric Morphism: p_act
  with signature eq ==> contrasimilar ==> contrasimilar
  as csim_act_m.
  Proof. intros; apply csim_act; auto. Qed.

  Add Parametric Morphism: p_ssumL
  with signature eq ==> contrasimilar ==> eq ==> contrasimilar
  as csim_ssumL_m.
  Proof.
    intros; repeat rewrite<- eq_ssumL.
    destruct y.
    × apply csim_internal_sum; eauto.
    × apply csim_stable_sum. apply csim_act; eauto.
    intro; introv HH; inverts HH.
    intro; introv HH; inverts HH.
    × apply csim_stable_sum. apply csim_act; eauto.
    intro; introv HH; inverts HH.
    intro; introv HH; inverts HH.
  Qed.

  Add Parametric Morphism: p_ssumR
  with signature eq ==> eq ==> contrasimilar ==> contrasimilar
  as csim_ssumR_m.
  Proof. intros; repeat rewrite<- eq_ssumR; setoid_rewrite csim_sum_comm; apply csim_ssumL_m; auto. Qed.

  Add Parametric Morphism: p_ssum
  with signature eq ==> contrasimilar ==> eq ==> contrasimilar ==> contrasimilar
  as csim_ssum.
  Proof.
    intros.
    eapply transitivity.
    apply csim_ssumL_m; eauto.
    apply csim_ssumR_m; eauto.
  Qed.

End Morphisms.

Section MiscLemmas.
  Import Notation.
  Import Notation.U.
  Open Scope proc.

  Lemma wbisim_res_list_tau_sum: ∀ AN p q,
    wbisimilar (p_res_list AN (().p+().q)) ((().p_res_list AN p)+(().p_res_list AN q)).
  Proof.
    induction AN; intros.
    simpl. apply wbisim_refl.
    simpl. destruct a.
    setoid_rewrite IHAN.
    apply wbisim_res_tau_sum.
  Qed.

  Lemma wbisim_res_list_act_comm: ∀ AN l p,
    (∀ a, l=l_in a → ¬In a (fst (split AN))) →
    (∀ a, l=l_out a → ¬In a (fst (split AN))) →
    wbisimilar (p_res_list AN (p_act l p)) (p_act l (p_res_list AN p)).
  Proof.
    induction AN; intros.
    apply wbisim_refl.
    simpl. destruct a.
    simpl in ×. setoid_rewrite fst_split in H. setoid_rewrite fst_split in H0.
    simpl in ×.
    setoid_rewrite IHAN; jauto.
    apply wbisim_res_act_comm; jauto.
  Qed.

  Lemma wbisim_res_list_in: ∀ AN1 AN2 n AN AN' a p,
    AN = AN1 ++ [(a,S n)] ++ AN2 →
    AN' = AN1 ++ [(a,n)] ++ AN2 →
    ¬In a (fst (split AN2)) →
    wbisimilar (p_res_list AN (a?.p)) (p_res_list AN' p).
  Proof.
    intros; subst.
    repeat rewrite p_res_list_app.
    simpl.
    setoid_rewrite wbisim_res_list_act_comm; try solve [introv HH; inverts HH; auto].
    setoid_rewrite wbisim_res_in.
    reflexivity.
  Qed.

  Lemma wbisim_res_list_out: ∀ AN1 AN2 n AN AN' a p,
    AN = AN1 ++ [(a,n)] ++ AN2 →
    AN' = AN1 ++ [(a,S n)] ++ AN2 →
    ¬In a (fst (split AN2)) →
    wbisimilar (p_res_list AN (a!.p)) (p_res_list AN' p).
  Proof.
    intros; subst.
    repeat rewrite p_res_list_app.
    simpl.
    setoid_rewrite wbisim_res_list_act_comm; try solve [introv HH; inverts HH; auto].
    setoid_rewrite wbisim_res_out.
    reflexivity.
  Qed.

End MiscLemmas.

Section Parallelization.
  Import Notation.
  Import Notation.U.
  Import Morphisms.

  Definition converges AN p :=
    ∀ la1 p',
      step_star p la1 p' →
      ∃ la2 N' N'',
        step_star p' la2 p_nil ∧
        (∀ a, In (l_out a) la2 → In a (fst (split AN))) ∧
        (∀ a, In (l_in a) la2 → In a (fst (split AN))) ∧
        res_list_count_labels (fst (split AN)) (snd (split AN)) la1 N' = true ∧
        res_list_count_labels (fst (split AN)) N' la2 N'' = true.

  Definition converges' AN p :=
    ∀ la1 p',
      step_star p la1 p' →
      ∃ N',
        res_list_count_labels (fst (split AN)) (snd (split AN)) la1 N' = true ∧
        step_star (p_res_list (combine (fst (split AN)) N') p') nil p_nil.

  Lemma res_list_filter_nil_in_In: ∀ A la a,
    res_list_filter A la = [] → In (l_in a) la → In a A.
  Proof.
    induction la; simpl; intros.
    false.
    rewrite res_list_filter_cons2 in H.
    destruct a.
    false.
    destruct in_dec.
    destruct H0; auto.
    inverts H0; auto.
    false.
    destruct in_dec.
    destruct H0; auto.
    inverts H0; auto.
    false.
  Qed.
  Lemma res_list_filter_nil_out_In: ∀ A la a,
    res_list_filter A la = [] → In (l_out a) la → In a A.
  Proof.
    induction la; simpl; intros.
    false.
    rewrite res_list_filter_cons2 in H.
    destruct a.
    false.
    destruct in_dec.
    destruct H0; auto.
    inverts H0; auto.
    false.
    destruct in_dec.
    destruct H0; auto.
    inverts H0; auto.
    false.
  Qed.

  Lemma converges_converges'_equiv: ∀ AN p,
    converges AN p ↔ converges' AN p.
  Proof.
    unfold converges, converges'; split; intros.
    × edestruct H as [la2[N'[N''[?[?[?[??]]]]]]]; clear H; eauto.
    ∃ N'; split; auto.
    change [] with ([]++@nil lts_L).
    eapply step_star_app.
    apply step_star_res_list with la2; eauto.
    symmetry.
    apply res_list_filter_In_filter; auto.
    eapply step_star_l_tau_nIn; eauto.
    apply step_star_res_list_nil.
    × edestruct H as [N'[??]]; clear H; eauto.
    edestruct step_star_res_list_inv' as [la2[N''[p''[?[?[??]]]]]]; eauto.
    apply res_list_count_labels_length in H1; destruct H1; auto.
    destruct H5.
    + assert (N'' = nil ∧ AN=nil).
      apply res_list_count_labels_length in H4.
      destruct H4.
      rewrite split_length_l in ×.
      destruct N''; destruct AN; auto; false.
      destruct p0; simpl in ×.
      rewrite fst_split in H5.
      simpl in H5; discriminate.
    destruct H6; subst.
    ∃ (@nil lts_L) (@nil nat) (@nil nat); splits; auto.
    + destruct H5 as [A1[A2[N1'[N2'[?[?[?[?[??]]]]]]]]].
    subst.
    assert (A1 = nil ∧ N1'=nil).
      destruct A1; destruct N1'; auto; false.
    destruct H5; subst.
    rewrite app_nil_l in ×.
    ∃ la2 N' N2'; splits; auto.
    intros; eapply res_list_filter_nil_out_In; eauto.
    intros; eapply res_list_filter_nil_in_In; eauto.
  Qed.

  Definition term_impl AN p1 p2 := ∀ AN' la p2',
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p_nil||p2')) → converges AN' p2'.

  Lemma term_impl_step_star1: ∀ AN p1 p2 la AN' p1' p2',
    term_impl AN p1 p2 →
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    term_impl AN' p1' p2'.
  Proof.
    unfold term_impl; intros.
    eapply H; eauto.
    eapply step_star_app; eauto.
  Qed.

  Lemma term_impl_step_star2: ∀ AN p1 p2 la AN' p1' p2',
    step_star (p_res_list AN (p2||p1)) la (p_res_list AN' (p2'||p1')) →
    length AN' = length AN →
    term_impl AN p1 p2 →
    term_impl AN' p1' p2'.
  Proof.
    intros.
    intro; intros.
    eapply H1; eauto.
    apply step_star_res_list_par_swap in H; eauto.
    eapply step_star_app; eauto.
  Qed.

  Lemma converges_nil: ∀ AN,
    converges AN p_nil.
  Proof.
    unfold converges; intros.
    apply step_star_nil_resolve in H. destruct H as [??]; subst.
    ∃ (@nil lts_L) (snd (split AN)) (snd (split AN)); splits; intros.
    - apply step_nil.
    - false.
    - false.
    - apply res_list_count_labels_nil2.
    rewrite split_length_l, split_length_r; reflexivity.
    - apply res_list_count_labels_nil2.
    rewrite split_length_l, split_length_r; reflexivity.
  Qed.

  Lemma term_impl_nil: ∀ AN p,
    term_impl AN p p_nil.
  Proof.
    unfold term_impl; intros.
    edestruct step_star_res_list_inv' with (A:=fst(split AN)) (N:=snd(split AN)) as [la'[N'[p'[?[?[??]]]]]]; eauto.
    rewrite split_combine'; eauto.
    rewrite split_length_l, split_length_r; reflexivity.
    destruct H3 as [? | [?[_[?[_[?[? _]]]]]]].
    × apply p_res_list_eq in H3.
    destruct H3 as [??]; subst.
    edestruct step_star_par_unzip' as [lp[la1[la2[?[?[??]]]]]]; eauto.
    apply step_star_nil_resolve in H3; destruct H3 as [??]; subst.
    apply converges_nil.
    intros; split; intro.
    false.
    subst.
    edestruct step_star_par_unzip as [p1'[p2'_[la1[la2[?[?[? _]]]]]]]; eauto.
    destruct H1 as [? | [?[??]] ]; subst; false.
    × subst. false.
    apply p_res_list_eq in H4.
    destruct H4 as [??]; subst.
    false.
    intros; split; intro; false.
  Qed.

  Lemma converges_step_star: ∀ AN p la AN' p',
    converges AN p →
    step_star p la p' →
    res_list_count_labels (fst (split AN)) (snd (split AN)) la (snd (split AN')) = true →
    fst (split AN') = fst (split AN) →
    converges AN' p'.
  Proof.
    unfold converges; intros.
    edestruct H with (p':=p'0) as [la2[N'[N''[?[?[?[??]]]]]]]; clear H.
    eapply step_star_app; eauto.
    rewrite H2.
    apply res_list_count_labels_app2 in H7.
    destruct H7 as [N'0[??]].
    apply res_list_count_labels_fun with (N'1:=snd (split AN')) in H; eauto; subst N'0.
    ∃ la2 N' N''; splits; intros; auto.
  Qed.

  Lemma converges_term_impl: ∀ AN p,
    converges AN p →
    term_impl AN p_nil p.
  Proof.
    unfold term_impl; intros.
    edestruct step_star_res_list_inv' with (A:=fst(split AN)) (N:=snd(split AN)) as [la'[N'[p'[?[?[??]]]]]]; eauto.
    rewrite split_combine'; eauto.
    rewrite split_length_l, split_length_r; reflexivity.
    destruct H4 as [? | [?[_[?[_[?[? _]]]]]]].
    × apply p_res_list_eq in H4.
    destruct H4 as [??]; subst.
    edestruct step_star_par_unzip' as [lp[la1[la2[?[?[??]]]]]]; eauto.
    apply step_star_nil_resolve in H2; destruct H2 as [??]; subst.
    rewrite interleaving_l_nil in H3.
    rewrite interleaving_l_nil in H0.
    eapply converges_step_star; eauto.
    rewrite combine_split.
    exact H3.
    apply res_list_count_labels_length in H3; destruct H3; auto.
    rewrite combine_split; auto.
    apply res_list_count_labels_length in H3; destruct H3; auto.
    intros; split; intro.
    false.
    subst.
    edestruct step_star_par_unzip as [p1'[p2'_[la1[la2[?[?[? _]]]]]]]; eauto.
    destruct H2 as [? | [?[??]] ]; subst; false.
    × subst. false.
    apply p_res_list_eq in H5.
    destruct H5 as [??]; subst.
    false.
    intros; split; intro; false.
  Qed.

  Lemma noninterference_step_star_res_list1: ∀ AN p1 p2 p3 p4 la AN' p1' p2',
    NameSet.Equal (NameSet.inter (fn_in (p1;;p3)) (fn_in (p2;; p4))) NameSet.empty →
    step_star (p_res_list AN (p1||p2)) la (p_res_list AN' (p1'||p2')) →
    fst (split AN') = fst (split AN) →
    NameSet.Equal (NameSet.inter (fn_in (p1';;p3)) (fn_in (p2';; p4))) NameSet.empty.
  Proof.
    introv Hnoninterference Hss HA.
    apply NameSetProps.subset_antisym.
    setoid_rewrite<- Hnoninterference.
    apply NameSet_Subset_inter.
    simpl.
    apply NameSetProps.union_subset_4.
    eapply fn_in_subset_step_star_res_list_parL; eauto.
    simpl.
    rewrite<- (split_length_l AN'). rewrite HA. apply split_length_l.
    apply NameSetProps.union_subset_4.
    eapply fn_in_subset_step_star_res_list_parR; eauto.
    rewrite<- (split_length_l AN'). rewrite HA. apply split_length_l.
    apply NameSetProps.subset_empty.
  Qed.

  Lemma seq_par_inversion: ∀ AN p1 p2 p3 p4 l p',
    step (p_res_list AN ((p1||p2);;(p3||p4))) l p' →
    (∃ AN' p1' p2',
      p' = p_res_list AN' ((p1'||p2');; (p3||p4)) ∧
      step (p_res_list AN (p1||p2)) l (p_res_list AN' (p1'||p2')) ∧
      fst (split AN)=fst (split AN')) ∨
    (p1=p_nil ∧ p2=p_nil ∧ p'=p_res_list AN (p_nil;; (p3||p4))).
  Proof.
    intros.
    edestruct step_res_list_inv as [ [l'[AN'[p'_[?[?[?[??]]]]]]] | [AN1[AN2[?[?[?[??]]]]]] ]; eauto.
    × subst. inverts H0. inverts H8.
    - left; ∃ AN' p'0 p2; splits; auto.
    eapply step_res_list; eauto.
    apply s_parL; auto.
    - left; ∃ AN' p1 q'; splits; auto.
    eapply step_res_list; eauto.
    apply s_parR; auto.
    - right; splits; auto.
    apply res_list_count_labels_single in H4.
    destruct H4 as [ [A1[a[A2[N1[n[N2[n'[?[?[?[?[??]]]]]]]]]]]] | [??] ].
    destruct H7 as [[??]|[??]]; false.
    rewrite<- (split_combine' AN).
    rewrite<- (split_combine' AN').
    congruence.
    × false.
  Qed.

  Lemma step_star_par_seq_converges: ∀ AN p3 p2 p4 la AN' p',
    step_star (p3 || p2;; p4) la p' →
    converges AN p2 →
    fst (split AN') = fst (split AN) →
    res_list_count_labels (fst (split AN)) (snd (split AN)) la (snd (split AN')) = true →
    (hidden_fn (fst (split AN)) p3 ∨ hidden_fn (fst (split AN)) p2) →
    NameSet.Equal (NameSet.inter (fn_in p3) (fn_in (p2;;p4))) NameSet.empty →
    ∃ la1 la2 pp'' AN'0 AN'1,
      (res_list_filter (fst (split AN)) la) = la1 ++ la2 ∧
      fst (split AN'0) = fst (split AN) ∧
      ((∃ p3' p24', p'=p3'||p24' ∧ fst (split AN'1)=fst (split AN)) ∨ (p'=p_nil ∧ pp'' =p_nil ∧ AN'1=nil))%proc ∧
      step_star (p_res_list AN' p') nil (p_res_list AN'1 pp'') ∧
      step_star (p_res_list AN p2) la1 (p_res_list AN'0 p_nil) ∧
      step_star (p_res_list AN'0 (p3||p4)) la2 (p_res_list AN'1 pp'').
  Proof.
    introv Hss Hconv HA Hres Hhidden Hfn_in; intros.
    edestruct step_star_parR_seq_inv as [ [p3'[p2'[Hss' ?]]] | [la1[la2[p3'[Hss1[Hss2 ?]]]]] ]; eauto; clear Hss.
    × subst. rename Hss' into Hss.
    edestruct step_star_par_unzip' with (p2:=p2) as [lp[la3[la1[Hss_p3[Hss_p2[??]]]]]]; eauto.
    clear Hss. subst.
    rewrite <-interleaving_com in Hres; [| omega].
    edestruct Hconv as [la2[D'[D''[Hss_p2'[?[?[Hres1 Hres2]]]]]]]; clear Hconv; eauto.
    eapply res_list_count_labels_interleaving1 with (N0:=snd(split AN)) (N0':=D') in Hres; auto.
    apply res_list_count_labels_app2 in Hres.
    destruct Hres as [N'0[Hres1' Hres3]].

    apply res_list_count_labels_fun with (N'1:=N'0) (N'2:=D') in Hres1'; eauto; subst D'.

    assert (HlenD'': length D'' = length AN).
      { apply res_list_count_labels_length in Hres2. destruct Hres2 as [H4 H5].
      rewrite H5.
      rewrite split_length_l. auto. }
    assert (HlenN'0: length N'0 = length AN).
      { apply res_list_count_labels_length in Hres2. destruct Hres2 as [H4 H5].
      rewrite H4.
      rewrite split_length_l. auto. }

    assert (Hnoninter: ∀ a, (In (l_in a) la1 ∨ In (l_in a) la2) → In (l_in a) la3 → False).
      { clear -Hfn_in Hss_p3 Hss_p2 Hss_p2'. intros.
      apply (NameSetProps.Dec.F.empty_iff a).
      setoid_rewrite<- Hfn_in. simpl.
      apply NameSetProps.Dec.F.inter_3.
      eapply fn_in_step_star_In; eauto.
      apply NameSetProps.FM.union_2.
      destruct H.
      eapply fn_in_step_star_In; eauto.
      eapply fn_in_subset_step_star; eauto.
      eapply fn_in_step_star_In; eauto. }

    destruct (res_list_count_labels_com _ la3 N'0 (snd (split AN')) la2 D'' Hres3) as [N'''[Hres2' Hres3']].
    exact Hres2.
    intros; eapply Hnoninter; eauto.

    assert (length N''' = length AN).
      { apply res_list_count_labels_length in Hres3'; destruct Hres3'. rewrite split_length_l in H3; auto. }

    assert (step_star (p_res_list AN' (p3' ‖ p2';; p4)) []
        (p_res_list (combine (fst (split AN)) N''') (p3' ‖ p4))).
      { apply step_star_res_list' with la2; auto.
      eapply step_tsnoc.
      apply step_star_parR_seq_app.
      apply step_star_parR_step; eauto.
      apply s_parR; apply s_seq_nil.
      rewrite combine_split; auto. rewrite split_length_l; auto.
      symmetry; apply res_list_filter_In_filter; auto.
      eapply step_star_l_tau_nIn; eauto.
      repeat (rewrite combine_split; auto).
      simpl.
      rewrite HA; apply H1.
      rewrite HA; apply H.
      rewrite HA.
      rewrite combine_split; auto. rewrite split_length_l; auto. }

    destruct Hhidden as [Hhidden|Hhidden].
    + ∃ (res_list_filter (fst (split AN)) la1) (@nil lts_L) (p3'||p4)%proc
        (combine (fst (split AN)) D'')
        (combine (fst (split AN)) N'''); splits; auto.
    - rewrite app_nil_r.
    rewrite<- interleaving_com.
    apply res_list_filter_interleaving_fn2.
    eapply step_star_l_tau_nIn; eauto.
    eapply step_star_l_tau_nIn; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    omega.
    - rewrite combine_split; auto. rewrite split_length_l; auto.
    - left; do 2 eexists; split; eauto.
    rewrite combine_split; auto. rewrite split_length_l; auto.
    - rewrite<- (app_nil_r (res_list_filter _ _)).
    eapply step_star_app.
    apply step_star_res_list' with (la:=la1) (AN':=combine (fst (split AN)) N'0); auto.
    apply Hss_p2.
    rewrite combine_split; auto. rewrite split_length_l; auto.
    rewrite combine_split; auto. rewrite split_length_l; auto.
    apply step_star_res_list with la2; auto.
    symmetry. apply res_list_filter_In_filter; auto.
    eapply step_star_l_tau_nIn; eauto.
    - apply step_star_res_list with la3; auto.
    apply step_star_parL_step; auto.
    symmetry. apply res_list_filter_In_filter; auto.
    eapply step_star_l_tau_nIn; eauto.
    intros; apply Hhidden; eapply fn_step_star_In; eauto.
    intros; apply Hhidden; eapply fn_step_star_In; eauto.
    + ∃ (@nil lts_L) (res_list_filter (fst (split AN)) la3) (p3'||p4)%proc
        (combine (fst (split AN)) D'')
        (combine (fst (split AN)) N'''); splits; auto.
    - rewrite app_nil_l.
    apply res_list_filter_interleaving_fn2.
    eapply step_star_l_tau_nIn; eauto.
    eapply step_star_l_tau_nIn; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    - rewrite combine_split; auto. rewrite split_length_l; auto.
    - left; do 2 eexists; split; eauto.
    rewrite combine_split; auto. rewrite split_length_l; auto.
    - rewrite<- (app_nil_r (@nil _)).
    eapply step_star_app.
    apply step_star_res_list' with (la:=la1) (AN':=combine (fst (split AN)) N'0); auto.
    apply Hss_p2.
    rewrite combine_split; auto. rewrite split_length_l; auto.
    symmetry. apply res_list_filter_In_filter; auto.
    eapply step_star_l_tau_nIn; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    rewrite combine_split; auto. rewrite split_length_l; auto.
    apply step_star_res_list with la2; auto.
    symmetry. apply res_list_filter_In_filter; auto.
    eapply step_star_l_tau_nIn; eauto.
    - apply step_star_res_list with la3; auto.
    apply step_star_parL_step; auto.

    + clear -Hss_p2 Hss_p3 Hfn_in; intros.
    apply NameSetFacts.empty_iff with (x:=a).
    rewrite<- Hfn_in.
    apply NameSetProps.Dec.F.inter_3.
    eapply fn_in_step_star_In; eauto.
    apply NameSetProps.Dec.F.union_2.
    eapply fn_in_step_star_In; eauto.

    + apply list_le_refl.

    × subst la.
    apply res_list_count_labels_app2 in Hres.
    destruct Hres as [N'1[Hres1 Hres3]].
    edestruct step_star_par_unzip' with (p2:=p2) as [lp[la12[la11[Hss_p3[Hss_p2[??]]]]]]; eauto.
    clear Hss1. subst la1.
    rewrite <-interleaving_com in Hres1; [| omega].
    edestruct Hconv as [la3[D'[_[_[_[_[Hres11 _]]]]]]]; clear Hconv; eauto.
    eapply res_list_count_labels_interleaving1 with (N0:=snd(split AN)) (N0':=D') in Hres1; auto.
    apply res_list_count_labels_app2 in Hres1.
    destruct Hres1 as [N'0[Hres11' Hres12]].
    apply res_list_count_labels_fun with (N'1:=N'0) (N'2:=D') in Hres11'; eauto; subst D'.

    assert (HlenN'0: length N'0 = length AN).
      { apply res_list_count_labels_length in Hres11. destruct Hres11 as [H2 H3].
      rewrite H3.
      rewrite split_length_l. split; auto. }

    assert (∃ (AN'':list (name×nat)), (∃ p3'' p4'', p'=p3''||p4'' ∧ AN''=AN') ∨ (p'=p_nil ∧ AN''=[]))%proc.
    { clear -Hss2 Hres3.
      edestruct step_star_par_unzip as [p3''[p4''[la4[la5[?[?[? _]]]]]]]; eauto.
      destruct H as [? | [?[??]] ]; subst; eauto.
      ∃ AN'; left; eauto. }
    destruct H as [AN'' ?].

    destruct Hhidden as [Hhidden|Hhidden].
    + ∃ (res_list_filter (fst (split AN)) la11) (res_list_filter (fst (split AN)) (la12++la2)) p'
        (combine (fst (split AN)) N'0)
        AN''; splits; auto.
    - repeat rewrite res_list_filter_app2.
    f_equal.
    rewrite<- interleaving_com.
    apply res_list_filter_interleaving_fn2.
    eapply step_star_l_tau_nIn; eauto.
    eapply step_star_l_tau_nIn; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    omega.
    rewrite (res_list_filter_In_filter (fst (split AN)) la12).
    reflexivity.
    eapply step_star_l_tau_nIn; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    - rewrite combine_split; auto. rewrite split_length_l; auto.
    - destruct H as [ [p3''[p4''[??]]] | [??] ]; subst; eauto.
    - destruct H as [ [p3''[p4''[??]]] | [??] ]; subst.
    apply step_nil.
    apply step_star_res_list_nil.
    - rewrite<- (split_combine' AN) at 1.
    apply step_star_res_list with la11; auto.
    - rewrite res_list_filter_app2.
    eapply step_star_app.
    apply step_star_res_list with la12; auto.
    apply step_star_parL_step; eauto.
    apply Hres12.
    destruct H as [ [p3''[p4''[??]]] | [??] ]; subst.
    rewrite<- (split_combine' AN').
    rewrite HA.
    apply step_star_res_list with la2; auto.
    rewrite<- (app_nil_r (res_list_filter (fst (split AN)) la2)).
    eapply step_star_app.
    apply step_star_res_list with la2; eauto.
    apply step_star_res_list_nil.

    + ∃ (@nil lts_L) (res_list_filter (fst (split AN)) (la12++la2)) p'
        (combine (fst (split AN)) N'0)
        AN''; splits; auto.
    - simpl. repeat rewrite res_list_filter_app2.
    f_equal; auto.
    apply res_list_filter_interleaving_fn2.
    eapply step_star_l_tau_nIn; eauto.
    eapply step_star_l_tau_nIn; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    - rewrite combine_split; auto. rewrite split_length_l; auto.
    - destruct H as [ [p3''[p4''[??]]] | [??] ]; subst; eauto.
    - destruct H as [ [p3''[p4''[??]]] | [??] ]; subst.
    apply step_nil.
    apply step_star_res_list_nil.
    - rewrite<- (split_combine' AN) at 1.
    apply step_star_res_list with la11; auto.
    symmetry; apply res_list_filter_In_filter.
    eapply step_star_l_tau_nIn; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    intros. eapply Hhidden. eapply fn_step_star_In; eauto.
    - rewrite res_list_filter_app2.
    eapply step_star_app.
    apply step_star_res_list with la12; auto.
    apply step_star_parL_step; eauto.
    apply Hres12.
    destruct H as [ [p3''[p4''[??]]] | [??] ]; subst.
    rewrite<- (split_combine' AN').
    rewrite HA.
    apply step_star_res_list with la2; auto.
    rewrite<- (app_nil_r (res_list_filter (fst (split AN)) la2)).
    eapply step_star_app.
    apply step_star_res_list with la2; eauto.
    apply step_star_res_list_nil.

    + clear -Hss_p2 Hss_p3 Hfn_in; intros.
    apply NameSetFacts.empty_iff with (x:=a).
    rewrite<- Hfn_in.
    apply NameSetProps.Dec.F.inter_3.
    eapply fn_in_step_star_In; eauto.
    apply NameSetProps.Dec.F.union_2.
    eapply fn_in_step_star_In; eauto.

    + apply list_le_refl.
  Qed.

  Lemma step_star_par_seq_converges1: ∀ AN p3 p2 p4 la AN' p',
    step_star (p3 || p2;; p4) la p' →
    converges AN p2 →
    fst (split AN') = fst (split AN) →
    res_list_count_labels (fst (split AN)) (snd (split AN)) la (snd (split AN')) = true →
    hidden_fn (fst (split AN)) p2 →
    NameSet.Equal (NameSet.inter (fn_in p3) (fn_in (p2;;p4))) NameSet.empty →
    ∃ pp'' AN'0,
      fst (split AN'0) = fst (split AN) ∧
      (p'=p_nil → pp'' =p_nil) ∧
      step_star (p_res_list AN' p') nil pp'' ∧
      step_star (p_res_list AN p2) nil (p_res_list AN'0 p_nil) ∧
      step_star (p_res_list AN'0 (p3||p4)) (res_list_filter (fst (split AN)) la) pp''.
  Proof.
    intros.
    edestruct step_star_par_seq_converges as [la1[la2[pp''[AN'0[AN'1[?[?[?[?[??]]]]]]]]]]; eauto.
    replace la1 with (@nil lts_L) in ×.
    rewrite app_nil_l in ×.
    subst la2.
    ∃ (p_res_list AN'1 pp'') AN'0; splits; intros; auto.
    destruct H7 as [ [p3'[p24'[??]]] | [?[??]] ]; subst; eauto. discriminate.
    symmetry; eapply step_star_hidden; eauto.
  Qed.

  Lemma step_star_par_seq_converges2: ∀ AN p1 p3 p4 la AN' p',
    step_star (p1;; p3 || p4) la p' →
    converges AN p1 →
    fst (split AN') = fst (split AN) →
    res_list_count_labels (fst (split AN)) (snd (split AN)) la (snd (split AN')) = true →
    hidden_fn (fst (split AN)) p4 →
    NameSet.Equal (NameSet.inter (fn_in (p1;;p3)) (fn_in p4)) NameSet.empty →
    ∃ la1 la2 pp'' AN'0,
      res_list_filter (fst (split AN)) la = la1 ++ la2 ∧
      fst (split AN'0) = fst (split AN) ∧
      (p'=p_nil → pp'' =p_nil) ∧
      step_star (p_res_list AN' p') nil pp'' ∧
      step_star (p_res_list AN p1) la1 (p_res_list AN'0 p_nil) ∧
      step_star (p_res_list AN'0 (p3||p4)) la2 pp''.
  Proof.
    introv Hss Hconv HA Hresla Hhidden Hnoninter.
    apply step_star_par_swap' in Hss.
    edestruct step_star_par_seq_converges as [la1[la2[pp''[AN'0[AN'1[?[?[?[?[??]]]]]]]]]]; eauto.
    setoid_rewrite NameSetProps.inter_sym; auto.
    destruct H1 as [ [p3'[p24'[??]]] | [?[??]] ].
    × destruct p'; simpl in H1; inverts H1.
    apply step_star_res_list_par_swap in H2.
    apply step_star_res_list_par_swap in H4.
    ∃ la1 la2 (p_res_list AN'1 (par_swap pp'')) AN'0; splits; auto.
    intros; discriminate.
    rewrite<- (split_length_l AN'1); rewrite<- (split_length_l AN'0); congruence.
    rewrite<- (split_length_l AN'1); rewrite<- (split_length_l AN'); congruence.
    × subst; simpl in ×.
    destruct p'; simpl in H1; try discriminate.
    ∃ la1 la2 p_nil AN'0; splits; auto.
    apply step_star_res_list_par_swap_nil'.
    simpl; auto.
  Qed.

  Lemma par_seq_inversion: ∀ AN p1 p2 p3 p4 la p',
    step_star (p_res_list AN ((p1;;p3)||(p2;;p4))) la p' →
    term_impl AN p1 p2 → term_impl AN p2 p1 →
    hidden_fn (fst (split AN)) (p2;;p4) →
    NameSet.Equal (NameSet.inter (fn_in (p1;;p3)) (fn_in (p2;; p4))) NameSet.empty →
    (∃ AN' p1' p2',
      p' = p_res_list AN' ((p1';;p3)||(p2';;p4)) ∧
      step_star (p_res_list AN (p1 || p2)) la (p_res_list AN' (p1' || p2')) ∧
      fst (split AN) = fst (split AN')) ∨
    (∃ p'',
      step_star (p_res_list AN ((p1||p2);;(p3||p4))) la p'' ∧ step_star p' nil p'').
  Proof.
    introv Hss Hterm12 Hterm21 Hhidden Hnoninter; intros. rename p' into pp'.
    edestruct step_star_res_list_inv' with (A:=fst (split AN)) (N:=snd (split AN)) as [la'[N'[p'[Hss'[?[??]]]]]]; eauto.
    rewrite split_combine'. eauto.
    rewrite split_length_l; rewrite split_length_r; reflexivity.
    clear Hss; rename Hss' into Hss.
    subst.
    edestruct step_star_par_seq_inv as [ [p1'[p2'[??]]] | [ [la1[p2'[la2[?[??]]]]] | [la1[p1'[la2[?[??]]]]] ] ]; eauto;
      clear Hss; try rename Hss' into Hss.
    × subst.
    destruct H1 as [? | [A1[A2[N1'[N2'[? _]]]]] ]; [| discriminate]. subst.
    left; do 3 eexists; splits; eauto.
    rewrite<- (split_combine' AN) at 1.
    eapply step_star_res_list; eauto.
    rewrite combine_split. reflexivity.
    apply res_list_count_labels_length in H0; destruct H0 as [??]; auto.
    × subst.
    apply res_list_count_labels_app2 in H0.
    destruct H0 as [N'0[??]].
    remember (combine (fst (split AN)) N'0) as AN'0.
    remember (combine (fst (split AN)) N') as AN'.
    assert (HA'0: fst (split AN'0) = fst (split AN)).
      subst. rewrite combine_split. reflexivity. apply res_list_count_labels_length in H0; destruct H0 as [_ H0]; auto.
    assert (HA': fst (split AN') = fst (split AN)).
      subst. rewrite combine_split. reflexivity. apply res_list_count_labels_length in H3; destruct H3 as [_ H3]; auto.
    assert (HlenAN'0: length AN'0 = length AN).
      rewrite<- split_length_l. rewrite<- split_length_l. congruence.
    assert (HlenAN': length AN' = length AN).
      rewrite<- split_length_l. rewrite<- split_length_l. congruence.
    replace N'0 with (snd (split AN'0)) in ×.
      2: subst; rewrite combine_split; [| apply res_list_count_labels_length in H0; destruct H0 as [_ H0]]; auto.
    replace N' with (snd (split AN')) in ×.
      2: subst AN'; rewrite combine_split; [| apply res_list_count_labels_length in H3; destruct H3 as [_ H3]]; auto.
    clear HeqAN' HeqAN'0.
    edestruct step_star_par_seq_converges1 with (AN:=AN'0) (AN':=AN') as [pp''[AN'1[?[?[?[??]]]]]]; eauto; try congruence.
    eapply Hterm12.
    eapply step_star_res_list'; eauto.
    congruence.
    rewrite HA'0.
    eapply hidden_fn_step_star_parL with (p2:=p2); eauto.
    eapply hidden_fn_seq1; eauto.
    apply NameSetProps.subset_antisym.
    setoid_rewrite<- Hnoninter.

    apply NameSet_Subset_inter.
    apply NameSetProps.union_subset_2.
    simpl.
    apply NameSetProps.union_subset_4.

    eapply fn_in_subset_step_star_parR; eauto.
    apply NameSetProps.subset_empty.
    assert (HlenAN'0'1: length AN'1 = length AN'0).
      rewrite<- (split_length_l AN'0). rewrite<- H4. rewrite split_length_l. reflexivity.
    right; ∃ pp''; split.
    rewrite res_list_filter_app2.
    eapply step_star_app.
    apply step_star_res_list_seq_app with (AN':=AN'0); auto.
    eapply step_star_res_list'; eauto.

    rewrite<- (app_nil_l la2). rewrite res_list_filter_app2. rewrite res_list_filter_nil2.
    eapply step_star_app.
    apply step_star_res_list_seq_app with (AN':=AN'1); eauto.
    apply step_star_res_list_parR_step; eauto.
    eapply step_tcons.
    apply s_res_list; try solve [intros; false]. apply s_seq; apply s_par_nil.
    eapply step_tcons.
    apply s_res_list; try solve [intros; false]. apply s_seq_nil.
    rewrite<- HA'0.
    apply H8.
    destruct H1 as [? | [A1[A2[N1'[N2'[?[?[?[?[??]]]]]]]]]].
    subst; auto.
    subst.
    rewrite H5; auto.
    apply step_star_res_list_nil.
    × subst.
    apply res_list_count_labels_app2 in H0.
    destruct H0 as [N'0[??]].
    remember (combine (fst (split AN)) N'0) as AN'0.
    remember (combine (fst (split AN)) N') as AN'.
    assert (HA'0: fst (split AN'0) = fst (split AN)).
      subst. rewrite combine_split. reflexivity. apply res_list_count_labels_length in H0; destruct H0 as [_ H0]; auto.
    assert (HA': fst (split AN') = fst (split AN)).
      subst. rewrite combine_split. reflexivity. apply res_list_count_labels_length in H3; destruct H3 as [_ H3]; auto.
    assert (HlenAN'0: length AN'0 = length AN).
      rewrite<- split_length_l. rewrite<- split_length_l. congruence.
    assert (HlenAN': length AN' = length AN).
      rewrite<- split_length_l. rewrite<- split_length_l. congruence.
    replace N'0 with (snd (split AN'0)) in ×.
      2: subst; rewrite combine_split; [| apply res_list_count_labels_length in H0; destruct H0 as [_ H0]]; auto.
    replace N' with (snd (split AN')) in ×.
      2: subst AN'; rewrite combine_split; [| apply res_list_count_labels_length in H3; destruct H3 as [_ H3]]; auto.
    clear HeqAN' HeqAN'0.
    edestruct step_star_par_seq_converges2 with (AN:=AN'0) (AN':=AN') as [la3[la4[pp''[AN'1[?[?[?[?[??]]]]]]]]]; eauto; try congruence.
    eapply Hterm21.
    apply step_star_res_list_par_swap'; eauto.
    eapply step_star_res_list'; eauto; congruence.
    congruence.
    rewrite HA'0.
    eapply hidden_fn_seq2; eauto.
    apply NameSetProps.subset_antisym.
    setoid_rewrite<- Hnoninter.
    apply NameSet_Subset_inter.
    simpl.
    apply NameSetProps.union_subset_4.
    eapply fn_in_subset_step_star_parL; eauto.
    apply NameSetProps.union_subset_2.
    apply NameSetProps.subset_empty.
    assert (HlenAN'0'1: length AN'1 = length AN'0).
      rewrite<- (split_length_l AN'0). rewrite<- H5. rewrite split_length_l. reflexivity.
    right; ∃ pp''; split.
    rewrite res_list_filter_app2.
    rewrite HA'0 in H4.
    rewrite H4.
    eapply step_star_app.
    apply step_star_res_list_seq_app with (AN':=AN'0); auto.
    eapply step_star_res_list'; eauto.
    eapply step_star_app.
    apply step_star_res_list_seq_app with (AN':=AN'1); eauto.
    apply step_star_res_list_parL_step; eauto.
    eapply step_tcons.
    apply s_res_list; try solve [intros; false]. apply s_seq; apply s_par_nil.
    eapply step_tcons; eauto.
    apply s_res_list; try solve [intros; false]. apply s_seq_nil.
    destruct H1 as [? | [A1[A2[N1'[N2'[?[?[?[?[??]]]]]]]]]].
    subst; auto.
    subst.
    rewrite H6; auto.
    apply step_star_res_list_nil.
  Qed.

  Lemma pbisim_seq_par: ∀ AN p1 p2 p3 p4,
    term_impl AN p1 p2 → term_impl AN p2 p1 →
    hidden_fn (fst (split AN)) (p2;; p4) →
    NameSet.Equal (NameSet.inter (fn_in (p1;; p3)) (fn_in (p2;; p4))) NameSet.empty →
    par_bisimilar (p_res_list AN ((p1||p2);; (p3||p4))) (p_res_list AN ((p1;;p3) || (p2;;p4))).
  Proof.
    intros.
    ∃ (fun p q ⇒
      (∃ AN p1 p2,
        q = p_res_list AN ((p1;;p3)||(p2;;p4)) ∧
        p = p_res_list AN ((p1||p2);;(p3||p4)) ∧
        term_impl AN p1 p2 ∧ term_impl AN p2 p1 ∧
        hidden_fn (fst (split AN)) (p2;; p4) ∧
        NameSet.Equal (NameSet.inter (fn_in (p1;; p3)) (fn_in (p2;; p4))) NameSet.empty) ∨
      wbisimilar p q
    ).
    split.
    clear AN p1 p2 H H0 H1 H2.
    splits; intros p q [ [AN[p1[p2[?[?[Hterm1[Hterm2[Hhidden Hnoninterference]]]]]]]] | ? ]; subst; intros; unfold inv in ×.
    × false. repeat red in H.
    destruct AN; simpl in H. discriminate.
    destruct p; discriminate.
    × eapply halted_wbisim1; eauto.
    × false. repeat red in H.
    destruct AN; simpl in H. discriminate.
    destruct p; discriminate.
    × eapply halted_wbisim2; eauto.
    × split; intros.
    - edestruct seq_par_inversion with (l:=l_tau) as [ [AN'[p1'[p2'[?[??]]]]] | [?[??]] ]; eauto.
    apply H.
    assert (Hlen: length AN' = length AN).
      rewrite<- (split_length_l AN'); rewrite<- (split_length_l AN); congruence.
    + ∃ (p_res_list AN' ((p1';; p3) || (p2';; p4))); split.
    apply single_tstep.
    apply step_res_list_par_seq_app; auto.
    left; do 3 eexists; splits; eauto.
    eapply term_impl_step_star1 with (AN:=AN) (p1:=p1) (p2:=p2); auto.
    apply single_tstep; auto.
    eapply term_impl_step_star2; eauto.
    apply single_tstep; auto.
    subst p'.
    rewrite<- H2; intros.
    apply hidden_fn_seq3.
    eapply hidden_fn_step_star_res_list_parR with (p2:=p2); eauto.
    apply single_tstep. apply H1.
    eapply hidden_fn_seq1; eauto.
    eapply hidden_fn_seq2; eauto.
    eapply noninterference_step_star_res_list1 with (AN:=AN) (AN':=AN'); eauto.
    apply single_tstep. apply H1.
    + subst. ∃ (p_res_list AN (p3||p4)); split.
    eapply step_tcons.
    eapply s_res_list; eauto.
    intros; discriminate.
    intros; discriminate.
    apply s_parL; apply s_seq_nil.
    eapply single_tstep.
    eapply s_res_list; eauto.
    intros; discriminate.
    intros; discriminate.
    apply s_parR; apply s_seq_nil.
    right.
    eapply wbisim_res_list; eauto.
    apply wbisim_nil_seq.
    - rename a into l.
    assert (∃ a, l=l_in a ∨ l=l_out a).
      inverts H; eauto.
    destruct H0 as [q ?].
    edestruct seq_par_inversion with (l:=l) as [ [AN'[p1'[p2'[?[??]]]]] | [?[??]] ]; eauto.
    inverts H; eauto.
    + assert (Hlen: length AN' = length AN).
      rewrite<- (split_length_l AN'); rewrite<- (split_length_l AN); congruence.
    ∃ (p_res_list AN' ((p1';; p3) || (p2';; p4))); split.
    apply single_lstep.
    inverts H; constructor; eauto; apply step_res_list_par_seq_app; auto.
    left; do 3 eexists; splits; eauto.
    eapply term_impl_step_star1 with (AN:=AN) (p1:=p1) (p2:=p2); auto.
    apply single_lstep with (a:=l); destruct H0; subst; constructor; eauto.
    eapply term_impl_step_star2; eauto.
    apply single_lstep with (a:=l); destruct H0; subst; constructor; eauto.
    subst p'.
    rewrite<- H3; intros.
    apply hidden_fn_seq3.
    eapply hidden_fn_step_star_res_list_parR with (p2:=p2) (la:=[l]); eauto.
    destruct H0 as [?|?]; subst l; apply single_lstep; constructor; eauto.
    eapply hidden_fn_seq1; eauto.
    eapply hidden_fn_seq2; eauto.
    eapply noninterference_step_star_res_list1 with (AN:=AN) (AN':=AN') (la:=[l]); eauto.
    destruct H0 as [?|?]; subst l; apply single_lstep; constructor; eauto.
    + subst.
    edestruct step_res_list_inv'' as [l'[?[?[??]]]]; eauto.
    inverts H; eauto.
    inverts H1. inverts H8.
    destruct H0; subst.
    destruct H3 as [ [a[?[??]]] | [??] ]; false.
    destruct H3 as [ [a[?[??]]] | [??] ]; false.
    × split; intros.
    - edestruct tstep_wbisim1 as [q'[??]]; eauto.
    - edestruct lstep_wbisim1 as [q'[??]]; eauto.
    × edestruct par_seq_inversion as [ [AN'[p1'[p2'[?[??]]]]] | [p''[??]] ]; eauto.
    assert (Hlen: length AN' = length AN).
      rewrite<- (split_length_l AN'); rewrite<- (split_length_l AN); congruence.
    left; eexists; split.
    apply step_star_res_list_seq_app; eauto.
    subst p'.
    left; do 3 eexists; splits; auto.
    eapply term_impl_step_star1. 2: apply H1. auto.
    eapply term_impl_step_star2; eauto.
    rewrite<- H2; intros.
    apply hidden_fn_seq3.
    eapply hidden_fn_step_star_res_list_parR; eauto.
    eapply hidden_fn_seq1; eauto.
    eapply hidden_fn_seq2; eauto.
    eapply noninterference_step_star_res_list1; eauto.
    × edestruct step_star_wbisim2 as [q'[??]]; eauto.
    × left; do 3 eexists; splits; eauto.
  Qed.

  Corollary esim_seq_par: ∀ AN p1 p2 p3 p4,
    term_impl AN p1 p2 → term_impl AN p2 p1 →
    hidden_fn (fst (split AN)) (p2;; p4) →
    NameSet.Empty (NameSet.inter (fn_in (p1;; p3)) (fn_in (p2;; p4))) →
    eventually_similar (p_res_list AN ((p1||p2);; (p3||p4))) (p_res_list AN ((p1;;p3) || (p2;;p4))).
  Proof.
    intros.
    apply pbisim_esim.
    eapply pbisim_seq_par; eauto.
    apply NameSetProps.empty_is_empty_1; auto.
  Qed.

  Corollary csim_seq_par: ∀ AN p1 p2 p3 p4,
    term_impl AN p1 p2 → term_impl AN p2 p1 →
    hidden_fn (fst (split AN)) (p2;; p4) →
    NameSet.Empty (NameSet.inter (fn_in (p1;; p3)) (fn_in (p2;; p4))) →
    contrasimilar (p_res_list AN ((p1||p2);; (p3||p4))) (p_res_list AN ((p1;;p3) || (p2;;p4))).
  Proof.
    intros.
    apply pbisim_csim.
    eapply pbisim_seq_par; eauto.
    apply NameSetProps.empty_is_empty_1; auto.
  Qed.

  Ltac NameSet_simpl:=
    unfold NameSet.Equal, NameSet.Subset in *; intros;
    repeat first [rewrite NameSet.remove_spec in ×
      | rewrite NameSet.add_spec in ×
      | rewrite NameSet.remove_spec in ×
      | rewrite NameSet.union_spec in ×
      | rewrite NameSet.inter_spec in ×
      | rewrite NameSet.diff_spec in ×
      | rewrite NameSetFacts.empty_iff in ×
      ].

  Corollary esim_seq_par_simpl: ∀ AN p1 p2,
    converges AN p1 →
    (hidden_fn (fst (split AN)) p1 ∨ hidden_fn (fst (split AN)) p2) →
    NameSet.Empty (NameSet.inter (fn_in p1) (fn_in p2)) →
    eventually_similar (p_res_list AN (p1;; p2)) (p_res_list AN (p1 || p2)).
  Proof.
    intros.
    cut (eventually_similar (p_res_list AN ((p1||p_nil);; (p_nil||p2))) (p_res_list AN ((p1;; p_nil) || (p_nil;; p2)))); intros.
    × setoid_rewrite wbisim_par_nil1 in H2.
    setoid_rewrite wbisim_par_nil2 in H2.
    setoid_rewrite wbisim_nil_seq in H2.
    setoid_rewrite wbisim_seq_nil in H2.
    exact H2.
    ×
    destruct H0.
    + setoid_rewrite wbisim_par_swap.
    eapply esim_seq_par; eauto.
    apply converges_term_impl; auto.
    apply term_impl_nil.
    apply hidden_fn_seq3; auto.
    unfold hidden_fn. simpl. setoid_rewrite NameSetFacts.empty_iff. intros; false.
    simpl.
    setoid_rewrite NameSetProps.empty_union_1 with (s:= NameSet.empty).
    setoid_rewrite NameSetProps.empty_union_2 with (s:= NameSet.empty).
    setoid_rewrite NameSetProps.inter_sym.
    exact H1.
    apply NameSet.empty_spec.
    apply NameSet.empty_spec.
    + eapply esim_seq_par; eauto.
    apply term_impl_nil.
    apply converges_term_impl; auto.
    simpl.
    setoid_rewrite NameSetProps.empty_union_1 with (s:= NameSet.empty).
    setoid_rewrite NameSetProps.empty_union_2 with (s:= NameSet.empty).
    exact H1.
    apply NameSet.empty_spec.
    apply NameSet.empty_spec.
  Qed.

  Corollary csim_seq_par_simpl: ∀ AN p1 p2,
    converges AN p1 →
    (hidden_fn (fst (split AN)) p1 ∨ hidden_fn (fst (split AN)) p2) →
    NameSet.Empty (NameSet.inter (fn_in p1) (fn_in p2)) →
    contrasimilar (p_res_list AN (p1;; p2)) (p_res_list AN (p1 || p2)).
  Proof.
    intros.
    apply ebisim_csim.
    apply esim_ebisim1.
    apply esim_seq_par_simpl; auto.
  Qed.

End Parallelization.

Module TestParallelization.
  Import Notation.
  Import BinPos.
  Import Morphisms.

  Definition l0 := 1%positive.
  Definition l1 := 2%positive.
  Definition l2 := 3%positive.

  Let M (a b c d e f: name):= p_res_list [(e,0),(f,0)] ((p_res_list [(c,0),(d,0)] ((().c!.O + ().d!.O);; l0!.O;; (c?.e!.O + d?.f!.O)));; (e?.l1!.O + f?.l2!.O)).
  Let N (a b c d e f: name):= p_res_list [(e,0),(f,0)] ((p_res_list [(c,0),(d,0)] ( (().c!.O + ().d!.O) || (l0!.O;; (c?.e!.O + d?.f!.O))));; (e?.l1!.O + f?.l2!.O)).

  Open Scope proc_scope.

  Lemma wbisim_converges: ∀ AN p,
    (∀ N, length N = length AN → wbisimilar (p_res_list (combine (fst (split AN)) N) p) p_nil) →
    (∀ a, ¬NameSet.In a (fn_in p)) →
    converges' AN p.   Proof.
    unfold converges'; intros.
    edestruct res_list_count_labels_nIn'' with (A:=fst (split AN)) (N:=snd (split AN)) (la:=la1) as [N' ?].
    intros.
    intro.
    apply fn_in_step_star_In with (a:=a) in H1; auto.
    apply H0 in H1. false.
    rewrite split_length_l, split_length_r; auto.
    eapply step_star_l_tau_nIn; eauto.
    ∃ N'; split; auto.
    edestruct res_list_count_labels_length as [??]; eauto.
    edestruct step_star_wbisim1 as [q'[??]].
    apply (H (snd (split AN))).
    rewrite H3, split_length_l; reflexivity.
    apply step_star_res_list' with (la:=la1) (AN':=combine (fst (split AN)) N'); eauto.
    rewrite combine_split; auto.
    rewrite combine_split; auto.
    rewrite combine_split; auto.
    rewrite combine_split; auto.
    rewrite combine_split in *; auto. simpl in ×.
    edestruct step_star_nil_resolve as [??]; eauto.
    subst q'.
    apply halted_wbisim2; auto.
    reflexivity.
  Qed.

  Lemma esim_M_N: ∀ a b c d e f,
    eventually_similar (M a b c d e f) (N a b c d e f).
  Proof.
    unfold M, N; intros.
    setoid_rewrite<- esim_seq_par_simpl; auto.
    × setoid_rewrite wbisim_seq_assoc.
    reflexivity.
    × apply converges_converges'_equiv.
    apply wbisim_converges; intros.
    + unfold split, fst.
    destruct N0. false. destruct N0. false.
    destruct N0.
    simpl in ×.
    setoid_rewrite wbisim_res_tau_sum.
    setoid_rewrite wbisim_res_tau_sum.
    rewrite eq_ssum.
    setoid_rewrite wbisim_res_out at 1.
    do 2 setoid_rewrite wbisim_res_nil.
    destruct (name_eq c d).
    subst.
    setoid_rewrite wbisim_res_out.
    do 2 setoid_rewrite wbisim_res_nil.
    setoid_rewrite wbisim_sum_dup.
    apply wbisim_intro_tau.
    setoid_rewrite wbisim_res_act_comm; try congruence.
    setoid_rewrite wbisim_res_out.
    do 2 setoid_rewrite wbisim_res_nil.
    setoid_rewrite wbisim_sum_dup.
    apply wbisim_intro_tau.

    false.
    + simpl.
    rewrite NameSet.union_spec in ×.
    rewrite NameSetFacts.empty_iff in ×.
    intuition.

    × left.
    simpl. red. simpl. intros.
    rewrite NameSet.union_spec in ×.
    repeat rewrite NameSet.add_spec in ×.
    rewrite NameSetFacts.empty_iff in ×.
    intuition.
  Qed.

  Lemma csim_M_N: ∀ a b c d e f,
    contrasimilar (M a b c d e f) (N a b c d e f).
  Proof. intros; apply ebisim_csim, esim_ebisim1, esim_M_N. Qed.

End TestParallelization.

Module Examples.
  Require Examples.
  Import Examples.ExampleTactics.
  Import BisimTheory.
  Import Notation.
  Import Morphisms.
  Open Scope proc_scope.

  Ltac try_constrs Nconstrs constrID := match constrID with
  | S ?constrID' ⇒
          let helper := solve
          [ cc constrID; auto
          | cc constrID; try_constrs Nconstrs Nconstrs ]
          in solve
          [ apply lstep_in; helper
          | apply lstep_out; helper
          | helper
          | try_constrs Nconstrs constrID' ]
  end.

  Ltac try_each_step prove_step_star Nconstrs max_steps constrID:= match constrID with
    | S ?constrID' ⇒ solve
      [ eapply @step_tcons; [cc constrID; try_constrs Nconstrs Nconstrs | prove_step_star Nconstrs max_steps ]
      | eapply @step_lcons; [constructor; cc constrID; try_constrs Nconstrs Nconstrs | prove_step_star Nconstrs max_steps ]
      | try_each_step prove_step_star Nconstrs max_steps constrID']
    end.

  Ltac prove_step_star Nconstrs max_steps := match max_steps with
  | S ?max_steps' ⇒ match goal with
    | |- @step_star _ ?S nil ?S ⇒ apply @step_nil
    | |- @step_star _ ?S1 ?la ?S2 ⇒ first
        [ eapply @single_tstep; try_constrs Nconstrs Nconstrs
        | eapply @single_lstep; try_constrs Nconstrs Nconstrs
        | try_each_step prove_step_star Nconstrs max_steps' Nconstrs ]
    | _ ⇒ auto
    end
  end.

  Ltac sstt Nconstrs max_steps RconstrID:= match RconstrID with
    | S ?RconstrID' ⇒ solve
      [ split; [| cc RconstrID]; prove_step_star Nconstrs max_steps
      | split; [| cc RconstrID]; prove_step_star Nconstrs max_steps
      | sstt Nconstrs max_steps RconstrID']
    end.

  Tactic Notation "tt" constr(Nconstrs) constr(max_steps) constr(m) := eexists; sstt Nconstrs max_steps m.

  Ltac ssel Nsteps Nconstrs S:=
    ∃ S; split; [prove_step_star Nconstrs Nsteps | constructor].
  Ltac sselL Nsteps Nconstrs a := left; ∃ a; split; auto; [prove_step_star Nconstrs Nsteps|constructor].
  Ltac sselR Nsteps Nconstrs a := right; ∃ a; split; prove_step_star Nconstrs Nsteps.

  Tactic Notation "sel" constr(S) := ssel 3 14 S.
  Tactic Notation "selL" constr(a) := sselL 3 14 a.
  Tactic Notation "selR" constr(a) := sselR 3 14 a.
  Tactic Notation "tt" constr(m) := tt 14 3 m.
  Tactic Notation "ss" := prove_step_star 14 3.
  Tactic Notation "ssel" constr(S) := ∃ S; split; [| constructor].

  Ltac sinv := match goal with
  | [ H: step _ _ _ |- _ ] ⇒ inverts H
  | [ H: tstep _ _ _ |- _ ] ⇒ inverts H; sinv
  | [ H: lstep _ _ _ |- _ ] ⇒ inverts H; sinv
  | [ H: @LabeledTransitionSystems.tstep _ _ _ |- _ ] ⇒ inverts H; sinv
  | [ H: @LabeledTransitionSystems.lstep _ _ _ _ |- _ ] ⇒ inverts H; sinv
  end.

  Lemma lstep_inv: ∀ p q a pq',
    lstep (p||q) a pq' →
    (∃ p', lstep p a p' ∧ pq'=p'||q) ∨ (∃ q', lstep q a q' ∧ pq'=p||q').
  Proof.
    intros. inverts H; inverts H0.
    left; ∃ p'; split; auto; constructor; auto.
    right; ∃ q'; split; auto; constructor; auto.
    left; ∃ p'; split; auto; constructor; auto.
    right; ∃ q'; split; auto; constructor; auto.
  Qed.

  Lemma step_star_par_tsum2: ∀ p q r la pqr',
    step_star (p || (().q + ().r)) la pqr' →
    ∃ la1 p' la2,
      step_star p la1 p' ∧ ((pqr'=(p' || (().q + ().r))∧la2=nil) ∨ step_star (p' || q) la2 pqr' ∨ step_star (p' || r) la2 pqr') ∧ la=la1++la2.
  Proof.
    intros.
    remember (p || (().q + ().r)) as pqr.
    revert p q r Heqpqr.
    induction H; intros; subst; try rename p' into pqr'; try rename p'' into pqr''.
    × ∃ (@nil lts_L) p0 (@nil lts_L); splits; auto; apply step_nil.
    × edestruct lstep_inv as [ [p'[??]] | [q'[??]] ]; eauto; subst pqr'.
    edestruct IHstep_star as [la1[p''[la2[?[??]]]]]; clear IHstep_star; eauto; subst.
    ∃ (a::la1) p'' la2; splits; auto; eapply step_lcons; eauto.
    inverts H1. inverts H2; inverts H6.
    inverts H2; inverts H6.
    × inverts H.
    - edestruct IHstep_star as [la1[p''[la2[?[??]]]]]; clear IHstep_star; eauto; subst.
    ∃ la1 p'' la2; splits; auto; eapply step_tcons; eauto. apply H5.
    - inverts H5.
    + inverts H4.
    ∃ (@nil lts_L) p0 la; splits; auto. apply step_nil.
    + inverts H4.
    ∃ (@nil lts_L) p0 la; splits; auto. apply step_nil.
  Qed.

  Ltac inv := match goal with
  | _ ⇒ sinv
  | [ H: @step_star _ (?c _) _ _ |- _ ] ⇒ inverts H
  | [ H: @step_star _ p_nil _ _ |- _ ] ⇒ inverts H
  end.

  Ltac inv2 := match goal with
  | _ ⇒ sinv
  | [ H: @step_star _ (p_par ?p (p_sum (p_act l_tau ?q) (p_act l_tau ?r))) ?la ?pqr' |- _ ] ⇒ destruct (step_star_par_tsum2 p q r la pqr' H) as [?[?[?[?[ [[??]|[?|?]] ?]]]]]; clear H; try subst p; try subst q; try subst r; try subst la
  | [ H: @step_star _ (?c _) _ _ |- _ ] ⇒ inverts H
  | [ H: @step_star _ p_nil _ _ |- _ ] ⇒ inverts H
  end.

  Definition list_lts_S_list_proc (a:list lts_S) : list proc := a.
  Tactic Notation "steps" constr(lp) := let rec steps_ lp:= match lp with
    | ?p :: ?lp' ⇒ solve
      [ eapply step_tcons with p; [try_constrs 14 14 | steps_ lp']
      | eapply step_lcons with p; [constructor 1; apply s_act; try_constrs 14 14 | steps_ lp']
      | eapply step_lcons with p; [constructor 2; apply s_act; try_constrs 14 14 | steps_ lp']
      ]
    | @nil proc ⇒ solve
      [ apply (@step_nil lts)
      | apply single_tstep; auto; try_constrs 14 14
      | apply single_lstep; auto; apply lstep_in; try_constrs 14 14
      | apply single_lstep; auto; apply lstep_out; try_constrs 14 14
      ]
    end in
  let lp_ := eval compute in (list_lts_S_list_proc lp) in
  steps_ lp_.

Module SumSum.
  Definition p_sum1 a P Q:= a!.P + a!.Q.
  Definition p_sum2 a P Q:= a!.(().P + ().Q).

  Inductive Rd a P Q: proc→proc→Prop :=
  | Rd1: Rd a P Q (a!.P + a!.Q) (a!.(().P + ().Q))
  | Rd4: ∀ p, Rd a P Q p p.
  Tactic Notation "fix_names" ident(a) ident(P) ident(Q) := match goal with
  | |- context [ Rd ?A ?PP ?QQ _ _ ] ⇒ rename A into a; rename PP into P; rename QQ into Q
  end.

  Lemma esim_true: ∀ a P Q,
    eventually_similar (p_sum1 a P Q) (p_sum2 a P Q).
  Proof.
    unfold p_sum1, p_sum2.
    intros.
    ∃ (Rd a P Q); splits; auto; try constructor; try intros p q; intros.
    - repeat red in H0. subst p. inverts H.
    apply step_nil.
    - inverts H; try solve [false]. apply step_nil.
    - inverts H; repeat inv.
    ∃ p'; split; try constructor. apply single_tstep; auto.
    - inverts H. repeat inv.
    ∃ p'; split; try constructor. steps [().p'+().Q].
    ∃ p'; split; try constructor. steps [().P+().p'].
    ∃ p'; split; try constructor. apply single_lstep; auto.
    - inverts H. inv.
    do 2 eexists; splits; try constructor.
    inv. inv.
    ∃ P P; splits; try constructor.
    apply single_tstep; apply s_sumL; apply s_act.
    eapply single_lstep; constructor; apply s_sumL, s_act.
    repeat inv.
    repeat inv.
    ∃ p' p'; splits; try constructor.
    eapply step_lcons; eauto. constructor. apply s_sumL, s_act.
    ∃ p' p'; splits; try constructor.
    eapply step_lcons; eauto. constructor. apply s_sumR, s_act.
    repeat inv.
    ∃ p' p'; splits; try constructor. auto.
  Qed.

  Lemma csim_true: ∀ a P Q,
    contrasimilar (p_sum1 a P Q) (p_sum2 a P Q).
  Proof. intros; apply ebisim_csim, esim_ebisim1, esim_true. Qed.

  Lemma wsim_backwards_false: ∀ a b c P Q R,
    a≠b → a≠c → b≠c →
    weak_simulation R →
    R (p_sum2 a (b!.P) (c!.Q)) (p_sum1 a (b!.P) (c!.Q)) →
    False.
  Proof.
    unfold p_sum1, p_sum2.
    intros.
    edestruct weak_simulation_lstep as [p'[??]]; eauto.
    apply lstep_out; repeat constructor.
    clear H3.
    repeat inv.
    - edestruct weak_simulation_step_star with (la:=[l_out c]) as [p'[??]]; eauto; ss.
    repeat inv.
    false.
    - edestruct weak_simulation_step_star with (la:=[l_out b]) as [p'[??]]; eauto; ss.
    repeat inv.
    false.
  Qed.

  Lemma coupled_sim_false: ∀ a b c P Q,
    a≠b → a≠c → b≠c →
    ¬coupled_similar (p_sum1 a (b!.P) (c!.Q)) (p_sum2 a (b!.P) (c!.Q)).
  Proof.
    unfold p_sum1, p_sum2.
    intros. intro.
    edestruct lstep_pcssim as [p'[??]]; eauto; [| apply cssim_pcssim2; eauto |].
    apply lstep_out; apply s_act.
    clear H2.
    repeat inv.
    - edestruct step_star_pcssim with (la:=[l_out c]) as [p'[??]]; eauto; ss.
    repeat inv.
    false.
    - edestruct step_star_pcssim with (la:=[l_out b]) as [p'[??]]; eauto; ss.
    repeat inv.
    false.
  Qed.

  Lemma wbisim_false: ∀ a b c P Q,
    a≠b → a≠c → b≠c →
    ¬wbisimilar (p_sum1 a (b!.P) (c!.Q)) (p_sum2 a (b!.P) (c!.Q)).
  Proof.
    intros; intro.
    eapply (coupled_sim_false a b c P Q); eauto.
    apply wbisim_coupled_sim; auto.
  Qed.

End SumSum.

Module SumPar.
  Definition p_sum_par P Q R:= ().(P || Q) + ().(P || R).
  Definition p_par_sum P Q R:= P || (().Q + ().R).

  Inductive Rd P Q R: proc→proc→Prop :=
  | Rd1: Rd P Q R (().(P || Q) + ().(P || R)) (P || (().Q + ().R))
  | Rd4: ∀ p, Rd P Q R p p.
  Tactic Notation "fix_names" ident(P) ident(Q) ident(R) := match goal with
  | |- context [ Rd ?PP ?QQ ?RR _ _ ] ⇒ rename PP into P; rename QQ into Q; rename RR into R
  end.

  Lemma step_star_app': ∀ p la1 p' la2 p'' la,
    step_star p la1 p' →
    step_star p' la2 p'' →
    la=la1++la2 →
    step_star p la p''.
  Proof. intros; subst; eapply step_star_app; eauto. Qed.

  Lemma esim_true: ∀ P Q R,
    eventually_similar (p_sum_par P Q R) (p_par_sum P Q R).
  Proof.
    unfold p_sum_par, p_par_sum.
    intros.
    ∃ (Rd P Q R); splits; auto; try constructor; try intros p q; intros.
    - inverts H; try solve [false]. apply step_nil.
    - inverts H; try solve [false]. apply step_nil.
    - inverts H.
    + inv; tt 4.
    + ∃ p'; split. apply single_tstep; auto. constructor.
    - inverts H.
    + repeat inv.
    + ∃ p'; split. apply single_lstep; auto. constructor.
    - inverts H.
    + edestruct step_star_par_unzip'' as [p1'[p2'[lip[la1[la2[?[?[?[??]]]]]]]]]; eauto.
    subst.
    clear H0.
    inverts H2.
    destruct H as [?|[?[??]]]; try discriminate. subst p'.
    ∃ (p1'||Q) (p1'||Q); splits; auto.
    eapply single_tstep. apply s_parR, s_sumL, s_act.
    eapply step_tcons.
    apply s_sumL, s_act.
    apply step_star_parL_step; auto. rewrite interleaving_r_nil; auto.
    constructor.
    inverts H0.
    inv; inv.
    inv; inv.
    ∃ p' p'; splits; auto.
    apply step_nil.
    inv.
    eapply step_tcons. apply s_sumL, s_act.
    destruct H as [?|[?[??]]]; subst.
    eapply step_star_par_zip'; eauto.
    eapply step_tsnoc.
    eapply step_star_par_zip'; eauto.
    apply s_par_nil.
    eapply step_tcons. apply s_sumR, s_act.
    destruct H as [?|[?[??]]]; subst.
    eapply step_star_par_zip'; eauto.
    eapply step_tsnoc.
    eapply step_star_par_zip'; eauto.
    apply s_par_nil.
    constructor.
    + ∃ p' p'; splits; auto; constructor.
  Qed.

  Lemma csim_true: ∀ P Q R,
    contrasimilar (p_sum_par P Q R) (p_par_sum P Q R).
  Proof. intros; apply ebisim_csim, esim_ebisim1, esim_true. Qed.

  Lemma wsim_backwards_false: ∀ a b c R,
    a≠b → a≠c → b≠c →
    weak_simulation R →
    R (p_par_sum (a!.O) (b!.O) (c!.O)) (p_sum_par (a!.O) (b!.O) (c!.O)) →
    False.
  Proof.
    unfold p_sum_par, p_par_sum.
    intros.
    edestruct weak_simulation_lstep as [p'[??]]; eauto.
    apply lstep_out; repeat constructor.
    clear H3.
    repeat inv.
    - edestruct weak_simulation_step_star as [p'[??]]; eauto.
    eapply step_tcons. apply s_parR, s_sumR, s_act.
    eapply step_lcons. apply lstep_out, s_parR, s_act.
    apply single_tstep, s_par_nil.
    repeat inv; congruence.
    - edestruct weak_simulation_step_star as [p'[??]]; eauto.
    eapply step_tcons. apply s_parR, s_sumR, s_act.
    eapply step_lcons. apply lstep_out, s_parR, s_act.
    apply single_tstep, s_par_nil.
    - edestruct weak_simulation_step_star as [p'[??]]; eauto.
    eapply step_tcons. apply s_parR, s_sumL, s_act.
    eapply step_lcons. apply lstep_out, s_parR, s_act.
    apply single_tstep, s_par_nil.
    repeat inv; congruence.
    - edestruct weak_simulation_step_star as [p'[??]]; eauto.
    eapply step_tcons. apply s_parR, s_sumL, s_act.
    eapply step_lcons. apply lstep_out, s_parR, s_act.
    apply single_tstep, s_par_nil.
  Qed.

  Lemma coupled_sim_false: ∀ a b c,
    a≠b → a≠c → b≠c →
    ¬coupled_similar (p_sum_par (a!.O) (b!.O) (c!.O)) (p_par_sum (a!.O) (b!.O) (c!.O)).
  Proof.
    intros. intros [R[?[?[?[??]]]]].
    apply (wsim_backwards_false a b c R); eauto.
  Qed.

  Lemma wbisim_false: ∀ a b c,
    a≠b → a≠c → b≠c →
    ¬wbisimilar (p_sum_par (a!.O) (b!.O) (c!.O)) (p_par_sum (a!.O) (b!.O) (c!.O)).
  Proof.
    intros; intro.
    eapply (coupled_sim_false a b c); eauto.
    apply wbisim_coupled_sim; auto.
  Qed.

  Lemma esim_true_O: ∀ a b c,
    eventually_similar (p_sum_par (a!.O) (b!.O) (c!.O)) (p_par_sum (a!.O) (b!.O) (c!.O)).
  Proof. intros; apply esim_true; auto. Qed.

  Lemma csim_true_O: ∀ a b c,
    contrasimilar (p_sum_par (a!.O) (b!.O) (c!.O)) (p_par_sum (a!.O) (b!.O) (c!.O)).
  Proof. intros; apply csim_true; auto. Qed.

End SumPar.

End Examples.