Library HOASSyntax

Require Export Binders TLC.LibEqual TLC.LibRelation TLC.LibTactics.
Require Export TLC.LibNat.

Require Export List.

Parameter name : Set.
Axiom dec_name: x y:name, x=y xy.

Inductive proc (V : Set) : Set :=
| pr_var : V proc V
| pr_inp : name proc (incV V) proc V
| pr_snd : name proc V proc V proc V
| pr_par : proc V proc V proc V
| pr_nu : (name proc V) proc V
| pr_nil : proc V
.

Arguments pr_var {V} _.
Arguments pr_inp {V} _ _.
Arguments pr_snd {V} _ _ _.
Arguments pr_par {V} _ _.
Arguments pr_nu {V} _.
Arguments pr_nil {V}.

Notation "a ? P" := (@pr_inp _ a P) (at level 42, right associativity).
Notation "a '!(' P ')' Q" := (@pr_snd _ a P Q) (at level 42, right associativity).
Notation "P '//' Q" := (@pr_par _ P Q) (at level 40, left associativity).
Notation " 'nu' P" := (@pr_nu _ P) (at level 42, right associativity).
Notation PO := (@pr_nil _).

Notation proc0 := (proc Empty_set).
Notation proc1 := (proc (incV Empty_set)).


Inductive isin {V:Set} (x:name) : proc V Prop :=
| isin_inp : a P, @isin (incV V) x P isin x (a ? P)
| isin_inp_name : P, isin x (x ? P)
| isin_snd1 : a P Q, isin x P isin x (a!(P) Q)
| isin_snd2 : a P Q, isin x Q isin x (a!(P) Q)
| isin_snd_name : P Q, isin x (x!(P) Q)
| isin_par1 : P Q, isin x P isin x (P // Q)
| isin_par2 : P Q, isin x Q isin x (P // Q)
| isin_nu : P, ( z, zx isin x (P z)) isin x (nu P).

Inductive notin {V:Set} (x:name) : proc V Prop :=
| notin_var : v, notin x (pr_var v)
| notin_nil : notin x PO
| notin_inp : a P, a x @notin (incV V) x P notin x (a ? P)
| notin_snd : a P Q, a x notin x P notin x Q
                                      notin x (a!(P) Q)
| notin_par : P Q, notin x P notin x Q notin x (P//Q)
| notin_nu : P, ( z, xz notin x (P z)) notin x (nu P).

Definition notin_ho {V:Set} a (P:name proc V) :=
   b, ab notin a (P b).

Hint Constructors isin notin:hopi.

Ltac head t :=
  match t with
  | ?t' _head t'
  | _t
  end.
Ltac head_constructor t :=
  let t' := head t in is_constructor t'.
Ltac simpl_notin_list :=
  repeat match goal with
  | [ H : ¬ In _ (cons _ _) |- _ ] ⇒
      rewrite not_in_cons in H; destruct H
  | [ H : ¬ In _ (app _ _) |- _ ] ⇒
      rewrite in_app_iff in H; apply Decidable.not_or in H; destruct H
  | [ H : ¬ In _ nil |- _ ] ⇒ clear H
  | [ H : ¬ In _ _ _ |- _ ] ⇒ destruct H
  | [ |- ¬ In _ (cons _ _) ] ⇒ rewrite not_in_cons; split; auto
  end.
Ltac simpl_notin_proc :=
  repeat match goal with
  | [ H : notin _ ?t |- _ ] ⇒ head_constructor t; inverts H
  | [ H : notin _ _ _ |- _ ] ⇒ destruct H
  | [ H : _ notin _ _ |- _ ] ⇒ destruct H
  end.
Ltac simpl_notin :=
  repeat (simpl_notin_list; simpl_notin_proc; simpl in *; auto).

Axiom proc_ext : {V:Set} x (P Q:nameproc V), notin_ho x P
  notin_ho x Q (P x = Q x) P = Q.

Ltac auto_proc_ext :=
  match goal with
  | [ H : ?P ?X = ?Q ?X |- _ ] ⇒
    (forwards*: @proc_ext X P Q; intros_all; auto with hopi);
    subst; simpl_notin; clear H; auto with hopi
  end.

Axiom beta_exp : {V:Set} a (P:proc V),
   P', notin_ho a P' P = P' a.
Axiom ho_beta_exp : {V:Set} a (P:name proc V),
   P', notin_ho a (fun xnu P' x) P = P' a.
Axiom ho_ho_beta_exp : {V:Set} a (P:name name proc V),
   P', notin_ho a (fun xnu (fun ynu P' x y)) P = P' a.

