(*=====================================================
=======================================================
               TOPOLOGICAL FMAPS, HMAPS -

              WITH TAGS AND EMBEDDINGS

                      PART 7:

              expf, degreef /L0, /L1

                  (DIM 0 and DIM 1)

(* RATHER REDONDANT WITH J2C... *)
=======================================================
=====================================================*)

Require Export Del06.

(*=====================================================
              cA_I, cF_I, expf_I
=====================================================*)

Lemma cA_I:forall(m:fmap)(k:dim)(x z:dart)(u:tag)(p:point),
  inv_hmap m -> prec_I m x -> x <> z ->
    (cA (I m x u p) k z = cA m k z).
Proof.
simpl in |- *.
intros.
elim (eq_dart_dec x z).
 tauto.
 tauto.
Qed.

Lemma cA_1_I:
 forall(m:fmap)(k:dim)(x z:dart)(u:tag)(p:point),
  inv_hmap m -> prec_I m x -> x <> z ->
    (cA_1 (I m x u p) k z = cA_1 m k z).
Proof.
simpl in |- *.
intros.
elim (eq_dart_dec x z).
 tauto.
 tauto.
Qed.

Lemma cF_I:forall(m:fmap)(x z:dart)(u:tag)(p:point),
  inv_hmap m -> prec_I m x -> exd m z -> x <> z ->
    (cF (I m x u p) z = cF m z).
Proof.
unfold cF in |- *.
intros.
rewrite cA_1_I.
 rewrite cA_1_I.
  tauto.
  tauto.
  tauto.
  tauto.
 tauto.
 tauto.
 simpl in |- *.
   elim (eq_dart_dec x z).
  tauto.
  intro.
    intro.
    unfold prec_I in H0.
    generalize (exd_cA_1 m zero z).
    rewrite <- H3.
    tauto.
Qed.

Lemma Iter_cF_I:
 forall(m:fmap)(x z:dart)(u:tag)(p:point)(i:nat),
  inv_hmap m -> prec_I m x ->
   exd m z -> x <> z ->
    Iter (cF (I m x u p)) i z = Iter (cF m) i z.
Proof.
induction i.
 simpl in |- *.
   tauto.
 simpl in |- *.
   intros.
   rewrite IHi.
  rewrite cF_I.
   tauto.
   tauto.
   tauto.
   assert (MF.f = cF).
    tauto.
    rewrite <- H3.
      generalize (MF.exd_Iter_f m i z).
      tauto.
   intro.
     unfold prec_I in H0.
     rewrite H3 in H0.
  generalize (MF.exd_Iter_f m i z).
     tauto.
  tauto.
  tauto.
  tauto.
  tauto.
Qed.

(* OK!: *)

Lemma expf_I:
 forall(m:fmap)(x z t:dart)(u:tag)(p:point),
  inv_hmap m -> prec_I m x ->
   exd m z -> x <> z ->
    (expf (I m x u p) z t <-> expf m z t).
Proof.
intros.
unfold expf in |- *.
unfold MF.expo in |- *.
simpl in |- *.
assert (MF.f = cF).
 tauto.
 rewrite H3.
   split.
  intros.
    decompose [and] H4.
    clear H4.
    elim H9.
    intros i Eq.
    split.
   tauto.
   split.
    tauto.
    split with i.
      generalize (Iter_cF_I m x z u p i H7 H8 H1 H2).
      intro.
      rewrite <- H4.
      tauto.
  intros.
    decompose [and] H4.
    clear H4.
    split.
   tauto.
   split.
    tauto.
    elim H8.
      intros i Hi.
      split with i.
      rewrite Iter_cF_I.
     tauto.
     tauto.
     tauto.
     tauto.
     tauto.
Qed.

(*=====================================================
=======================================================
              expf_L0, degree_L0
======================================================
=====================================================*)

(* RECALL: NEW VERSION (IN J2B):
EQUIVALENT TO THE ANCIENT ONE:

Theorem expof_L0_CNS:
  forall(m:fmap)(X Y z t:dart)(H:inv_hmap m),
    prec_L m zero X Y -> exd m z ->
       let m1 := L m zero X Y in
       let Y_0_1 := cF m Y in
       let X0 := cA m zero X in
       let X_1 := cA_1 m one X in
 (expof m1 z t <->
   (if expof_dec m Y X_1 H
    then
      betweenf m X_1 z Y /\ betweenf m X_1 t Y \/
      betweenf m Y_0_1 z X0 /\ betweenf m Y_0_1 t X0 \/
      ~ expof m Y z /\ expof m z t
    else
      expof m z t \/
      expof m Y z /\ expof m X_1 t \/
      expof m Y t /\ expof m X_1 z)).
*)

(* ANCIENT VERSION: OK, WITH THE PREVIOUS RESULT: *)

Theorem expf_L0_CNS:forall (m:fmap)(x y z t:dart),
  inv_hmap (L m zero x y) -> exd m z ->
  (expf (L m zero x y) z t <->
   let x0 := cA m zero x in
   let x_1 := cA_1 m one x in
   let y_0:= cA_1 m zero y in
   let y_0_1 := cA_1 m one y_0 in
   (if expf_dec m x_1 y
    then betweenf m x_1 z y /\ betweenf m x_1 t y
      \/ betweenf m y_0_1 z x0 /\ betweenf m y_0_1 t x0
      \/ ~ expf m x_1 z /\ expf m z t
    else   expf m z t
      \/ expf m z y /\ expf m t x0
      \/ expf m t y /\ expf m z x0)).
Proof.
intros.
assert (prec_L m zero x y).
 simpl in H.
    tauto.
assert (inv_hmap m).
 simpl in H;  tauto.
generalize (expof_L0_CNS m x y z t H2 H1 H0).
  simpl in |- *.
  fold (cF m y) in |- *.
  set (x0 := cA m zero x) in |- *.
  set (x_1 := cA_1 m one x) in |- *.
  assert (x_1 = cF m x0).
 unfold x0 in |- *.
   unfold cF in |- *.
   rewrite cA_1_cA in |- *.
  fold x_1 in |- *.
     tauto.
  tauto.
 unfold prec_L in H1;  tauto.
assert (expof m x0 x_1).
 unfold expof in |- *.
   unfold MF.expo in |- *.
   split.
  unfold x0 in |- *.
    generalize (exd_cA m zero x).
    unfold prec_L in H1;  tauto.
 split with 1%nat.
   simpl in |- *.
   rewrite H3 in |- *.
    tauto.
elim (expof_dec m y x_1 H2).
 elim (expf_dec m x_1 y).
  intros.
    assert (~ expof m y z <-> ~ expf m x_1 z).
   split.
    intro.
      intro.
      apply H6.
      apply expof_trans with x_1.
      tauto.
    generalize (expf_expof m x_1 z).
       tauto.
   intro.
     intro.
     apply H6.
     apply expf_trans with y.
    apply expf_symm.
      generalize (expf_expof m y x_1).
       tauto.
   generalize (expf_expof m y z);  tauto.
  generalize (expf_expof m z t H2).
    intro.
    generalize (expf_expof (L m zero x y) z t H).
    intro.
     tauto.
 intros.
   elim b.
   apply expf_symm.
   generalize (expf_expof m y x_1 H2).
    tauto.
elim (expf_dec m x_1 y).
 intros.
   elim b.
   apply expof_symm.
   tauto.
 generalize (expf_expof m x_1 y H2).
    tauto.
intros.
  set
   (E1 :=
    expof m z t \/ expof m y z /\ expof m x_1 t \/
       expof m y t /\ expof m x_1 z)
   in |- *.
  set
   (E2 :=
    expf m z t \/ expf m z y /\ expf m t x0 \/
       expf m t y /\ expf m z x0)
   in |- *.
  fold E1 in H5.
  cut (E1 <-> E2).
 generalize (expf_expof (L m zero x y) z t H).
    tauto.
assert (expof m y z <-> expf m z y).
 split.
  intro.
    apply expf_symm.
    generalize (expf_expof m y z).
     tauto.
 intro.
   apply expof_symm.
   tauto.
 generalize (expf_expof m z y).
    tauto.
assert (expof m x_1 t <-> expof m t x0).
 split.
  intro.
    apply expof_trans with x_1.
   apply expof_symm.
     tauto.
    tauto.
  apply expof_symm.
    tauto.
   tauto.
 intro.
   apply expof_symm.
   tauto.
 apply expof_trans with x0.
   tauto.
  tauto.
assert (expof m x_1 t <-> expf m t x0).
 generalize (expf_expof m t x0).
    tauto.
clear H7.
  assert (expof m y t <-> expf m t y).
 generalize (expf_expof m t y).
   generalize (expof_symm m y t).
   generalize (expof_symm m t y).
    tauto.
