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

(* 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 chain_property: forall E A B (X Y:atom),
  binds X (bind_sub A) E ->
  binds Y (bind_sub_lb B) E ->
  sub E X Y ->
  (sub E X B -> sub E A Y \/ X = Y).
   (* /\ *)
  (* (sub E A Y -> sub E X B \/ X = Y). *)
Proof with auto.
  (* intros E. intros.
  generalize dependent A.
  generalize dependent B.
  dependent induction H1...
  - intros. clear IHsub.
    assert (A = U) by admit. subst...
  - intros. clear IHsub.
    assert (B = U) by admit. subst...
  admit. *)

  induction E.
  - admit.
  - intros. dependent destruction H1.
    + right...
    + assert (A=U) by admit. subst.

    (* Search sub fv_tt. *)
      left...
    + assert (B=U) by admit. subst.
      inversion H0;subst.
      * analyze_binds H.
        dependent destruction H2.
        { left. apply sa_trans_tvar_lb with (U:=X)...

        }

        admit.
      * inversion H;subst.
        { analyze_binds H1. admit. }
        { assert (sub E X U).
          { add_nil.   destruct a.
            apply sub_strengthening with (X:=a) (U:=b)...
            { get_well_form. assert (wf_env E) by (inversion H2;subst;auto).
              apply WF_from_binds_typ_lb in H4...
              apply WF_imply_dom in H4.
              assert (a <> X). { apply uniq_from_wf_env in H2.
                inversion H2;subst. apply binds_In in H5.
                intros C. subst. exfalso... }
              inversion H3;solve_notin...
            }
            { get_well_form. inversion H2... }
          }
          destruct IHE with (A:=A) (B:=U) (X:=X) (Y:=Y)...
          { apply sa_trans_tvar_lb with (U:=U)... }
          * left. rewrite_env (nil ++[ a ] ++ E).
            apply Sub_weakening... get_well_form...
        }

  generalize dependent A.
  generalize dependent B.
  dependent induction H1;intros...
  - admit.
  - specialize (IHsub )

  intros E. *)

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]...
    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.

(* Lemma sub_narrowing_env: forall E1 X E2 C D A B,
  sub (map (subst_tb X C) E1 ++ X ~ bind_sub typ_top ++ E2) A B ->
  equiv E2 C D ->
  sub (map (subst_tb X D) E1 ++ X ~ bind_sub typ_top ++ E2) A B .
Proof with auto.
  intros. dependent induction H...
  +
    constructor. admit.
  +
    constructor.
    admit.
    inversion H0;subst.
    admit.
    admit.
  +
    constructor.
    admit. admit.
  +
    analyze_binds_uniq H.
    { apply uniq_from_wf_env. get_well_form... }
    * destruct (binds_subst_extensial_no_subst _ _ _ _ _ BindsTac).
      eapply sa_trans_tvar with (U:=subst_tt X D x).
      { admit. }
      { apply IHsub. with (C0:=C)... }

    (* eapply WF_var. apply H4. *)
    admit
    Search wf_env. get_well_form...

  intros E1. induction E1;intros.
  - apply H.
  - destruct a as [Y b]. simpl. *)

(* Check equiv_sub_subst_not_var. *)

Lemma wf_env_subst_map: forall E1 E2 X S T,
  wf_env (map (subst_tb X S) E1 ++ E2) ->
  WF E2 T ->
  wf_env (map (subst_tb X T) E1 ++ E2).
Admitted.

Lemma fl_env_not_int_subst_tb:
  forall E1 E2 X D,
  X \notin fl_env E1 \u fl_env E2 \u fl_tt D ->
  X \notin fl_env (map (subst_tb X D) E1 ++ E2).
Proof with auto.
  intros.
  induction E1;intros...
Admitted.

Print wf_env.

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)...
  -
    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_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.