Ltac exp x P := let Pr := fresh P in
   destruct (beta_exp x P) as [Pr []]; subst.
Ltac ho_exp x P := let Pr := fresh P in
   destruct (ho_beta_exp x P) as [Pr []]; subst.
Ltac ho_ho_exp x P := let Pr := fresh P in
   destruct (ho_ho_beta_exp x P) as [Pr []]; subst.

Ltac all_exp x := repeat match goal with
  | [ P : proc _ |- _ ] ⇒ exp x P
  end.

The next tactic rewrites an hypothesis Q = P a into Q' a = P a and then applies the proc_ext axiom
Ltac change_ext :=
  match goal with
  | [ H : ?Q = ?P ?x |- _ ] ⇒
      let R := (eval pattern x in Q) in change (R = P x) in H; auto_proc_ext
  end.

The next tactic beta-expands the processes w.r.t. x and then uses proc_ext
Ltac exp_ext x := all_exp x; repeat change_ext.

Axiom unsat : {V:Set} (P:proc V), a, notin a P.

Ltac fresh_proc P := destruct (unsat P); simpl_notin.

Fixpoint listproc {V:Set} (L : list name) (P : proc V) : proc V :=
  match L with
  | nilP
  | cons a L'a!(PO)(listproc L' P)
  end.

Lemma listproc_in {V}: a (P : proc V) L,
    notin a (listproc L P) ¬In a L notin a P.
Proof.
  intros.
  induction L; simpl in *; auto.
  simpl_notin.
  forwards*: IHL.
Qed.

Lemma unsat_lp {V}: L (P : proc V), a, ¬In a L notin a P.
Proof.
  intros. fresh_proc (listproc L P).
   x. forwards*: @listproc_in.
Qed.

Lemma unsat_list: (L:list name), a, ¬In a L.
Proof.
  intros. fresh_proc (listproc L (@pr_nil Empty_set)).
   x. forwards*: @listproc_in.
Qed.

Ltac fresh_lp L P := destruct (unsat_lp L P); simpl_notin.
Ltac fresh_list L := destruct (unsat_list L); simpl_notin.

Lemma sep {V:Set}: (P:proc V), a b,
    isin a P notin b P ab.
Proof.
  induction P; introv Hin Hnotin; inverts Hnotin; inverts Hin; auto.
  fresh_list (a::b::nil). forwards*: H1 x.
Qed.

Lemma isin_not_notin {V:Set}: (P:proc V),
     a, isin a P ¬ notin a P.
Proof.
  intros_all. forwards*: @sep a a.
Qed.

Lemma notin_not_isin {V:Set}: (P:proc V),
     a, notin a P ¬ isin a P.
Proof.
  intros_all. forwards*: @sep a a.
Qed.


Operations on process variables


Fixpoint mapV {V W: Set} (f : V W) (P : proc V) : proc W :=
  match P with
  | pr_var xpr_var (f x)
  | a ? Pa ? (mapV (incV_map f) P)
  | a !(P) Qa !(mapV f P) (mapV f Q)
  | nu Pnu (fun xmapV f (P x))
  | P // Q(mapV f P) // (mapV f Q)
  | POPO
  end.

Notation shiftV := (mapV (@VS _)).
Notation shiftV1 := (mapV (incV_map (@VS _))).

Definition liftV {V W: Set} (f : V proc W) (x : incV V) :
  proc (incV W) :=
  match x with
  | VZpr_var VZ
  | VS yshiftV (f y)
  end.

Fixpoint bind {V W : Set} (f : V proc W) (P : proc V) : proc W:=
  match P with
  | pr_var xf x
  | a ? Pa ? (bind (liftV f) P)
  | a !(P) Qa !(bind f P) (bind f Q)
  | nu Pnu (fun xbind f (P x))
  | P // Q(bind f P) // (bind f Q)
  | POPO
  end.

Definition subst_func {V: Set} (P : proc V) (x : incV V) : proc V :=
  match x with
  | VZP
  | VS ypr_var y
  end.

Notation subst P Q := (@bind _ _ (@subst_func _ Q) P).


Basic lemmas about monadic operations


Lemma mapV_id {V: Set} (P : proc V) :
  mapV (fun xx) P = P.