assert (expof m x_1 z <-> expof m z x0).
 split.
  intro.
    apply expof_trans with x_1; apply expof_symm;  tauto.
 intro.
   apply expof_trans with x0.
  apply expof_symm.
    tauto.
   tauto.
 apply expof_symm.
   tauto.
  tauto.
assert (expof m x_1 z <-> expf m z x0).
 generalize (expf_expof m z x0).
    tauto.
clear H9.
  unfold E1 in |- *; unfold E2 in |- *.
  generalize (expf_expof m z t H2).
   tauto.
Qed.

(* COROLLARIES: *)

Theorem expf_L0_CS:forall (m:fmap)(x y z t:dart),
  inv_hmap (L m zero x y) -> exd m z ->
   let x0 := cA m zero x in
   let x_1 := cA_1 m one x in
   let y_0:= cA_1 m zero y in
   let y_0_1 := cA_1 m one y_0 in
   (if expf_dec m x_1 y
    then betweenf m x_1 z y /\ betweenf m x_1 t y
      \/ betweenf m y_0_1 z x0 /\ betweenf m y_0_1 t x0
      \/ ~ expf m x_1 z /\ expf m z t
    else   expf m z t
      \/ expf m z y /\ expf m t x0
      \/ expf m t y /\ expf m z x0)
   -> expf (L m zero x y) z t.
Proof.
intros.
generalize (expf_L0_CNS m x y z t H H0).
 tauto.
Qed.

Theorem expf_L0_CN:forall (m:fmap)(x y z t:dart),
  inv_hmap (L m zero x y) -> exd m z ->
   let x0 := cA m zero x in
   let x_1 := cA_1 m one x in
   let y_0:= cA_1 m zero y in
   let y_0_1 := cA_1 m one y_0 in
 expf (L m zero x y) z t ->
   (if expf_dec m x_1 y
    then betweenf m x_1 z y /\ betweenf m x_1 t y
      \/ betweenf m y_0_1 z x0 /\ betweenf m y_0_1 t x0
      \/ ~ expf m x_1 z /\ expf m z t
    else   expf m z t
      \/ expf m z y /\ expf m t x0
      \/ expf m t y /\ expf m z x0).
Proof.
intros.
generalize (expf_L0_CNS m x y z t H H0).
 tauto.
Qed.

(*====================================================
         CONSEQUENCES FOR PARTICULAR CASES:
=====================================================*)

(* WHAT ARE y, x0... AFTER L0: *)

Lemma y_L0:forall (m:fmap)(x y:dart),
  let m1 := L m zero x y in
  inv_hmap m1 -> y = cA m1 zero x.
Proof.
 simpl in |- *.
intros.
elim (eq_dart_dec x x).
 tauto.
 tauto.
Qed.

Lemma x0_L0:forall (m:fmap)(x y:dart),
  let m1 := L m zero x y in
  inv_hmap m1 ->
     cA m zero x = bottom m1 zero x.
Proof.
simpl in |- *.
intros.
elim (eq_dart_dec y (bottom m zero x)).
 intros.
   unfold prec_L in H.
   rewrite cA_eq.
  elim (succ_dec m zero x).
   tauto.
   tauto.
  tauto.
 unfold prec_L in H.
   intro.
   rewrite cA_eq.
  elim (succ_dec m zero x).
   tauto.
   tauto.
  tauto.
Qed.

Lemma x_1_L0:forall (m:fmap)(x y:dart),
  let m1 := L m zero x y in
  inv_hmap m1 ->
     cA_1 m one x = cA_1 m1 one x.
Proof.
simpl in |- *.
tauto.
Qed.

Lemma y_0_L0:forall (m:fmap)(x y:dart),
  let m1 := L m zero x y in
  inv_hmap m1 ->
     cA_1 m zero y = top m1 zero x.
Proof.
simpl in |- *.
unfold prec_L in |- *.
intros.
rewrite cA_1_top.
 elim (eq_dart_dec x (top m zero x)).
  tauto.
  intro.
    rewrite nosucc_top in b.
   tauto.
   tauto.
   tauto.
   tauto.
 tauto.
 tauto.
 tauto.
Qed.

Lemma y_0_1_L0:forall (m:fmap)(x y:dart),
  let m1 := L m zero x y in
  inv_hmap m1 ->
     cF m y = cA_1 m1 one (top m1 zero x).
Proof.
intros.
unfold cF in |- *.
unfold m1 in |- *.
rewrite <- y_0_L0.
 simpl in |- *.
   tauto.
 fold m1 in |- *.
   tauto.
Qed.

(* OK :*)

Lemma not_expf_expf_L0_CN: forall (m:fmap)(x y:dart),
  inv_hmap (L m zero x y) ->
   let x_1:= cA_1 m one x in
   let x0 := cA m zero x in
    ~expf m x_1 y ->
      expf (L m zero x y) y x0.
Proof.
intros.
assert (inv_hmap (L m zero x y)).
  tauto.
rename H1 into Inv.
  simpl in Inv.
  unfold prec_L in Inv.
  apply expf_L0_CS.
  tauto.
 tauto.
elim (expf_dec m (cA_1 m one x) y).
 fold x_1 in |- *.
    tauto.
fold x_1 in |- *.
  intros.
  right.
  left.
  split.
 apply expf_refl.
   tauto.
  tauto.
fold x0 in |- *.
  apply expf_refl.
  tauto.
unfold x0 in |- *.
  generalize (exd_cA m zero x).
   tauto.
Qed.

(* CONTRAVARIANT FORM AND NC: *)

Lemma expf_not_expf_L0_CV:forall (m:fmap)(x y:dart),
  inv_hmap (L m zero x y) ->
  let x_1:= cA_1 m one x in
  let x0 := cA m zero x in
     expf (L m zero x y) y x0 ->
        ~expf m x_1 y.
Proof.
intros.
assert (inv_hmap (L m zero x y)).
 tauto.
 rename H1 into Inv.
   simpl in Inv.
   unfold prec_L in Inv.
   decompose [and] Inv.
   clear Inv.
   generalize (expf_L0_CN m x y y x0 H H2 H0).
   simpl in |- *.
   fold x_1 in |- *.
   elim (expf_dec m x_1 y).
  intros.
    elim H6.
   clear H6.
     intros.
     decompose [and] H6.
     clear H6.
     generalize H9.
     clear H9.
     unfold betweenf in |- *.
     unfold MF.between in |- *.
     intros.
     elim H9.
    intros i Hi.
      clear H9.
      elim Hi.
      clear Hi.
      intros j Hj.
      decompose [and] Hj.
      clear Hj.
      set (p := MF.Iter_upb m x_1) in |- *.
      fold p in H12.
      assert (Iter (MF.f m) (p - 1) x_1 = x0).
     rewrite <- MF.Iter_f_f_1.
      unfold p in |- *.
        rewrite MF.Iter_upb_period.
       simpl in |- *.
         assert (MF.f_1 = cF_1).
        tauto.
        rewrite H11.
          unfold cF_1 in |- *.
          unfold x_1 in |- *.
          rewrite cA_cA_1.
         fold x0 in |- *.
           tauto.
         tauto.
         tauto.
       tauto.
       unfold x_1 in |- *.
         generalize (exd_cA_1 m one x).
         tauto.
      tauto.
      unfold x_1 in |- *.
        generalize (exd_cA_1 m one x).
        tauto.
      lia.
     assert (i = (p - 1)%nat).
      apply MF.unicity_mod_p with m x_1.
       tauto.
       unfold x_1 in |- *.
         generalize (exd_cA_1 m one x).
         tauto.
       fold p in |- *.
         lia.
       fold p in |- *.
         lia.
       rewrite H6.
         symmetry  in |- *.
         tauto.
      absurd (i = (p - 1)%nat).
       elim (eq_nat_dec i j).
        intro.
          rewrite a0 in H6.
          assert (x0 = y).
         rewrite <- H6.
           tauto.
         unfold x0 in H14.
           tauto.
        intro.
          lia.
       tauto.
    tauto.
    unfold x_1 in |- *.
      generalize (exd_cA_1 m one x).
      tauto.
   clear H6.
     intro.
     elim H6.
    clear H6.
      fold x0 in |- *.
      fold (cF m y) in |- *.
      intro.
      decompose [and] H6.
      clear H6.
      assert (exd m x0).
     unfold x0 in |- *.
       generalize (exd_cA m zero x).
       tauto.
     assert (exd m x_1).
      unfold x_1 in |- *.
        generalize (exd_cA_1 m one x).
        tauto.
      generalize H8.
        clear H8.
        unfold betweenf in |- *.
        unfold MF.between in |- *.
        intros.
        elim H8.
       intros i Hi.
         clear H8.
         elim Hi.
         clear Hi.
         intros j Hj.
         decompose [and] Hj.
         clear Hj.
         set (y_0_1 := cF m y) in |- *.
         fold y_0_1 in H8.
         fold y_0_1 in H12.
         set (p := MF.Iter_upb m (cF m y)) in |- *.
         fold p in H14.
         fold y_0_1 in p.
         assert (Iter (MF.f m) (p - 1) y_0_1 = y).
        rewrite <- MF.Iter_f_f_1.
         unfold p in |- *.
           rewrite MF.Iter_upb_period.
          simpl in |- *.
            assert (MF.f_1 = cF_1).
           tauto.
           rewrite H13.
             unfold cF_1 in |- *.
             unfold y_0_1 in |- *.
             unfold cF in |- *.
             rewrite cA_cA_1.
            rewrite cA_cA_1.
             tauto.
             tauto.
             tauto.
            tauto.
            generalize (exd_cA_1 m zero y).
              tauto.
          tauto.
          unfold y_0_1 in |- *.
            generalize (exd_cF m y).
            tauto.
         tauto.
         unfold y_0_1 in |- *.
           generalize (exd_cF m y).
           tauto.
         lia.
        assert (i = (p - 1)%nat).
         apply MF.unicity_mod_p with m y_0_1.
          tauto.
          unfold y_0_1 in |- *.
            generalize (exd_cF m y).
            tauto.
          fold p in |- *.
            lia.
          fold p in |- *.
            lia.
          rewrite H13.
            tauto.
         elim (eq_nat_dec i j).
          intro.
            rewrite a0 in H8.
            rewrite H12 in H8.
            unfold x0 in H8.
            tauto.
          intro.
            elim b.
            lia.
       tauto.
       generalize (exd_cF m y).
         tauto.
    clear H6.
      tauto.
  tauto.
