Set Implicit Arguments.
Require Import Metalib.Metatheory.
Require Import Program.Equality.
Require Export Reverse.

Lemma subst_reverse: forall A B X C D,
    X \notin fl_tt A \u fl_tt B ->
    subst_tt X (typ_label X C) A = subst_tt X (typ_label X D) B ->
    (C = D \/ (X \notin fv_tt A \u fv_tt B)) /\ (A=B).
Proof with auto.
  induction A;induction B;intros;simpl in *; try solve [inversion H0|right;auto|destruct (a==X);inversion H0]...
  -
    destruct (a==X);subst...
    destruct (a0==X);subst...
    inversion H0...
    inversion H0...
    destruct (a0==X);subst...
    inversion H0...
  -
    destruct (a==X);subst...
    +
      inversion H0...
      apply notin_union in H.
      destruct_hypos.
      apply notin_union in H1.
      destruct_hypos.
      apply notin_singleton_1 in H1...
      destruct H1...
    +
      inversion H0...
  -
    inversion H0.
    apply IHA1 in H2...
    apply IHA2 in H3...
    destruct_hypos;subst.
    destruct H2;destruct H1...
  -
    inversion H0.
    apply IHA1 in H2...
    apply IHA2 in H3...
    destruct_hypos;subst.
    destruct H2;destruct H1...
  -
    inversion H0.
    apply IHA1 in H2...
    apply IHA2 in H3...
    destruct_hypos;subst.
    destruct H2;destruct H1...
  -
    inversion H0.
    apply IHA in H2...
    destruct_hypos;subst...
  -
    destruct (a0==X);subst...
    +
      inversion H0.
      apply notin_union in H.
      destruct_hypos.
      apply notin_union in H.
      destruct_hypos.
      apply notin_singleton_1 in H...
      destruct H...
    +
      inversion H0.
  -
    inversion H0.
    apply IHA in H3...
    destruct_hypos;subst...
Qed.

Lemma fl_tt_open_tt: forall (X:atom) T,
    fl_tt (open_tt T X)  = fl_tt T.
Proof with auto.
  intros. unfold open_tt. generalize 0. induction T;intros;simpl...
  - destruct (n0==n)...
  - rewrite <- (IHT1 n), <- (IHT2 n)...
  - rewrite <- (IHT1 n), <- (IHT2 (S n))...
  - rewrite <- (IHT1 n), <- (IHT2 (S n))...
  - rewrite <- (IHT n)...
Qed.

Lemma equiv_fl_tt: forall E S S',
    equiv E S S' ->
    fl_tt S [<=] fl_tt S'.
Proof with auto.
  intros.
  destruct H.
  assert (type S) as TS. { get_well_form. get_type... }
  assert (type S') as TS'. { get_well_form. get_type... }
  generalize dependent S'.
  generalize dependent E.
  induction TS;intros.
  - inversion H;subst;simpl;try apply AtomSetProperties.subset_empty.
  - inversion H;subst;simpl;try apply AtomSetProperties.subset_empty.
  - inversion H;subst;simpl;try apply AtomSetProperties.subset_empty.
  - inversion H;subst;simpl;try apply AtomSetProperties.subset_empty.
  - inversion H0;subst;simpl;try apply AtomSetProperties.subset_empty.
    { inversion H. }
    { inversion H;subst;simpl.
      pose proof binds_ub_lb_invalid _ _ _ H4 H1. exfalso.
      apply H3. apply uniq_from_wf_env. get_well_form... }
    inversion H;subst;simpl.
    inversion TS';subst.
    specialize (IHTS1 _ _ H5 H7 H3).
    specialize (IHTS2 _ _ H9 H6 H4).
    apply union_s_m...
  - inversion H2;subst;simpl;try apply AtomSetProperties.subset_empty.
    { inversion H1. }
    { inversion H1;subst;simpl.
      pose proof binds_ub_lb_invalid _ _ _ H6 H3. exfalso.
      apply H5. apply uniq_from_wf_env. get_well_form... }
    inversion H1;subst. pick_fresh X. specialize_x_and_L X L0. specialize_x_and_L X L1.
    specialize_x_and_L X L. specialize (H0 ((X ~ bind_sub typ_top ++ E)) (open_tt A1 X)).
    rewrite !fl_tt_open_tt in H0.
    apply sub_nominal_inversion in H11... apply sub_nominal_inversion in H8...
    apply H0... get_type...
  - inversion H2;subst;simpl;try apply AtomSetProperties.subset_empty.
    { inversion H1. }
    { inversion H1;subst;simpl.
      pose proof binds_ub_lb_invalid _ _ _ H6 H3. exfalso.
      apply H5. apply uniq_from_wf_env. get_well_form... }
    inversion H1;subst. pick_fresh X.
    specialize_x_and_L X L0. specialize_x_and_L X L1.
    specialize_x_and_L X L.
    apply union_s_m...
    + apply IHTS with (E:=E)... get_type...
    + specialize (H0 ((X ~ bind_sub S1 ++ E)) (open_tt T0 X)).
      rewrite !fl_tt_open_tt in H0.
      apply H0...
      { add_nil. apply sub_narrowing with (Q:=T1)... }
      { get_type... }
  - inversion H2;subst;simpl;try apply AtomSetProperties.subset_empty.
    { inversion H1. }
    { inversion H1;subst;simpl.
      pose proof binds_ub_lb_invalid _ _ _ H6 H3. exfalso.
      apply H5. apply uniq_from_wf_env. get_well_form... }
    inversion H1;subst. pick_fresh X.
    specialize_x_and_L X L0. specialize_x_and_L X L1.
    specialize_x_and_L X L.
    apply union_s_m...
    + apply IHTS with (E:=E)... get_type...
    + specialize (H0 ((X ~ bind_sub_lb S1 ++ E)) (open_tt T0 X)).
      rewrite !fl_tt_open_tt in H0.
      apply H0...
      { add_nil. apply sub_narrowing_lb with (Q:=T1)... }
      { get_type... }
  - inversion H0;subst;simpl;try apply AtomSetProperties.subset_empty.
    { inversion H. }
    { inversion H;subst;simpl.
      pose proof binds_ub_lb_invalid _ _ _ H4 H1. exfalso.
      apply H3. apply uniq_from_wf_env. get_well_form... }
    apply union_s_m.
    { intros x... }
    inversion H;subst.
    apply IHTS with (E:=E)...
    get_type...
Qed.

Lemma lis_app_false: forall {A:Type} (E E1: list A)
  (x:A), E = E1 ++ x :: E -> False.
Proof.
  intros. generalize dependent E1. revert x.
  induction E;intros.
  - induction E1; inversion H;subst.
  - destruct E1;inversion H;subst.
    + apply IHE with (x:=x) (E1:=nil). auto.
    + apply IHE with (x:=a0) (E1:=E1++[x]).
      rewrite H2 at 1.
      rewrite !app_assoc. f_equal.
Qed.

Lemma fl_tt_subst_tt: forall X S T,
 fl_tt T [<=] fl_tt (subst_tt X S T).
Proof with auto.
  induction T;intros;simpl;try apply AtomSetProperties.subset_empty...
  + apply union_s_m...
  + apply union_s_m...
  + apply union_s_m...
  + apply union_s_m... intros x...
Qed.

Module GeneralEquivEnv.

Inductive equiv_env: env -> env -> Prop :=
| equiv_env_nil: equiv_env nil nil
| equiv_env_cons: forall X E1 E2 S T,
    X \notin dom E2 ->
    equiv_env E1 E2 ->
    equiv E2 S T ->
    equiv_env (X ~ bind_sub S ++ E1) (X ~ bind_sub T ++ E2)
| equiv_env_cons_lb: forall X E1 E2 S T,
    X \notin dom E2 ->
    equiv_env E1 E2 ->
    equiv E2 S T ->
    equiv_env (X ~ bind_sub_lb S ++ E1) (X ~ bind_sub_lb T ++ E2)
| equiv_env_cons_typ: forall X E1 E2 S T,
    X \notin dom E2 ->
    equiv_env E1 E2 ->
    equiv E2 S T ->
    equiv_env (X ~ bind_typ S ++ E1) (X ~ bind_typ T ++ E2)
.

Lemma equiv_weakening: forall E1 E2 E A B,
equiv (E1 ++ E2) A B ->
wf_env (E1 ++ E ++ E2) ->
  equiv (E1 ++ E ++ E2) A B.
Proof with auto.
  intros. destruct H.
  split.
  - apply Sub_weakening...
  - apply Sub_weakening...
Qed.

Ltac add_nil :=
    match goal with
    | [ |- WF ?E _ ] => rewrite_alist (nil ++ E)
    | [ |- sub ?E _ _ ] => rewrite_alist (nil ++ E)
    | [ |- equiv ?E _ _ ] => rewrite_alist (nil ++ E)
    end.

Lemma equiv_env_binds : forall E1 E2 X (U:typ),
    equiv_env E1 E2 ->
    binds X (bind_sub U) E1 ->
    exists U', binds X (bind_sub U') E2 /\ equiv E2 U U'.
Proof with auto.
  intros.
  induction H.
  + inversion H0.
  + analyze_binds H0.
    * inversion BindsTacVal;subst. exists T. split;auto.
      destruct H2. split.
      { add_nil. apply Sub_weakening... get_well_form.
        constructor... }
      { add_nil. apply Sub_weakening... get_well_form.
        constructor... }
    * destruct IHequiv_env;auto.
      destruct_hypos.
      exists x. split;auto.
      destruct H3. split.
      { add_nil. apply Sub_weakening... get_well_form...
        constructor... destruct H2. get_well_form... }
      { add_nil. apply Sub_weakening... get_well_form.
        constructor... destruct H2. get_well_form... }
  + analyze_binds H0.
    apply IHequiv_env in BindsTac.
    destruct_hypos.
    exists x. split;auto.
    add_nil. apply equiv_weakening...
    { destruct H3. destruct H2. get_well_form.
      constructor... }
  + analyze_binds H0.
    apply IHequiv_env in BindsTac.
    destruct_hypos.
    exists x. split;auto.
    add_nil. apply equiv_weakening...
    { destruct H3. destruct H2. get_well_form.
      constructor... }
Qed.

Lemma equiv_env_binds_lb : forall E1 E2 X (U:typ),
    equiv_env E1 E2 ->
    binds X (bind_sub_lb U) E1 ->
    exists U', binds X (bind_sub_lb U') E2 /\ equiv E2 U U'.
Proof with auto.
  intros.
  induction H.
  + inversion H0.
  + analyze_binds H0.
    apply IHequiv_env in BindsTac.
    destruct_hypos.
    exists x. split;auto.
    add_nil. apply equiv_weakening...
    { destruct H3. destruct H2. get_well_form.
      constructor... }
  + analyze_binds H0.
    * inversion BindsTacVal;subst. exists T. split;auto.
      destruct H2. split.
      { add_nil. apply Sub_weakening... get_well_form.
        constructor... }
      { add_nil. apply Sub_weakening... get_well_form.
        constructor... }
    * destruct IHequiv_env;auto.
      destruct_hypos.
      exists x. split;auto.
      destruct H3. split.
      { add_nil. apply Sub_weakening... get_well_form...
        constructor... destruct H2. get_well_form... }
      { add_nil. apply Sub_weakening... get_well_form.
        constructor... destruct H2. get_well_form... }
  + analyze_binds H0.
    apply IHequiv_env in BindsTac.
    destruct_hypos.
    exists x. split;auto.
    add_nil. apply equiv_weakening...
    { destruct H3. destruct H2. get_well_form.
      constructor... }
Qed.

Lemma equiv_env_wf_env : forall E1 E2,
    equiv_env E1 E2 ->
    wf_env E1 ->
    wf_env E2.
Proof with auto.
  intros.
  induction H...
  - inversion H0;subst. constructor...
    destruct H2. get_well_form...
  - inversion H0;subst. constructor...
    destruct H2. get_well_form...
  - inversion H0;subst. constructor...
    destruct H2. get_well_form...
Qed.

Lemma equiv_env_WF_var : forall E1 E2 (X:atom),
    equiv_env E1 E2 ->
    WF E1 X ->
    WF E2 X.
Proof with auto.
  intros.
  inversion H0;subst.
  + apply equiv_env_binds with (E2:=E2) in H3...
    destruct_hypos. apply WF_var with (U:=x)...
  + apply equiv_env_binds_lb with (E2:=E2) in H3...
    destruct_hypos. apply WF_var_lb with (U:=x)...