(*

Lemma equiv_sub_subst_map: forall (A B : typ) (X : atom)
(E E1 E2 : list (atom * binding)) ( D S : typ),
    X \notin 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 D \u fl_tt S ->
  sub (E ++ map (subst_tb X D) E1 ++ E2) A B ->
  equiv E2 S D ->
  sub (E ++ map (subst_tb X S) E1 ++ E2) A B.
Proof with auto.
  intros.
  dependent induction H0...
  - admit.
  - admit.
  - admit.
  -
    apply sa_trans_tvar with (U:=U).
    2:{
        apply IHsub with (D0:=D)... solve_notin. admit.
    }

Lemma equiv_sub_subst_map: forall (A B : typ) (X : atom)
(E1 E2 : list (atom * binding)) (C D S : typ),
    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 D) E1 ++ E2) (subst_tt X C A) (subst_tt X D B)->
  equiv E2 C D ->
  equiv E2 C S ->
  equiv E2 S D ->
  sub (map (subst_tb X S) E1 ++ E2) (subst_tt X C A) (subst_tt X D B).

Lemma equiv_sub_subst_map: forall (A B : typ) (X : atom)
(E1 E2 : list (atom * binding)) (C D S : typ),
    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 D) E1 ++ E2) (subst_tt X C A) (subst_tt X D B)->
  equiv E2 C D ->
  equiv E2 C S ->
  equiv E2 S D ->
  sub (map (subst_tb X S) E1 ++ E2) (subst_tt X C A) (subst_tt X D B).
Proof with auto.
  intros. unfold equiv in *. destruct_hypos.
  assert (Hwfe: wf_env (map (subst_tb X S) E1 ++ E2)).
  { get_well_form.
    apply wf_env_subst_map with (S:=D)...
  }
  dependent induction H0.
  - rewrite <- x0. rewrite <- x. constructor...
  - rewrite <- x0. rewrite <- x.
    get_well_form.
    constructor...
    admit.
  - rewrite <- x. constructor...
    admit.
  -
    (* X0 <: U <: B [->D] *)
    destruct A;inversion x. simpl in *.
    destruct (a == X);inversion H9.
    + subst.
      apply sa_trans_tvar with (U:=subst_tt X C U)...
      *  admit.
      * apply IHsub...
        { solve_notin. apply notin_fl_env with (Y:=X) in H1...
          apply fl_env_not_int_subst_tb... }
        { rewrite <- subst_tt_fresh... get_well_form.
          apply WF_imply_dom in H20...
          rewrite dom_app in H20. rewrite dom_map in H20.
          intros c. apply H20 in c. admit. }
 *)

(*

     }
  constructor...
    admit.

  unfold equiv in *. destruct_hypos.
  generalize dependent C.
  generalize dependent D.
  generalize dependent S.
  revert A B X E2.
  induction E1;intros...
  destruct a as [X0 b].
  Search sub.

  induction A;intros.
  -
    simpl in H. dependent destruction H.
    + dependent destruction B;try solve [inversion x].
      * constructor... get_well_form. eapply wf_env_subst_map; eassumption.
      * simpl in *. destruct (a == X);inversion x.
        constructor... get_well_form. eapply wf_env_subst_map; eassumption.
    + dependent destruction B;try solve [inversion x].

Check subst_reverse_equiv.

      }

  induction B;intros;try solve
    [constructor;get_well_form;eapply wf_env_subst_map;eassumption
    ]...
  { constructor.

  get_well_form...

  }

  ...
  - induction A;try solve [inversion x0
      |simpl in *;destruct (a==X);inversion x0]...
      2:{ simpl in *. destruct (a == X);inversion x0.
      2:{ inversion x0. } inversion x0. }
    dependent destruction Hwf2;try solve [inversion x
      |simpl in *;destruct (X0==X);inversion x]...
 *)