Qed.

(* THEN, BY expf_dec: IMPORTANT RESULT *)

Theorem expf_not_expf_L0: forall (m:fmap)(x y:dart),
  inv_hmap (L m zero x y) ->
  let x_1:= cA_1 m one x in
  let x0 := cA m zero x in
   (expf m x_1 y <->
       ~expf (L m zero x y) y x0).
Proof.
intros.
generalize (expf_not_expf_L0_CV m x y H).
simpl in |- *.
fold x0 in |- *.
fold x_1 in |- *.
intros.
generalize (not_expf_expf_L0_CN m x y H).
simpl in |- *.
fold x0 in |- *.
fold x_1 in |- *.
intro.
generalize (expf_dec m x_1 y).
tauto.
Qed.

(*====================================================
                  degreef_L0
=====================================================*)

Open Scope nat_scope.

(* RECALL:
Definition degreef:=MF0Tr.MfM.degree.

Lemma degreef_0_1:
  MF0Tr.MfM.degree = MF1Tr.MfM.degree.
Proof. tauto. Qed.
*)

(* OK: *)

Theorem degreef_L0_merge:
  forall (m : fmap) (x y : dart),
    inv_hmap m -> exd m x -> exd m y ->
       let m1 := L m zero x y in
       let x_1:= cA_1 m one x in
   ~ expof m y x_1 ->
 degreef m1 x_1 = degreef m x_1 + degreef m y.
Proof.
intros.
set (X := y) in |- *.
set (Y := x_1) in |- *.
assert (x = cA m one Y).
 unfold Y in |- *.
   unfold x_1 in |- *.
   rewrite cA_cA_1 in |- *.
   tauto.
  tauto.
  tauto.
assert (m1 = L m zero (cA m one Y) X).
 rewrite <- H3 in |- *.
   unfold X in |- *.
    tauto.
unfold degreef in |- *.
  assert (m1 = ModcF0.Tr m X Y).
 unfold m1 in |- *.
    tauto.
rewrite H4 in |- *.
  rewrite <- H4 in |- *.
  rewrite H5 in |- *.
  apply MF0Tr.degree_Tr_merge_y.
 unfold ModcF0.Prec_Tr in |- *.
    tauto.
 tauto.
unfold X in |- *.
   tauto.
unfold Y in |- *.
  unfold x_1 in |- *.
  generalize (exd_cA_1 m one x).
   tauto.
unfold expof in H2.
   tauto.
Qed.

(* OK: *)

Lemma MF0Tr_cF_Iter: forall(m:fmap)(i:nat)(z:dart),
  Iter (MF0Tr.MfM.f m) i z = Iter (cF m) i z.
Proof.
induction i.
 simpl in |- *.
    tauto.
intros.
  simpl in |- *.
  rewrite IHi in |- *.
   tauto.
Qed.

(* SPLIT: OK: *)

Theorem degreef_L0_split
     : forall (m : fmap) (x y : dart) (j : nat),
       inv_hmap m ->
       exd m x ->
       exd m y ->
       let m1 := L m zero x y in
       let y1 := cF m y in
       let x_1:= cA_1 m one x in
       let dx_1 := degreef m x_1 in
       x_1 = Iter (cF m) j y ->
        2 <= j <= dx_1 ->
 degreef m1 x_1 + degreef m1 y1 = degreef m x_1.
Proof.
simpl in |- *.
intros.
unfold degreef in |- *.
set (X := y) in |- *.
set (Y := cA_1 m one x) in |- *.
assert (x = cA m one Y).
 unfold Y in |- *.
   rewrite cA_cA_1 in |- *.
   tauto.
  tauto.
  tauto.
rewrite H4 in |- *.
  assert (ModcF0.Tr m X Y = L m zero (cA m one Y) X).
  tauto.
rewrite <- H5 in |- *.
  apply (MF0Tr.degree_Tr_split m X Y j).
  tauto.
unfold X in |- *.
   tauto.
unfold Y in |- *.
  generalize (exd_cA_1 m one x).
   tauto.
unfold Y in |- *.
   tauto.
unfold ModcF0.Prec_Tr in |- *.
   tauto.
unfold Y in |- *.
   tauto.
Qed.

(*==================================================
====================================================
              degreef_L1, expf_L1
====================================================
===================================================*)

(* OK, USEFUL ?

Lemma cF_L1:forall(m:fmap)(x y z:dart),
  inv_hmap m -> prec_L m one x y ->
   let x10 := cF_1 m x in
   let y0 := cA m zero y in
   let y_1 := cA_1 m one y in
   let m1:= L m one x y in
  cF m1 z =
   if eq_dart_dec y0 z then x
   else if eq_dart_dec x10 z then y_1
          else cF m z.
Proof.
intros.
unfold m1 in |- *.
elim (exd_dec m z).
 intro.
   rename a into Ez.
   unfold m1 in |- *.
   rewrite cF_L in |- *.
   elim (eq_dim_dec one zero).
  intro.
    inversion a.
 intros.
   elim (eq_dart_dec y (cA_1 m zero z)).
  intro.
    elim (eq_dart_dec y0 z).
   fold m1 in |- *.
      tauto.
  intros.
    elim b0.
    unfold y0 in |- *.
    rewrite a in |- *.
    rewrite cA_cA_1 in |- *.
    tauto.
   tauto.
   tauto.
 elim (eq_dart_dec (cA m one x) (cA_1 m zero z)).
  fold m1 in |- *.
    intros.
    elim (eq_dart_dec y0 z).
   unfold y0 in |- *.
     intro.
     elim b0.
     rewrite <- a0 in |- *.
     rewrite cA_1_cA in |- *.
     tauto.
    tauto.
   unfold prec_L in H0.
      tauto.
  elim (eq_dart_dec x10 z).
   intros.
     unfold y_1 in |- *.
      tauto.
  intros.
    unfold x10 in b1.
    elim b1.
    unfold cF_1 in |- *.
    rewrite a in |- *.
    rewrite cA_cA_1 in |- *.
    tauto.
   tauto.
   tauto.
 intros.
   elim (eq_dart_dec y0 z).
  intro.
    unfold y0 in a.
    elim b1.
    rewrite <- a in |- *.
    rewrite cA_1_cA in |- *.
    tauto.
   tauto.
  unfold prec_L in H0.
     tauto.
 elim (eq_dart_dec x10 z).
  unfold x10 in |- *.
    intros.
    unfold cF_1 in a.
    elim b0.
    rewrite <- a in |- *.
    rewrite cA_1_cA in |- *.
    tauto.
   tauto.
  generalize (exd_cA m one x).
    unfold prec_L in H0.
     tauto.
  tauto.
intros.
  elim (eq_dart_dec y0 z).
 intro.
   unfold y0 in a.
   elim b.
   rewrite <- a in |- *.
   generalize (exd_cA m zero y).
   unfold prec_L in H0.
    tauto.
elim (eq_dart_dec x10 z).
 unfold x10 in |- *.
   intros.
   elim b.
   rewrite <- a in |- *.
   generalize (exd_cF_1 m x).
   unfold prec_L in H0.
    tauto.
intros.
  assert (~ exd m1 z).
 unfold m1 in |- *.
   simpl in |- *.
    tauto.
assert (inv_hmap m1).
 unfold m1 in |- *.
   simpl in |- *.
    tauto.
generalize (exd_cF_not_nil m1 z H2).
  intro.
  intros.
  generalize (exd_dec m z).
  intro.
  generalize (exd_dec m1 z).
  intro.
  generalize (eq_dart_dec (cF m z) nil).
  generalize (eq_dart_dec (cF m1 z) nil).
  intros.
  assert (cF m z = nil).
 generalize (exd_cF_not_nil m z H).
   intro.
    tauto.
assert (cF m1 z = nil).
  tauto.
fold m1 in |- *.
  rewrite H8 in |- *.
   tauto.
Qed.

*)