Qed.

Lemma equiv_env_to_wf_env: forall E1 E2,
    equiv_env E1 E2 ->
    wf_env E2.
Proof with auto.
  intros. induction H...
  + constructor... destruct H1. get_well_form...
  + constructor... destruct H1. get_well_form...
  + constructor... destruct H1. get_well_form...
Qed.

Lemma equiv_env_WF : forall E1 E2 (X:typ),
    equiv_env E1 E2 ->
    WF E1 X ->
    WF E2 X.
Proof with auto.
  intros. revert H. revert E2. dependent induction H0;intros...
  + apply equiv_env_binds with (E2:=E2) in H...
    destruct_hypos. apply WF_var with (U:=x)...
  + apply equiv_env_binds_lb with (E2:=E2) in H...
    destruct_hypos. apply WF_var_lb with (U:=x)...
  + apply WF_all with (L:=L \u dom E2)...
    intros. specialize_x_and_L X L.
    apply H1... constructor...
    apply equiv_reflexivity...
    apply equiv_env_to_wf_env in H2...
  + apply WF_all_lb with (L:=L \u dom E2)...
    intros. specialize_x_and_L X L.
    apply H1... constructor...
    apply equiv_reflexivity...
    apply equiv_env_to_wf_env in H2...
  + apply WF_rec with (L:=L \u dom E2)...
    * intros. specialize_x_and_L X L.
      apply H0... constructor...
      apply equiv_reflexivity...
      apply equiv_env_to_wf_env in H3...
    * intros. specialize_x_and_L X L.
      apply H2... constructor...
      apply equiv_reflexivity...
      apply equiv_env_to_wf_env in H3...
Qed.

Lemma equiv_env_sub : forall A B (* C D *) E1 E2,
    equiv_env E1 E2 ->
    sub E1 A B ->
    (* equiv E2 A C -> equiv E2 B D -> *)
    sub E2 A B.
Proof with auto.
  intros.
  generalize dependent E2.
  (* revert C D. *)
  induction H0;intros...
  -
    constructor. apply equiv_env_wf_env with (E1:=E)...
  -
    constructor... apply equiv_env_wf_env with (E1:=E)...
    inversion H0;subst.
    + apply equiv_env_binds with (E2:=E2) in H4...
      destruct_hypos. apply WF_var with (U:=x)...
    + apply equiv_env_binds_lb with (E2:=E2) in H4...
      destruct_hypos. apply WF_var_lb with (U:=x)...
  -
    constructor... apply equiv_env_wf_env with (E1:=E)...
    apply equiv_env_WF with (E1:=E)...
  -
    constructor... apply equiv_env_wf_env with (E1:=E)...
    apply equiv_env_WF with (E1:=E)...
  -
    pose proof equiv_env_binds _ _ H1 H.
    destruct_hypos.
    (* unfold equiv in H2, H3. destruct_hypos. *)
    apply sa_trans_tvar with (U:=x)...
    (* destruct H7. *)
    eapply sub_transitivity with (Q:=U)...
    destruct H3...
  -
    pose proof equiv_env_binds_lb _ _ H1 H.
    (* unfold equiv in H2, H3.  *)
    destruct_hypos.
    apply sa_trans_tvar_lb with (U:=x)...
    eapply sub_transitivity with (Q:=U)...
    destruct H3...
  -
    apply sa_all with (L:=L \u dom E2).
    + apply IHsub1...
    + apply IHsub2...
    + intros. specialize_x_and_L X L.
      apply H0... constructor...
      apply equiv_reflexivity...
      { apply equiv_env_to_wf_env in H1... }
      { get_well_form... apply equiv_env_WF with (E1:=E)... }
  -
    apply sa_all_lb with (L:=L \u dom E2).
    + apply IHsub1...
    + apply IHsub2...
    + intros. specialize_x_and_L X L.
      apply H0... constructor...
      apply equiv_reflexivity...
      { apply equiv_env_to_wf_env in H1... }
      { get_well_form... apply equiv_env_WF with (E1:=E)... }
  -
    apply sa_rec with (L:=L \u dom E2).
    + intros. specialize_x_and_L X L.
      eapply equiv_env_WF. 2:{ eassumption. }
      constructor... apply equiv_reflexivity...
      apply equiv_env_to_wf_env in H3...
    + intros. specialize_x_and_L X L.
      eapply equiv_env_WF. 2:{ eassumption. }
      constructor... apply equiv_reflexivity...
      apply equiv_env_to_wf_env in H3...
    + intros. specialize_x_and_L X L.
      apply H2... constructor...
      apply equiv_reflexivity...
      { apply equiv_env_to_wf_env in H3... }
Qed.

Lemma equiv_env_refl: forall E,
  wf_env E ->
    equiv_env E E.
Proof with auto.
  induction E.
  - constructor.
  - intros. inversion H;subst.
    specialize (IHE H2).
    + constructor... apply equiv_reflexivity...
    + constructor... apply equiv_reflexivity...
    + constructor... apply equiv_reflexivity...
Qed.

Lemma equiv_env_dom: forall E1 E2,
    equiv_env E1 E2 ->
    dom E1 = dom E2.
Proof with auto.
  intros. induction H...
  - simpl. rewrite IHequiv_env. reflexivity.
  - simpl. rewrite IHequiv_env. reflexivity.
  - simpl. rewrite IHequiv_env. reflexivity.
Qed.

Lemma equiv_env_sym: forall E1 E2,
    equiv_env E1 E2 ->
    equiv_env E2 E1.
Proof with auto.
  intros. induction H.
  - constructor.
  - constructor... { rewrite <- (equiv_env_dom IHequiv_env)... }
    destruct H1. split; apply equiv_env_sub with (E1:=E2)...
  - constructor... { rewrite <- (equiv_env_dom IHequiv_env)... }
    destruct H1. split; apply equiv_env_sub with (E1:=E2)...
  - constructor... { rewrite <- (equiv_env_dom IHequiv_env)... }
    destruct H1. split; apply equiv_env_sub with (E1:=E2)...
Qed.

Lemma equiv_env_subst_tb: forall E1 E2 X D S,
  wf_env (E1 ++ (X ~ bind_sub typ_top) ++ E2) ->
  equiv E2 S D ->
  equiv_env (map (subst_tb X D) E1 ++E2) (map (subst_tb X S) E1 ++ E2).
Proof with auto.
  intros.
  induction E1.
  + apply equiv_env_refl... apply wf_env_map_free2 with (B:=bind_sub typ_top)...
    destruct H0. get_well_form...
  + destruct a. simpl in H. destruct H0.
    destruct b;inversion H;subst;simpl.
    * constructor...
      split.
      - apply equiv_sub_subst_not_var.
        { apply Reflexivity... }
        { split... } { split... }
        { apply equiv_reflexivity;get_well_form... }
      - apply equiv_sub_subst_not_var.
        { apply Reflexivity... }
        { split... }
        { apply equiv_reflexivity;get_well_form... }
        { split... }
    * constructor... split.
      - apply equiv_sub_subst_not_var.
        { apply Reflexivity... }
        { split... } { split... }
        { apply equiv_reflexivity;get_well_form... }
      - apply equiv_sub_subst_not_var.
        { apply Reflexivity... }
        { split... }
        { apply equiv_reflexivity;get_well_form... }
        { split... }
    * constructor... split.
      - apply equiv_sub_subst_not_var.
        { apply Reflexivity... }
        { split... } { split... }
        { apply equiv_reflexivity;get_well_form... }
      - apply equiv_sub_subst_not_var.
        { apply Reflexivity... }
        { split... }
        { apply equiv_reflexivity;get_well_form... }
        { split... }
Qed.

End GeneralEquivEnv.

Lemma choose_flip: forall m A B ,
    choose m A B = choose (flip m) B A .
Proof with auto.
  intros.
  destruct m...
Qed.

Lemma subst_tt_wf_env_label_rec: forall E1 X E2 U,
    wf_env (map (subst_tb X (typ_label X (open_tt U X))) E1 ++ (X, bind_sub typ_top) :: E2) ->
    X \notin fv_tt U \u fl_env E1 ->
    WF E2 (typ_mu U) ->
    wf_env (map (subst_tb X (typ_mu U)) E1 ++ E2).
Proof with auto.
  intros.
  apply wf_env_drop_label in H.
  rewrite drop_label_reverse_env in H...
  apply wf_env_map_free2 with (B:=bind_sub typ_top)...
Qed.

Lemma drop_wf_env_label_rec: forall E1 X E2 U,
    wf_env (map (subst_tb X (typ_label X (open_tt U X))) E1 ++ (X, bind_sub typ_top) :: E2) ->
    X \notin fv_tt U \u fl_env E1 ->
    WF E2 (typ_mu U) ->
    wf_env ( E1 ++ (X, bind_sub typ_top) :: E2).
Proof with auto.
  intros.
  apply wf_env_drop_label in H.
  rewrite drop_label_reverse_env in H...
Qed.

Lemma binds_map_free_env2: forall E1 E2 X Y U S,
    Y \notin {{X}}  ->
    wf_env (E1 ++ (Y, bind_sub typ_top) :: E2) ->
    binds X (bind_sub U) (E1 ++ (Y, bind_sub typ_top) :: E2) ->
    binds X (bind_sub (subst_tt Y S U)) (map (subst_tb Y S) E1 ++  E2).
Proof with auto.
  intros.
  analyze_binds H1...
  -
    unfold binds in *.
    apply In_lemmaL.
    apply binds_map_free...
  -
    unfold binds in *.
    apply In_lemmaR.
    rewrite <- maps_subst_tb_free with (X:=Y) (U:=S)...
    apply binds_map_free...
    apply notin_from_wf_env in H0...
Qed.

Lemma binds_subst_extensial: forall E S T X0 X U,
    binds X0 (bind_sub U) (map (subst_tb X S) E) ->
    exists A,
      binds X0 (bind_sub A) (map (subst_tb X T) E).
Proof with auto.
  induction E;intros...
  simpl in *.
  analyze_binds H.
  simpl in *.
  destruct a.
  analyze_binds H.
  -
    destruct b;simpl in *; inversion BindsTacVal.
    exists (subst_tt X T t)...
  -
    apply IHE with (T:=T) in BindsTac...
    destruct_hypos.
    exists x...
Qed.

Lemma binds_subst_extensial_lb: forall E S T X0 X U,
    binds X0 (bind_sub_lb U) (map (subst_tb X S) E) ->
    exists A,
      binds X0 (bind_sub_lb A) (map (subst_tb X T) E).
Proof with auto.
  induction E;intros...
  simpl in *.
  analyze_binds H.
  simpl in *.
  destruct a.
  analyze_binds H.
  -
    destruct b;simpl in *; inversion BindsTacVal.
    exists (subst_tt X T t)...
  -
    apply IHE with (T:=T) in BindsTac...
    destruct_hypos.
    exists x...
Qed.

Lemma binds_subst_extensial_no_subst: forall E S  X0 X U,
    binds X0 (bind_sub U) (map (subst_tb X S) E) ->
    exists A,
      binds X0 (bind_sub A) E.
Proof with auto.
  induction E;intros...
  simpl in *.
  analyze_binds H.
  simpl in *.
  destruct a.
  analyze_binds H.
  -
    destruct b;simpl in *; inversion BindsTacVal.
    exists t...
  -
    apply IHE in BindsTac...
    destruct_hypos.
    exists x...
Qed.

Lemma binds_subst_extensial_no_subst_lb: forall E S  X0 X U,
    binds X0 (bind_sub_lb U) (map (subst_tb X S) E) ->
    exists A,
      binds X0 (bind_sub_lb A) E.
Proof with auto.
  induction E;intros...
  simpl in *.
  analyze_binds H.
  simpl in *.
  destruct a.
  analyze_binds H.
  -
    destruct b;simpl in *; inversion BindsTacVal.
    exists t...
  -
    apply IHE in BindsTac...
    destruct_hypos.
    exists x...
Qed.

Lemma subst_tb_wf_reverse: forall S X T E Q E2,
  WF (map (subst_tb X T) E ++ X ~ bind_sub Q ++E2) (subst_tt X T S) ->
  WF (X ~ bind_sub Q ++E2) T ->
  WF (E ++ X ~ bind_sub Q ++ E2) S.