Proof.
  induction P; default_simp; auto.
  asserts_rewrite (incV_map (fun (x:V) ⇒ x) = fun xx).
   extens. intros [ | x ]; simpl; congruence.
   rewrite× IHP.
  extens; intros. rewrite H. auto.
Qed.

Lemma mapV_mapV {A B C : Set} : (P : proc A)
  (f : A B) (g : B C),
  mapV g (mapV f P) = mapV (fun xg (f x)) P.
Proof.
  intros. gen B C. induction P; default_simp.
    rewrite IHP. repeat fequals. extens. intros [ | x]; simpl; try reflexivity.
  extens; intros. rewrite H; auto.
Qed.

Lemma bind_return {V: Set} : (P : proc V)(f : V proc V),
  ( x, f x = pr_var x) bind f P = P.
Proof.
  induction P; default_simp.
  + rewrite× IHP. intros [ | x ]; simpl; trivial.
    rewrite× H.
  + extens. intros. rewrite H; simpl; auto.
Qed.

Lemma bind_return' {V: Set} : (P : proc V), bind (@pr_var _ ) P = P.
Proof.
  intros; apply bind_return; reflexivity.
Qed.

Lemma bind_proc0: (P: proc0) (f : Empty_set proc0), bind f P = P.
Proof.
  intros. apply bind_return. intros; inverts x.
Qed.

Lemma bind_mapV {A B1 B2 C : Set} : (P : proc A )
    (f1 : A B1) (f2 : B1 proc C )(g1 : A proc B2 ) (g2 : B2 C),
      ( x, f2 (f1 x) = mapV g2 (g1 x)) bind f2 (mapV f1 P) = mapV g2 (bind g1 P).
Proof.
  intros. gen B1 B2 C. induction P; default_simp.
  + erewrite IHP. eauto. intros [ | x ]; simpl; auto.
    rewrite H; repeat rewrite mapV_mapV; reflexivity.
  + extens; intros. erewrite H; eauto.
Qed.

Lemma bind_bind {A B C : Set}: (P : proc A )(f : A proc B )
  (g : B proc C ),
  bind g (bind f P) = bind (fun xbind g (f x)) P.
Proof.
  intros. gen B C. induction P; default_simp.
  + rewrite IHP. repeat fequals. extens. intros [ | x ]; simpl; [ reflexivity | ].
    apply bind_mapV; reflexivity.
  + extens; intros. rewrite H. reflexivity.
Qed.

Lemma bind_mapV_comp {A B C :Set}: P (f:Bproc C )(g:AB),
  bind f (mapV g P) = bind (fun xf (g x)) P.
Proof.
  intros; gen C B. induction P; default_simp.
  + rewrite IHP. fequals. extens. intros [ | x ]; simpl; auto.
  + extens; intros. rewrite H; reflexivity.
Qed.

Lemma subst_shift {V : Set} : (P Q : proc V ), subst (shiftV P) Q = P.
Proof.
  intros; erewrite bind_mapV.
  + rewrite mapV_id; apply bind_return'.
  + reflexivity.
Qed.