(*===================================================
           NEW INSTANTIATIONS  OF
           degreef_L1, expof_L1:
====================================================*)

(* MERGE: ANCIENT FORM NEWLY PROVEN: OK!! *)

Theorem degreef_L1_merge:
  forall (m:fmap)(x y z:dart),
   let y0 := cA m zero y in
   let m1 := L m one x y in
   inv_hmap m1 -> exd m z ->
   ~expf m x y0 ->
   let dx:= degreef m x in
   let dy0:= degreef m y0 in
   MF.degree m1 z =
      if expf_dec m x z then dx + dy0
      else if expf_dec m y0 z then dx + dy0
           else degreef m z.
Proof.
intros.
generalize H.
intro.
unfold m1 in H2.
simpl in H2.
unfold prec_L in H2.
decompose [and] H2.
clear H2.
set (X := y0) in |- *.
set (Y := x) in |- *.
set (dX := dy0) in |- *.
set (dY := dx) in |- *.
unfold m1 in |- *.
fold Y in |- *.
assert (y = cA_1 m zero X).
 unfold X in |- *.
   unfold y0 in |- *.
   rewrite cA_1_cA in |- *.
   tauto.
  tauto.
  tauto.
rewrite H2 in |- *.
  unfold expf in H1.
  assert (~ MF.expo m x y0).
  tauto.
assert (ModcF1.Prec_Tr m y0 x).
 unfold ModcF1.Prec_Tr in |- *.
    tauto.
assert (ModcF1.Tr m y0 x = L m one x y).
 unfold ModcF1.Tr in |- *.
   unfold y0 in |- *.
   rewrite cA_1_cA in |- *.
   tauto.
  tauto.
  tauto.
assert (inv_hmap (ModcF1.Tr m y0 x)).
 rewrite H11 in |- *.
   fold m1 in |- *.
    tauto.
assert (~ MF1Tr.MfM.expo m y0 x).
 intro.
   elim H8.
   apply MF.expo_symm.
   tauto.
  tauto.
assert (exd m y0).
 unfold y0 in |- *.
   generalize (exd_cA m zero y).
    tauto.
generalize (MF1Tr.degree_Tr_merge_summary m y0 x z H3 H10 H14 H5 H0 H12 H13).
  assert (MF.degree = MF1Tr.MfM.degree).
  tauto.
unfold dY in |- *.
  unfold dX in |- *.
  fold (degreef m x) in |- *.
  unfold dx in |- *; unfold dy0 in |- *.
  unfold degreef in |- *.
  assert (MF0Tr.MfM.degree = MF1Tr.MfM.degree).
  tauto.
rewrite <- H16 in |- *.
  fold (degreef m x) in |- *.
  fold (degreef m y0) in |- *.
  unfold X in |- *.
  unfold Y in |- *.
  unfold y0 in |- *.
  rewrite cA_1_cA in |- *.
 fold y0 in |- *.
   fold (degreef m z) in |- *.
   rewrite H11 in |- *.
   rewrite H15 in |- *.
   rewrite <- H16 in |- *.
   fold (degreef (L m one x y) z) in |- *.
   fold m1 in |- *.
   elim (MF1Tr.MfM.expo_dec m y0 z H3).
  elim (expf_dec m y0 z).
   elim (expf_dec m x z).
    intros.
      rewrite plus_comm in |- *.
       tauto.
   intros.
     rewrite plus_comm in |- *.
      tauto.
  unfold expf in |- *.
     tauto.
 elim (expf_dec m y0 z).
  unfold expf in |- *.
     tauto.
 elim (MF1Tr.MfM.expo_dec m x z H3).
  elim (expf_dec m x z).
   intros.
     rewrite plus_comm in |- *.
      tauto.
  unfold expf in |- *.
     tauto.
 elim (expf_dec m x z).
  unfold expf in |- *.
     tauto.
  tauto.
 tauto.
 tauto.
Qed.

(* SPLIT: ANCIENT FORM NEWLY PROVEN: OK!! *)

Theorem degreef_L1_split:
  forall (m:fmap)(x y z:dart)(j : nat),
   let y0 := cA m zero y in
   let y_1:= cA_1 m one y in
   let m1 := L m one x y in
   let dx:= degreef m x in
   inv_hmap m1 -> exd m z ->
   x = Iter (cF m) j y0 ->
   2 <= j <= dx ->
   degreef m z =
      if expf_dec m x z
      then degreef m1 x + degreef m1 y_1
      else degreef m1 z.
Proof.
intros.
generalize H.
intro.
unfold m1 in H3.
simpl in H3.
unfold prec_L in H3.
decompose [and] H3.
clear H3.
assert (ModcF1.Tr m y0 x = L m one x y).
 unfold ModcF1.Tr in |- *.
   unfold y0 in |- *.
   rewrite cA_1_cA in |- *.
   tauto.
  tauto.
  tauto.
assert (ModcF1.Prec_Tr m y0 x).
 unfold ModcF1.Prec_Tr in |- *.
    tauto.
assert (inv_hmap (ModcF1.Tr m y0 x)).
 rewrite H3 in |- *.
   fold m1 in |- *.
    tauto.
assert (exd m y0).
 unfold y0 in |- *.
   generalize (exd_cA m zero y).
    tauto.
generalize
 (MF1Tr.degree_Tr_split_summary m y0 x z j
      H4 H9 H12 H6 H0 H1 H2 H11).
  assert (MF0Tr.MfM.degree = MF1Tr.MfM.degree).
  tauto.
assert (MF.degree = MF1Tr.MfM.degree).
  tauto.
rewrite <- H13 in |- *.
  rewrite H3 in |- *.
  fold m1 in |- *.
  fold (degreef m1 x) in |- *.
  fold (degreef m1 z) in |- *.
  assert (MF1Tr.MfM.f m y0 = y_1).
 unfold y0 in |- *.
   unfold MF1Tr.MfM.f in |- *.
   assert (cF = ModcF1.M.f).
   tauto.
 rewrite <- H15 in |- *.
   unfold cF in |- *.
   rewrite cA_1_cA in |- *.
  fold y_1 in |- *.
     tauto.
  tauto.
  tauto.
rewrite H15 in |- *.
  fold (degreef m1 y_1) in |- *.
  fold (degreef m z) in |- *.
  elim (MF1Tr.MfM.expo_dec m x z H4).
 elim (expf_dec m x z).
   tauto.
 unfold expf in |- *.
    tauto.
elim (expf_dec m x z).
 unfold expf in |- *.
    tauto.
 tauto.
Qed.

(* ANCIENT FORM, NEWLY PROVEN, OK: *)

Theorem expf_L1_CNS:forall (m:fmap)(x y z t:dart),
  inv_hmap (L m one x y) -> exd m z ->
  (expf (L m one x y) z t <->
    let x1 := cA m one x in
    let x10 := cA m zero x1 in
    let y0 := cA m zero y in
    let y_1 := cA_1 m one y in
      if expf_dec m x y0
      then betweenf m x z y0 /\ betweenf m x t y0
        \/ betweenf m y_1 z x10 /\ betweenf m y_1 t x10
        \/ ~ expf m x z /\ expf m z t
      else   expf m z t
          \/ expf m z x /\ expf m t y0
          \/ expf m t x /\ expf m z y0).
Proof.
intros.
assert (prec_L m one x y).
 simpl in H.
    tauto.
assert (inv_hmap m).
 simpl in H;  tauto.
generalize (expof_L1_CNS m x y z t H2 H1 H0).
  simpl in |- *.
  fold (cF_1 m x) in |- *.
  set (y0 := cA m zero y) in |- *.
  set (y_1 := cA_1 m one y) in |- *.
  elim (expof_dec m y0 x H2).
 elim (expf_dec m x y0).
  intros.
    assert (~ expof m y0 z <-> ~ expf m x z).
   split.
    intro.
      intro.
      apply H4.
      apply expof_trans with x.
      tauto.
    generalize (expf_expof m x z).
       tauto.
   intro.
     intro.
     apply H4.
     apply expf_trans with y0.
    apply expf_symm.
      generalize (expf_expof m y0 x).
       tauto.
   generalize (expf_expof m y0 z).
      tauto.
  generalize (expf_expof (L m one x y) z t).
    intros.
    generalize (expf_expof m z t H2).
     tauto.
 intros.
   elim b.
   apply expf_symm.
   generalize (expf_expof m y0 x).
    tauto.