Proof with eauto.
  intros.
  dependent induction H;simpl in *;try solve [dependent destruction H;eauto]...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
    rewrite <- x.
    analyze_binds H...
    apply binds_subst_extensial_no_subst in BindsTac...
    destruct_hypos...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
    rewrite <- x.
    analyze_binds H...
    apply binds_subst_extensial_no_subst_lb in BindsTac...
    destruct_hypos...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
    dependent destruction x.
    constructor...
  -
    induction S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
    dependent destruction x...
    clear IHS1 IHS2.
    apply WF_all with (L:=L \u {{X}});intros...
    rewrite_env ((X0 ~ bind_sub S1 ++ E) ++ (X, bind_sub Q) :: E2).
    apply H1 with (X0:=X0) (T0:=T)...
    rewrite subst_tt_open_tt_var...
    get_type...
  -
    induction S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
    dependent destruction x...
    clear IHS1 IHS2.
    apply WF_all_lb with (L:=L \u {{X}});intros...
    rewrite_env ((X0 ~ bind_sub_lb S1 ++ E) ++ (X, bind_sub Q) :: E2).
    apply H1 with (X0:=X0) (T0:=T)...
    rewrite subst_tt_open_tt_var...
    get_type...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
    dependent destruction x...
    apply WF_rec with (L:=L \u {{X}});intros...
    +
      rewrite_env ((X0 ~ bind_sub typ_top ++ E) ++ (X, bind_sub Q) :: E2).
      apply H0 with (X0:=X0) (T0:=T)...
      rewrite subst_tt_open_tt_var...
      get_type...
    +
      rewrite_env ((X0 ~ bind_sub typ_top ++ E) ++ (X, bind_sub Q) :: E2).
      apply H2 with (X0:=X0) (T0:=T)...
      rewrite subst_tt_open_tt_twice...
      get_type...
  -
    destruct S;simpl in *;try solve [inversion x]...
    destruct (a==X);try solve [inversion x]...
    constructor...
    apply IHWF with (T0:=T)...
    inversion x...
Qed.

Lemma subst_tb_wf_env_reverse: forall E E2 X T,
    wf_env (map (subst_tb X T) E ++ (X~ bind_sub typ_top) ++ E2) ->
    WF ((X~ bind_sub typ_top) ++ E2) T ->
    wf_env (E ++ (X~ bind_sub typ_top) ++ E2).
Proof with auto.
  induction E;intros...
  destruct a.
  destruct b.
  -
    simpl in *.
    dependent destruction H...
    constructor...
    apply IHE with (T:=T)...
    apply subst_tb_wf_reverse in H0...
  -
    simpl in *.
    dependent destruction H...
    constructor...
    apply IHE with (T:=T)...
    apply subst_tb_wf_reverse in H0...
  -
    simpl in *.
    dependent destruction H...
    constructor...
    apply IHE with (T:=T)...
    apply subst_tb_wf_reverse in H0...
Qed.

Lemma WF_narrowing_env: forall E1 E E2 A S T X,
    WF (E1 ++ map (subst_tb X S) E ++ E2) A ->
    WF (E1 ++ map (subst_tb X T) E ++ E2) A.
Proof with auto.
  intros.
  dependent induction H;try solve [analyze_binds H;eauto]...
  -
    analyze_binds H; try solve [apply WF_var with (U:=U);auto].
    apply binds_subst_extensial with (T:=T) in BindsTac0.
    destruct_hypos.
    apply WF_var with (U:=x)...
  -
    analyze_binds H; try solve [apply WF_var_lb with (U:=U);auto].
    apply binds_subst_extensial_lb with (T:=T) in BindsTac0.
    destruct_hypos.
    apply WF_var_lb with (U:=x)...
  -
    apply WF_all with (L:=L )...
    apply IHWF with (S0:=S)...
    intros.
    rewrite_env ((X0 ~ bind_sub T1 ++ E1) ++ map (subst_tb X T) E ++ E2).
    eapply H1 with (S0:=S)...
  -
    apply WF_all_lb with (L:=L )...
    apply IHWF with (S0:=S)...
    intros.
    rewrite_env ((X0 ~ bind_sub_lb T1 ++ E1) ++ map (subst_tb X T) E ++ E2).
    eapply H1 with (S0:=S)...
  -
    apply WF_rec with (L:=L );intros...
    rewrite_env ((X0 ~ bind_sub typ_top ++ E1) ++ map (subst_tb X T) E ++ E2).
    eapply H0 with (S0:=S)...
    rewrite_env ((X0 ~ bind_sub typ_top ++ E1) ++ map (subst_tb X T) E ++ E2).
    eapply H2 with (S0:=S)...
Qed.

(* this lemma is not used *)
Lemma binds_subst_extensial_equiv: forall  E2  E S T X0 X U,
    binds X0 (bind_sub U) (map (subst_tb X S) E ++ (X, bind_sub typ_top):: E2) ->
    equiv ( (X, bind_sub typ_top)::E2) S T ->
    wf_env (map (subst_tb X T) E ++ (X, bind_sub typ_top)::E2) ->
    wf_env (map (subst_tb X S) E ++ (X, bind_sub typ_top)::E2) ->
    WF (map (subst_tb X T) E ++(X, bind_sub typ_top):: E2) U ->
    exists A,
      equiv (map (subst_tb X T) E ++ (X, bind_sub typ_top)::E2) U A /\ binds X0 (bind_sub A) (map (subst_tb X T) E ++ (X, bind_sub typ_top)::E2).
Proof with auto.
  induction E;intros...
  -
    simpl in *.
    exists U...
    split...
    unfold equiv;
      split;apply Reflexivity...
  -
    simpl in *.
    destruct a.
    apply binds_cons_uniq_iff in H.
    destruct H.
    +
      destruct_hypos;subst.
      destruct b;simpl in *.
      *
        dependent destruction H4.
        exists (subst_tt X T t).
        split...
        unfold equiv;split.
        --
          rewrite_env (nil ++ (a~ bind_sub (subst_tt X T t)) ++ map (subst_tb X T) E ++ (X, bind_sub typ_top) ::E2).
          apply Sub_weakening...
          apply equiv_sub_subst...
          apply Reflexivity...
          ++
            dependent destruction H1.
            apply subst_tb_wf_reverse with (T:=T)...
            unfold equiv in *;destruct_hypos;get_well_form...
          ++
            dependent destruction H1.
            apply subst_tb_wf_env_reverse in H1...
            unfold equiv in *;destruct_hypos;get_well_form...
          ++
            unfold equiv in *;destruct_hypos;split;
            get_well_form;apply Reflexivity...
        --
          rewrite_env (nil ++ (a~ bind_sub (subst_tt X T t)) ++ map (subst_tb X T) E ++ (X, bind_sub typ_top) ::E2).
          apply Sub_weakening...
          apply equiv_sub_subst...
          apply Reflexivity...
          ++
            dependent destruction H1.
            apply subst_tb_wf_reverse with (T:=T)...
            unfold equiv in *;destruct_hypos;get_well_form...
          ++
            dependent destruction H1.
            apply subst_tb_wf_env_reverse in H1...
            unfold equiv in *;destruct_hypos;get_well_form...
          ++
            unfold equiv in *;destruct_hypos;split...
          ++
            unfold equiv in *;destruct_hypos;split;
              get_well_form;apply Reflexivity...
          ++
            unfold equiv in *;destruct_hypos;split...
      *
        inversion H4.
      * inversion H4.
    +
      destruct_hypos.
      destruct IHE with (S:=S) (T:=T) (X:=X) (X0:=X0) (U:=U)...
      dependent destruction H1...
      dependent destruction H2...
      apply WF_from_binds_typ in H...
      rewrite_env (nil ++ map (subst_tb X T) E ++ (X, bind_sub typ_top) :: E2).
      apply WF_narrowing_env with (S:=S)...
      dependent destruction H2...
      destruct H5...
      exists x...
      split...
      unfold equiv in *;destruct_hypos.
      split;rewrite_env (nil ++ (a~ subst_tb X T b) ++ map (subst_tb X T) E ++ (X, bind_sub typ_top) :: E2);apply Sub_weakening...
    +
      apply uniq_from_wf_env...
Qed.

Lemma notin_fl_env: forall E X Y U,
    binds X (bind_sub U) E ->
    Y \notin fl_env E ->
    Y \notin fl_tt U.
Proof with eauto.
  induction E;intros...
  simpl in *.
  destruct a.
  destruct b...
  -
    analyze_binds H.
    inversion BindsTacVal...
    apply IHE with (X:=X)...
  -
    analyze_binds H.
    apply IHE with (X:=X)...
  -
    analyze_binds H.
    apply IHE with (X:=X)...
Qed.

Lemma binds_uniq: forall E X A B,
    wf_env E ->
    binds X (bind_sub A) E ->
    binds X (bind_sub B) E ->
    A = B.
Proof with auto.
  induction E;intros...
  analyze_binds H0.
  destruct a.
  analyze_binds_uniq H0.
  -
    apply uniq_from_wf_env...
  -
    analyze_binds_uniq H1...
    inversion BindsTacVal...
  -
    analyze_binds_uniq H1...
    apply IHE with (X:=X)...
    dependent destruction H...
Qed.

Lemma sub_tvar_trans_var: forall X A E B,
    binds X (bind_sub A) E ->
    sub E X B ->
    (typ_fvar X) <> B ->
    sub E A B \/ exists (Y:atom) U', B = Y /\ binds Y (bind_sub_lb U') E .
Proof with auto.
  intros.
  generalize dependent A.
  dependent induction H0;intros...
  -
    destruct H1...
  -
    constructor... constructor...
    apply WF_from_binds_typ with (x:=X)...
  -
    apply  binds_uniq with (A:=A) in H...
    subst...
    get_well_form...
  -
    right. exists X0, U...
Qed.

(*
Lemma sub_tvar_trans_var': forall X A E B,
    binds X (bind_sub A) E ->
    sub E X B ->
    (typ_fvar X) <> B ->
    sub E A B \/ exists (Y:atom) U', B = Y /\ binds Y (bind_sub_lb U') E /\ sub E A Y.
Proof with auto.
  intros.
  generalize dependent A.
  dependent induction H0;intros...
  -
    destruct H1...
  -
    constructor... constructor...
    apply WF_from_binds_typ with (x:=X)...
  -
    apply  binds_uniq with (A:=A) in H...
    subst...
    get_well_form...
  -
    right. exists X0, U...
    repeat split...
    apply sa_trans_tvar_lb with (U:=U)...
Qed. *)

Lemma sub_tvar_trans_var'': forall X A E B,
    binds X (bind_sub A) E ->
    sub E X B ->
    (typ_fvar X) = B \/
    sub E A B \/ exists (Y:atom) U', B = Y /\ binds Y (bind_sub_lb U') E /\ sub E X Y.
Proof with auto.
  intros.
  generalize dependent A.
  dependent induction H0;intros...
  (* -
    destruct H1... *)
  - right. left.
    constructor...
     (* constructor... *)
    apply WF_from_binds_typ with (x:=X)...
  -
    apply  binds_uniq with (A:=A) in H...
    subst...
    get_well_form...
  -
    destruct (IHsub X) with (A:=A)...
    + subst.
    right. right. exists X0, X...
    repeat split... apply sa_trans_tvar_lb with (U:=X)...
    + destruct H2...
    * subst.
      right. right. exists X0, U...
      repeat split... apply sa_trans_tvar_lb with (U:=U)...
    * destruct_hypos. subst.
      right. right. exists X0, x...
      repeat split... apply sa_trans_tvar_lb with (U:=x)...
Qed.

Lemma sub_tvar_trans_var': forall X A E B,
    binds X (bind_sub A) E ->
    sub E X B ->
    (typ_fvar X) = B \/
    sub E A B \/ exists (Y:atom) U', B = Y /\ binds Y (bind_sub_lb U') E /\ sub E X Y.
Proof with auto.
  intros.
  generalize dependent A.
  dependent induction H0;intros...
  (* -
    destruct H1... *)
  - right. left.
    constructor...
     (* constructor... *)
    apply WF_from_binds_typ with (x:=X)...
  -
    apply  binds_uniq with (A:=A) in H...
    subst...
    get_well_form...
  -
    destruct (IHsub X) with (A:=A)...
    + subst.
    right. right. exists X0, X...
    repeat split... apply sa_trans_tvar_lb with (U:=X)...
    + destruct H2...
    * subst.
      right. right. exists X0, U...
      repeat split... apply sa_trans_tvar_lb with (U:=U)...
    * destruct_hypos. subst.
      right. right. exists X0, x...
      repeat split... apply sa_trans_tvar_lb with (U:=x)...