Inductive size {V:Set} : proc V nat Prop :=
| sz_var : v, size (pr_var v) 0
| sz_nil : size (@pr_nil V) 0
| sz_inp : a P n, @size (incV V) P n size (a ? P) (1+n)
| sz_out : a P Q n m, size P n size Q m size (a!(P) Q)(1+n+m)
| sz_par : P Q n m, size P n size Q m size (P//Q)(1+n+m)
| sz_nu : P n, ( x, size (P x) n) size (nu P) (1+n).

Hint Constructors notin isin size:hopi.

Lemma size_rename {V:Set} : n (P:name proc V) x, notin_ho x P
  size (P x) n y, size (P y) n.
Proof with nat_math.
  intros. gen x y V.
  induction n using TLC.LibNat.peano_induction; intros.
  inverts H1; try solve [change_ext].
  + destruct (dec_name a x); subst; exp_ext x;
      constructor; apply H with x; auto...
  + destruct (dec_name a x); subst; exp_ext x;
      constructor; apply H with x; auto...
  + exp_ext x. constructor; apply H with x; auto...
  + ho_exp x P0. change_ext.
    constructor. intros.
    fresh_lp (x::nil) (nu (P1 y)).
    apply H with x1; [nat_math | intros_all; apply H6; auto |].
    change (size ((fun xP1 x x1) y) n0).
    apply H with x; [nat_math | | apply H3].
    intros_all. forwards*: H1 b. inverts H5. apply H8. auto.
Qed.

Hint Constructors size:hopi.

Lemma exists_sz {V:Set} : (P:proc V), n, size P n.
Proof.
  intros; induction P; try solve [eexists; eauto with hopi].
  - destruct IHP. eexists; eauto with hopi.
  - destruct IHP1. destruct IHP2. eexists; eauto with hopi.
  - destruct IHP1. destruct IHP2. eexists; eauto with hopi.
  - fresh_proc (nu p). forwards[n]: H x.
     (1+n). constructor. intros.
    apply size_rename with x; assumption.
Qed.


Lemma notin_rename' {V:Set}: n (P:proc V), (size P n)
       P' c, (notin_ho c P') P=(P' c)
       a b, (notin a (P' b)) (notin_ho a P').
Proof with nat_math.
  intro n; gen V.
  induction n using TLC.LibNat.peano_induction;
      introv Hs Hc Hp' Hnotin.
  destruct P; inverts Hs; intros_all; try solve [change_ext].
  - destruct (dec_name n0 c); subst; exp_ext c;
      constructor; auto; apply× H...
  - destruct (dec_name n0 c); subst; exp_ext c;
      constructor; auto.
    1,3:forwards*: H n1 P2...
    all:forwards*: H m P0...
  - exp_ext c. constructor.
    forwards*: H n0 P2...
    forwards*: H m P0...
  - ho_exp c p. rename p0 into P''. change_ext.
    constructor. intros.
    fresh_lp (z::a::c::nil) (nu (P'' b0)). rename x into c'.
    assert ( x, xc size (P'' b0 x) n0).
      intros; change (size ((fun cP'' c x) b0) n0).
      eapply size_rename; eauto. intros_all.
      forwards*: Hc b1. simpl_notin.
    assert (notin a (P'' b0 c')).
      change (notin a ((fun b0P'' b0 c') b0)).
      eapply H; eauto. nat_math. intros_all.
      forwards*: Hc b1. simpl_notin.
    clear H1. eapply H; eauto...
Qed.

Lemma notin_rename {V:Set}: (P:nameproc V) a b,
   notin a (P b) c, ac notin a (P c).
Proof.
  intros. fresh_proc (nu P).
  destruct (exists_sz (nu P)) as [n]. inverts H1.
  eapply notin_rename'; eauto.
Qed.

Lemma isin_rename' {V:Set}: n (P:proc V), (size P n)
       P' c, (notin_ho c P') P=(P' c)
       a b, ab isin a (P' b)
       d, isin a (P' d).
Proof with nat_math.
  intro n; gen V.
  induction n using TLC.LibNat.peano_induction;
      introv Hs Hc Hp' Hab Hin. intros.
  destruct P; inverts Hs; intros_all; try solve [change_ext].
  - destruct (dec_name n0 c); subst; exp_ext c.
    + inverts Hin; [|contradiction].
      constructor. forwards*: H H3...
    + inverts Hin; [|apply isin_inp_name].
      constructor. forwards*: H H4...
  - destruct (dec_name n0 c); subst; exp_ext c.
    + inverts Hin; [| |contradiction].
      × apply isin_snd1. forwards*: H n1 P2 H3...
      × apply isin_snd2. forwards*: H m H3...
    + inverts Hin; [| |apply isin_snd_name].
      × apply isin_snd1. forwards*: H n1 P2 H6...
      × apply isin_snd2. forwards*: H m H6...
  - exp_ext c. inverts Hin.
    + apply isin_par1. forwards*: H n0 P2 H5...
    + apply isin_par2. forwards*: H m H5...
  - ho_exp c p. rename p0 into P''. change_ext.
    inverts Hin. constructor. intros.
    fresh_lp (z::a::c::d::nil) (nu (P'' b)). rename x into c'.
    change (isin a ((fun dP'' d z) d)).
    apply H with n0 (P'' c' z) c' b; auto.
    + nat_math.
    +
      fresh_lp (z::a::c::d::nil) (nu (P'' c')). rename x into c''.
      eapply size_rename; eauto.
      change (size ((fun cP'' c c'') c') n0).
      eapply size_rename; eauto. intros_all.
      forwards*: Hc b0. simpl_notin.
    +
      intros_all. change (notin c' ((fun bP'' b z) b0)).
      eapply notin_rename; eauto.
Qed.

Lemma isin_rename {V:Set}: (P:nameproc V) a b,
   ab isin a (P b) c, isin a (P c).
Proof.
  intros. fresh_proc (nu P).
  destruct (exists_sz (P x)) as [n].
  apply isin_rename' with n (P x) x b; auto.
Qed.

Lemma isin_notin_dec {V:Set}: a (P:proc V), isin a P notin a P.
Proof.
  induction P; intuition (auto with hopi).
  - destruct (dec_name a n); subst; intuition (auto with hopi).
  - destruct (dec_name a n); subst; intuition (auto with hopi).
  - fresh_lp (a::nil) (nu p). forwards[]: H x.
    + left. constructor. intros. apply isin_rename with x; eauto.
    + right. constructor. intros. eapply notin_rename; eauto.
Qed.

Lemma isin_arg' {V:Set}: n (P':proc V), size P' n
   P c, notin_ho c P P' = (P c)
   a, notin_ho a P isin a (P a)
   b, isin b (P b).
Proof.
  intros; gen V; induction n using TLC.LibNat.peano_induction; intros.
  inverts H0; auto.
  - change_ext. inverts H4.
  - change_ext. inverts H4.
  - destruct (dec_name a0 c); subst; exp_ext c.
    constructor. eapply H; eauto.
    + nat_math.
    + intros_all. forwards*: H3 b0. simpl_notin.
    + inverts× H4. forwards*: H3 c. inverts× H4.
  - destruct (dec_name a0 c); subst; exp_ext c.
    inverts H4.
    + apply× @isin_snd1. forwards*: H n0 P1. nat_math.
      intros_all. forwards*: H3 b0. simpl_notin.
    + apply× @isin_snd2. forwards*: H m Q0. nat_math.
      intros_all. forwards*: H3 b0. simpl_notin.
    + forwards*: H3 c. inverts× H4.
  - exp_ext c. inverts H4.
    + apply× @isin_par1. forwards*: H n0 P1. nat_math.
      intros_all. forwards*: H3 b0. simpl_notin.
    + apply× @isin_par2. forwards*: H m Q0. nat_math.
      intros_all. forwards*: H3 b0. simpl_notin.
  - ho_exp c P0. change_ext.
    constructor. intros. inverts H4.
    fresh_lp (a::c::b::nil) (nu P1 b). rename x into z'.
    apply isin_rename with z'; auto.
    change (isin b ((fun b ⇒ (P1 b z')) b)).
    eapply H; eauto.
    + nat_math.
    + intros_all. forwards*: H1 b0. simpl_notin.
    + intros_all. forwards*: H3 b0. simpl_notin.
Qed.

Lemma isin_arg {V:Set}: (P:nameproc V) a, notin_ho a P
  isin a (P a) b, isin b (P b).
Proof.
  intros. fresh_proc (nu P).
  destruct (exists_sz (P x)) as [n].
  apply isin_arg' with n (P x) x a; auto.
Qed.

Lemma unused_arg {V:Set} : (P:name proc V) a,
  notin a (P a) a b, P a = P b.
Proof.
  intros P a Hnotin.
  assert (notin_ho a P). { intros z Hz. apply notin_rename with a; auto. }
  induction (P a) eqn:HH; symmetry in HH; change_ext.
Qed.

Lemma notin_arg {V:Set} : (P:name proc V) a,
  notin a (P a) b, notin_ho b P notin b (P b).
Proof.
  intros. destruct (isin_notin_dec b (P b)); auto.
  destruct (dec_name a b); subst; auto.
  forwards*: H0 a. rewrite (unused_arg P _ H a b) in H3; auto.
Qed.

Lemma list_of_proc {V:Set}: (P:proc V),
   L, a, ¬In a L notin a P.
Proof.
  intro P; gen V. induction P; intros.
  - (@nil name); intros; auto with hopi.
  - destruct IHP as [L]. (n::L). intros.
    simpl_notin; auto with hopi.
  - destruct IHP1 as [L]. destruct IHP2 as [L'].
     (n::(L++L')). intros. simpl_notin; auto with hopi.
  - destruct IHP1 as [L]. destruct IHP2 as [L'].
     (L++L'). intros. simpl_notin; auto with hopi.
  - fresh_proc (nu p). forwards*: H x.
    destruct H0 as [Lx]. Lx. intros.
    constructor; intros. apply notin_rename with x; auto.
  - (@nil name); intros; auto with hopi.
Qed.


Inductive isinV {V:Set} : V proc V Prop :=
| isinV_var : v, isinV v (pr_var v)
| isinV_inp : a v P, @isinV (incV V) (VS v) P isinV v (a ? P)
| isinV_snd1 : a v P Q, isinV v P isinV v (a!(P) Q)
| isinV_snd2 : a v P Q, isinV v Q isinV v (a!(P) Q)
| isinV_par1 : v P Q, isinV v P isinV v (P // Q)
| isinV_par2 : v P Q, isinV v Q isinV v (P // Q)
| isinV_nu : v P, ( z, isinV v (P z)) isinV v (nu P).

Hint Constructors isinV:hopi.

Lemma isinV_rename' {V:Set}: n (Q:proc V),
      (size Q n)
       P x, (notin_ho x P) Q=(P x)
       z v, (isinV v (P z))
       y, isinV v (P y).
Proof with nat_math.
  intro n; gen V.
  induction n using TLC.LibNat.peano_induction; intros.
  destruct Q; inverts H0; try solve [change_ext].
  - destruct (dec_name n0 x); subst; exp_ext x.
    + constructor. inverts H3. eapply H; eauto...
    + apply isinV_inp. inverts H3. eapply H; eauto...
  - destruct (dec_name n0 x); subst; exp_ext x.
    + inverts H3.
      × apply isinV_snd1. clear H0 H9. eapply H; eauto...
      × apply isinV_snd2. eapply H; eauto...
    + inverts H3.
      × apply isinV_snd1. clear H4 H9. eapply H; eauto...
      × apply isinV_snd2. eapply H; eauto...
  - exp_ext x. inverts H3.
    + apply isinV_par1. clear H8 H0. eapply H; eauto...
    + apply isinV_par2. eapply H; eauto...
  - ho_exp x p. rename p0 into P'. change_ext.
    clear H0. inverts H3. constructor. intros.
    fresh_lp (z0::x::nil) (nu P' y). rename x0 into z'.
    assert (isinV v (P' y z')).
    { change (isinV v ((fun yP' y z') y)).
      eapply H; eauto. nat_math.
      intros_all. forwards*: H1 b. inverts H6.
      apply H9. auto. }
    assert ( x0, x0x size (P' y x0) n0).
    { intros. change (size ((fun yP' y x0) y) n0).
      eapply size_rename; eauto. intros_all. forwards*: H1 b.
      inverts H9. apply H11. auto. }
    
    clear H5. eapply H; eauto...
Qed.

Lemma isinV_rename {V:Set} : (P:nameproc V) x v, isinV v (P x)
    y, isinV v (P y).
Proof.
  intros. fresh_proc (nu P).
  destruct (exists_sz (nu P)) as [n]. inverts H0.
  eapply isinV_rename'; eauto.
Qed.


Lemma notin_mapV {V W:Set} : (P:proc V) (f:VW) a, notin a P notin a (mapV f P).
Proof.
  intros_all. gen W. induction H; simpl; eauto with hopi.
Qed.

Lemma notin_mapV_rev {V W:Set} : (P:proc V) (f:VW) a,
    notin a (mapV f P) notin a P.
Proof.
  intros_all. gen W.
  induction P; intros; simpl_notin; constructor; auto;
    try solve [apply× IHP]; try solve [apply× IHP1]; try solve [apply× IHP2].
  intros. apply× H.
Qed.

Lemma notin_bind {V W:Set} : (P:proc V)(f:Vproc W) a,
  ( (v:V), isinV v P notin a (f v))
  notin a P notin a (bind f P).
Proof.
  intros; gen W.
  induction H0; simpl; eauto with hopi; intros; simpl_notin;
    constructor; default_simp; auto with hopi.
  + apply IHnotin; intros [|]; simpl; auto with hopi.
    intros. apply× @notin_mapV; auto with hopi.
  + apply× H0. intros. apply H1. constructor; auto.
    intros. eapply isinV_rename; eauto.
Qed.

Lemma notin_bind_rev {V W:Set} : (P:proc V)(f:Vproc W) a, notin a (bind f P)
   ( v, isinV v P notin a (f v)) notin a P.
Proof.
  intros. gen W. induction P; simpl; intuition (eauto with hopi);
    simpl_notin; try inverts H0; try inverts H1; try (constructor; auto);
    try solve [forwards*: IHP1 f]; try solve [forwards*: IHP2 f].
  - auto.
  - edestruct IHP. apply H4.
    forwards: H H2. simpl in H1. eapply notin_mapV_rev; eauto.
  - edestruct IHP; eauto.
  - fresh_list (a::nil). forwards*: H x.
  - intros. forwards*: H.
Qed.