elim (expf_dec m x y0).
 intros.
   elim b.
   apply expof_symm.
   tauto.
 generalize (expf_expof m x y0 H2).
    tauto.
set
 (E1 := expof m z t \/ expof m y0 z /\ expof m x t \/
    expof m y0 t /\ expof m x z)
 in |- *.
  set
   (E2 :=
    expf m z t \/ expf m z x /\ expf m t y0 \/
       expf m t x /\ expf m z y0)
   in |- *.
  intros.
  cut (E1 <-> E2).
 generalize (expf_expof (L m one x y) z t).
    tauto.
assert (expof m y0 z <-> expf m z y0).
 split.
  intro.
    apply expf_symm.
    generalize (expf_expof m y0 z).
     tauto.
 intro.
   apply expof_symm.
   tauto.
 generalize (expf_expof m z y0).
    tauto.
assert (expof m x t <-> expf m t x).
 split.
  intro.
    apply expf_symm.
    generalize (expf_expof m x t).
     tauto.
 intro.
   apply expof_symm.
   tauto.
 generalize (expf_expof m t x).
    tauto.
assert (expof m x z <-> expf m z x).
 split.
  intro.
    apply expf_symm.
    generalize (expf_expof m x z).
     tauto.
 intro.
   apply expof_symm.
   tauto.
 generalize (expf_expof m z x).
    tauto.
assert (expof m y0 t <-> expf m t y0).
 split.
  intro.
    apply expf_symm.
    generalize (expf_expof m y0 t).
     tauto.
 intro.
   apply expof_symm.
   tauto.
 generalize (expf_expof m t y0).
    tauto.
generalize (expf_expof m z t).
  intro.
  unfold E1 in |- *.
  unfold E2 in |- *.
   tauto.
Qed.

(* OK: *)

Theorem expf_L1_CN:forall (m:fmap)(x y z t:dart),
  inv_hmap (L m one x y) -> exd m z ->
  expf (L m one x y) z t ->
    let x1 := cA m one x in
    let x10 := cA m zero x1 in
    let y0 := cA m zero y in
    let y_1 := cA_1 m one y in
      if expf_dec m x y0
      then betweenf m x z y0 /\ betweenf m x t y0
        \/ betweenf m y_1 z x10 /\ betweenf m y_1 t x10
        \/ ~ expf m x z /\ expf m z t
      else   expf m z t
          \/ expf m z x /\ expf m t y0
          \/ expf m t x /\ expf m z y0.
Proof.
intros.
generalize (expf_L1_CNS m x y z t H H0).
 tauto.
Qed.

(* OK: *)

Theorem expf_L1_CS:forall (m:fmap)(x y z t:dart),
  inv_hmap (L m one x y) -> exd m z ->
    let x1 := cA m one x in
    let x10 := cA m zero x1 in
    let y0 := cA m zero y in
    let y_1 := cA_1 m one y in
      (if expf_dec m x y0
      then betweenf m x z y0 /\ betweenf m x t y0
        \/ betweenf m y_1 z x10 /\ betweenf m y_1 t x10
        \/ ~ expf m x z /\ expf m z t
      else   expf m z t
          \/ expf m z x /\ expf m t y0
          \/ expf m t x /\ expf m z y0)
     -> expf (L m one x y) z t.
Proof.
intros.
generalize (expf_L1_CNS m x y z t H H0).
 tauto.
Qed.

(*=====================================================
=======================================================
                    END OF PART 7
=======================================================
=====================================================*)


(*
 This is the definition of formal syntax for Dan Grossman's Thesis,
  "SAFE PROGRAMMING AT THE C LEVEL OF ABSTRACTION".

  Finally a nice clean enough easy to use context functor.

*)
Set Implicit Arguments.
Require Export ContextDef.
Require Export BooleanEqualityDef.
Require Export BooleanEqualitySetFunDef.
Require Export VariableEqualityDef.
Require Export VariableEqualitySetFunDef.
Require Export CpdtTactics.
Require Import MoreTacticals.

(* Todo admit, fix or undo. *)
Module ContextFun(I: BooleanEquality) (R : BooleanEquality) <: Context.
  Module K  := I.
  Module T  := R.
  Module KS := BooleanEqualitySetFun(K).

Inductive Context' : Type :=
| dot  : Context'
| ctxt : K.t -> T.t -> Context' -> Context'.

Definition Context := Context'.
Definition empty  := dot.