Qed.

Lemma open_tt_var_rev: forall A B (X:atom),
    X \notin fv_tt A \u fv_tt B ->
    open_tt A X = open_tt B X ->
    A = B.
Proof with auto.
  unfold open_tt.
  generalize 0.
  intros n A B.
  generalize dependent n.
  generalize dependent B.
  induction A;induction B;intros;simpl in *;try solve [inversion H0|destruct (n0==n);subst;inversion H0]...
  -
    destruct (n1==n);destruct (n1==n0);subst...
    inversion H0.
    inversion H0.
  -
    destruct (n0==n);subst...
    inversion H0.
    rewrite <- H2 in H.
    solve_notin_self X.
  -
    destruct (n0==n);subst...
    inversion H0.
    rewrite  H2 in H.
    solve_notin_self X.
  -
    inversion H0.
    apply IHA1 in H2...
    apply IHA2 in H3...
    subst...
  -
    inversion H0.
    apply IHA1 in H2...
    apply IHA2 in H3...
    subst...
  -
    inversion H0.
    apply IHA1 in H2...
    apply IHA2 in H3...
    subst...
  -
    inversion H0.
    apply IHA in H2...
    subst...
  -
    inversion H0.
    apply IHA in H3...
    subst...
Qed.

Lemma EqDec_eq : forall (A B: typ),
    {A = B} + {A <> B}.
Proof with auto.
  intros.
  decide equality.
  decide equality.
Qed.

Lemma mu_transform_0: forall C  (Y X:atom) A ,
    type (typ_mu C) ->
    X <> Y ->
    (subst_tt X (typ_mu C) (open_tt A (typ_label Y (open_tt A Y)))) =
 (open_tt (subst_tt X (typ_mu C) A)
       (typ_label Y (open_tt (subst_tt X (typ_mu C) A) Y))).
Proof with auto.
  intros.
  rewrite subst_tt_open_tt...
  f_equal.
  simpl...
  f_equal.
  rewrite subst_tt_open_tt_var...
Qed.

Lemma mu_transform_1: forall (X Y:atom) A C,
    X <> Y ->
    type (open_tt C X) ->
    (open_tt (subst_tt X (typ_label X (open_tt C X)) A)
                 (typ_label Y (open_tt (subst_tt X (typ_label X (open_tt C X)) A) Y))) =
    (subst_tt X (typ_label X (open_tt C X)) (open_tt A (typ_label Y (open_tt A Y)))).
Proof with auto.
  intros.
  rewrite subst_tt_open_tt...
  f_equal...
  simpl...
  f_equal...
  rewrite subst_tt_open_tt...
  f_equal...
  simpl...
  destruct (Y==X)...
  destruct H...
Qed.

Inductive equiv_env (X:atom) (G:env) (S:typ) : env -> env -> Prop :=
| equiv_env_base:
    X \notin dom G -> wf_env G -> WF G (typ_mu S) ->
    equiv_env X G S (X ~ bind_sub typ_top ++ G) (X ~ bind_sub typ_top ++ G)
(* | equiv_env_cons_equal : forall E1 E2 Y S,
    X \notin fv_tt S ->
    equiv_env E1 E2 ->
    equiv_env (Y ~ bind_sub S ++ E1) (Y ~ bind_sub S ++ E2) *)