Check sub_narrowing.

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  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 Hwf1 Hwf2 Hx Hsub H1 H2.
  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_env 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_env in Heqenv... } *)
      constructor.
      inversion H3;subst.
      pick_fresh Y. add_nil.
      apply WF_replacing_var with (X:=Y)...
  }
  generalize dependent m.
  (* 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)...
        admit.
      * simpl in *. destruct (X0 == X);inversion x;subst...
        pose proof binds_ub_lb_invalid _ _ _ H2 H1.
        destruct H5... apply uniq_from_wf_env.
        admit.
    + 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.
        admit.
      * simpl in *. destruct (X0 == X);inversion x;subst...
        apply sa_fvar... apply WF_var_lb with (U:=subst_tt X (typ_mu S) U)...
        admit.
  -
    (* 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... admit.
  -
    (* 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.
      (* contradiction lb/ub*)
      admit.
    }
    simpl in x. destruct (X1 == X);try solve [inversion x].
    inversion x;subst. simpl.
    destruct (X1 ==X);try contradiction.
    (* pose proof equiv_env_binds. _ _ Heqenv. H0. *)
    (* assert (exists E1' E2',
    E = (map (subst_tb X (typ_label X (open_tt S X))) E1' ++
    X ~ bind_sub typ_top ++ E2')
    ) by admit.
    destruct H3 as [E']. destruct_hypos. subst. *)
    (* apply equiv_env_sub with (E1:= E')... { } *)
    apply sa_trans_tvar with (U:= subst_tt X (typ_mu S) U0)...
    +
      apply binds_map_free_sub with (Q:=typ_top)...
      (* wf_env *) admit.
    +

      apply IHHsub with (m:=m)...
      *
      (* pose proof equiv_env_binds _ _ Heqenv H.
        destruct_hypos.
        apply binds_map_free_env with (S:=typ_label X (open_tt S X)) in H0...
        2:{ admit. }
        pose proof binds_unique _ _ _ _ _ H3 H0.
        assert (uniq
        (map (subst_tb X (typ_label X (open_tt S X))) E1 ++
         X ~ bind_sub typ_top ++ E2)) by admit.
         apply H5 in H6. inversion H6... *)
         admit.
      *
        solve_notin. (* X notin fl_tt U0, can workaround? *)
        admit.
      *
        apply binds_map_free_sub with (S:=(typ_label X (open_tt S X))) in H0... 2:{ admit. }
        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))...
        assert (wf_env (map (subst_tb X (typ_label X (open_tt S X))) E1 ++
        X ~ bind_sub typ_top ++ E2)). { admit. }
        pose proof binds_uniq _ _ _ H4 H H3...
      * get_well_form. apply Reflexivity...
        destruct m...
  -
    (* [X |-> <X, C>] A <: U <: X  *)
    (* eapply equiv_env_sub. apply Heqenv.
    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;subst.
      (* contradiction lb/ub*)
      admit.
    }
    simpl in x. destruct (X1 == X);try solve [inversion x].
    inversion x;subst. simpl.
    destruct (X1 ==X);try contradiction.
    apply sa_trans_tvar_lb with (U:= subst_tt X (typ_mu S) U0)...
    +
      apply binds_map_free_sub2 with (Q:=typ_top)...
      admit. (* wf_env easy *)
    +
      apply IHHsub with (m:=m)(S0:=S) (E3:=E2) (E4:=E1)...
      * apply WF_from_binds_typ_lb with (x:=X1)...
        admit. (* wf_env *)
      * apply binds_map_free_env_lb with (S:=typ_label X (open_tt S X)) in H0...
        2:{ (* wf_env *) admit. }
        pose proof binds_unique _ _ _ _ _ H H0.
        assert (uniq
        (map (subst_tb X (typ_label X (open_tt S X))) E1 ++
        X ~ bind_sub typ_top ++ E2)) by admit.
        apply H3 in H4. inversion H4...
      * solve_notin. (* X notin fl_tt U0, can workaround? *)
      admit.
      * apply equiv_env_refl...
      * get_well_form. apply Reflexivity...
        destruct m... *)
    admit.
  -
    (* 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)(S0:=S) (E3:=E2) (E4:=E1)...
      * solve_notin. admit. admit.
      (* * apply equiv_env_refl... *)
      * destruct m;simpl in *...
      * destruct m;simpl in *...
    +
      apply IHHsub2 with (m:=m)(S0:=S) (E3:=E2) (E4:=E1)...
      * solve_notin. admit. admit.
      (* * 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.
    assert (type4rec T0) by admit.
    assert (type4rec T4) by admit.
    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... admit. }
      replace T4 with (subst_label X S2).
      2:{ rewrite H8. rewrite drop_label_reverse_type... admit. }
      split.
      + apply open_twice_to_one...
      + apply open_twice_to_one...
    }
    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...
    { solve_notin. admit. admit. }
    { rewrite <- H6. rewrite <- H8. unfold equiv... }
    { split... }
    { admit. }
    { admit. }
    { admit. }
    { admit. }
    + (* 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)...
      }

    (* eapply sub_transitivity with (Q:= subst_tt X (typ_mu S) (typ_all T4 T5)).
    2:{
      apply equiv_sub_subst_not_var...
      apply Reflexivity... admit.
      get_well_form...
      unfold equiv in *. destruct_hypos.
      get_well_form. apply equiv_reflexivity...
    }  *)
    simpl.
    apply sa_all with (L:=L \u L0 \u L1 \u {{X}});intros...
    --
      apply equiv_sub_subst_not_var...
      (* apply equiv_reflexivity;unfold equiv in *;destruct_hypos;
      get_well_form;try split...  *)
    --
      apply equiv_sub_subst_not_var;
      unfold equiv in *;destruct_hypos;try split...
      (* apply Reflexivity;unfold equiv in *;destruct_hypos;
      get_well_form;try split...
      apply Reflexivity;unfold equiv in *;destruct_hypos;
      get_well_form;try split... *)
    --
    (* Check su?b_narrowing. *)
    add_nil.
    apply sub_narrowing with (Q:= subst_tt X (typ_mu S) T4).
      {
        (* apply equiv_sub_subst_not_var... *)
      admit.

      }

      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.
    (* specialize (@H0 S X S C (open_tt T5 X0) (open_tt T3 X0) E2
      ((X0 ~ bind_sub T4) ++ E1)
    ). *)

    (* apply sub_transitivity with (Q:=subst_tt X (typ_mu S) (open_tt T5 X0)).
    2:{ apply equiv_sub_subst_not_var... apply Reflexivity. admit. admit. apply equiv_reflexivity. admit. admit. } *)

    apply H0 with (m:=m)...
    4:{  }

      (* apply H0 with (m:=m) (X1:=X0)(S0:=D)(E3:=E2)(E4:=(X0 ~ bind_sub T4) ++ E1) ... *)
      * 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)...
      * solve_notin. admit. admit. admit.
      (* TODO: need equivalent context! *)
      * rewrite H8. simpl. rewrite subst_tt_open_tt...
        simpl. destruct (X0 == X)... subst. exfalso. apply H15...
        admit.
      * rewrite H7. rewrite subst_tt_open_tt...
        simpl. destruct (X0 == X)... subst. exfalso. apply H15...
        admit.
      * rewrite H9. rewrite subst_tt_open_tt...
        simpl. destruct (X0 == X)... subst. exfalso. apply H15...
        admit.
      * admit.
        * admit.
        (* * solve_notin. admit. *)

    + (* 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}});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) (X0:=X0)...
      * 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)...
      * simpl. rewrite H8.
        rewrite <- !subst_tt_fresh with (T:=T4)...
      * rewrite H7. rewrite subst_tt_open_tt...
        simpl. destruct (X0 == X)... subst. exfalso. apply H13...
        admit.
      * rewrite H9. rewrite subst_tt_open_tt...
        simpl. destruct (X0 == X)... subst. exfalso. apply H13...
        admit.
      * admit.
      * admit.

  -
  (* ALL X0 :> S1. T1 <: ALL X0 :> S2. T2  *)
    admit.

  -
  (* Rec X0. T1 <: Rec X0. T2  *)
    admit.

  -
  (* Label X0. T1 <: Label X0. T2  *)
  admit.