Function add (c : Context') (k: KS.elt) (t : T.t)  : Context' :=
  match c with
    | dot => (ctxt k t dot)
    | (ctxt k' t' c') =>
      match KS.BE.eqb k k' with
        | true  => (ctxt k  t  c')
        | false => (ctxt k' t' (add c' k t))
      end
  end.
Hint Unfold add.

Function map (c : Context') (k : KS.elt) : option T.t :=
  match c with
    | dot => None
    | (ctxt k' t' c') =>
      match KS.BE.eqb k k' with
        | true  => Some t'
        | false => (map c' k)
      end
  end.
Hint Unfold map.

Function delete (c : Context') (k : KS.elt) : Context' :=
  match k, c with
    | k, dot => dot
    | k, (ctxt k' t' c') =>
      match KS.BE.eqb k k' with
        | true  => c'
        | false => (ctxt k' t' (delete c' k))
      end
  end.
Hint Unfold delete.

Function nodup (c : (Context')) : bool :=
  match c with
    | dot => true
    | (ctxt k' t' c') =>
      match map c' k' with
        | Some t  => false
        | None  => nodup c'
      end
end.
Hint Unfold nodup.

Function extends (c c' : Context') : bool :=
  match c with
    | dot => true
    | ctxt k t c'' =>
      match map c' k with
       | Some t' =>
         match (T.eqb t t') with
           | true => extends c'' c'
           | false => false
         end
       | None => false
      end
  end.
Hint Unfold extends.

Function equal (c c' : Context') : bool :=
  andb (extends c c') (extends c' c).
Hint Unfold equal.

Function concat (c c' : Context') {struct c'} : Context' :=
  match c' with
  | dot => c
  | (ctxt k v d) => (ctxt k v (concat c d))
  end.

Function dom (c : Context') : KS.t :=
 match c with
 | dot => KS.empty
 | (ctxt k v c') => KS.union (KS.singleton k) (dom c')
 end.

(*
(* Do I need this? is it being used by LN LibEnv.env? *)
Lemma Context'_ind':
  forall (P : Context' -> Prop),
  (P dot) ->
  (forall E x v, P E -> P (concat E (ctxt x v dot))) ->
  (forall E, P E).
Proof.
(*
  induction E; try solve[crush].
*)
Admitted.

(* Can I add k t to the front of c'? *)
Function extends1 (c : Context') (k : KS.elt ) (t : T.t) (c' : Context') : bool :=
  match map c' k with
   | Some _ => false
   | None =>
     match map c k with
      | Some _ => false
      | None   => (equal (ctxt k t c) c')
     end
end.
Hint Unfold extends1.

Function extends1' (c : Context') (k : KS.elt ) (t : T.t) (c' : Context') : bool :=
  match map c' k with
   | Some _ => false
   | None =>
     match map c k with
      | Some _ => false
      | None   => extends (ctxt k t c) c'
     end
end.
Hint Unfold extends1'.

Lemma map_empty_none: forall k, map empty k = None.
Proof.
(*
   crush.
*)
Admitted.

Lemma nodup_empty: nodup empty = true.
Proof.
(*
  crush.
*)
Admitted.

Ltac case_if e :=
  match goal with
    | H: context [if e ?x ?y then _ else _] |- _ => case_eq(e x y); intros; subst
    | |- context [if e ?x ?y then _ else _] => case_eq(e x y); intros; subst
  end.

Lemma map_add: forall c k t, map (add c k t) k = Some t.
Proof.
(*
  intros.
  induction c; crush.
  case_if K.eqb; crush.
*)
Admitted.

Lemma map_agreement:
  forall c k t,
    nodup c = true ->
    map c k = Some t ->
    forall t',
      map c k = Some t' ->
      t = t'.
Proof.
(*
 intros.
 induction c; crush.
*)
Admitted.

Lemma map_some_none_neq:
  forall c k k',
    map c k  = None ->
    forall t,
      map c k' = Some t ->
      k <> k'.
Proof.
(*
  induction c; crush.
*)
Admitted.

Ltac expand_cases :=
  repeat match goal with
          | [ H : (if ?x then _ else _) = Some _ |- _ ] =>
            destruct x ; try solve[inversion H]
          | [ H : (if ?x then _ else _) = None   |- _ ] =>
            destruct x ; try solve[inversion H]
          end.

Ltac invert_some_eq :=
  repeat match goal with
          | [ H : Some _ = Some _ |- _ ] =>
            inversion H; subst; clear H
         end.

Lemma map_some_none_beq_t_false:
  forall c k k',
    map c k  = None ->
    forall t,
      map c k' = Some t ->
      KS.BE.eqb k k' = false.
Proof.
(*
  intros.
  induction c.
  crush.
  pose proof H as H'.
  pose proof H0 as H0'.
  unfold map in H.
  fold map in H.
  unfold map in H0.
  fold map in H0.

  Ltac rewrite_eq e :=
    match goal with
     | [ H : e ?a ?b = _ ,
         I : context[if e ?a ?b then _ else _ ]  |- _ ] =>
       rewrite H in I; try solve[inversion I]
    end.

Ltac case_if2 e :=
  match goal with
    | H: context [if e ?x ?y then _ else _] |- _ => case_eq(e x y); intros;
          rewrite_eq e
    | |- context [if e ?x ?y then _ else _] => case_eq(e x y); intros;
          rewrite_eq e
  end.

(*  Much cleaner!  No variables, no context variables.  *)
  case_if2 K.eqb;   case_if2 K.eqb.

(*
  case_eq(K.eqb k e); case_eq(K.eqb k' e); intros;
  rewrite H1 in *; rewrite H2 in *; try solve [inversion H].
*)

  inversion H0.
  subst.
  case_eq(K.eqb k k'); intros; try reflexivity.
  apply K.eqb_to_eq in H3.
  subst.

  rewrite H1 in H2.
  inversion H2.
  apply IHc in H; try assumption.
*)
Admitted.

Lemma empty_extended_by_all:
  forall c,
    extends empty c = true.
Proof.
(*
  crush.
*)
Admitted.

Lemma empty_extends_only_empty:
  forall c,
    extends c empty = true ->
    c = empty.
Proof.
(*
  intros.
  induction c; crush.
*)
Admitted.

Lemma extends_r_str:
  forall c c',
    extends c c' = true ->
    forall v t,
      nodup (ctxt v t c') = true ->
      extends c (ctxt v t c') = true.
Proof.
(*
  intros c c'.
  functional induction (extends c c'); try solve[crush].
  intros.
  apply IHb with (v:= v) (t:= t0) in H.
  unfold extends.
  fold extends.
  case_eq(map (ctxt v t0 c') k); intros.
  case_eq(T.eqb t t1); intros; try assumption.
  pose proof H0 as H0'.
  unfold map in H1.
  fold map in H1.
  case_eq(K.eqb k v); intros; try rewrite H3 in H1.
  move t1 before t.
  unfold nodup in H0.
  fold nodup in H0.
  apply K.eqb_to_eq in H3.
  rewrite <- H3 in H0.
  rewrite e0 in H0.
  inversion H0.
  rewrite e0 in H1.
  crush.

  pose proof H1 as H1'.
  unfold map in H1.
  fold map in H1.
  case_eq(K.eqb k v); intros; rewrite H2 in H1.
  inversion H1.
  rewrite e0 in H1.
  inversion H1.
  assumption.
*)
Admitted.

Lemma extends1_to_equality:
  forall c v t c',
    extends1 c v t c' = true ->
    equal (ctxt v t c) c' = true.
Proof.
(*
  intros.
  pose proof H as H'.
  unfold extends1 in H.
  case_eq(map c' v); intros; rewrite H0 in H; try solve[inversion H];
  case_eq(map c v); intros; try rewrite H1 in H; try solve[inversion H].
  assumption.
*)
Admitted.

Lemma extends1_r_str:
  forall c v t c',
    extends1 c v t c' = true ->
    forall v' t',
      nodup (ctxt v t (ctxt v' t' c')) = true ->
      extends1 c v t (ctxt v' t' c') = true.
Proof.
(*
  intros.
  induction c'; intros.
  unfold extends1 in H.
  fold extends1 in H.
  simpl in H.
  case_eq(map (ctxt v' t' (empty)) v); intros.
  intros c v t c'.
  functional induction (extends1 c v t c'); try solve[crush].
  intros.
  unfold extends1.
  case_eq(map (ctxt v' t' c') v); intros.
  unfold nodup in H0.
  fold nodup in H0.
  unfold map in H0.
  fold map in H0.
  case_eq(K.eqb v v'); intros; rewrite H2 in H0.
  inversion H0.
  rewrite e in H0.
  case_eq(map c' v'); intros; rewrite H3 in H0.
  inversion H0.
  unfold map in H1.
  fold map in H1.
  rewrite H2 in H1.
  rewrite H1 in e.
  inversion e.
  rewrite e0.
  unfold map in H1.
  case_eq(K.eqb v v'); intros; rewrite H2 in H1.
  inversion H1.
  fold map in H1.
  (* stuck *)
*)
Admitted.

(*
Lemma extends_refl_no_nodup:
  forall c,
    extends c c = true.
Proof.
  intros.
  induction c; try solve [crush].
  unfold extends.
  fold extends.
  simpl.
  rewrite K.eqb_refl.
  rewrite T.beq_t_refl.
  unfold extends.
  fold extends.
Qed.
*)

Lemma extends_refl:
  forall c,
    nodup c = true ->
    extends c c = true.
Proof.
(*
  intros.
  induction c; try solve [crush].
  unfold extends.
  fold extends.
  simpl.
  rewrite K.eqb_refl.
  rewrite T.eqb_refl.
  apply extends_r_str; try assumption.
  unfold nodup in H.
  fold nodup in H.
  case_eq(map c k); intros; rewrite H0 in H.
  inversion H.
  apply IHc in H.
  assumption.
*)
Admitted.

Lemma extends_l_weak:
  forall c c' k,
    extends c c' = true ->
    forall t,
      map c' k = Some t ->
      extends (ctxt k t c) c' = true.
Proof.
(*
  intros.
  unfold extends.
  fold extends.
  unfold map.
  fold map.
  rewrite H0.
  rewrite T.eqb_refl.
  assumption.
*)
Admitted.

Lemma extends_l_weak_r_str:
  forall c c' k,
    extends c c' = true ->
    map c' k = None  ->
    forall t,
      nodup c' = true ->
      extends (ctxt k t c) (ctxt k t c') = true.
Proof.
(*
  intros.
  unfold extends.
  fold extends.
  unfold map.
  fold map.
  rewrite K.eqb_refl.
  rewrite T.eqb_refl.

  apply extends_r_str; try assumption.
  unfold nodup.
  fold nodup.
  rewrite H0.
  assumption.
*)
Admitted.

Lemma extends_l_str:
  forall c c' k t,
    extends (ctxt k t c) c' = true -> extends c c' = true.
Proof.
(*
  intros.
  induction c; try solve[crush].
  unfold extends in H.
  fold extends in H.
  unfold extends.
  fold extends.
  case_eq(map c' k); intros; rewrite H0 in *; case_eq(map c' k0); intros; try rewrite H1 in *; try solve[inversion H]; case_eq(T.eqb t t1); intros; try rewrite H2 in *; try inversion H.
 case_eq(T.eqb t0 t2); intros; rewrite H4 in *; try inversion H; reflexivity.
*)
Admitted.

Lemma map_extends_none_agreement:
  forall c c',
   extends c c' = true ->
   forall v,
     map c' v = None ->
     map c v  = None.
Proof.
(*
  intros c c' ext.
  functional induction (extends c c'); try solve [crush].
  intros.
  apply IHb with (v:= v) in ext; try assumption.
  unfold map.
  fold map.
  case_eq (K.eqb v k); intros.
  apply K.eqb_to_eq in H0.
  subst.
  rewrite e0 in H.
  inversion H.
  assumption.
*)
Admitted.

Lemma equal_empty_empty:
  forall c,
    equal empty c = true ->
    c = empty.
Proof.
(*
  intros.
  induction c; crush.
*)
Admitted.

Lemma K_eq_sym:  forall k k', K.eqb k k' = K.eqb k' k.
Proof.
(*
  apply K.eqb_sym.
*)
Admitted.

Lemma map_r_str:
  forall c k0 t0 k t,
    map (ctxt k0 t0 c) k = Some t ->
    KS.BE.eqb k0 k = false ->
    map c k = Some t.
Proof.
(*
  intros.
  unfold map in H.
  fold map in H.
  rewrite K.eqb_sym in H0.
  rewrite H0 in H.
  assumption.
*)
Admitted.

Lemma map_r_str_add:
  forall c k0 t0 k t,
    map (add c k0 t0) k = Some t ->
    KS.BE.eqb k k0 = false ->
    map c k = Some t.
Proof.
(*
  intros.
  induction c.
  unfold add in H.
  unfold map in H.
  rewrite H0 in H.
  inversion H.

  unfold map.
  fold map.
  unfold add in H.
  fold add in H.
  case_eq(K.eqb k0 k1); case_eq(K.eqb k k1); intros; rewrite H2 in H.
  apply K.eqb_trans with (x:= k) in H1.
  apply K.eqb_to_eq in H1.
  subst.
  rewrite K.eqb_sym in H0.
  apply K.eqb_to_eq in H2.
  subst.
  rewrite K.eqb_refl in H0.
  inversion H0.

  apply K.eqb_refl.
  unfold map in H.
  fold map in H.
  rewrite H0 in H.
  assumption.

  unfold map in H.
  fold map in H.
  rewrite H1 in H.
  assumption.

  unfold map in H.
  fold map in H.
  rewrite H1 in H.
  apply IHc in H.
  assumption.
*)
Admitted.

Lemma nodup_add_none:
  forall c,
    nodup c = true ->
    forall k,
     map c k = None  ->
    forall t,
      nodup (add c k t) = true.
Proof.
(*
  induction c; try solve [crush].
  intros.
  unfold nodup in H.
  fold nodup in H.
  case_eq (map c k); intros; rewrite H1 in H; try inversion H.
  unfold map in H0.
  fold map in H0.
  case_eq (K.eqb k0 k); intros; rewrite H2 in H0.
  inversion H0.

  unfold add.
  fold add.
  rewrite H2.
  unfold nodup.
  fold nodup.
  rewrite H3.
  (* TODO renaming broke proof. *)
  case_eq (map (add c k t0) k); intros.
  apply map_r_str_add in H4; try assumption.
  rewrite H4 in H1.
  inversion H1.
  apply IHc with (k:= k0) (t:= t1) in H; try assumption.
  rewrite K.eqb_sym in H2; try assumption.
  apply IHc with (k:= k0) (t:= t0) in H3; try assumption.
*)
Admitted.

Lemma nodup_r_str:
  forall c,
    nodup c = true ->
    forall k,
     map c k = None  ->
    forall t,
      nodup (ctxt k t c) = true.
Proof.
(*
  induction c; try solve [crush].
*)
Admitted.

(* Perhaps I want this someday too. *)
(*
Lemma nodup_add_some:
  forall c,
    nodup c = true ->
    forall k t,
     map c k = Some t  ->
    forall t',
      nodup (add c k t') = true.
*)

Lemma nodup_map_some_context_absurd:
  forall c k t t',
    map c k = Some t ->
    nodup (ctxt k t' c) = true
     -> False.
Proof.
(*
  intros.
  induction c; try solve[crush].
  unfold map in H.
  fold map in H.
  case_eq(K.eqb k k0); intros; rewrite H1 in H.
  inversion H; subst.
  apply K.eqb_to_eq in H1.
  rewrite H1 in H0.
  unfold nodup in H0.
  fold nodup in H0.
  simpl in H0.
  rewrite K.eqb_refl in H0.
  inversion H0.
  unfold nodup in H0.
  fold nodup in H0.
  simpl in H0.
  rewrite H1 in H0.
  rewrite H in H0.
  inversion H0.
*)
Admitted.

Lemma map_extension_disagreement_absurd:
  forall c c',
    extends c c' = true ->
    forall v t,
      map c v  = Some t ->
      map c' v = None ->
      False.
Proof.
(*
  intros c c' ext.
  functional induction (extends c c'); try solve [crush].
  intros.
  apply IHb with (v:= v) (t:= t0) in ext; try assumption.
  unfold map in H.
  fold map in H.
  case_eq(K.eqb v k); intros; rewrite H1 in H; try assumption.
  apply K.eqb_to_eq in H1.
  subst.
  rewrite e0 in H0.
  inversion H0.
*)
Admitted.

Lemma map_add_recursion:
  forall c k t k',
    map (add c k' t) k = Some t ->
    KS.BE.eqb k k' = false ->
    map c k = Some t.
Proof.
(*
  intros.
  induction c.
  simpl in H.
  rewrite H0 in H.
  inversion H.
  unfold map.
  fold map.
  case_eq(K.eqb k k0); intros.
  apply K.eqb_to_eq in H1.
  subst.
  unfold add in H.
  fold add in H.
  rewrite K.eqb_sym in H0.
  rewrite H0 in H.
  unfold map in H.
  fold map in H.
  rewrite K.eqb_refl in H.
  assumption.
  unfold add in H.
  fold add in H.
  case_eq(K.eqb k' k0); intros; rewrite H2 in H.
  unfold map in H.
  fold map in H.
  rewrite H0 in H.
  assumption.
  unfold map in H.
  fold map in H.
  rewrite H1 in H.
  apply IHc in H.
  assumption.
*)
Admitted.

Lemma extends_r_weak:
  forall c c' k t,
    extends c (ctxt k t c') = true ->
    nodup (ctxt k t c') = true ->
    map c k = None ->
    extends c c' = true.
Proof.
(*
  intros.
  induction c; try solve[crush].
  unfold extends in H.
  fold extends in H.
  unfold extends.
  fold extends.
  case_eq(map c' k0); intros;
  case_eq(map (ctxt k t c') k0); intros; rewrite H3 in H; try solve[inversion H].
  case_eq(T.eqb t0 t1); intros; try rewrite H4 in *; try solve[inversion H].
  case_eq(T.eqb t0 t2); intros;rewrite H5 in H; try solve[inversion H].
  unfold map in H1.
  fold map in H1.
  case_eq(K.eqb k k0); intros; rewrite H6 in H1; try inversion H1.
  apply IHc in H; try assumption.
  case_eq(T.eqb t0 t2); intros; rewrite H5 in H; try solve[inversion H].
  apply T.eqb_to_eq in H5.
  subst.
  unfold map in H3.
  fold map in H3.
  unfold map in H1.
  fold map in H1.
  case_eq(K.eqb k k0); intros.
  rewrite K.eqb_sym in H3.
  rewrite H5 in *.
  inversion H1.

  rewrite K.eqb_sym in H5.
  rewrite H5 in *.
  apply T.eqb_to_neq in H4.
  rewrite H2 in H3.
  inversion H3.
  crush.
(*  apply T.eqb_to_eq in H4.
  subst. *)
  unfold map in H3.
  fold map in H3.
  unfold map in H1.
  fold map in H1.
  case_eq(K.eqb k0 k); intros.
  rewrite K.eqb_sym in H1.
  rewrite H4 in *.
  inversion H1.

  rewrite K.eqb_sym in H1.
  rewrite H4 in *.
  rewrite H2 in H3.
  inversion H3.
*)
Admitted.

Lemma map_disagreement_absurd:
  forall c k t,
    nodup c = true ->
    map c k = Some t ->
    forall k' t',
    map (ctxt  k' t' c) k = None ->
  False.
Proof.
(*
  intros.
  assert (Z: extends c (ctxt k' t' c) = true).
  assert (Y: extends c c = true).
  apply extends_refl; try assumption.
  apply extends_r_str with (v:= k') (t:= t') in Y; try assumption.
  unfold nodup.
  fold nodup.
  case_eq(map c k'); intros; try assumption.
  unfold map in H1.
  fold map in H1.
  case_eq(K.eqb k k'); intros; rewrite H3 in H1; try solve [inversion H1].
  rewrite H1 in H0.
  inversion H0.
  apply map_extension_disagreement_absurd with (v:= k) (t:= t) in Z; try assumption.
*)
Admitted.

Lemma map_add_disagreement_absurd:
  forall c k t,
    map c k = Some t ->
    forall k' t',
    map (add c k' t') k = None ->
  False.
Proof.
(*
  intros c.
  induction c; try solve [crush].
  intros.
  unfold map in H.
  fold map in H.
  unfold add in H0.
  fold add in H0.
  case_eq(K.eqb k0 k); case_eq(K.eqb k' k); intros; rewrite H1 in H0; rewrite H2 in H.
  apply K.eqb_trans with (x:= k') in H1.
  apply K.eqb_to_eq in H2.
  subst.
  unfold map in H0.
  fold map in H0.
  rewrite K.eqb_sym in H1.
  apply K.eqb_to_eq in H1.
  subst.
  rewrite K.eqb_refl in H0.
  inversion H0.
  apply K.eqb_refl.
  apply K.eqb_to_eq in H2.
  subst.
  unfold map in H0.
  fold map in H0.
  rewrite K.eqb_refl in H0.
  inversion H0.
  unfold map in H0.
  fold map in H0.
  case_eq (K.eqb k0 k'); intros; rewrite H3 in H0.
  inversion H0.
  rewrite H0 in H.
  inversion H0.
  inversion H.
  unfold map in H0.
  fold map in H0.
  rewrite H2 in H0.
  apply IHc with (k':= k') (t':= t') in H; try assumption.
*)
Admitted.

Lemma map_add_some_agreement:
  forall c k t,
    map c k = Some t ->
    forall k0 t0,
      KS.BE.eqb k k0 = false ->
      map (add c k0 t0) k = Some t.
Proof.
(*
  intros.
  functional induction (add c k0 t0); try solve [crush].
  unfold map.
  fold map.
  rewrite H0.
  apply K.eqb_to_eq in e0.
  subst.
  unfold map in H.
  fold map in H.
  rewrite H0 in H.
  assumption.

  unfold map in H.
  fold map in H.
  unfold map.
  fold map.
  case_eq(K.eqb k k'); intros; rewrite H1 in H.
  assumption.

  apply IHc0 in H; try assumption.
*)
Admitted.

Lemma extends_r_str_add:
  forall c c',
    extends c c' = true ->
    forall k t,
      map c k = None ->
      extends c (add c' k t) = true.
Proof.
(*
  (* extends *)
  intros c c'.
  functional induction (extends c c'); try solve [crush].
  intros.
  pose proof e1 as e1'.
  apply T.eqb_to_eq in e1.
  subst.
  unfold map in H0.
  fold map in H0.
  case_eq(K.eqb k0 k); intros; rewrite H1 in H0.
  inversion H0.
  apply IHb with (k:= k0) (t:= t0) in H; try assumption.
  apply extends_l_weak; try assumption.
  apply map_add_some_agreement; try assumption.
  rewrite K.eqb_sym in H1.
  assumption.
*)
Admitted.

Lemma map_extends_some_agreement:
  forall c v t,
    map c v  = Some t ->
    nodup c = true ->
    forall c',
      extends c c' = true ->
      nodup c' = true ->
      map c' v = Some t.
Proof.
(*
  intros.
  functional induction (extends c c'); try solve [crush].
  unfold map in H.
  fold map in H.
  unfold nodup in H0.
  fold nodup in H0.
  case_eq(K.eqb v k); intros; rewrite H3 in H.
  inversion H.
  subst.
  case_eq(map c'' k); intros; rewrite H4 in H0.
  inversion H0.
  clear H.
  apply K.eqb_to_eq in H3.
  apply T.eqb_to_eq in e1.
  subst.
  assumption.
  case_eq(map c'' k); intros; rewrite H4 in H0.
  inversion H0.
  apply IHb in H; try assumption.
*)
Admitted.

Lemma map_none_r_str:
  forall c v v',
   map c v  = None ->
   map c v' = None ->
   KS.BE.eqb v' v = false ->
   forall t,
     map (ctxt v t c) v' = None.
Proof.
(*
  intros.
  induction c.
  unfold map.
  fold map.
  rewrite H1.
  reflexivity.
  refold map.
  refold_in map H.
  refold_in map H0.
  case_eq(K.eqb v k); intros; rewrite H2 in *;
  case_eq(K.eqb v' k); intros; rewrite H3 in *;
  case_eq(K.eqb v' v); intros; rewrite H4 in *;
  try solve[inversion H];
  try solve[inversion H0];
  try solve[inversion H1].
  apply IHc in H; try assumption.
*)
Admitted.

Lemma map_none_r_weak:
  forall k k' t c,
    map (ctxt k t c) k' = None ->
    KS.BE.eqb k' k = false ->
    map c k' = None.
Proof.
(*
  intros.
  unfold map in H.
  fold map in H.
  rewrite H0 in H.
  assumption.
*)
Admitted.

Lemma extends_trans:
  forall c c' c'',
    nodup c = true ->
    extends c  c'  = true ->
    nodup c' = true ->
    extends c' c'' = true ->
    nodup c'' = true ->
    extends c  c'' = true.
Proof.
(*
  (* triple induction *)
  intros c c' c'' nodupc extendscc' nodupc' extendsc'c'' nodupc''.
  induction c; try solve [crush]; induction c'; try solve [crush]; induction c''; try solve [crush].
  move extendscc' after IHc''.
  move extendsc'c'' after extendscc'.
  pose proof extendscc' as H'.
  apply extends_l_str in extendscc'.
  inversion nodupc.
  case_eq (map c k); intros; rewrite H in H0; try solve[inversion H0].
  rewrite H0.
  apply IHc in H0; try assumption.
  apply extends_l_weak with (k:= k) (t:= t).
  assumption.

  unfold map.
  fold map.
  case_eq (K.eqb k k1); intros.
  apply K.eqb_to_eq in H1.
  rewrite <- H1 in extendsc'c''.
  rewrite <- H1 in H0.
  rewrite <- H1 in nodupc''.

(* Naming mess up.
  assert (Z: map (ctxt t t0 c) t = Some t0).
  simpl.
  rewrite K.eqb_refl.
  reflexivity.

  apply map_extends_some_agreement with (v:= k) (t:= t) in H'; try assumption.
  apply map_extends_some_agreement with (v:= k) (t:= t) in extendsc'c'';
    try assumption.
  unfold map in extendsc'c''.
  fold map in extendsc'c''.
  rewrite K.eqb_refl in extendsc'c''.
  assumption.

  assert (Z: map (ctxt k t c) k = Some t).
  unfold map.
  fold map.
  rewrite K.eqb_refl.
  reflexivity.
  apply map_extends_some_agreement with (v:= k) (t:= t) in H';
    try assumption.
  apply map_extends_some_agreement with (v:= k) (t:= t) in extendsc'c'';
    try assumption.
  unfold map in extendsc'c''.
  fold map in extendsc'c''.
  rewrite H1 in extendsc'c''.
  assumption.
*)
Admitted.

Lemma equal_refl:
  forall c,
    nodup c = true ->
    equal c c = true.
Proof.
  intros.
  unfold equal.
  apply andb_true_iff.
  split.
  apply extends_refl; try assumption.
  apply extends_refl; try assumption.
*)
Admitted.

Lemma equal_sym:
  forall c c',
    equal c c' = equal c' c.
Proof.
(*
  intros.
  unfold equal.
  crush.
*)
Admitted.

Lemma equal_trans:
  forall c c' c'',
    nodup c = true ->
    equal c  c'  = true ->
    nodup c' = true ->
    equal c' c'' = true ->
    nodup c'' = true ->
    equal c  c'' = true.
Proof.
(*
  intros c c' c'' nodupc equalcc' nodupc' equalc'c'' nodupc''.
  unfold equal in equalcc'.
  apply andb_true_iff in equalcc'.
  inversion equalcc'.
  unfold equal in equalc'c''.
  apply andb_true_iff in equalc'c''.
  inversion equalc'c''.
  unfold equal.
  apply andb_true_iff.

  split.
  intros.
  apply extends_trans with (c:= c) (c':= c') (c'':= c'') in H; try assumption.
  apply extends_trans with (c:= c'') (c':= c') (c'':= c) in H0; try assumption.
*)
Admitted.

Lemma equal_implies_extends:
  forall d d',
    equal d d' = true ->
    extends d d' = true.
Proof.
(*
  unfold equal.
  intros.
  apply andb_true_iff in H.
  inversion H.
  assumption.
*)
Admitted.

(* It would be nice if these were true but they're not unless I cannonicalize. *)
Lemma equal_eq:
  forall c c',
    equal c c' = true ->
    c = c'.
Admitted.

Lemma equal_neq:
  forall c c',
    equal c c' = false ->
    c <> c'.
Admitted.

Lemma equal_empty_only_empty:
  forall c,
    equal empty c = true ->
    c = empty.
Proof.
(*
  intros.
  unfold equal in H.
  apply andb_true_iff in H.
  inversion H.
  apply empty_extends_only_empty in H1.
  assumption.
*)
Admitted.

Lemma equal_if_map_some:
  forall c c',
    nodup c  = true ->
    nodup c' = true->
    equal c c' = true ->
    (forall k t, map c k = Some t -> map c' k = Some t).
Proof.
(*
  intros c c'.
  functional induction (equal c c').
  intros.
  apply andb_true_iff in H1.
  inversion H1.
  apply map_extends_some_agreement with (c':= c') in H2; try assumption.
*)
Admitted.

Lemma equal_iff_map_some:
  forall c c',
    nodup c  = true ->
    nodup c' = true ->
    equal c c' = true ->
    (forall k t, map c k = Some t <-> map c' k = Some t).
Proof.
(*
  intros.

  split.
  intros.
  apply equal_if_map_some with (c:= c) (c':= c') (k:= k) (t:= t) in H; try assumption.

  intros.
  rewrite equal_sym in H1.
  apply equal_if_map_some with (c:= c') (c':= c) (k:= k) (t:= t) in H; try assumption.
*)
Admitted.

(* Admitting alpha conversion in the most specific ways:
    that x is not in a context and that
    x is not equal to x'. *)
Lemma admit_alpha_conversion_context:
  forall v c,
    map v c = None.
Admitted.

Lemma admit_alpha_conversion_beq_t:
  forall k k',
    KS.BE.eqb k k' = false.
Admitted.

*)
End ContextFun.