| equiv_env_cons: forall E1 E2 Y S' T,
    Y \notin dom E2 ->
    equiv_env X G S E1 E2 ->
    equiv G (typ_mu S') (typ_mu S) ->
    WF E2 T -> WF E1 T ->
    X \notin fl_tt T ->
    equiv_env X G S
      (Y ~ bind_sub (subst_tt X (typ_label X (open_tt S' X)) T) ++ E1)
      (Y ~ bind_sub (subst_tt X (typ_label X (open_tt S X)) T) ++ E2)
| equiv_env_cons_lb: forall E1 E2 Y S' T,
    Y \notin dom E2 ->
    equiv_env X G S E1 E2 ->
    equiv G (typ_mu S') (typ_mu S) ->
    WF E2 T -> WF E1 T ->
    X \notin fl_tt T ->
    equiv_env X G S
      (Y ~ bind_sub_lb (subst_tt X (typ_label X (open_tt S' X)) T) ++ E1)
      (Y ~ bind_sub_lb (subst_tt X (typ_label X (open_tt S X)) T) ++ E2)
| equiv_env_cons_typ: forall E1 E2 Y S' T,
    Y \notin dom E2 ->
    equiv_env X G S E1 E2 ->
    equiv G (typ_mu S') (typ_mu S) ->
    WF E2 T -> WF E1 T ->
    X \notin fl_tt T ->
    equiv_env X G S
      (Y ~ bind_typ (subst_tt X (typ_label X (open_tt S' X)) T) ++ E1)
      (Y ~ bind_typ (subst_tt X (typ_label X (open_tt S X)) T) ++ E2)
.

Lemma equiv_env_sublist2: forall X G S E1 E2,
  equiv_env X G S E1 E2 ->
  exists E3, E2 = E3 ++ X ~ bind_sub typ_top ++ G.
Proof with auto.
  intros.
  induction H...
  - exists nil...
  - destruct IHequiv_env as [E3 EQ]. subst.
    exists (Y ~ bind_sub (subst_tt X (typ_label X (open_tt S X)) T) ++ E3)...
  - destruct IHequiv_env as [E3 EQ]. subst.
    exists (Y ~ bind_sub_lb (subst_tt X (typ_label X (open_tt S X)) T) ++ E3)...
  - destruct IHequiv_env as [E3 EQ]. subst.
    exists (Y ~ bind_typ (subst_tt X (typ_label X (open_tt S X)) T) ++ E3)...
Qed.

Lemma equiv_env_sublist1: forall X G S E1 E2,
  equiv_env X G S E1 E2 ->
  exists E3, E1 = E3 ++ X ~ bind_sub typ_top ++ G.
Proof with auto.
  intros.
  induction H...
  - exists nil...
  - destruct IHequiv_env as [E3 EQ]. subst.
    exists (Y ~ bind_sub (subst_tt X (typ_label X (open_tt S' X)) T) ++ E3)...
  - destruct IHequiv_env as [E3 EQ]. subst.
    exists (Y ~ bind_sub_lb (subst_tt X (typ_label X (open_tt S' X)) T) ++ E3)...
  - destruct IHequiv_env as [E3 EQ]. subst.
    exists (Y ~ bind_typ (subst_tt X (typ_label X (open_tt S' X)) T) ++ E3)...
Qed.

Lemma equiv_env_to_wf_env2: forall X G S E1 E2,
    equiv_env X G S E1 E2 ->
    (* wf_env E1 -> *)
    wf_env E2.
Proof with auto.
  intros. induction H...
  + constructor...
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist2 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H6;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
  + constructor...
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist2 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H6;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
  + constructor...
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist2 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H6;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
Qed.

Lemma equiv_env_dom: forall X G S E1 E2,
  equiv_env X G S E1 E2 ->
  dom E1 = dom E2.
Proof with auto.
  intros.
  induction H...
  - simpl... f_equal...
  - simpl... f_equal...
  - simpl... f_equal...
Qed.

Lemma equiv_env_binds_ub: forall Y X G S E1 E2 T,
  equiv_env Y G S E1 E2 ->
  binds X (bind_sub T) E2 ->
  exists T', binds X (bind_sub T') E1.
Proof with auto.
  intros.
  induction H...
  - exists T...
  - destruct H0.
    + inversion H0;subst. exists (subst_tt Y (typ_label Y (open_tt S' Y)) T0)...
    + destruct IHequiv_env... exists x...
  - destruct H0.
    + inversion H0.
    + destruct IHequiv_env... exists x...
  - destruct H0.
    + inversion H0.
    + destruct IHequiv_env... exists x...
Qed.

Lemma equiv_env_binds_lb: forall Y X G S E1 E2 T,
  equiv_env Y G S E1 E2 ->
  binds X (bind_sub_lb T) E2 ->
  exists T', binds X (bind_sub_lb T') E1.
Proof with auto.
  intros.
  induction H...
  - exists T...
  - destruct H0.
    + inversion H0.
    + destruct IHequiv_env... exists x...
  - destruct H0.
    + inversion H0;subst. exists (subst_tt Y (typ_label Y (open_tt S' Y)) T0)...
    + destruct IHequiv_env... exists x...
  - destruct H0.
    + inversion H0.
    + destruct IHequiv_env... exists x...
Qed.

Lemma equiv_env_to_wf_env1: forall X G S E1 E2,
    equiv_env X G S E1 E2 ->
    wf_env E1.
Proof with auto.
  intros. induction H...
  + constructor...
    2:{ apply equiv_env_dom in H0. rewrite H0... }
    apply subst_tt_wf...
    destruct H1. get_well_form.
    destruct (equiv_env_sublist1 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H7;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
  + constructor...
    2:{ apply equiv_env_dom in H0. rewrite H0... }
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist1 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H7;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
  + constructor...
    2:{ apply equiv_env_dom in H0. rewrite H0... }
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist1 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H7;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
Qed.

Lemma equiv_env_derives_general: forall X G S E1 E2,
    equiv_env X G S E1 E2 ->
    GeneralEquivEnv.equiv_env E1 E2.
Proof with auto.
  intros.
  induction H...
  - apply GeneralEquivEnv.equiv_env_refl...
  - constructor... apply equiv_subst_refl...
    destruct (equiv_env_sublist2 H0) as [E2'];subst.
    pose proof equiv_env_to_wf_env2 H0.
    destruct H1.
    assert (Hwfe: wf_env (X ~ bind_sub typ_top ++ G)).
    { get_well_form. constructor...
      apply uniq_from_wf_env in H5.
      apply fresh_mid_tail in H5... }
    split.
    + inversion H1;subst. pick_fresh Z.
      specialize_x_and_L Z L.
      add_nil. apply Sub_weakening...
      apply sub_nominal_inversion in H12...
      constructor.
      apply sub_replacing_var with (X:=Z)...
    + inversion H6;subst. pick_fresh Z.
      specialize_x_and_L Z L.
      add_nil. apply Sub_weakening...
      apply sub_nominal_inversion in H12...
      constructor.
      apply sub_replacing_var with (X:=Z)...
  - constructor... apply equiv_subst_refl...
    destruct (equiv_env_sublist2 H0) as [E2'];subst.
    pose proof equiv_env_to_wf_env2 H0.
    destruct H1.
    assert (Hwfe: wf_env (X ~ bind_sub typ_top ++ G)).
    { get_well_form. constructor...
      apply uniq_from_wf_env in H5.
      apply fresh_mid_tail in H5... }
    split.
    + inversion H1;subst. pick_fresh Z.
      specialize_x_and_L Z L.
      add_nil. apply Sub_weakening...
      apply sub_nominal_inversion in H12...
      constructor.
      apply sub_replacing_var with (X:=Z)...
    + inversion H6;subst. pick_fresh Z.
      specialize_x_and_L Z L.
      add_nil. apply Sub_weakening...
      apply sub_nominal_inversion in H12...
      constructor.
      apply sub_replacing_var with (X:=Z)...
  - constructor... apply equiv_subst_refl...
    destruct (equiv_env_sublist2 H0) as [E2'];subst.
    pose proof equiv_env_to_wf_env2 H0.
    destruct H1.
    assert (Hwfe: wf_env (X ~ bind_sub typ_top ++ G)).
    { get_well_form. constructor...
      apply uniq_from_wf_env in H5.
      apply fresh_mid_tail in H5... }
    split.
    + inversion H1;subst. pick_fresh Z.
      specialize_x_and_L Z L.
      add_nil. apply Sub_weakening...
      apply sub_nominal_inversion in H12...
      constructor.
      apply sub_replacing_var with (X:=Z)...
    + inversion H6;subst. pick_fresh Z.
      specialize_x_and_L Z L.
      add_nil. apply Sub_weakening...
      apply sub_nominal_inversion in H12...
      constructor.
      apply sub_replacing_var with (X:=Z)...
Qed.

(*

Hard to prove, so add WF E1 T

Lemma equiv_env_to_wf_env1: forall X G S  E1 E2,
    equiv_env X G S E1 E2 ->
    wf_env E1.
Proof with auto.
  intros. induction H...
  (* + constructor... 2:{ rewrite (equiv_env_dom H0)... }
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist1 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H4;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
  + constructor...
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist2 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H4;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)...
  + constructor...
    apply subst_tt_wf... destruct H1. get_well_form.
    destruct (equiv_env_sublist2 H0) as [E3 EQ]. subst.
    add_nil. apply WF_weakening... inversion H4;subst...
    constructor. pick_fresh Z. specialize_x_and_L Z L.
    apply WF_replacing_var with (X:=Z)... *)
Admitted.

Lemma equiv_env_WF: forall X G S E1 E2,
  equiv_env X G S E1 E2 -> forall T,
  WF E2 T -> WF E1 T.
Proof with auto.
Admitted. *)

Lemma equiv_env_trans_var_ex_general:
forall X1 U E E' E2 X S U',
  X \notin fl_tt U' ->
  equiv_env X E2 S E E' ->
  binds X1 (bind_sub U) E ->
  binds X1 (bind_sub (subst_tt X (typ_label X (open_tt S X)) U')) E' ->
  WF E2 (typ_mu S) ->
  exists S',
    U = subst_tt X (typ_label X (open_tt S' X)) U'
    /\ equiv E2 (typ_mu S') (typ_mu S).
Proof with auto.
  intros.
  induction H0.
  - destruct H1.
    + inversion H1;subst.
      destruct H2. 2:{ apply binds_In in H2. exfalso... }
      inversion H2;subst.
      destruct U';try solve [inversion H7].
      2:{ simpl in H7. destruct (a==X1);inversion H7. }
      exists S. split...
      apply equiv_reflexivity...
    + destruct H2. { inversion H2;subst. apply binds_In in H1. exfalso... }
      pose proof binds_uniq _ _ _ H4 H1 H2.
      exists S. split...
      apply equiv_reflexivity...
  - destruct H1.
    + inversion H1.
      destruct H2. 2:{ apply binds_In in H2. subst. exfalso... }
      inversion H2. subst.
      apply subst_reverse in H13...
      destruct H13. subst. exists S'.
      split...
    + destruct H2. { inversion H2;subst. apply binds_In in H1.
        apply equiv_env_dom in H4. rewrite <- H4 in *. exfalso... }
      apply IHequiv_env...
  - destruct H1.
    + inversion H1.
    + destruct H2. { inversion H2;subst. }
      apply IHequiv_env...
  - destruct H1.
    + inversion H1.
    + destruct H2. { inversion H2;subst. }
      apply IHequiv_env...
Qed.

Lemma binds_uniq_lb: forall E X A B,
    wf_env E ->
    binds X (bind_sub_lb A) E ->
    binds X (bind_sub_lb B) E ->
    A = B.
Proof with auto.
  induction E;intros...
  analyze_binds H0.
  destruct a.
  analyze_binds_uniq H0.
  -
    apply uniq_from_wf_env...
  -
    analyze_binds_uniq H1...
    inversion BindsTacVal...
  -
    analyze_binds_uniq H1...
    apply IHE with (X:=X)...
    dependent destruction H...
Qed.

Lemma equiv_env_trans_var_ex_general_lb:
forall X1 U E E' E2 X S U',
  X \notin fl_tt U' ->
  equiv_env X E2 S E E' ->
  binds X1 (bind_sub_lb U) E ->
  binds X1 (bind_sub_lb (subst_tt X (typ_label X (open_tt S X)) U')) E' ->
  WF E2 (typ_mu S) ->
  exists S',
    U = subst_tt X (typ_label X (open_tt S' X)) U'
    /\ equiv E2 (typ_mu S') (typ_mu S).
Proof with auto.
  intros.
  induction H0.
  - destruct H1.
    + inversion H1;subst.
    + destruct H2. { inversion H2;subst. }
      pose proof binds_uniq_lb _ _ _ H4 H1 H2.
      exists S. split...
      apply equiv_reflexivity...
  - destruct H1.
    + inversion H1.
    + destruct H2. { inversion H2;subst. }
      apply IHequiv_env...
  - destruct H1.
    + inversion H1.
      destruct H2. 2:{ apply binds_In in H2. subst. exfalso... }
      inversion H2. subst.
      apply subst_reverse in H13...
      destruct H13. subst. exists S'.
      split...
    + destruct H2. { inversion H2;subst. apply binds_In in H1.
        apply equiv_env_dom in H4. rewrite <- H4 in *. exfalso... }
      apply IHequiv_env...
  - destruct H1.
    + inversion H1.
    + destruct H2. { inversion H2;subst. }
      apply IHequiv_env...
Qed.

Lemma binds_ub_lb_invalid_equiv_env: forall  E1 E2 X Y G U U0 S,
  binds X (bind_sub_lb U) E1 ->
  binds X (bind_sub U0) E2 ->
  equiv_env Y G S E1 E2 ->
  False.
Proof with auto.
  intros.
  pose proof equiv_env_binds_ub _ _ H1 H0.
  destruct H2.
  apply equiv_env_to_wf_env1 in H1.
  pose proof binds_unique _ _ _ _ _ H H2.
  apply uniq_from_wf_env in H1. specialize (H3 H1).
  inversion H3.
Qed.

Lemma binds_lb_ub_invalid_equiv_env: forall  E1 E2 X Y G U U0 S,
  binds X (bind_sub U) E1 ->
  binds X (bind_sub_lb U0) E2 ->
  equiv_env Y G S E1 E2 ->
  False.
Proof with auto.
  intros.
  pose proof equiv_env_binds_lb _ _ H1 H0.
  destruct H2.
  apply equiv_env_to_wf_env1 in H1.
  pose proof binds_unique _ _ _ _ _ H H2.
  apply uniq_from_wf_env in H1. specialize (H3 H1).
  inversion H3.
Qed.

Lemma equiv_env_transform: forall E2 E E1 X S S' ,
X \notin fl_env E1 \u fl_env E2 ->
equiv_env X E2 S E
           (map (subst_tb X (typ_label X (open_tt S X))) E1 ++
            X ~ bind_sub typ_top ++ E2) ->
equiv E2 (typ_mu S') (typ_mu S) ->
equiv_env X E2 S' E
            (map (subst_tb X (typ_label X (open_tt S' X))) E1 ++
            X ~ bind_sub typ_top ++ E2).
Proof with auto.
  intros. dependent induction H0.
  - destruct E1.
    2:{ destruct p. inversion x;subst. apply lis_app_false in H7. destruct H7. }
    constructor... destruct H3. get_well_form...
  - destruct E1.
    { inversion x;subst. apply equiv_env_sublist2 in H0.
      destruct H0 as [E2']. apply lis_app_false in H0. destruct H0. }
    destruct p. destruct b; inversion x;subst.
    simpl in H.
    simpl. apply subst_reverse in H9...
    destruct H9. subst.
    constructor...
    + unfold equiv in *. destruct_hypos. split; apply sub_transitivity with (Q:=typ_mu S)...
    + add_nil. apply WF_narrowing_env with (S:=typ_label X (open_tt S X))...
  - destruct E1.
    { inversion x;subst. }
    destruct p. destruct b; inversion x;subst.
    simpl in H.
    simpl. apply subst_reverse in H9...
    destruct H9. subst.
    constructor...
    + unfold equiv in *. destruct_hypos. split; apply sub_transitivity with (Q:=typ_mu S)...
    + add_nil. apply WF_narrowing_env with (S:=typ_label X (open_tt S X))...
  - destruct E1.
    { inversion x;subst. }
    destruct p. destruct b; inversion x;subst.
    simpl in H.
    simpl. apply subst_reverse in H9...
    destruct H9. subst.
    constructor...
    + unfold equiv in *. destruct_hypos. split; apply sub_transitivity with (Q:=typ_mu S)...
    + add_nil. apply WF_narrowing_env with (S:=typ_label X (open_tt S X))...
Qed.

Lemma notin_fl_env_lb: forall E X Y U,
    binds X (bind_sub_lb U) E ->
    Y \notin fl_env E ->
    Y \notin fl_tt U.
Proof with eauto.
  induction E;intros...
  simpl in *.
  destruct a.
  destruct b...
  -
    analyze_binds H.
    apply IHE with (X:=X)...
  -
    analyze_binds H.
    inversion BindsTacVal...
    apply IHE with (X:=X)...
  -
    analyze_binds H.
    apply IHE with (X:=X)...
Qed.

Lemma subst_tt_eq: forall T X, subst_tt X X T = T.
Proof with auto.
  intros T X. induction T;intros;simpl...
  - destruct (a == X)... rewrite e...
  - rewrite IHT1. rewrite IHT2...
  - rewrite IHT1. rewrite IHT2...
  - rewrite IHT1. rewrite IHT2...
  - rewrite IHT...
  - rewrite IHT...
Qed.

Lemma map_subst_tb_eq: forall E X, map (subst_tb X X) E = E.
Proof with auto.
  induction E...
  intros.
  destruct a. simpl. rewrite IHE. f_equal.
  destruct b;simpl;f_equal;rewrite subst_tt_eq...
Qed.

(* Lemma sub_generalize_intensive : forall E1 E2 A B C D X m S,
    (* sub (E1 ++ X ~ bind_sub typ_top ++ E2) A B -> *)
    WF (E1 ++ X ~ bind_sub typ_top ++ E2) A ->
    WF (E1 ++ X ~ bind_sub typ_top ++ E2) B ->
    X \notin fv_tt C \u fv_tt D \u fl_env E1 \u fl_env E2 \u fl_tt A \u fl_tt B \u dom E1 \u dom E2 \u fv_tt S \u fl_tt C \u fl_tt D \u fl_tt S ->
    sub (map (subst_tb X (typ_label X (open_tt S X))) E1 ++ X ~ bind_sub typ_top ++ E2) (subst_tt X (typ_label X (open_tt C X)) A) (subst_tt X (typ_label X  (open_tt D X)) B) ->
    sub E2 (typ_mu (choose m C S))  (typ_mu (choose m S C)) ->
    sub E2 (typ_mu (choose m S D))  (typ_mu (choose m D S)) ->
    sub (map (subst_tb X (typ_mu S)) E1 ++ E2) (subst_tt X (typ_mu C) A) (subst_tt X (typ_mu D) B). *)

Lemma sub_generalize_intensive : forall E1 E2 A B C D X m S G,
(* sub (E1 ++ X ~ bind_sub typ_top ++ E2) A B -> *)
WF (E1 ++ X ~ bind_sub typ_top ++ E2) A ->
WF (E1 ++ X ~ bind_sub typ_top ++ E2) B ->
X \notin fv_tt C \u fv_tt D \u fl_env E1 \u fl_env E2 \u fl_tt A \u fl_tt B \u dom E1 \u dom E2 \u fv_tt S \u fl_tt C \u fl_tt D \u fl_tt S ->
sub G (subst_tt X (typ_label X (open_tt C X)) A) (subst_tt X (typ_label X  (open_tt D X)) B) ->
sub E2 (typ_mu (choose m C S))  (typ_mu (choose m S C)) ->
sub E2 (typ_mu (choose m S D))  (typ_mu (choose m D S)) ->
equiv_env X E2 S G (map (subst_tb X (typ_label X (open_tt S X))) E1 ++ X ~ bind_sub typ_top ++ E2) ->
sub  (map (subst_tb X (typ_mu S)) E1 ++ E2)
  (subst_tt X (typ_mu C) A) (subst_tt X (typ_mu D) B).
Proof with auto.
  intros E1 E2 A B C D X m S G Hwf1 Hwf2 Hx Hsub H1 H2 Heqenv.
  assert (Hwfe: wf_env (map (subst_tb X (typ_mu S)) E1 ++ E2)).
  { destruct m; get_well_form...
    + apply wf_env_subst_tb with (Q:=typ_top)...
      apply subst_tb_wf_env_reverse with (T:=(typ_label X (open_tt S X)))...
      {
        apply equiv_env_to_wf_env2 in Heqenv...
      }
      constructor.
      inversion H4;subst.
      pick_fresh Y. add_nil.
      apply WF_replacing_var with (X:=Y)...
    + apply wf_env_subst_tb with (Q:=typ_top)...
      apply subst_tb_wf_env_reverse with (T:=(typ_label X (open_tt S X)))...
      {
         apply equiv_env_to_wf_env2 in Heqenv...
      }
      constructor.
      inversion H3;subst.
      pick_fresh Y. add_nil.
      apply WF_replacing_var with (X:=Y)...
  }
  assert (Hwfe2: wf_env (E1 ++ X ~ bind_sub typ_top ++ E2)).
  { apply equiv_env_to_wf_env2 in Heqenv.
    apply subst_tb_wf_env_reverse in Heqenv...
    assert (WF E2 (typ_mu S)) by
      (destruct m; get_well_form;auto)...
    inversion H;subst.
    pick_fresh Y. add_nil. constructor.
    apply WF_replacing_var with (X:=Y)...
  }
  generalize dependent m.
  generalize dependent S.
  generalize dependent E1.
  generalize dependent E2.
  dependent induction Hsub;intros...
  -
    (* nat <: nat *)
    dependent destruction Hwf1;try solve [inversion x0
      |simpl in *;destruct (X0==X);inversion x0]...
    dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
    (* eapply equiv_env_sub. apply Heqenv. auto. *)
  -
    (* X <: X *)
    (* eapply equiv_env_sub. apply Heqenv. *)
    dependent destruction Hwf1;try solve [inversion x0].
    + simpl in *. destruct (X1 == X);inversion x0;subst...
      dependent destruction Hwf2;try solve [inversion x].
      * simpl in *. destruct (X0 == X);inversion x;subst...
        apply sa_fvar... apply WF_var with (U:=subst_tt X (typ_mu S) U)...
        apply binds_map_free_sub with (Q:=typ_top)...
      * simpl in *. destruct (X0 == X);inversion x;subst...
        pose proof binds_ub_lb_invalid _ _ _ H2 H1.
        destruct H5... apply uniq_from_wf_env...
    + simpl in *. destruct (X1 == X);inversion x0;subst...
      dependent destruction Hwf2;try solve [inversion x].
      * simpl in *. destruct (X0 == X);inversion x;subst...
        pose proof binds_ub_lb_invalid _ _ _ H1 H2.
        destruct H5... apply uniq_from_wf_env...
      * simpl in *. destruct (X0 == X);inversion x;subst...
        apply sa_fvar... apply WF_var_lb with (U:=subst_tt X (typ_mu S) U)...
        apply binds_map_free_sub2 with (Q:=typ_top)...
  -
    (* A <: Top *)
    (* eapply equiv_env_sub. apply Heqenv. *)
    dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
    simpl. apply sa_top... add_nil.
    apply WF_narrowing_env with (S:=typ_mu C)...
    simpl. apply subst_tb_wf with (Q:=bind_sub typ_top)...
    destruct m;get_well_form...
  -
    (* Bot <: A *)
    (* eapply equiv_env_sub. apply Heqenv. *)
    dependent destruction Hwf1;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
    simpl. apply sa_bot... add_nil.
    apply WF_narrowing_env with (S:=typ_mu D)...
    simpl. apply subst_tb_wf with (Q:=bind_sub typ_top)...
    destruct m;get_well_form...
  -
    (* X0 <: U <: [X |-> <X, D>] B *)
    (* eapply equiv_env_sub. apply Heqenv. *)
    dependent destruction Hwf1;try solve [inversion x
    |simpl in *;destruct (X0==X);inversion x]...
    2:{
      simpl in x. destruct (X1 == X);try solve [inversion x].
      inversion x.
      rewrite H4 in H.
      apply binds_map_free_sub2 with (S:=(typ_label X (open_tt S X))) in H0...
      assert (binds X1 (bind_sub_lb (subst_tt X (typ_label X (open_tt S X)) U0))
      (map (subst_tb X (typ_label X (open_tt S X))) E1 ++ X ~ bind_sub typ_top ++ E2))...
      pose proof binds_lb_ub_invalid_equiv_env _ _ _ H H3 Heqenv. destruct H5.
    }
    simpl in x. destruct (X1 == X);try solve [inversion x].
    inversion x;subst. simpl.
    destruct (X1 ==X);try contradiction.

    assert (exists S',
        U = subst_tt X (typ_label X (open_tt S' X)) U0 /\
        equiv ( E2) (typ_mu S') (typ_mu S)).
    {
      apply equiv_env_trans_var_ex_general
        with (X1:=X1) (E:=E) (E':=(map (subst_tb X (typ_label X (open_tt S X))) E1 ++
        X ~ bind_sub typ_top ++ E2))...
      + apply notin_fl_env with (Y:=X) in H0...
        apply Infrastructure.notin_fl_env...
      + apply binds_map_free_sub with (S:=(typ_label X (open_tt S X))) in H0...
      + destruct m;get_well_form...
    }

    destruct H3 as [S' [Hs1 Hs2]].

    (* NEED to define a more general sub_env_equiv *)
    apply GeneralEquivEnv.equiv_env_sub with (E1:=map (subst_tb X (typ_mu S')) E1 ++ E2).
    { apply GeneralEquivEnv.equiv_env_subst_tb...
      destruct Hs2. split... }

    apply sa_trans_tvar with (U:= subst_tt X (typ_mu S') U0)...
    +
      apply binds_map_free_sub with (Q:=typ_top)...
    +
      apply IHHsub with (m:=m)...
      * apply WF_from_binds_typ with (x:=X1)...
      * assert (fv_tt S' [<=] dom E2).
        { destruct Hs2. get_well_form... apply WF_imply_dom in H7... }
        assert (X `notin` dom E2 -> X `notin` fv_tt S')...
        assert (X `notin` fl_tt S -> X `notin` fl_tt S')...
        { apply equiv_fl_tt in Hs2. simpl in Hs2... }
        solve_notin...
        { apply notin_fl_env with (Y:=X) in H0... apply Infrastructure.notin_fl_env... }
      *
        apply equiv_env_transform with (S:=S)...
      * apply wf_env_map_free2 with (B:=bind_sub typ_top)...
        destruct Hs2. get_well_form...
      * destruct Hs2. get_well_form. apply Reflexivity... destruct m;simpl in *...
      * destruct Hs2. destruct m;simpl in *;apply sub_transitivity with (Q:=typ_mu S)...

  -
    (* X0 :> U :> [X |-> <X, D>] B *)
    dependent destruction Hwf2;try solve [inversion x
    |simpl in *;destruct (X0==X);inversion x]...
    {
      simpl in x. destruct (X1 == X);try solve [inversion x].
      inversion x.
      rewrite H4 in H.
      apply binds_map_free_sub with (S:=(typ_label X (open_tt S X))) in H0...
      assert (binds X1 (bind_sub (subst_tt X (typ_label X (open_tt S X)) U0))
      (map (subst_tb X (typ_label X (open_tt S X))) E1 ++ X ~ bind_sub typ_top ++ E2))...
      pose proof binds_ub_lb_invalid_equiv_env _ _ _ H H3 Heqenv. destruct H5.
    }
    simpl in x. destruct (X1 == X);try solve [inversion x].
    inversion x;subst. simpl.
    destruct (X1 ==X);try contradiction.

    assert (exists S',
        U = subst_tt X (typ_label X (open_tt S' X)) U0 /\
        equiv ( E2) (typ_mu S') (typ_mu S)).
    {
      apply equiv_env_trans_var_ex_general_lb
        with (X1:=X1) (E:=E) (E':=(map (subst_tb X (typ_label X (open_tt S X))) E1 ++
        X ~ bind_sub typ_top ++ E2))...
      + apply notin_fl_env_lb with (Y:=X) in H0...
        apply Infrastructure.notin_fl_env...
      + apply binds_map_free_sub2 with (S:=(typ_label X (open_tt S X))) in H0...
      + destruct m;get_well_form...
    }

    destruct H3 as [S' [Hs1 Hs2]].

    (* NEED to define a more general sub_env_equiv *)
    apply GeneralEquivEnv.equiv_env_sub with (E1:=map (subst_tb X (typ_mu S')) E1 ++ E2).
    { apply GeneralEquivEnv.equiv_env_subst_tb...
      destruct Hs2. split... }

    apply sa_trans_tvar_lb with (U:= subst_tt X (typ_mu S') U0)...
    +
      apply binds_map_free_sub2 with (Q:=typ_top)...
    +
      apply IHHsub with (m:=m)...
      * apply WF_from_binds_typ_lb with (x:=X1)...
      * assert (fv_tt S' [<=] dom E2).
        { destruct Hs2. get_well_form... apply WF_imply_dom in H7... }
        assert (X `notin` dom E2 -> X `notin` fv_tt S')...
        assert (X `notin` fl_tt S -> X `notin` fl_tt S')...
        { apply equiv_fl_tt in Hs2. simpl in Hs2... }
        solve_notin...
        { apply notin_fl_env_lb with (Y:=X) in H0... apply Infrastructure.notin_fl_env... }
      *
        apply equiv_env_transform with (S:=S)...
      * apply wf_env_map_free2 with (B:=bind_sub typ_top)...
        destruct Hs2. get_well_form...
      * destruct Hs2. destruct m;simpl in *;apply sub_transitivity with (Q:=typ_mu S)...
      * destruct Hs2. get_well_form. apply Reflexivity... destruct m;simpl in *...
  -
    (* A1 -> A2 <: B1 -> B2 *)
    (* eapply equiv_env_sub. apply Heqenv. *)
    dependent destruction Hwf1;try solve [inversion x0
    |simpl in *;destruct (X0==X);inversion x0]...
    dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
    simpl in x0. inversion x0.
    simpl in x. inversion x.
    simpl.
    apply sa_arrow.
    +
      apply IHHsub1 with (m:=flip m)(S:=S)...
      * simpl in Hx. solve_notin.
      (* * apply equiv_env_refl... *)
      * destruct m;simpl in *...
      * destruct m;simpl in *...
    +
      apply IHHsub2 with (m:=m)(S:=S)...
      * simpl in Hx. solve_notin.
      (* * apply equiv_env_refl... *)
  -
    (* ALL S1. T1 <: ALL S2. T2  *)
    (* eapply equiv_env_sub. apply Heqenv. *)
    dependent destruction Hwf1;try solve [inversion x0
    |simpl in *;destruct (X0==X);inversion x0]...
    dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
    simpl in x0. inversion x0.
    simpl in x. inversion x.
    simpl in Hx.
    assert (type4rec T0). { apply type_to_rec. get_type... }
    assert (type4rec T4). { apply type_to_rec. get_type... }
    assert (Heqv: equiv (E1 ++ (X ~ bind_sub typ_top) ++ E2) T0 T4).
    {
      rewrite <- drop_label_reverse_env with (E:=E1) (X:=X) (U:=open_tt S X)...
      replace T0 with (subst_label X S1).
      2:{ rewrite H6. rewrite drop_label_reverse_type... }
      replace T4 with (subst_label X S2).
      2:{ rewrite H8. rewrite drop_label_reverse_type... }
      split.
      + subst. apply open_twice_to_one...
        apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
      + subst. apply open_twice_to_one...
        apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
    }
    clear IHHsub1.  clear IHHsub2.
    destruct Heqv as [Heqv1 Heqv2].
    pose proof @subst_reverse_equiv T0 H5 T4 H10 X C D E1 E2 S.
    destruct H11...
    { rewrite <- H6. rewrite <- H8.
      split.
      + apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
      + apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
    }
    { split... }
    { assert (WF E2 (typ_mu C)). { destruct m;get_well_form... }
      inversion H11;subst. pick_fresh Y.
      specialize_x_and_L Y L. apply WF_replacing_var with (X:=Y)...
    }
    { assert (WF E2 (typ_mu D)). { destruct m;get_well_form... }
      inversion H11;subst. pick_fresh Y.
      specialize_x_and_L Y L. apply WF_replacing_var with (X:=Y)...
    }
    { assert (WF E2 (typ_mu S)). { destruct m;get_well_form... }
      inversion H11;subst. pick_fresh Y.
      specialize_x_and_L Y L. apply WF_replacing_var with (X:=Y)...
    }
    + (* C = D *)
      assert (equiv E2 (typ_mu C) (typ_mu D)).
      {
        unfold equiv in *.
        destruct_hypos.
        split.
        apply  equiv_sub_unfolding with (Y:=X)...
        apply  equiv_sub_unfolding with (Y:=X)...
      }
      assert (equiv E2 (typ_mu C) (typ_mu S)).
      {
        unfold equiv in *.
        destruct_hypos.
        destruct m;simpl in *.
        split...
        apply sub_transitivity with (Q:=typ_mu D)...
        split...
        apply sub_transitivity with (Q:=typ_mu D)...
      }
      assert (equiv E2 (typ_mu S) (typ_mu D)).
      {
        unfold equiv in *.
        destruct_hypos.
        destruct m;simpl in *.
        split...
        apply sub_transitivity with (Q:=typ_mu C)...
        split...
        apply sub_transitivity with (Q:=typ_mu C)...
      }

    simpl.
    apply sa_all with (L:=L \u L0 \u L1 \u {{X}} \u dom E1 \u dom E2);intros...
    --
      apply equiv_sub_subst_not_var...
    --
      apply equiv_sub_subst_not_var;
      unfold equiv in *;destruct_hypos;try split...
    --
      add_nil.
      apply sub_narrowing with (Q:= subst_tt X (typ_mu S) T4).
      {
        apply equiv_sub_subst_not_var...
        + apply Reflexivity...
        + unfold equiv in *. destruct_hypos. split...
        + unfold equiv in *. destruct_hypos. split...
        + unfold equiv in *. get_well_form. apply equiv_reflexivity...
      }

      rewrite_env (map (subst_tb X (typ_mu S)) (X0 ~ bind_sub T4 ++ E1) ++ E2).

      rewrite subst_tt_open_tt_var...
      2:{ unfold equiv in *;get_well_form;destruct_hypos;get_type... }
      rewrite subst_tt_open_tt_var...
      2:{ unfold equiv in *;get_well_form;destruct_hypos;get_type... }
      specialize_x_and_L X0 L.

      apply H0 with (m:=m)...
      * subst T1. rewrite subst_tt_open_tt_var... constructor. destruct H11. get_type...
      * subst T2. rewrite subst_tt_open_tt_var... constructor. destruct H11. get_type...
      * specialize_x_and_L X0 L0. rewrite app_assoc.
        add_nil. apply WF_narrowing with (V := T0)...
      * specialize_x_and_L X0 L1. rewrite app_assoc.
        add_nil. apply WF_narrowing with (V := T4)...
      * constructor...
      * simpl in Hx. solve_notin.
      * rewrite H8. simpl. constructor...
        { unfold equiv in *. destruct_hypos. split... }
        { apply WF_narrowing_env_subst... }
        { apply equiv_env_derives_general in Heqenv.
          apply GeneralEquivEnv.equiv_env_sym in Heqenv.
          apply (GeneralEquivEnv.equiv_env_WF Heqenv).
          add_nil. apply WF_narrowing_env with (S:=X).
          rewrite map_subst_tb_eq. get_well_form...
        }
      * simpl. constructor... apply subst_tb_wf with (Q:=bind_sub typ_top)...
        unfold equiv in *. get_well_form...

    + (* X notin *) simpl.
    assert (subst_tt X (typ_mu C) T0 = subst_tt X (typ_mu S) T0) as HS1.
    {
      rewrite <- subst_tt_fresh...
      rewrite <- subst_tt_fresh...
    }
    assert (subst_tt X (typ_mu D) T4 = subst_tt X (typ_mu S) T4) as HS2.
    {
      rewrite <- subst_tt_fresh...
      rewrite <- subst_tt_fresh...
    }
    rewrite HS1.
    rewrite HS2.
    assert (equiv E2 (typ_mu S) (typ_mu S)).
    {
      unfold equiv;split;apply Reflexivity;get_well_form;auto;
        destruct m;simpl in *...
    }
    apply sa_all with (L:=L \u L0 \u L1 \u {{X}} \u dom E1 \u dom E2);intros...
    --
      apply equiv_sub_subst_not_var...
    --
      apply equiv_sub_subst_not_var...
    --
      assert (type (typ_mu D)).
      destruct m;simpl in *;get_type...
      assert (type (typ_mu C)).
      destruct m;simpl in *;get_type...
      rewrite subst_tt_open_tt_var...
      rewrite subst_tt_open_tt_var...
      rewrite_env  ( map (subst_tb X (typ_mu S)) (X0 ~ bind_sub T4 ++ E1) ++ E2).
      apply H0 with (m:=m) (X:=X0)...
      * subst T1. rewrite subst_tt_open_tt_var... constructor.
        assert (WF E2 (typ_mu C)). { destruct m;get_well_form... }
        inversion H7;subst. pick_fresh Y.
        specialize_x_and_L Y L2. apply WF_replacing_var with (Y:=X) in H17...
        get_type...
      * subst T2. rewrite subst_tt_open_tt_var... constructor.
        assert (WF E2 (typ_mu D)). { destruct m;get_well_form... }
        inversion H9;subst. pick_fresh Y.
        specialize_x_and_L Y L2. apply WF_replacing_var with (Y:=X) in H17...
        get_type...
      * specialize_x_and_L X0 L0. rewrite app_assoc.
        add_nil. apply WF_narrowing with (V := T0)...
      * specialize_x_and_L X0 L1. rewrite app_assoc.
        add_nil. apply WF_narrowing with (V := T4)...
      * constructor...
      * simpl in Hx. solve_notin.
      * rewrite H8.
        assert (subst_tt X (typ_label X (open_tt D X)) T4 = subst_tt X (typ_label X (open_tt S X)) T4) as HS3.
        {
          rewrite <- subst_tt_fresh...
          rewrite <- subst_tt_fresh...
        }
        rewrite HS3. simpl. constructor...
         {  apply WF_narrowing_env_subst... }
        { apply equiv_env_derives_general in Heqenv.
          apply GeneralEquivEnv.equiv_env_sym in Heqenv.
          apply (GeneralEquivEnv.equiv_env_WF Heqenv).
          add_nil. apply WF_narrowing_env with (S:=X).
          rewrite map_subst_tb_eq. get_well_form...
        }
      * simpl. constructor... apply subst_tb_wf with (Q:=bind_sub typ_top)...
        unfold equiv in *. get_well_form...

  -
  (* ALL X0 :> S1. T1 <: ALL X0 :> S2. T2  *)
    dependent destruction Hwf1;try solve [inversion x0
    |simpl in *;destruct (X0==X);inversion x0]...
    dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
    simpl in x0. inversion x0.
    simpl in x. inversion x.
    simpl in Hx.
    assert (type4rec T0). { apply type_to_rec. get_type... }
    assert (type4rec T4). { apply type_to_rec. get_type... }
    assert (Heqv: equiv (E1 ++ (X ~ bind_sub typ_top) ++ E2) T0 T4).
    {
      rewrite <- drop_label_reverse_env with (E:=E1) (X:=X) (U:=open_tt S X)...
      replace T0 with (subst_label X S1).
      2:{ rewrite H6. rewrite drop_label_reverse_type... }
      replace T4 with (subst_label X S2).
      2:{ rewrite H8. rewrite drop_label_reverse_type... }
      split.
      + subst. apply open_twice_to_one...
        apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
      + subst. apply open_twice_to_one...
        apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
    }
    clear IHHsub1.  clear IHHsub2.
    destruct Heqv as [Heqv1 Heqv2].
    pose proof @subst_reverse_equiv T0 H5 T4 H10 X C D E1 E2 S.
    destruct H11...
    { rewrite <- H6. rewrite <- H8.
      split.
      + apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
      + apply equiv_env_derives_general in Heqenv.
        apply (GeneralEquivEnv.equiv_env_sub Heqenv)...
    }
    { split... }
    { assert (WF E2 (typ_mu C)). { destruct m;get_well_form... }
      inversion H11;subst. pick_fresh Y.
      specialize_x_and_L Y L. apply WF_replacing_var with (X:=Y)...
    }
    { assert (WF E2 (typ_mu D)). { destruct m;get_well_form... }
      inversion H11;subst. pick_fresh Y.
      specialize_x_and_L Y L. apply WF_replacing_var with (X:=Y)...
    }
    { assert (WF E2 (typ_mu S)). { destruct m;get_well_form... }
      inversion H11;subst. pick_fresh Y.
      specialize_x_and_L Y L. apply WF_replacing_var with (X:=Y)...
    }
    + (* C = D *)
      assert (equiv E2 (typ_mu C) (typ_mu D)).
      {
        unfold equiv in *.
        destruct_hypos.
        split.
        apply  equiv_sub_unfolding with (Y:=X)...
        apply  equiv_sub_unfolding with (Y:=X)...
      }
      assert (equiv E2 (typ_mu C) (typ_mu S)).
      {
        unfold equiv in *.
        destruct_hypos.
        destruct m;simpl in *.
        split...
        apply sub_transitivity with (Q:=typ_mu D)...
        split...
        apply sub_transitivity with (Q:=typ_mu D)...
      }
      assert (equiv E2 (typ_mu S) (typ_mu D)).
      {
        unfold equiv in *.
        destruct_hypos.
        destruct m;simpl in *.
        split...
        apply sub_transitivity with (Q:=typ_mu C)...
        split...
        apply sub_transitivity with (Q:=typ_mu C)...
      }

    simpl.
    apply sa_all_lb with (L:=L \u L0 \u L1 \u {{X}} \u dom E1 \u dom E2);intros...
    --
      apply equiv_sub_subst_not_var...
    --
      apply equiv_sub_subst_not_var;
      unfold equiv in *;destruct_hypos;try split...
    --
      add_nil.
      apply sub_narrowing_lb with (Q:= subst_tt X (typ_mu S) T4).
      {
        apply equiv_sub_subst_not_var...
        + apply Reflexivity...
        (* + unfold equiv in *. destruct_hypos. split...
        + unfold equiv in *. destruct_hypos. split... *)
        + unfold equiv in *. get_well_form. apply equiv_reflexivity...
      }

      rewrite_env (map (subst_tb X (typ_mu S)) (X0 ~ bind_sub_lb T4 ++ E1) ++ E2).

      rewrite subst_tt_open_tt_var...
      2:{ unfold equiv in *;get_well_form;destruct_hypos;get_type... }
      rewrite subst_tt_open_tt_var...
      2:{ unfold equiv in *;get_well_form;destruct_hypos;get_type... }
      specialize_x_and_L X0 L.

      apply H0 with (m:=m)...
      * subst T1. rewrite subst_tt_open_tt_var... constructor. destruct H11. get_type...
      * subst T2. rewrite subst_tt_open_tt_var... constructor. destruct H11. get_type...
      * specialize_x_and_L X0 L0. rewrite app_assoc.
        add_nil. apply WF_narrowing_lb with (V := T0)...
      * specialize_x_and_L X0 L1. rewrite app_assoc.
        add_nil. apply WF_narrowing_lb with (V := T4)...
      * constructor...
      * simpl in Hx. solve_notin.
      * rewrite H8. simpl. constructor...
        { unfold equiv in *. destruct_hypos. split... }
        { apply WF_narrowing_env_subst... }
        { apply equiv_env_derives_general in Heqenv.
          apply GeneralEquivEnv.equiv_env_sym in Heqenv.
          apply (GeneralEquivEnv.equiv_env_WF Heqenv).
          add_nil. apply WF_narrowing_env with (S:=X).
          rewrite map_subst_tb_eq. get_well_form...
        }
      * simpl. constructor... apply subst_tb_wf with (Q:=bind_sub typ_top)...
        unfold equiv in *. get_well_form...

    + (* X notin *) simpl.
    assert (subst_tt X (typ_mu C) T0 = subst_tt X (typ_mu S) T0) as HS1.
    {
      rewrite <- subst_tt_fresh...
      rewrite <- subst_tt_fresh...
    }
    assert (subst_tt X (typ_mu D) T4 = subst_tt X (typ_mu S) T4) as HS2.
    {
      rewrite <- subst_tt_fresh...
      rewrite <- subst_tt_fresh...
    }
    rewrite HS1.
    rewrite HS2.
    assert (equiv E2 (typ_mu S) (typ_mu S)).
    {
      unfold equiv;split;apply Reflexivity;get_well_form;auto;
        destruct m;simpl in *...
    }
    apply sa_all_lb with (L:=L \u L0 \u L1 \u {{X}} \u dom E1 \u dom E2);intros...
    --
      apply equiv_sub_subst_not_var...
    --
      apply equiv_sub_subst_not_var...
    --
      assert (type (typ_mu D)).
      destruct m;simpl in *;get_type...
      assert (type (typ_mu C)).
      destruct m;simpl in *;get_type...
      rewrite subst_tt_open_tt_var...
      rewrite subst_tt_open_tt_var...
      rewrite_env  ( map (subst_tb X (typ_mu S)) (X0 ~ bind_sub_lb T4 ++ E1) ++ E2).
      apply H0 with (m:=m) (X:=X0)...
      * subst T1. rewrite subst_tt_open_tt_var... constructor.
        assert (WF E2 (typ_mu C)). { destruct m;get_well_form... }
        inversion H7;subst. pick_fresh Y.
        specialize_x_and_L Y L2. apply WF_replacing_var with (Y:=X) in H17...
        get_type...
      * subst T2. rewrite subst_tt_open_tt_var... constructor.
        assert (WF E2 (typ_mu D)). { destruct m;get_well_form... }
        inversion H9;subst. pick_fresh Y.
        specialize_x_and_L Y L2. apply WF_replacing_var with (Y:=X) in H17...
        get_type...
      * specialize_x_and_L X0 L0. rewrite app_assoc.
        add_nil. apply WF_narrowing_lb with (V := T0)...
      * specialize_x_and_L X0 L1. rewrite app_assoc.
        add_nil. apply WF_narrowing_lb with (V := T4)...
      * constructor...
      * simpl in Hx. solve_notin.
      * rewrite H8.
        assert (subst_tt X (typ_label X (open_tt D X)) T4 = subst_tt X (typ_label X (open_tt S X)) T4) as HS3.
        {
          rewrite <- subst_tt_fresh...
          rewrite <- subst_tt_fresh...
        }
        rewrite HS3. simpl. constructor...
         {  apply WF_narrowing_env_subst... }
        { apply equiv_env_derives_general in Heqenv.
          apply GeneralEquivEnv.equiv_env_sym in Heqenv.
          apply (GeneralEquivEnv.equiv_env_WF Heqenv).
          add_nil. apply WF_narrowing_env with (S:=X).
          rewrite map_subst_tb_eq. get_well_form...
        }
      * simpl. constructor... apply subst_tb_wf with (Q:=bind_sub typ_top)...
        unfold equiv in *. get_well_form...

  -
    dependent destruction Hwf1;try solve [inversion x0
    |simpl in *;destruct (X0==X);inversion x0]...
    dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
    simpl in x0. inversion x0.
    simpl in x. inversion x.
    simpl in Hx. simpl.
    apply sa_rec with (L:=L \u L0 \u L1 \u {{X}} \u dom E1 \u dom E2);intros...
    { rewrite subst_tt_open_tt_var... 2:{ destruct m;get_type... }
      apply WF_narrowing_env with (S:=typ_mu C)...
      rewrite_env (map (subst_tb X (typ_mu C)) (X0 ~ bind_sub typ_top ++ E1) ++ E2).
      apply subst_tb_wf with (Q:=bind_sub typ_top)... rewrite app_assoc...
      destruct m;get_well_form... }
    { rewrite subst_tt_open_tt_var... 2:{ destruct m;get_type... }
      apply WF_narrowing_env with (S:=typ_mu D)...
      rewrite_env (map (subst_tb X (typ_mu D)) (X0 ~ bind_sub typ_top ++ E1) ++ E2).
      apply subst_tb_wf with (Q:=bind_sub typ_top)... rewrite app_assoc...
      destruct m;get_well_form... }

    rewrite_env (map (subst_tb X (typ_mu S)) (X0 ~ bind_sub typ_top ++ E1) ++ E2).
    rewrite <- subst_tt_open_tt_twice... 2:{ destruct m;get_type... }
    rewrite <- subst_tt_open_tt_twice... 2:{ destruct m;get_type... }
    apply H2 with (m:=m) (X:=X0)...
    + assert (type (typ_label X (open_tt C X))).
      { constructor.
        assert (WF E2 (typ_mu C)). { destruct m;get_well_form... }
        inversion H12;subst. pick_fresh Y.
        specialize_x_and_L Y L2. apply WF_replacing_var with (Y:=X) in H14...
        get_type...
      }
      subst A1. rewrite subst_tt_open_tt...
      f_equal. simpl. rewrite subst_tt_open_tt_var...
    + assert (type (typ_label X (open_tt D X))).
      { constructor.
        assert (WF E2 (typ_mu D)). { destruct m;get_well_form... }
        inversion H12;subst. pick_fresh Y.
        specialize_x_and_L Y L2. apply WF_replacing_var with (Y:=X) in H14...
        get_type...
      }
      subst A2. rewrite subst_tt_open_tt...
      f_equal. simpl. rewrite subst_tt_open_tt_var...
    + rewrite app_assoc...
    + rewrite app_assoc...
    + rewrite app_assoc...
    + simpl. solve_notin...
    + simpl. rewrite_env ((X0 ~ bind_sub (subst_tt X (typ_label X (open_tt S X)) typ_top) ++ E)).
      rewrite_env ((X0,  bind_sub (subst_tt X (typ_label X (open_tt S X)) typ_top))
      :: map (subst_tb X (typ_label X (open_tt S X))) E1 ++
         (X, bind_sub typ_top) :: E2).
      constructor... { destruct m;get_well_form;apply equiv_reflexivity... }
    + apply wf_env_map_free2 with (B:=bind_sub typ_top)...
      { rewrite app_assoc... }
      { destruct m;get_well_form... }
  (* Label X0. T1 <: Label X0. T2  *)
  -
    dependent destruction Hwf1;try solve [inversion x0
    |simpl in *;destruct (X1==X);inversion x0]...
    2:{ (* can't be lower bound variable *)
        simpl in x0. destruct (X1 == X);inversion x0;subst.
        apply binds_mid_eq in H. inversion H. apply uniq_from_wf_env... }
    (* A is a label *)
    + inversion x0;subst. destruct (X1 == X);inversion H3;subst.
      dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
      2:{ (* can't be lower bound variable *)
        simpl in x. destruct (X0 == X);inversion x;subst.
        apply binds_mid_eq in H0. inversion H0. apply uniq_from_wf_env... }
      (* B is a label *)
      * simpl in x. destruct (X0 == X);inversion x;subst.
        simpl. rewrite eq_dec_refl.
        destruct m. { add_nil.  apply Sub_weakening... apply sub_transitivity with (Q:=typ_mu S)... }
        assert (sub E2 (typ_mu D) (typ_mu C)) as Hs. { apply sub_transitivity with (Q:=typ_mu S)... }
        inversion Hs;subst.
        (* need to prove one time unfolding of mu x. C  is equiv to that of mu x. D *)
        apply sa_rec with (L:=L \u fv_tt C \u fv_tt D \u {{X}} \u fl_tt C \u fl_tt D \u dom E1 \u dom E2 \u fl_env E2);intros...
        { apply WF_weakening. pick_fresh Y. specialize_x_and_L Y L.
          apply WF_replacing_var with (X:=Y)... }
        { apply WF_weakening. pick_fresh Y. specialize_x_and_L Y L.
          apply WF_replacing_var with (X:=Y)... }
        rename X0 into Y.
        specialize_x_and_L Y L.
        rewrite_alist (nil ++ [(Y, bind_sub typ_top)] ++ E2) in H9.
        apply sub_nominal_inversion in H9...
        assert (sub ([(Y, bind_sub typ_top)] ++ E2) (open_tt C Y) (open_tt D Y)).
        {
          rewrite subst_tt_intro with (X:=X)...
          remember ((subst_tt X Y (open_tt C X))).
          rewrite subst_tt_intro with (X:=X)...
          subst.
          rewrite_env (map (subst_tb X Y) nil ++ [(Y, bind_sub typ_top)] ++ E2).
          apply sub_replacing...
          2:{ constructor... get_well_form... }
          apply equiv_env_derives_general in Heqenv.
          apply (GeneralEquivEnv.equiv_env_sub Heqenv) in Hsub.
          apply sub_strengthening_env in Hsub...
          { constructor... get_well_form... }
          { apply WF_replacing_var with (X:=Y)... }
          { apply WF_replacing_var with (X:=Y)... }
        }
        rewrite subst_tt_intro with (X:=Y)...
        remember (subst_tt Y (typ_label Y (open_tt C Y)) (open_tt C Y)).
        rewrite subst_tt_intro with (X:=Y)...
        subst. apply Sub_weakening...
        rewrite_env (map (subst_tb Y (typ_label Y (open_tt C Y))) nil ++ [(Y, bind_sub typ_top)] ++ E2).
        apply equiv_sub_subst...
        { split; constructor... }
        { apply equiv_reflexivity... get_well_form... }
        { split; constructor... }
      * (* B is label type *)
        simpl in x. inversion x. subst. simpl in Hx. exfalso...
        assert (X0 \notin {{X0}})...

    (* A is label type *)
    + inversion x0;subst.
      dependent destruction Hwf2;try solve [inversion x
        |simpl in *;destruct (X0==X);inversion x]...
    { (* B can't be label *)
      simpl in x. destruct (X0 == X);inversion x;subst.
      simpl in Hx. exfalso.
      assert (X `notin` {{X}})...
    }
    { (* B can't be lower bound variable *)
      simpl in x. destruct (X0 == X);inversion x;subst.
      apply binds_mid_eq in H. inversion H.
      apply uniq_from_wf_env... }
    simpl in x, x0. inversion x;subst.
    simpl. constructor. simpl in Hx.
    apply IHHsub with (m:=m)...
Qed.

Lemma unfolding_lemma: forall E A B,
    sub E (typ_mu A) (typ_mu B) ->
    sub E (open_tt A (typ_mu A)) (open_tt B (typ_mu B)).
Proof with auto.
  intros.
  assert (Ht:=H).
  dependent destruction H.
  pick fresh X.
  rewrite subst_tt_intro with (X:=X)...
  remember (subst_tt X (typ_mu A) (open_tt A X)) .
  rewrite subst_tt_intro with (X:=X)...
  subst.
  rewrite_env (map (subst_tb X (typ_mu B)) nil ++ E).
  apply sub_generalize_intensive with (m:=Pos) (G:=map (subst_tb X (typ_label X (open_tt B X))) empty ++ X ~ bind_sub typ_top ++ E)...
  -
    specialize_x_and_L X L...
  -
    specialize_x_and_L X L...
  -
    rewrite !fl_tt_open_tt. solve_notin.
  -
    specialize_x_and_L X L...
    rewrite <- subst_tt_intro...
    rewrite <- subst_tt_intro...
  -
    get_well_form.
    apply Reflexivity...
  -
    simpl. get_well_form. constructor...
Qed.


Require Import  VST.floyd.proofauto
 Core.Core Core.Notations Core.Notations Types.
Require Import ExtLib.Structures.Monad.
Require Import Exec.Der_write_TL_m.

Inductive DWT_Error := .

Require Import VST.floyd.sublist.

Fixpoint der_write_tags_loop1 ts sl (ls : list Z) :=
  match ts with
    | [] => ret (ls, encode sl)
    | h :: tl => '(l, encode y) <- der_write_tags_loop1 tl sl ls ;;
                '(encode x) <- der_write_TL_m (Int.repr h) (Int.repr y) 0 0%int;;
                ret (y :: l, encode (x + y))
  end.

Fixpoint der_write_tags_loop2 (ts : list Z) (ls : list int)
         (i : Z) (size : Z) (last_tag_form : Z)  :=
  match ts, ls with
  | t :: tl, l :: ls =>
    let c := if (negb (last_tag_form =? 0) || (i <? (len ts - 1)))%bool
             then Int.one
             else Int.zero in
     '(encode z1) <- der_write_TL_m (Int.repr t) l size c ;;
     '(encode z2) <- der_write_tags_loop2 tl ls (i - 1) size last_tag_form ;;
     ret (encode (z1 + z2))
  | _, _ => ret (encode 0)
  end.

Definition der_write_tags (td : TYPE_descriptor)
           (struct_len : Z) (tag_mode : Z)
           (last_tag_form : Z) (tag : Z)
           (size : Z) : errW1 asn_enc_rval :=

  let ts := tags td in
  let l := len ts in

  if 4 <? l + 1
  then raise (CustomError DWT_Error)
  else if (if tag_mode =? 0
           then l + 1
           else l) =? 0
       then ret (encode 0)
       else
         '(ls, z) <- der_write_tags_loop1 ts struct_len [] ;;
          _ <- der_write_tags_loop2 ts (map Int.repr ls) l size last_tag_form ;;
          ret (encode (encoded z - struct_len)).