Admitted. *)

Lemma sub_generalize_intensive : forall E1 E2 A B C D X m S,
    sub (E1 ++ X ~ bind_sub typ_top ++ E2) A 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).
Proof with auto.
  intros.
  generalize dependent m.
  generalize dependent C.
  generalize dependent D.
  generalize dependent S.
  dependent induction H;intros...
  -
    simpl.
    constructor...
    apply subst_tt_wf_env_label_rec...
    get_well_form...
    destruct m;simpl in *;get_well_form...
  -
    simpl in *.
    destruct (X0==X);subst...
    +
      assert (wf_env (empty ++ map (subst_tb X (typ_mu S)) E1 ++ E2)).
      apply subst_tt_wf_env_label_rec...
      get_well_form...
      destruct m;simpl in *;get_well_form...
      rewrite_env (nil ++ map (subst_tb X (typ_mu S)) E1 ++ E2).
      apply Sub_weakening...
      destruct m;simpl in *...
      *
        apply sub_transitivity with (Q:=typ_mu S)...
      *
        assert (sub E2 (typ_mu D) (typ_mu C)).
        {
          apply sub_transitivity with (Q:=typ_mu S)...
        }
        dependent destruction H6.
        dependent destruction H2.
        apply sub_strengthening_env in H2...
        --
          pick fresh Y.
          apply equiv_sub_unfolding with (Y:=Y)...
          apply sub_replacing_var with (X:=X)...
          constructor...
          get_well_form...
          specialize_x_and_L Y L.
          apply sub_nominal_inversion in H8...
        --
          constructor...
          get_well_form...
        --
          pick fresh Y.
          apply WF_replacing_var with (X:=Y)...
        --
          pick fresh Y.
          apply WF_replacing_var with (X:=Y)...
    +
      constructor...
      apply subst_tt_wf_env_label_rec...
      get_well_form...
      destruct m;simpl in *;get_well_form...
      assert (typ_fvar X0 = subst_tt X (typ_mu S) (typ_fvar X0)).
      simpl...
      destruct (X0==X);subst...
      destruct n...
      rewrite H5.
      apply subst_tb_wf with (Q:=bind_sub typ_top)...
      destruct m;simpl in *;get_well_form...
  -
    simpl.
    constructor...
    apply subst_tt_wf_env_label_rec...
    get_well_form...
    destruct m;simpl in *;get_well_form...
    rewrite_env (nil ++ map (subst_tb X (typ_mu S)) E1 ++ E2).
    apply  WF_narrowing_env with (S:=typ_mu C).
    apply subst_tb_wf with (Q:=bind_sub typ_top)...
    destruct m;simpl in *;get_well_form...
  -
    simpl in *.
    destruct (X0==X);subst...
    +
      analyze_binds_uniq H.
      apply uniq_from_wf_env...
      get_well_form...
      inversion BindsTacVal;subst.
      dependent destruction H0.
      * (* top *)
        simpl...
        constructor...
        apply subst_tt_wf_env_label_rec...
        get_well_form...
        destruct m;simpl in *;get_well_form...
        rewrite_env (nil ++ map (subst_tb X (typ_mu S)) E1 ++ E2).
        apply  WF_narrowing_env with (S:=typ_mu C).
        apply WF_weakening...
        destruct m;simpl in *;get_well_form...
      * (* top + lbvar *)
        simpl... destruct (X0 == X). { subst. apply binds_mid_eq in H... inversion H. }
        eapply sa_trans_tvar_lb with (U:=subst_tt X (typ_mu S) U)...
        { apply binds_map_free_sub2 with (S:=(typ_mu S)) in H...
          get_well_form... }
        eapply sub_transitivity with (Q:=subst_tt X (typ_mu S) typ_top).
        { constructor...
          apply subst_tt_wf_env_label_rec...
          get_well_form...
          destruct m;simpl in *;get_well_form...
          rewrite_env (nil ++ map (subst_tb X (typ_mu S)) E1 ++ E2).
          apply  WF_narrowing_env with (S:=typ_mu C).
          apply WF_weakening...
          destruct m;simpl in *;get_well_form... }
        { apply sub_through_subst_tt with (Q:=typ_top)...
          constructor;get_well_form... destruct m... }
    +
      destruct ( EqDec_eq T  (typ_fvar X0)).
      *
        induction T;try solve [inversion e].
        rewrite e in *.
        simpl...
        destruct (X0==X);subst...
        destruct n...
        constructor...
        apply subst_tt_wf_env_label_rec...
        get_well_form...
        destruct m;simpl in *;get_well_form...
        apply WF_var with (U:=subst_tt X (typ_mu S) U)...
        apply binds_map_free_env2...
        get_well_form...
      *
        apply sub_tvar_trans_var' with (A:=subst_tt X (typ_label X (open_tt S X)) U) in H2...
        destruct H2.
        { induction T;simpl;try solve [inversion H2];simpl in H2...
            destruct (a==X);subst... inversion H2. exfalso... }
             (* contradiction.
            intros v;inversion v. } *)

        2:{ apply binds_map_free_env...
            get_well_form... }

        destruct H2.
        -- (* normal case: A = X0 <: U <: T = B*)
          apply sa_trans_tvar with (U:=subst_tt X (typ_mu S) U)...
          ++
            apply binds_map_free_env2...
            get_well_form...
          ++
            apply IHsub with (m:=m)...
            **
              solve_notin.
              apply notin_fl_env with (X:=X0) (E:=E1 ++ (X, bind_sub typ_top) :: E2)...
              solve_notin.
            **
              destruct m;simpl in *;apply Reflexivity;get_well_form...
        -- (* lower bound case: A = X0 <: U <: T <: X1 = B *)
          destruct H2 as [Y [U']]. destruct_hypos.
          induction T;simpl;try solve [inversion H2]...
          simpl in H2.
          destruct (a==X);subst...
          { inversion H2. }
          inversion H2. subst a.

          inversion H0;subst.
          { admit.  }
          { admit. }
          {  }

          apply sa_trans_tvar with (U:=subst_tt X (typ_mu S) U)...
          ++
            apply binds_map_free_env2...
            get_well_form...
          ++
            replace (typ_fvar a) with (subst_tt X (typ_mu D) a).
            2:{ simpl. destruct (a==X)... contradiction.  }
            apply IHsub with (m:=m)...

              (* ---------- *)
        apply sa_trans_tvar with (U:=subst_tt X (typ_mu S) U)...
        +++
          apply binds_map_free_env2...
          get_well_form...
        +++
          apply IHsub...
        --
          apply IHsub with (m:=m)...
          ++
            solve_notin.
            apply notin_fl_env with (X:=X0) (E:=E1 ++ (X, bind_sub typ_top) :: E2)...
            solve_notin.
          ++
            apply sub_tvar_trans_var'' with (A:=subst_tt X (typ_label X (open_tt S X)) U) in H2...
            **
               destruct H2 as[H2|[H2|H2]]...
               *** admit.
               *** admit.
               (* destruct H2 as [Y [U' ]]... destruct_hypos.
               rewrite H2.

               Search X0.
               eapply sa_trans_tvar_lb with (U:=U')... *)

               (* Stuck here *)

            **
              apply binds_map_free_env...
              get_well_form...
            (* **
              induction T;simpl;try solve [intros v;inversion v]...
              destruct (a==X);subst...
              intros v;inversion v. *)
          ++
            destruct m;simpl in *;apply Reflexivity;get_well_form...
  -
    simpl in *.
    dependent destruction H2.
    constructor...
    +
      apply IHsub1 with (m:=flip m)...
      destruct m;simpl in *...
      destruct m;simpl in *...
    +
      apply IHsub2 with (m:=m)...
  -
    simpl in *.
    dependent destruction H4.
    assert (equiv (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)) S1) (subst_tt X (typ_label X (open_tt D X)) S2)) as HE.
    {
      unfold equiv...
    }
    assert (type4rec S1) as TS1.
    {
      get_type...
      apply type_to_rec in H19...
    }
    assert (type4rec S2) as TS2.
    {
      get_type...
      apply type_to_rec in H20...
    }
    apply subst_reverse_equiv  with (B:=S2) (X:=X) (C:=C) (D:=D) (E1:=E1) (E2:=E2) (S:=S) in TS1...
    +
      destruct TS1.
      *
        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)...
          }
        apply sa_all with (L:=L \u L0  \u {{X}});intros...
        --
          apply equiv_sub_subst_not_var...
        --
          apply equiv_sub_subst_not_var;unfold equiv in *;destruct_hypos;try split...
        --
          rewrite subst_tt_open_tt_var...
          rewrite subst_tt_open_tt_var...
          rewrite_env  (nil ++ X0 ~ bind_sub (subst_tt X (typ_mu D) S2) ++ map (subst_tb X (typ_mu S)) E1 ++ E2).
          apply sub_narrowing with (Q:=subst_tt X (typ_mu S) S2)...
          ++
            apply equiv_sub_subst_refl_no_var...
            get_well_form...
            get_well_form...
            unfold equiv in *;destruct_hypos;split;apply sub_transitivity with (Q:=typ_mu C)...
            unfold equiv in *;destruct_hypos;split;apply sub_transitivity with (Q:=typ_mu C)...
            unfold equiv in *;destruct_hypos;split;apply Reflexivity;get_well_form...
          ++
            rewrite_env (map (subst_tb X (typ_mu S)) (X0 ~ bind_sub S2 ++ E1) ++ E2).
            apply H2 with (m:=m)...
            solve_notin.
            rewrite <- subst_tt_open_tt_var...
            rewrite <- subst_tt_open_tt_var...
            rewrite_env (nil ++ X0 ~ bind_sub  (subst_tt X (typ_label X (open_tt S X)) S2) ++ map (subst_tb X (typ_label X (open_tt S X))) E1 ++
                             (X, bind_sub typ_top) :: E2).
            apply sub_narrowing with (Q:= subst_tt X (typ_label X (open_tt D X)) S2)...
            apply equiv_sub_subst_refl...
            **
              get_well_form...
            **
              get_well_form...
            **
              apply equiv_unfolding...
            **
              apply equiv_unfolding...
              apply equiv_reflexivity;get_well_form...
              destruct m;simpl in *...
            **
              apply equiv_unfolding...
            **
              apply H4...
            **
              unfold equiv in *;destruct_hypos;get_type...
            **
              unfold equiv in *;destruct_hypos;get_type...
          ++
            unfold equiv in *;get_well_form;destruct_hypos;get_type...
          ++
            unfold equiv in *;get_well_form;destruct_hypos;get_type...
      *
        assert (subst_tt X (typ_mu C) S1 = subst_tt X (typ_mu S) S1) as HS1.
        {
          rewrite <- subst_tt_fresh...
          rewrite <- subst_tt_fresh...
          }
        assert (subst_tt X (typ_mu D) S2 = subst_tt X (typ_mu S) S2) 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 {{X}});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 S2 ++ E1) ++ E2).
          apply H2 with (m:=m)...
          solve_notin.
          rewrite <- subst_tt_open_tt_var...
          rewrite <- subst_tt_open_tt_var...
          rewrite_env (X0 ~ bind_sub (subst_tt X (typ_label X (open_tt S X)) S2) ++
                          map (subst_tb X (typ_label X (open_tt S X))) E1 ++ (X, bind_sub typ_top) :: E2).
          assert (subst_tt X (typ_label X (open_tt S X)) S2 = subst_tt X (typ_label X (open_tt D X)) S2) as HS.
          {
            rewrite <- subst_tt_fresh...
            rewrite <- subst_tt_fresh...
          }
          rewrite HS...
          ++
            dependent destruction H10.
            constructor...
            pick fresh Y.
            rewrite subst_tt_intro with (X:=Y)...
            apply subst_tt_type...
          ++
            dependent destruction H11.
            constructor...
            pick fresh Y.
            rewrite subst_tt_intro with (X:=Y)...
            apply subst_tt_type...
    +
      unfold equiv;split...
    +
      assert (WF E2 (typ_mu C)).
      destruct m;simpl in *;get_well_form...
      dependent destruction H7...
      pick fresh Y.
      apply WF_replacing_var with (X:=Y)...
    +
      assert (WF E2 (typ_mu D)).
      destruct m;simpl in *;get_well_form...
      dependent destruction H7...
      pick fresh Y.
      apply WF_replacing_var with (X:=Y)...
    +
      assert (WF E2 (typ_mu S)).
      destruct m;simpl in *;get_well_form...
      dependent destruction H7...
      pick fresh Y.
      apply WF_replacing_var with (X:=Y)...
    +
      get_well_form...
  -
    simpl in *.
    dependent destruction H4.
    apply sa_rec with (L:=L \u L0 \u {{X}} \u fv_tt C \u fv_tt D   \u dom E1 \u dom E2);intros...
    +
      rewrite subst_tt_open_tt_var...
      rewrite_env (nil ++ map (subst_tb X (typ_mu S)) (X0~bind_sub typ_top ++ E1) ++ E2).
      apply WF_narrowing_env with (S:=typ_mu C)...
      apply subst_tb_wf with (Q:=bind_sub typ_top)...
      apply H...
      destruct m;simpl;get_well_form...
      destruct m;simpl;get_type...
    +
      rewrite subst_tt_open_tt_var...
      rewrite_env (nil ++ map (subst_tb X (typ_mu S)) (X0~bind_sub typ_top ++ E1) ++ E2).
      apply WF_narrowing_env with (S:=typ_mu D)...
      apply subst_tb_wf with (Q:=bind_sub typ_top)...
      apply H0...
      destruct m;simpl;get_well_form...
      destruct m;simpl;get_type...
    +
      assert (type (typ_mu C) /\ type (typ_mu D)).
      split;destruct m;simpl in *;get_type...
      destruct_hypos.
      rename X0 into Y.
      rewrite_env (map (subst_tb X (typ_mu S)) (Y~bind_sub typ_top ++ E1) ++ E2).
      rewrite <- mu_transform_0...
      rewrite <- mu_transform_0...
      apply H2 with (X1:=X) (X0:=Y) (m:=m)...
      *
        solve_notin.
      *
        rewrite <- mu_transform_1...
        rewrite <- mu_transform_1...
        apply H6...
        dependent destruction H11.
        pick fresh Z.
        rewrite subst_tt_intro with (X:=Z)...
        apply subst_tt_type...
        dependent destruction H10.
        pick fresh Z.
        rewrite subst_tt_intro with (X:=Z)...
        apply subst_tt_type...
  -
    simpl in *.
    dependent destruction H1.
    constructor...
    apply IHsub 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)...
  -
    specialize_x_and_L X L.
    apply sub_nominal_inversion in H1...
  -
    solve_notin.
  -
    simpl.
    rewrite <- subst_tt_intro...
    rewrite <- subst_tt_intro...
    apply H1...
  -
    get_well_form.
    apply Reflexivity...
Qed.