Set Implicit Arguments.

Require Import Bedrock.Platform.AutoSep.
Require Import Bedrock.Platform.Facade.examples.QsADTs.
Import Adt.
Require Import Bedrock.Platform.Cito.RepInv.

Require Import Bedrock.Platform.Facade.examples.ListSeqF Bedrock.Platform.Facade.examples.ArrayTupleF Bedrock.Platform.Facade.examples.TupleListF Bedrock.Platform.Facade.examples.Tuples0F Bedrock.Platform.Facade.examples.Tuples1F Bedrock.Platform.Facade.examples.Tuples2F.

Definition rep_inv p adtvalue : HProp :=
  match adtvalue with
    | Tuple t => tuple t p
    | WordList ts => ListSeqF.Adt.lseq ts p
    | TupleList ts => lseq ts p
    | Tuples0 len ts => tuples0 len ts p
    | Tuples1 len key ts => tuples1 len key ts p
    | Tuples2 len key1 key2 ts => tuples2 len key1 key2 ts p
  end.

Module Ri <: RepInv QsADTs.Adt.

  Definition RepInv := W -> ADTValue -> HProp.

  Definition rep_inv := rep_inv.

  Lemma rep_inv_ptr : forall p a, rep_inv p a ===> p =?> 1 * any.
  Proof.
    destruct a; simpl.

    eapply Himp_trans; [ apply tuple_fwd | ].
    sepLemmaLhsOnly.
    fold (@length W) in *.
    Transparent Malloc.freeable.
    unfold Malloc.freeable in H0.
    destruct t; simpl in *; intuition (try omega).
    destruct t; simpl in *; intuition (try omega).
    unfold array; simpl.
    sepLemma; apply any_easy.

    eapply Himp_trans; [ apply ListSeqF.Adt.lseq_fwd | sepLemma ]; apply any_easy.

    eapply Himp_trans; [ apply lseq_fwd | sepLemma ]; apply any_easy.

    unfold tuples0; sepLemma; apply any_easy.

    eapply Himp_trans; [ apply tuples1_fwd | sepLemma ]; apply any_easy.

    eapply Himp_trans; [ apply tuples2_fwd | sepLemma ]; apply any_easy.
  Qed.

End Ri.


(* ========================= *)
(* ===== CH10_CHI_CH.v ===== *)
(* ========================= *)

Require Export CH09_planar.

Open Scope nat_scope.

(* ========================== *)
(* ======= ########## ======= *)
(* ========================== *)

Lemma inv_hmap_CH2 :
  forall (d1:dart)(t1:tag)(p1:point)(d2:dart)(t2:tag)(p2:point)(max:dart),
  d1 <> d2 -> d1 <> nil -> d2 <> nil -> d1 <= max -> d2 <= max ->
  inv_hmap (CH2 d1 t1 p1 d2 t2 p2 max).
Proof.
intros d1 t1 p1 d2 t2 p2 max HA1 HB1 HB2 HC1 HC2.
assert (HB3 : max+1 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HB4 : max+2 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HA2 : d1 <> max+1); [lia|idtac].
assert (HA3 : d2 <> max+1); [lia|idtac].
assert (HA4 : d1 <> max+2); [lia|idtac].
assert (HA5 : d2 <> max+2); [lia|idtac].
assert (HA6 : max+1 <> max+2); [lia|idtac].
simpl; unfold prec_I, prec_L; simpl;
repeat split; unfold succ, pred; simpl;
elimeqdartdec; try intuition.
Qed.

Lemma inv_poly_CH2 :
  forall (d1:dart)(t1:tag)(p1:point)(d2:dart)(t2:tag)(p2:point)(max:dart),
  d1 <> d2 -> d1 <> nil -> d2 <> nil -> d1 <= max -> d2 <= max ->
  inv_poly (CH2 d1 t1 p1 d2 t2 p2 max).
Proof.
intros d1 t1 p1 d2 t2 p2 max HA1 HB1 HB2 HC1 HC2.
assert (HB3 : max+1 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HB4 : max+2 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HA2 : d1 <> max+1); [lia|idtac].
assert (HA3 : d2 <> max+1); [lia|idtac].
assert (HA4 : d1 <> max+2); [lia|idtac].
assert (HA5 : d2 <> max+2); [lia|idtac].
assert (HA6 : max+1 <> max+2); [lia|idtac].
unfold inv_poly; simpl; intros d H.
repeat (elim H; clear H; intro H; try subst d).
(* max+2 *)
right; right; unfold red_dart, succ, pred; simpl;
repeat split; elimeqdartdec; intuition.
(* max+1 *)
right; right; unfold red_dart, succ, pred; simpl;
repeat split; elimeqdartdec; intuition.
(* d2 *)
right; left; unfold blue_dart, succ, pred; simpl;
repeat split; elimeqdartdec; intuition.
(* d1 *)
right; left; unfold blue_dart, succ, pred; simpl;
repeat split; elimeqdartdec; intuition.
Qed.

Lemma planar_CH2 :
  forall (d1:dart)(t1:tag)(p1:point)(d2:dart)(t2:tag)(p2:point)(max:dart),
  d1 <> d2 -> d1 <> nil -> d2 <> nil -> d1 <= max -> d2 <= max ->
  planar (CH2 d1 t1 p1 d2 t2 p2 max).
Proof.
intros d1 t1 p1 d2 t2 p2 max HA1 HB1 HB2 HC1 HC2.
assert (HB3 : max+1 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HB4 : max+2 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HA2 : d1 <> max+1); [lia|idtac].
assert (HA3 : d2 <> max+1); [lia|idtac].
assert (HA4 : d1 <> max+2); [lia|idtac].
assert (HA5 : d2 <> max+2); [lia|idtac].
assert (HA6 : max+1 <> max+2); [lia|idtac].
unfold CH2.
apply <- planarity_criterion_0.
right; simpl; elimeqdartdec; unfold expf; split.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold MF.expo; split. simpl; intuition.
exists 1; simpl; unfold MF.f, McF.f, cF.
simpl; elimeqdartdec; trivial.
apply <- planarity_criterion_0.
left; simpl; intro h; intuition.
apply <- planarity_criterion_1.
left; simpl; intro h; intuition.
apply planar_I.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
apply <- planarity_criterion_1.
left; simpl; intro h; intuition.
apply planar_I.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
apply planar_I.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
apply planar_I.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
apply plf_planar; simpl; trivial.
unfold prec_I; simpl; intuition.
unfold prec_I; simpl; intuition.
unfold prec_I; simpl; intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold prec_I; simpl; intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
unfold inv_hmap, prec_I, prec_L, succ, pred.
simpl; elimeqdartdec; repeat split; try intuition.
Qed.

Lemma well_emb_CH2 :
  forall (d1:dart)(t1:tag)(p1:point)(d2:dart)(t2:tag)(p2:point)(max:dart),
  d1 <> d2 -> d1 <> nil -> d2 <> nil -> d1 <= max -> d2 <= max -> p1 <> p2 ->
  well_emb (CH2 d1 t1 p1 d2 t2 p2 max).
Proof.
intros d1 t1 p1 d2 t2 p2 max HA1 HB1 HB2 HC1 HC2 HP1.
assert (HB3 : max+1 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HB4 : max+2 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HA2 : d1 <> max+1); [lia|idtac].
assert (HA3 : d2 <> max+1); [lia|idtac].
assert (HA4 : d1 <> max+2); [lia|idtac].
assert (HA5 : d2 <> max+2); [lia|idtac].
assert (HA6 : max+1 <> max+2); [lia|idtac].
assert (HP2 : p2 <> p1); [apply neq_sym_point; assumption | idtac].
unfold well_emb; simpl; intros d H.
repeat (elim H; clear H; intro H; try subst d; repeat split;
 unfold succ, pred; simpl; elimeqdartdec; try tauto).
 intros d H; repeat (elim H; clear H; intro H; try subst d; elimeqdartdec; try tauto).
 intros d H; repeat (elim H; clear H; intro H; try subst d; elimeqdartdec; try tauto).
 intros d H; repeat (elim H; clear H; intro H; try subst d; elimeqdartdec; try tauto).
 intros d H; repeat (elim H; clear H; intro H; try subst d; elimeqdartdec; try tauto).
Qed.

Lemma convex_CH2 :
  forall (d1:dart)(t1:tag)(p1:point)(d2:dart)(t2:tag)(p2:point)(max:dart),
  d1 <> d2 -> d1 <> nil -> d2 <> nil -> d1 <= max -> d2 <= max -> p1 <> p2 ->
  convex (CH2 d1 t1 p1 d2 t2 p2 max).
Proof.
intros d1 t1 p1 d2 t2 p2 max HA1 HB1 HB2 HC1 HC2 HP1.
assert (HB3 : max+1 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HB4 : max+2 <> nil).
 apply neq_le_trans with max; [idtac|lia].
 apply neq_le_trans with d1; try assumption.
assert (HA2 : d1 <> max+1); [lia|idtac].
assert (HA3 : d2 <> max+1); [lia|idtac].
assert (HA4 : d1 <> max+2); [lia|idtac].
assert (HA5 : d2 <> max+2); [lia|idtac].
assert (HA6 : max+1 <> max+2); [lia|idtac].
unfold convex; simpl; intros d H.
repeat (elim H; clear H; intro H; try subst d; unfold blue_dart, succ, pred; simpl).
 elimeqdartdec; try tauto.
 elimeqdartdec; try tauto.
 intro H; clear H; intros d H.
 repeat (elim H; clear H; intro H; try subst d; elimeqdartdec; try tauto).
 intro H; clear H; intros d H.
 repeat (elim H; clear H; intro H; try subst d; elimeqdartdec; try tauto).
Qed.

(* ========================== *)
(* ======= ########## ======= *)
(* ========================== *)

Lemma inv_hmap_inv_poly_planar_well_emb_convex_CHI :
  forall (m1:fmap)(m2:fmap)(max:dart),
  inv_hmap m1 -> linkless m1 -> well_emb m1 -> noalign m1 ->
  inv_hmap m2 -> inv_poly m2 -> planar m2 -> well_emb m2 -> convex m2 ->
  (forall (d:dart), max <= d -> d <> nil) ->
  (forall (d:dart), exd m1 d -> ~ exd m2 d) ->
  (forall (d:dart), max <= d -> ~ exd m1 d /\ ~ exd m2 d) ->
  (forall (d1:dart)(d2:dart), exd m1 d1 -> exd m2 d2 -> (fpoint m1 d1) <> (fpoint m2 d2)) ->
  (forall (d1:dart)(d2:dart)(d3:dart), exd m1 d1 -> exd m1 d2 -> exd m2 d3 ->
   (fpoint m1 d1) <> (fpoint m1 d2) -> ~ align (fpoint m1 d1) (fpoint m1 d2) (fpoint m2 d3)) ->
  (forall (d1:dart)(d2:dart)(d3:dart), exd m1 d1 -> exd m2 d2 -> exd m2 d3 ->
   (fpoint m2 d2) <> (fpoint m2 d3) -> ~ align (fpoint m1 d1) (fpoint m2 d2) (fpoint m2 d3)) ->
  inv_hmap (CHI m1 m2 max) /\ inv_poly (CHI m1 m2 max) /\ planar (CHI m1 m2 max) /\ well_emb (CHI m1 m2 max) /\ convex (CHI m1 m2 max).
Proof.
induction m1.
 (* Case 1 : m = V *)
 intros m2 max Hm11 Hm12 Hm13 Hm14 Hm21 Hm22 Hm23 Hm24 Hm25 Hw0 Hw1 Hw5 Hp1 Hp2 Hp3.
 simpl in *; intuition.
 (* Case 2 : m = I *)
 intros m2 max Hm11 Hm12 Hm13 Hm14 Hm21 Hm22 Hm23 Hm24 Hm25 Hw0 Hw1 Hw5 Hp1 Hp2 Hp3.
 simpl in *; unfold prec_I in *.
 destruct Hm11 as [Hm11 [Hneq Hexd]].
(**)
assert (Hw2 : forall (d0:dart), d = d0 \/ exd m1 d0 -> d0 < max).
 intros d0 Hd0.
 elim Hd0; clear Hd0; intro Hd0; try subst d.
  elim (le_lt_dec max d0); intro H.
   generalize (Hw5 d0 H); intuition.
   assumption.
  elim (le_lt_dec max d0); intro H.
   generalize (Hw5 d0 H); intuition.
   assumption.
assert (Hw3 : forall (d0:dart), exd m2 d0 -> ~ exd m1 d0).
 intros d0 Hd0; elim (exd_dec m1 d0).
  intro H; generalize (Hw1 d0); intuition.
  intro H; assumption.
assert (Hw4 : forall (d0:dart), exd m2 d0 -> d0 < max).
 intros d0 Hd0; elim (le_lt_dec max d0).
  intro H; generalize (Hw5 d0 H); intuition.
  intro H; assumption.
move Hw1 after Hp3; move Hw0 after Hp3; move Hw5 after Hw4.
(**)
assert (Hp4 : forall (da:dart), exd m1 da -> fpoint m1 da <> p).
 intros da Hda.
 assert (H0 : exd (I m1 d t p) d); [simpl;tauto|idtac].
 generalize (Hm13 d H0); unfold well_emb; simpl.
 intros [H1 [H2 [H3 [H4 H5]]]]; clear H0 H1 H2 H3 H4.
 assert (H0 : exd (I m1 d t p) da); [simpl;tauto|idtac].
 generalize (H5 da H0); elimeqdartdec; clear H0 H5.
 elim (eq_dart_dec d da); intro Heq; [subst d; contradiction | idtac].
 intro H0; apply neq_sym_point; apply H0; try assumption.
 apply neq_sym; assumption.
 rewrite not_exd_A_nil; try assumption.
 apply exd_not_nil with m1; try assumption.
 rewrite not_exd_A_1_nil; try assumption.
 apply exd_not_nil with m1; try assumption.
(**)
 apply IHm1; clear IHm1; try assumption.
 (* well_emb m1 /\ noalign m1 *)
 apply well_emb_I with d t p; try assumption.
 simpl; unfold prec_I; repeat split; assumption.
 apply noalign_I with d t p; try assumption.
 simpl; unfold prec_I; repeat split; assumption.
 (* inv_hmap CHID *)
 apply inv_hmap_CHID; try assumption.
 apply submap_2_submap; try assumption.
 apply submap_2_refl.
 unfold inv_noalign_point.
  intros da db Hda Hdb Hp0.
  assert (H0 : exd (I m1 d t p) d); [simpl;tauto|idtac].
  generalize (Hp3 d da db H0 Hda Hdb Hp0); clear H0.
  elimeqdartdec; intro H0; auto with myorientation.
 apply (Hw0 max (le_refl max)).
 generalize (Hw2 d); intuition.
 apply Hw1; left; trivial.
 generalize (Hw5 max (le_refl max)); intuition.
 (* inv_poly CHID *)
 apply inv_poly_CHID; try assumption.
 unfold inv_noalign_point.
  intros da db Hda Hdb Hp0.
  assert (H0 : exd (I m1 d t p) d); [simpl;tauto|idtac].
  generalize (Hp3 d da db H0 Hda Hdb Hp0); clear H0.
  elimeqdartdec; intro H0; auto with myorientation.
 apply (Hw0 max (le_refl max)).
 generalize (Hw2 d); intuition.
 apply Hw1; left; trivial.
 generalize (Hw5 max (le_refl max)); intuition.
 (* planar CHID *)
 apply planar_CHID; try assumption.
 apply submap_2_submap; try assumption.
 apply submap_2_refl.
 unfold inv_noalign_point.
  intros da db Hda Hdb Hp0.
  assert (H0 : exd (I m1 d t p) d); [simpl;tauto|idtac].
  generalize (Hp3 d da db H0 Hda Hdb Hp0); clear H0.
  elimeqdartdec; intro H0; auto with myorientation.
 apply (Hw0 max (le_refl max)).
 generalize (Hw2 d); intuition.
 apply Hw1; left; trivial.
 generalize (Hw5 max (le_refl max)); intuition.
 (* well_emb CHID *)
 apply well_emb_CHID; try assumption.
 unfold inv_noalign_point.
  intros da db Hda Hdb Hp0.
  assert (H0 : exd (I m1 d t p) d); [simpl;tauto|idtac].
  generalize (Hp3 d da db H0 Hda Hdb Hp0); clear H0.
  elimeqdartdec; intro H0; auto with myorientation.
 apply (Hw0 max (le_refl max)).
 generalize (Hw2 d); intuition.
 apply Hw1; left; trivial.
 generalize (Hw5 max (le_refl max)); intuition.
 intros da Hda; apply neq_sym_point.
 assert (H0 : exd (I m1 d t p) d); [simpl;tauto|idtac].
 generalize (Hp1 d da H0 Hda); clear H0.
 elimeqdartdec; trivial.
 (* convex CHID *)
 apply inv_convex_CHID; try assumption.
 unfold inv_noalign_point.
  intros da db Hda Hdb Hp0.
  assert (H0 : exd (I m1 d t p) d); [simpl;tauto|idtac].
  generalize (Hp3 d da db H0 Hda Hdb Hp0); clear H0.
  elimeqdartdec; intro H0; auto with myorientation.
 apply (Hw0 max (le_refl max)).
 generalize (Hw2 d); intuition.
 apply Hw1; left; trivial.
 generalize (Hw5 max (le_refl max)); intuition.
 (* Hw0 *)
 intros d0 Hd0; apply Hw0; lia.
 (* Hw1 *)
 intros d0 Hd0; apply not_exd_CHID.
  apply Hw1; right; assumption.
  apply exd_not_exd_neq with m1; assumption.
  generalize (Hw2 d0); intuition.
 (* Hw5 *)
 intros d0 Hd0; split.
  assert (H : max <= d0); [lia|idtac].
  generalize (Hw5 d0 H); intuition.
  apply not_exd_CHID; try lia.
  assert (H : max <= d0); [lia|idtac].
  generalize (Hw5 d0 H); intuition.
  assert (H : max <= d0); [lia|idtac].
  generalize (Hw5 d0 H); intuition.
 (* Hp1 *)
 intros da db Hda Hdb.
 generalize Hdb; intro Hdb2.
 apply exd_CHID_exd_m_or_x_or_max in Hdb2.
 elim Hdb2; clear Hdb2; intro Hdb2.
  rewrite <- inv_fpoint_CHID; try assumption.
  assert (H0 : exd (I m1 d t p) da); [simpl;tauto|idtac].
  generalize (Hp1 da db H0 Hdb2); clear H0.
  elim (eq_dart_dec d da); trivial.
   intro Heq; subst d; contradiction.
  apply exd_not_exd_neq with m2; try assumption.
  apply Hw1; left; trivial.
  generalize (Hw4 db Hdb2); intuition.
 elim Hdb2; clear Hdb2; intro Hdb2; subst db.
  rewrite fpoint_x; try assumption.
  apply Hp4; assumption.
  apply Hw1; left; trivial.
  rewrite fpoint_max; try assumption.
  apply Hp4; assumption.
  generalize (Hw5 max (le_refl max)); intuition.
 (* Hp2 *)
 intros da db dc Hda Hdb Hdc Hp0.
 generalize Hdc; intro Hdc2.
 apply exd_CHID_exd_m_or_x_or_max in Hdc2.
 elim Hdc2; clear Hdc2; intro Hdc2.
  rewrite <- inv_fpoint_CHID; try assumption.
  assert (H01 : exd (I m1 d t p) da); [simpl;tauto|idtac].
  assert (H02 : exd (I m1 d t p) db); [simpl;tauto|idtac].
  generalize (Hp2 da db dc H01 H02 Hdc2); clear H01 H02.
  elim (eq_dart_dec d da).
   intro Heq; subst d; contradiction.
  elim (eq_dart_dec d db).
   intro Heq; subst d; contradiction.
  intros H1 H2 H0; apply H0; assumption.
  apply exd_not_exd_neq with m2; try assumption.
  apply Hw1; left; trivial.
  generalize (Hw4 dc Hdc2); intuition.
 elim Hdc2; clear Hdc2; intro Hdc2; subst dc.
  rewrite fpoint_x; try assumption.
  assert (H01 : exd (I m1 d t p) da); [simpl;tauto|idtac].
  assert (H02 : exd (I m1 d t p) db); [simpl;tauto|idtac].
  assert (H03 : exd (I m1 d t p) d); [simpl;tauto|idtac].
  generalize (Hm14 da db d H01 H02 H03); clear H01 H02 H03.
  simpl; elimeqdartdec.
  elim (eq_dart_dec d da).
   intro Heq; subst d; contradiction.
  elim (eq_dart_dec d db).
   intro Heq; subst d; contradiction.
  intros H1 H2 H0; apply H0; try assumption.
  apply Hp4; assumption.
  apply Hp4; assumption.
  apply Hw1; left; trivial.
  rewrite fpoint_max; try assumption.
  assert (H01 : exd (I m1 d t p) da); [simpl;tauto|idtac].
  assert (H02 : exd (I m1 d t p) db); [simpl;tauto|idtac].
  assert (H03 : exd (I m1 d t p) d); [simpl;tauto|idtac].
  generalize (Hm14 da db d H01 H02 H03); clear H01 H02 H03.
  simpl; elimeqdartdec.
  elim (eq_dart_dec d da).
   intro Heq; subst d; contradiction.
  elim (eq_dart_dec d db).
   intro Heq; subst d; contradiction.
  intros H1 H2 H0; apply H0; try assumption.
  apply Hp4; assumption.
  apply Hp4; assumption.
  generalize (Hw5 max (le_refl max)); intuition.
 (* Hp3 *)
 intros d1 d2 d3 Hd1 Hd2 Hd3 Hp0.
 generalize Hd2; intro Hd20.
 apply exd_CHID_exd_m_or_x_or_max in Hd20.
 elim Hd20; clear Hd20; intro Hd20.
 assert (H1 : fpoint m2 d2 = fpoint (CHID m2 m2 d t p max) d2).
  apply inv_fpoint_CHID; try assumption.
  apply exd_not_exd_neq with m2; try assumption.
  apply Hw1; left; trivial.
  generalize (Hw4 d2 Hd20); intuition.
 rewrite <- H1 in *.
 generalize Hd3; intro Hd30.
 apply exd_CHID_exd_m_or_x_or_max in Hd30.
 elim Hd30; clear Hd30; intro Hd30.
 assert (H2 : fpoint m2 d3 = fpoint (CHID m2 m2 d t p max) d3).
  apply inv_fpoint_CHID; try assumption.
  apply exd_not_exd_neq with m2; try assumption.
  apply Hw1; left; trivial.
  generalize (Hw4 d3 Hd30); intuition.
 rewrite <- H2 in *.
 assert (H3 : exd (I m1 d t p) d1); [simpl;tauto|idtac].
 generalize (Hp3 d1 d2 d3 H3 Hd20 Hd30 Hp0); clear H3.
 elim (eq_dart_dec d d1); trivial.
  intro Heq; subst d; contradiction.
 elim Hd30; clear Hd30; intro Hd30; subst d3.
 assert (H2 : fpoint (CHID m2 m2 d t p max) d = p).
  apply fpoint_x; try assumption.
  apply Hw1; left; trivial.
 rewrite H2 in *.
 assert (H3 : exd (I m1 d t p) d1); [simpl;tauto|idtac].
 assert (H4 : exd (I m1 d t p) d); [simpl;tauto|idtac].
 generalize (Hp2 d1 d d2 H3 H4 Hd20); clear H3 H4.
 simpl; elimeqdartdec.
 elim (eq_dart_dec d d1).
  intro Heq; subst d; contradiction.
  generalize (Hp4 d1 Hd1); intros H Heq H0.
  generalize (H0 H); auto with myorientation.
 assert (H2 : fpoint (CHID m2 m2 d t p max) max = p).
  apply fpoint_max; try assumption.
  generalize (Hw5 max (le_refl max)); intuition.
 rewrite H2 in *.
 assert (H3 : exd (I m1 d t p) d1); [simpl;tauto|idtac].
 assert (H4 : exd (I m1 d t p) d); [simpl;tauto|idtac].
 generalize (Hp2 d1 d d2 H3 H4 Hd20); clear H3 H4.
 simpl; elimeqdartdec.
 elim (eq_dart_dec d d1).
  intro Heq; subst d; contradiction.
  generalize (Hp4 d1 Hd1); intros H Heq H0.
  generalize (H0 H); auto with myorientation.
 elim Hd20; clear Hd20; intro Hd20; subst d2.
 assert (H1 : fpoint (CHID m2 m2 d t p max) d = p).
  apply fpoint_x; try assumption.
  apply Hw1; left; trivial.
 rewrite H1 in *.
 generalize Hd3; intro Hd30.
 apply exd_CHID_exd_m_or_x_or_max in Hd30.
 elim Hd30; clear Hd30; intro Hd30.
 assert (H2 : fpoint m2 d3 = fpoint (CHID m2 m2 d t p max) d3).
  apply inv_fpoint_CHID; try assumption.
  apply exd_not_exd_neq with m2; try assumption.
  apply Hw1; left; trivial.
  generalize (Hw4 d3 Hd30); intuition.
 rewrite <- H2 in *.
 assert (H3 : exd (I m1 d t p) d1); [simpl;tauto|idtac].
 assert (H4 : exd (I m1 d t p) d); [simpl;tauto|idtac].
 generalize (Hp2 d1 d d3 H3 H4 Hd30); clear H3 H4.
 simpl; elimeqdartdec.
 elim (eq_dart_dec d d1).
  intro Heq; subst d; contradiction.
  generalize (Hp4 d1 Hd1); intros H Heq H0.
  generalize (H0 H); auto with myorientation.
 elim Hd30; clear Hd30; intro Hd30; subst d3.
 assert (H2 : fpoint (CHID m2 m2 d t p max) d = p).
  apply fpoint_x; try assumption.
  apply Hw1; left; trivial.
 rewrite H2 in *; tauto.
 assert (H2 : fpoint (CHID m2 m2 d t p max) max = p).
  apply fpoint_max; try assumption.
  generalize (Hw5 max (le_refl max)); intuition.
 rewrite H2 in *; tauto.
 assert (H1 : fpoint (CHID m2 m2 d t p max) max = p).
  apply fpoint_max; try assumption.
   generalize (Hw5 max (le_refl max)); intuition.
 rewrite H1 in *.
 generalize Hd3; intro Hd30.
 apply exd_CHID_exd_m_or_x_or_max in Hd30.
 elim Hd30; clear Hd30; intro Hd30.
 assert (H2 : fpoint m2 d3 = fpoint (CHID m2 m2 d t p max) d3).
  apply inv_fpoint_CHID; try assumption.
  apply exd_not_exd_neq with m2; try assumption.
  apply Hw1; left; trivial.
  generalize (Hw4 d3 Hd30); intuition.
 rewrite <- H2 in *.
 assert (H3 : exd (I m1 d t p) d1); [simpl;tauto|idtac].
 assert (H4 : exd (I m1 d t p) d); [simpl;tauto|idtac].
 generalize (Hp2 d1 d d3 H3 H4 Hd30); clear H3 H4.
 simpl; elimeqdartdec.
 elim (eq_dart_dec d d1).
  intro Heq; subst d; contradiction.
  generalize (Hp4 d1 Hd1); intros H Heq H0.
  generalize (H0 H); auto with myorientation.
 elim Hd30; clear Hd30; intro Hd30; subst d3.
 assert (H2 : fpoint (CHID m2 m2 d t p max) d = p).
  apply fpoint_x; try assumption.
  apply Hw1; left; trivial.
 rewrite H2 in *; tauto.
 assert (H2 : fpoint (CHID m2 m2 d t p max) max = p).
  apply fpoint_max; try assumption.
  generalize (Hw5 max (le_refl max)); intuition.
 rewrite H2 in *; tauto.
 (* Case 3 : m = L *)
 intros m2 max Hm11 Hm12 Hm13 Hm14 Hm21 Hm22 Hm23 Hm24 Hm25 Hw0 Hw1 Hw5 Hp1 Hp2 Hp3.
 simpl in *; intuition.
Qed.

(* ========================== *)
(* ======= ########## ======= *)
(* ========================== *)

Lemma inv_hmap_inv_poly_planar_well_emb_convex_CH :
  forall (m:fmap), prec_CH m ->
  inv_hmap (CH m) /\ inv_poly (CH m) /\ planar (CH m) /\ well_emb (CH m) /\ convex (CH m).
Proof.
induction m.
 (* Case 1 : m = V *)
 intros [Hmap [Hless [Hemb Halign]]].
 simpl in *; intuition.
 unfold inv_poly; simpl; intuition.
 apply plf_planar; simpl; trivial.
 unfold convex; simpl; intuition.
 clear IHm.
 (* Case 2 : m = I *)
 induction m.
  (* Case 2.1 : m = I V *)
  intros [Hmap [Hless [Hemb Halign]]].
  simpl in *; unfold prec_I in *; simpl in *.
  destruct Hmap as [Hmap [H1 H2]].
  split; [idtac|split; [idtac|split]].
  repeat split; try assumption.
  unfold inv_poly; simpl.
  intros da Hda.
  elim Hda; clear Hda; intro Hda; try subst da; try tauto.
  left; unfold black_dart, succ, pred; simpl; tauto.
  apply plf_planar; simpl; try trivial.
  unfold prec_I; simpl; repeat split; trivial.
  simpl in *; intuition.
  unfold convex; simpl in *.
  intros da Hda1 Hda2 db Hdb.
  elim Hda1; clear Hda1; intro Hda1; try subst da; try tauto.
  elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
  clear IHm.
  (* Case 2.2 : m = I I *)
  intros [Hmap [Hless [Hemb Halign]]].
  simpl in *; unfold prec_I in *; simpl in *.
  destruct Hmap as [[Hmap [H1 H2]] [H3 H4]].
  rewritenotorandnot H4 H4 H5.
  move H3 after H1; move H5 after H2;
  move H4 after H3; move Hless after H4.
(**)
assert (Hp1 : p <> p0).
 assert (H0 : exd (I (I m d0 t0 p0) d t p) d); [simpl;tauto|idtac].
 generalize (Hemb d H0); unfold well_emb; simpl.
 intros [Hw1 [Hw2 [Hw3 [Hw4 Hw5]]]]; clear H0 Hw1 Hw2 Hw3 Hw4.
 assert (H0 : exd (I (I m d0 t0 p0) d t p) d0); [simpl;tauto|idtac].
 generalize (Hw5 d0 H0); elimeqdartdec; clear H0 Hw5.
 intro H0; apply H0; try assumption.
 rewrite not_exd_A_nil; try assumption.
 rewrite not_exd_A_1_nil; try assumption.
assert (Hp2 : forall (d:dart), exd m d -> p <> fpoint m d).
 intros da Hda.
 assert (Hneq1 : da <> d). apply exd_not_exd_neq with m ; try assumption.
 assert (Hneq2 : da <> d0). apply exd_not_exd_neq with m ; try assumption.
 assert (H0 : exd (I (I m d0 t0 p0) d t p) d); [simpl;tauto|idtac].
 generalize (Hemb d H0); unfold well_emb; simpl.
 intros [Hw1 [Hw2 [Hw3 [Hw4 Hw5]]]]; clear H0 Hw1 Hw2 Hw3 Hw4.
 assert (H0 : exd (I (I m d0 t0 p0) d t p) da); [simpl;tauto|idtac].
 generalize (Hw5 da H0); elimeqdartdec; clear H0 Hw5.
 intro H0; apply H0; try assumption.
 rewrite not_exd_A_nil; try assumption.
 apply exd_not_nil with m; try assumption.
 rewrite not_exd_A_1_nil; try assumption.
 apply exd_not_nil with m; try assumption.
assert (Hp3 : forall (d:dart), exd m d -> p0 <> fpoint m d).
 intros da Hda.
 assert (Hneq1 : da <> d). apply exd_not_exd_neq with m ; try assumption.
 assert (Hneq2 : da <> d0). apply exd_not_exd_neq with m ; try assumption.
 assert (H0 : exd (I (I m d0 t0 p0) d t p) d0); [simpl;tauto|idtac].
 generalize (Hemb d0 H0); unfold well_emb; simpl.
 intros [Hw1 [Hw2 [Hw3 [Hw4 Hw5]]]]; clear H0 Hw1 Hw2 Hw3 Hw4.
 assert (H0 : exd (I (I m d0 t0 p0) d t p) da); [simpl;tauto|idtac].
 generalize (Hw5 da H0); elimeqdartdec; clear H0 Hw5.
 intro H0; apply H0; try assumption.
 rewrite not_exd_A_nil; try assumption.
 apply exd_not_nil with m; try assumption.
 rewrite not_exd_A_1_nil; try assumption.
 apply exd_not_nil with m; try assumption.
assert (Hp4 : forall (da:dart)(db:dart), exd m da -> exd m db -> da <> db -> fpoint m da <> fpoint m db).
 intros da db Hda Hdb Hneq.
 assert (Hneq1 : da <> d). apply exd_not_exd_neq with m ; try assumption.
 assert (Hneq2 : da <> d0). apply exd_not_exd_neq with m ; try assumption.
 assert (Hneq3 : db <> d). apply exd_not_exd_neq with m ; try assumption.
 assert (Hneq4 : db <> d0). apply exd_not_exd_neq with m ; try assumption.
 assert (H0 : exd (I (I m d0 t0 p0) d t p) da); [simpl;tauto|idtac].
 generalize (Hemb da H0); unfold well_emb; simpl.
 intros [Hw1 [Hw2 [Hw3 [Hw4 Hw5]]]]; clear H0 Hw1 Hw2 Hw3 Hw4.
 assert (H0 : exd (I (I m d0 t0 p0) d t p) db); [simpl;tauto|idtac].
 generalize (Hw5 db H0); elimeqdartdec; clear H0 Hw5.
 intro H0; apply H0; try assumption.
 apply neq_sym; assumption.
 rewrite linkless_A_nil; try assumption.
 apply exd_not_nil with m; try assumption.
 rewrite linkless_A_1_nil; try assumption.
 apply exd_not_nil with m; try assumption.
(**)
elim (le_lt_dec d0 (max_dart m)).
 elim (le_lt_dec d (max_dart m)).
  (* 1 / 4 *)
  intros Hmax1 Hmax2.
  apply inv_hmap_inv_poly_planar_well_emb_convex_CHI; try assumption.
apply well_emb_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply well_emb_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
apply noalign_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply noalign_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
  apply inv_hmap_CH2; try assumption.
  apply inv_poly_CH2; try assumption.
  apply planar_CH2; try assumption.
  apply well_emb_CH2; try assumption.
   apply neq_sym_point; assumption.
  apply convex_CH2; try assumption.
   apply neq_sym_point; assumption.
(* Hw0 *)
intros da Hda;
apply neq_le_trans with d; [assumption|lia].
(* Hw1 *)
intros da Hda; simpl.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
apply and_not_not_or; split; try tauto.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
(* Hw5 *)
intros da Hda; split; simpl.
apply gt_max_dart_not_exd; lia.
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|tauto].
(* Hp1 *)
intros da db Hda Hdb; simpl in *.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elim eq_dart_dec; intro Heq3; [intuition|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
(* Hp2 *)
intros da db dc Hda Hdb Hdc Hp0; simpl in *.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
(* Hp3 *)
intros da db dc Hda Hdb Hdc; simpl in *.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq2; subst d0; contradiction.
intros Heq1 Heq2.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec; tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
  (* 2 / 4 *)
  intros Hmax1 Hmax2.
  apply inv_hmap_inv_poly_planar_well_emb_convex_CHI; try assumption.
apply well_emb_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply well_emb_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
apply noalign_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply noalign_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
  apply inv_hmap_CH2; try assumption; lia.
  apply inv_poly_CH2; try assumption; lia.
  apply planar_CH2; try assumption; lia.
  apply well_emb_CH2; try assumption; try lia.
   apply neq_sym_point; assumption.
  apply convex_CH2; try assumption; try lia.
   apply neq_sym_point; assumption.
(* Hw0 *)
intros da Hda.
apply neq_le_trans with d; [assumption|lia].
(* Hw1 *)
intros da Hda; simpl.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
apply and_not_not_or; split; try tauto.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
(* Hw5 *)
intros da Hda; split; simpl.
apply gt_max_dart_not_exd; lia.
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|tauto].
(* Hp1 *)
intros da db Hda Hdb; simpl in *.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elim eq_dart_dec; intro Heq3; [intuition|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
(* Hp2 *)
intros da db dc Hda Hdb Hdc Hp0; simpl in *.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
(* Hp3 *)
intros da db dc Hda Hdb Hdc; simpl in *.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq2; subst d0; contradiction.
intros Heq1 Heq2.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec; tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
 elim (le_lt_dec d d0).
  (* 3 / 4 *)
  intros Hmax1 Hmax2.
  apply inv_hmap_inv_poly_planar_well_emb_convex_CHI; try assumption.
apply well_emb_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply well_emb_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
apply noalign_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply noalign_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
  apply inv_hmap_CH2; try assumption; lia.
  apply inv_poly_CH2; try assumption; lia.
  apply planar_CH2; try assumption; lia.
  apply well_emb_CH2; try assumption; try lia.
   apply neq_sym_point; assumption.
  apply convex_CH2; try assumption; try lia.
   apply neq_sym_point; assumption.
(* Hw0 *)
intros da Hda.
apply neq_le_trans with d; [assumption|lia].
(* Hw1 *)
intros da Hda; simpl.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
apply and_not_not_or; split; try tauto.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
(* Hw5 *)
intros da Hda; split; simpl.
apply gt_max_dart_not_exd; lia.
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|tauto].
(* Hp1 *)
intros da db Hda Hdb; simpl in *.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elim eq_dart_dec; intro Heq3; [intuition|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
(* Hp2 *)
intros da db dc Hda Hdb Hdc Hp0; simpl in *.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
(* Hp3 *)
intros da db dc Hda Hdb Hdc; simpl in *.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq2; subst d0; contradiction.
intros Heq1 Heq2.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec; tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
  (* 4 / 4 *)
  intros Hmax1 Hmax2.
  apply inv_hmap_inv_poly_planar_well_emb_convex_CHI; try assumption.
apply well_emb_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply well_emb_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
apply noalign_I with d0 t0 p0; try assumption.
simpl; unfold prec_I; simpl; repeat split; assumption.
apply noalign_I with d t p; try assumption.
simpl; unfold prec_I; simpl; repeat split; try assumption.
apply and_not_not_or; split; assumption.
  apply inv_hmap_CH2; try assumption; lia.
  apply inv_poly_CH2; try assumption; lia.
  apply planar_CH2; try assumption; lia.
  apply well_emb_CH2; try assumption; try lia.
   apply neq_sym_point; assumption.
  apply convex_CH2; try assumption; try lia.
   apply neq_sym_point; assumption.
(* Hw0 *)
intros da Hda.
apply neq_le_trans with d; [assumption|lia].
(* Hw1 *)
intros da Hda; simpl.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply exd_le_max_dart in Hda; lia.
apply and_not_not_or; split.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
apply and_not_not_or; split; try tauto.
apply neq_sym; apply exd_not_exd_neq with m; assumption.
(* Hw5 *)
intros da Hda; split; simpl.
apply gt_max_dart_not_exd; lia.
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|idtac].
apply and_not_not_or; split; [lia|tauto].
(* Hp1 *)
intros da db Hda Hdb; simpl in *.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp2; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim eq_dart_dec; intro Heq1; [lia|idtac].
elim eq_dart_dec; intro Heq2; [lia|idtac].
elim eq_dart_dec; intro Heq3; [intuition|idtac].
elimeqdartdec; apply neq_sym_point; apply Hp3; assumption.
(* Hp2 *)
intros da db dc Hda Hdb Hdc Hp0; simpl in *.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
generalize (Halign da db d H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp2; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) db); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da db d0 H01 H02 H03); simpl; elimeqdartdec.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d db).
 intro Heq2; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq3; subst d0; contradiction.
elim (eq_dart_dec d0 db).
 intro Heq4; subst d0; contradiction.
intros Heq1 Heq2 Heq3 Heq4.
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp3; assumption.
apply neq_sym_point; apply Hp3; assumption.
(* Hp3 *)
intros da db dc Hda Hdb Hdc; simpl in *.
elim (eq_dart_dec d da).
 intro Heq1; subst d; contradiction.
elim (eq_dart_dec d0 da).
 intro Heq2; subst d0; contradiction.
intros Heq1 Heq2.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec; tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
intro H; apply H; try assumption.
apply neq_sym_point; apply Hp2; assumption.
apply neq_sym_point; apply Hp3; assumption.
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdb; clear Hdb; intro Hdb; try subst db.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdb; clear Hdb; intro Hdb; try subst db; try tauto.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|tauto].
elim Hdc; clear Hdc; intro Hdc; try subst dc.
elimeqdartdec.
elim eq_dart_dec; intro Heq3; [lia|idtac].
elim eq_dart_dec; intro Heq4; [lia|idtac].
elim eq_dart_dec; intro Heq5; [lia|idtac].
elim eq_dart_dec; intro Heq6; [lia|idtac].
assert (H01 : exd (I (I m d0 t0 p0) d t p) da); [simpl; tauto | idtac].
assert (H02 : exd (I (I m d0 t0 p0) d t p) d); [simpl; tauto | idtac].
assert (H03 : exd (I (I m d0 t0 p0) d t p) d0); [simpl; tauto | idtac].
generalize (Halign da d d0 H01 H02 H03); simpl; elimeqdartdec.
generalize (neq_sym_point p0 (fpoint m da) (Hp3 da Hda)).
generalize (neq_sym_point p (fpoint m da) (Hp2 da Hda)).
auto with myorientation.
elim Hdc; clear Hdc; intro Hdc; try subst dc; try tauto.
  clear IHm.
  (* Case 2.3 : m = I L *)
  intros [Hmap [Hless [Hemb Halign]]].
  simpl in *; intuition.
  clear IHm.
 (* Case 3 : m = L *)
 intros [Hmap [Hless [Hemb Halign]]].
 simpl in *; intuition.
Qed.

(* ========================== *)
(* ======= ########## ======= *)
(* ========================== *)

Theorem inv_hmap_CH : forall (m:fmap),
  prec_CH m -> inv_hmap (CH m).
Proof.
intros m H; generalize (inv_hmap_inv_poly_planar_well_emb_convex_CH m H); intuition.
Qed.

Theorem inv_poly_CH : forall (m:fmap),
  prec_CH m -> inv_poly (CH m).
Proof.
intros m H; generalize (inv_hmap_inv_poly_planar_well_emb_convex_CH m H); intuition.
Qed.

Theorem planar_CH : forall (m:fmap),
  prec_CH m -> planar (CH m).
Proof.
intros m H; generalize (inv_hmap_inv_poly_planar_well_emb_convex_CH m H); intuition.
Qed.

Theorem well_emb_CH : forall (m:fmap),
  prec_CH m -> well_emb (CH m).
Proof.
intros m H; generalize (inv_hmap_inv_poly_planar_well_emb_convex_CH m H); intuition.
Qed.

Theorem convex_CH : forall (m:fmap),
  prec_CH m -> convex (CH m).
Proof.
intros m H; generalize (inv_hmap_inv_poly_planar_well_emb_convex_CH m H); intuition.
Qed.


(* PREAMBLE *)

From compcert.common    Require AST.
From compcert.lib       Require Coqlib.
From compcert.cfrontend Require Csyntax Csem.
From trancert.lib       Require Decidability Tac.
From trancert.analysis  Require Subexpr.

Import AST Csyntax Csem Tac Coqlib Decidability Subexpr.

Section ExistsVar.

  Variable P: common.AST.ident -> Prop.

  Definition expr_is_var e : Prop := exists v ty, e = Evar v ty /\ P v.

  Definition exists_var_in_expr e:  Prop := subexpr_cond expr_is_var e.
  Definition exists_var_in_exprlist el:  Prop := subexprlist_cond expr_is_var el.

  Definition exists_var_in_ctx (C: expr->expr): Prop := (exists k1 k2, context k1 k2 C ) -> forall e, exists_var_in_expr (C e).
  Definition exists_var_in_ctxlist (C: expr->exprlist): Prop := (exists k, contextlist k C ) -> forall e, exists_var_in_exprlist (C e).

  Section Decidability.
    Import lib.Decidability.
    Hypothesis Hdec: forall v, dec (P v).

    Lemma expr_is_var_dec:
      forall e : expr, dec (expr_is_var e).
    Proof.
      unfold dec, expr_is_var in *.
      intros []; try solve [
                       constructor 2;
                       inversion 1;
                       repeat destruct_exists;
                       repeat destruct_and;
                       discriminate].
      - destruct (Hdec x).
        repeat constructor. eauto.
        constructor 2. inversion 1. decomp. inv H. contradiction.
    Defined.

    Theorem exists_var_in_expr_dec: forall e, dec (exists_var_in_expr e).
    Proof.
        apply subexpr_cond_dec. apply expr_is_var_dec.
    Defined.

    Theorem exists_var_in_exprlist_dec: forall e, dec (exists_var_in_exprlist e).
    Proof.
        apply subexprlist_cond_dec.
        apply expr_is_var_dec.
    Defined.

  End Decidability.

  (** It's hard to generalize this for [subexpr_cond]: an arbitrary [P] might
  only hold for complex subexpressions that might be cut in pieces when an
  expression is split onto a context and a subexpression.
   *)

  Hint Constructors subexpr_cond: subexpr.
  Hint Constructors or: subexpr.
  Hint Constructors and: subexpr.
  Hint Constructors ex: subexpr.
  Hint Extern 1 => decomp: subexpr.

  Lemma exists_var_context_split:
    forall C k1 k2,
      context k1 k2 C ->
      forall e, exists_var_in_expr (C e) -> (exists_var_in_expr e \/ exists_var_in_ctx C)
  with exists_var_contextlist_split:
         forall C k, contextlist k C ->
                forall e, exists_var_in_exprlist (C e) ->
                     ( exists_var_in_expr e \/ exists_var_in_ctxlist C ).
  Proof.
    {
      clear exists_var_context_split.
      unfold exists_var_in_ctx, exists_var_in_expr in *.
      induction 1; auto;
        try solve [
              inversion_clear 1;
              solve
                [
                  match goal with [H: subexpr_cond _ _|-_] => eapply IHcontext in H end;
                  decomp; auto;
                  solve [left; eauto with subexpr| right; eauto with subexpr]
                |
                match goal with [H: expr_is_var _|-_] => inversion_clear H end ;
                eauto with subexpr]
            | auto |
            inversion_clear 1; decomp; eauto with subexpr;
            [match goal with [H: subexpr_cond _ _|-_] => eapply IHcontext in H end; decomp;
             right; intros; constructor; eauto|
             match goal with [H: expr_is_var _|-_] => inversion_clear H end ;
             eauto with subexpr]
            ].
      - inversion_clear 1; decomp; eauto with subexpr.
        + eapply exists_var_contextlist_split in H1; [|eassumption].
          decomp; eauto.
          right. intros. decomp. apply ecs_call. right. apply H1. eauto.
        + inv H1. decomp.
      - inversion_clear 1.
        + eapply exists_var_contextlist_split in H1; [|eassumption].
          decomp; eauto.
          right. intros. decomp. apply ecs_builtin. apply H1. eauto.
        + inv H1. decomp.
    }
    {
      clear exists_var_contextlist_split.
      induction 1.
      - inversion_clear 1; decomp.
        eapply exists_var_context_split in H1; decomp; eauto.
        right.
        constructor; auto. left. apply H1; eauto.
        right.
        constructor. auto.
      - inversion_clear 1; decomp.
        + right. constructor; eauto; decomp.
        + eapply IHcontextlist in H1; decomp; eauto.
          right. constructor; auto. right. apply H1.
          decomp.
          inv H0; eauto.
    }
  Defined.

End ExistsVar.

Section AllPointers.
  Import common.Values Integers.Ptrofs.

  Variable P: block -> int  -> Prop.
(* FIXME we can probably rewrite it with subexpr_cond. *)
  Inductive forall_pointers_in_expr : expr -> Prop :=
  | aep_val : forall b ofs ty, P b ofs -> forall_pointers_in_expr (Eval (Vptr b ofs) ty)
  | aep_loc: forall b ofs ty, P b ofs -> forall_pointers_in_expr (Eloc b ofs ty)

  (* boilerplate*)
  | aep_var : forall x ty, forall_pointers_in_expr (Evar x ty)
  | aep_sizeof: forall x ty, forall_pointers_in_expr (Esizeof x ty)
  | aep_alignof: forall x ty, forall_pointers_in_expr (Ealignof x ty)
  | aep_field : forall l f ty, forall_pointers_in_expr l -> forall_pointers_in_expr (Efield l f ty)
  | aep_valof : forall l ty, forall_pointers_in_expr l -> forall_pointers_in_expr (Evalof l ty)
  | aep_deref : forall r ty, forall_pointers_in_expr r -> forall_pointers_in_expr (Ederef r ty)
  | aep_addrof: forall l ty, forall_pointers_in_expr l -> forall_pointers_in_expr (Eaddrof l ty)
  | aep_unop: forall op r ty, forall_pointers_in_expr r -> forall_pointers_in_expr (Eunop op r ty)
  | aep_binop: forall op r1 r2 ty,
      forall_pointers_in_expr r1 ->
      forall_pointers_in_expr r2 ->
      forall_pointers_in_expr (Ebinop op r1 r2 ty)
  | aep_cast: forall r ty, forall_pointers_in_expr r -> forall_pointers_in_expr (Ecast r ty)
  | aep_seqand: forall r1 r2 ty,
      forall_pointers_in_expr r1 ->
      forall_pointers_in_expr r2 ->
      forall_pointers_in_expr (Eseqand r1 r2 ty)
  | aep_seqor: forall r1 r2 ty,
      forall_pointers_in_expr r1 ->
      forall_pointers_in_expr r2 ->
      forall_pointers_in_expr (Eseqor r1 r2 ty)
  | aep_condition: forall r1 r2 r3 ty,
      forall_pointers_in_expr r1 ->
      forall_pointers_in_expr r2 ->
      forall_pointers_in_expr r3 ->
      forall_pointers_in_expr (Econdition r1 r2 r3 ty)
  | aep_assign: forall l r ty,
      forall_pointers_in_expr l ->
      forall_pointers_in_expr r ->
      forall_pointers_in_expr (Eassign l r ty)
  | aep_assignop: forall op l r tyres ty,
      forall_pointers_in_expr l ->
      forall_pointers_in_expr r ->
      forall_pointers_in_expr (Eassignop op l r tyres ty)
  | aep_postincr: forall i l ty, forall_pointers_in_expr l -> forall_pointers_in_expr (Epostincr i l ty)
  | aep_comma: forall r1 r2 ty,
      forall_pointers_in_expr r1 ->
      forall_pointers_in_expr r2 ->
      forall_pointers_in_expr (Ecomma r1 r2 ty)
  | aep_call: forall r1 rargs ty,
      forall_pointers_in_expr r1  ->
      forall_pointers_in_exprlist rargs  ->
      forall_pointers_in_expr (Ecall r1 rargs ty)
  | aep_builtin: forall ef tyargs rargs ty,
      forall_pointers_in_exprlist rargs ->
      forall_pointers_in_expr (Ebuiltin ef tyargs rargs ty)
  | ep_paren: forall r tc ty, forall_pointers_in_expr r -> forall_pointers_in_expr (Eparen r tc ty)
  with forall_pointers_in_exprlist : exprlist-> Prop :=
  | aepl_first : forall_pointers_in_exprlist Enil
  | aepl_rest : forall e es,
      forall_pointers_in_expr e ->
      forall_pointers_in_exprlist es -> forall_pointers_in_exprlist (Econs e es)
  .

  Hypothesis Hdec: forall b ofs, dec (P b ofs).
  Theorem forall_pointers_in_expr_dec:
    forall e, dec (forall_pointers_in_expr e)
    with forall_pointers_in_exprlist_dec:
           forall e, dec (forall_pointers_in_exprlist e).
  Proof.
    {
      clear forall_pointers_in_expr_dec.
      induction e; try solve [
                         left; constructor
                       | try destruct IHe;
                         try destruct IHe1;
                         try destruct IHe2;
                         try destruct IHe3;
                         [left; constructor|right; inversion_clear 1..]; auto
                       ].
      - destruct v; try solve [right; inversion_clear 1].
        destruct (Hdec b i); [left|right].
        + constructor; auto.
        + inversion 1. contradiction.
      - destruct (forall_pointers_in_exprlist_dec rargs), IHe;
          [ left; constructor| right; inversion_clear 1..]; eauto.
      - destruct (forall_pointers_in_exprlist_dec rargs);
          [ left; constructor| right; inversion_clear 1..]; eauto.
      - destruct (Hdec b ofs); [left|right].
        + constructor; auto.
        + inversion 1. contradiction.
    }
    {
      clear forall_pointers_in_exprlist_dec.
      induction e.
      - left. repeat constructor.
      - destruct (forall_pointers_in_expr_dec r1), IHe;
          [ left; repeat constructor | right; inversion_clear 1..]; eauto.
    }
  Defined.

End AllPointers.


(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
Require Import ssreflect.
Require Import ssrnat.
Require Import seq.
Require Import cfmap.
Require Import cfreducible.
Require Import configurations.

Lemma red553to562 : reducible_in_range 553 562 the_configs.
Proof. CheckReducible. Qed.


Add LoadPath "PLC".
Add LoadPath "../metatheory".
Add LoadPath "../lib".
Require PLC_confluence.
Require Export F_soundness.

Ltac gather_atoms ::=
  let A := gather_atoms_with (fun x : vars => x) in
  let B := gather_atoms_with (fun x : var => {{ x }}) in
  let C := gather_atoms_with (fun x : typing_env => dom x) in
  let D1 := gather_atoms_with (fun x => fv_term x) in
  let D2 := gather_atoms_with (fun x => ftv_typ x) in
  let D3 := gather_atoms_with (fun x => ftv_term x) in
  let D4 := gather_atoms_with (fun x => PLC_ott.fv_term x) in
  constr:(A \u B \u C \u D1 \u D2 \u D3 \u D4).

Inductive erase : term -> PLC_ott.term -> Prop :=
| erase_var : forall (x: termvar),
  erase (term_var_f x) (PLC_ott.term_var_f x)
| erase_abs : forall L τ e e',
  lc_typ τ ->
  (forall (x: termvar), x ∉ L ->
  erase (open_term_wrt_term e (term_var_f x)) (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x))) ->
  erase (term_abs τ e) (PLC_ott.term_abs e')
| erase_app : forall e₁ e₁' e₂ e₂',
  erase e₁ e₁' ->
  erase e₂ e₂' ->
  erase (term_app e₁ e₂) (PLC_ott.term_app e₁' e₂')
| erase_gen : forall L e e',
  (forall (x: termvar), x `notin` L ->
  erase (open_term_wrt_typ e (typ_var_f x)) (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x))) ->
  erase (term_gen e) (PLC_ott.term_abs e')
| erase_TApp : forall τ e e',
  lc_typ τ ->
  erase e e' ->
  erase (term_inst e τ) (PLC_ott.term_app e' (PLC_ott.term_abs (PLC_ott.term_var_b 0)))
.
Hint Constructors erase.

Lemma id_regular : PLC_ott.lc_term (PLC_ott.term_abs (PLC_ott.term_var_b 0)).
Proof.
constructor; intros;
unfold PLC_ott.open_term_wrt_term; simpl; auto.
Qed.
Hint Immediate id_regular.

Lemma erase_regular1 : forall e e',
  erase e e' → lc_term e.
Proof.
intros e e' H.
induction H; auto.
Qed.

Lemma erase_regular2 : forall e e',
  erase e e' → PLC_ott.lc_term e'.
Proof.
intros e e' H.
induction H; auto.
Qed.
Hint Resolve erase_regular1 erase_regular2.

Lemma erase_subst : forall e₁ e₂ e₁' e₂' x,
  erase e₁ e₁' → erase e₂ e₂' →
  erase (subst_term e₂ x e₁) (PLC_ott.subst_term e₂' x e₁').
Proof.
intros e₁ e₂ e₁' e₂' x H1 H2.
induction H1; simpl in *; auto.
Case "var".
unfold termvar in *; unfold PLC_ott.termvar in *.
destruct (x0 == x); auto.
Case "abs".
pick fresh y. apply erase_abs with (L := L ∪ {{x}}); intros; auto.
replace (term_var_f x0) with (subst_term e₂ x (term_var_f x0)).
rewrite <- subst_term_open_term_wrt_term; eauto.
replace (PLC_ott.term_var_f x0) with (PLC_ott.subst_term e₂' x (PLC_ott.term_var_f x0)).
rewrite <- PLC_inf.subst_term_open_term_wrt_term; eauto.
autorewrite with lngen; reflexivity.
autorewrite with lngen; reflexivity.
Case "gen".
pick fresh y. apply erase_gen with (L := L ∪ {{x}}); intros; auto.
rewrite <- subst_term_open_term_wrt_typ; eauto.
replace (PLC_ott.term_var_f x0) with (PLC_ott.subst_term e₂' x (PLC_ott.term_var_f x0)).
rewrite <- PLC_inf.subst_term_open_term_wrt_term; eauto.
autorewrite with lngen; reflexivity.
Qed.
Hint Resolve erase_subst.

Lemma erase_tsubst : forall e e' τ a,
  lc_typ τ → erase e e' → erase (tsubst_term τ a e) e'.
Proof.
intros e e' τ a Hlc H.
induction H; simpl in *; auto with lngen.
Case "abs".
pick fresh x. apply erase_abs with (L := L ∪ {{a}}); intros; auto with lngen.
replace (term_var_f x0) with (tsubst_term τ a (term_var_f x0)) by reflexivity.
rewrite <- tsubst_term_open_term_wrt_term; eauto.
Case "gen".
pick fresh x. apply erase_gen with (L := L ∪ {{a}}); intros; auto.
replace (typ_var_f x0) with (tsubst_typ τ a (typ_var_f x0)).
rewrite <- tsubst_term_open_term_wrt_typ; eauto.
autorewrite with lngen; auto.
Qed.
Hint Resolve erase_tsubst.

Lemma erase_fv : forall e e',
  erase e e' → fv_term e [=] PLC_ott.fv_term e'.
Proof.
intros e e' H. induction H; simpl in *; try fsetdec.
Case "abs".
pick fresh x.
assert (PLC_ott.fv_term (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x)) [<=] PLC_ott.fv_term (PLC_ott.term_var_f x) ∪ PLC_ott.fv_term e') by auto with lngen.
assert (PLC_ott.fv_term e' [<=] PLC_ott.fv_term (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x))) by auto with lngen.
assert (fv_term (open_term_wrt_term e (term_var_f x)) [<=] fv_term (term_var_f x) ∪ fv_term e) by auto with lngen.
assert (fv_term e [<=] fv_term (open_term_wrt_term e (term_var_f x))) by auto with lngen.
assert (fv_term (open_term_wrt_term e (term_var_f x)) [=] PLC_ott.fv_term (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x))) by auto.
simpl in *.
fsetdec.
Case "gen".
pick fresh x.
assert (PLC_ott.fv_term (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x)) [<=] PLC_ott.fv_term (PLC_ott.term_var_f x) ∪ PLC_ott.fv_term e') by auto with lngen.
assert (PLC_ott.fv_term e' [<=] PLC_ott.fv_term (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x))) by auto with lngen.
assert (fv_term (open_term_wrt_typ e (typ_var_f x)) [<=] fv_term e) by auto with lngen.
assert (fv_term e [<=] fv_term (open_term_wrt_typ e (typ_var_f x))) by auto with lngen.
assert (fv_term (open_term_wrt_typ e (typ_var_f x)) [=] PLC_ott.fv_term (PLC_ott.open_term_wrt_term e' (PLC_ott.term_var_f x))) by auto.
simpl in *.
fsetdec.
Qed.

Lemma erase_uniqueness : forall e e₁ e₂,
  erase e e₁ → erase e e₂ → e₁ = e₂.
Proof.
intros e e1 e2 H1 H2.
generalize dependent e2.
induction H1; intros e2 H2; inversion H2; subst; f_equal; auto.
Case "abs". pick fresh x.
apply PLC_inf.open_term_wrt_term_inj with (x1 := x); auto.
Case "gen". pick fresh x.
apply PLC_inf.open_term_wrt_term_inj with (x1 := x); auto.
Qed.

Lemma erase_exists : forall e, lc_term e → exists e', erase e e'.
Proof.
intros e H.
induction H; eauto.
Case "abs". pick fresh x.
destruct (H1 x) as [e' H2].
exists (PLC_ott.term_abs (PLC_inf.close_term_wrt_term x e')).
apply erase_abs with (L := PLC_ott.fv_term e' ∪ {{x}}); intros; auto.
rewrite <- PLC_inf.subst_term_spec.
rewrite (subst_term_intro x); auto.
Case "app".
destruct IHlc_term1 as [e1' H1].
destruct IHlc_term2 as [e2' H2].
eauto.
Case "gen". pick fresh x.
destruct (H0 x) as [e' H1].
exists (PLC_ott.term_abs (PLC_inf.close_term_wrt_term x e')).
apply erase_gen with (L := PLC_ott.fv_term e' ∪ {{x}}); intros; auto.
rewrite <- PLC_inf.subst_term_spec.
rewrite (tsubst_term_intro x); auto.
assert (x ∉ PLC_ott.fv_term e').
assert (fv_term (open_term_wrt_typ e (typ_var_f x)) [=] PLC_ott.fv_term e') by auto using erase_fv.
assert (fv_term (open_term_wrt_typ e (typ_var_f x)) [<=] fv_term e). auto with lngen.
fsetdec.
autorewrite with lngen. auto.
Case "inst". destruct IHlc_term as [e' H1]. eauto.
Qed.

Lemma erase_red0 : forall e₁ e₂ e₁' e₂',
  red0 e₁ e₂ → erase e₁ e₁' →
  erase e₂ e₂' → PLC_ott.red0 e₁' e₂'.
Proof.
intros e₁ e₂ e₁' e₂' Hred H1 H2.
inversion Hred; subst; inversion H1; subst.
Case "beta".
inversion H6; subst. assert (e₂' = PLC_ott.open_term_wrt_term e' e₂'0).
eapply erase_uniqueness; eauto.
pick fresh x. rewrite (subst_term_intro x); auto.
rewrite (PLC_inf.subst_term_intro x); auto.
subst; eauto.
Case "beta_t".
inversion H7; subst. assert (e₂' = PLC_ott.open_term_wrt_term e'0 (PLC_ott.term_abs (PLC_ott.term_var_b 0))).
eapply erase_uniqueness; eauto.
pick fresh x. rewrite (tsubst_term_intro x); auto.
rewrite (PLC_inf.subst_term_intro x); auto.
assert (x ∉ PLC_ott.fv_term (PLC_ott.open_term_wrt_term e'0 (PLC_ott.term_var_f x))).
assert (fv_term (open_term_wrt_typ e (typ_var_f x)) [=] PLC_ott.fv_term (PLC_ott.open_term_wrt_term e'0 (PLC_ott.term_var_f x))) by eauto using erase_fv.
assert (fv_term (open_term_wrt_typ e (typ_var_f x)) [<=] fv_term e) by auto with lngen.
fsetdec.
autorewrite with lngen. auto.
subst; eauto.
Qed.

Lemma erase_red1 : forall e₁ e₂ e₁' e₂',
  e₁ ⇝ e₂ → erase e₁ e₁' →
  erase e₂ e₂' → PLC_ott.red1 e₁' e₂'.
Proof.
intros e₁ e₂ e₁' e₂' Hred Herase1 Herase2.
generalize dependent e₁'. generalize dependent e₂'.
induction Hred; intros.
Case "empty". eauto using erase_red0.
Case "appL". inversion Herase1; subst; inversion Herase2; subst.
replace e₂'1 with e₂'0 by eauto using erase_uniqueness; eauto.
Case "appR". inversion Herase1; subst; inversion Herase2; subst.
replace e₁' with e₁'0 by eauto using erase_uniqueness; eauto.
Case "abs". inversion Herase1; subst; inversion Herase2; subst.
pick fresh x.
apply PLC_ott.red1_abs with (L := L ∪ L0 ∪ L1 ∪ {{x}}); intros; eauto.
Case "inst". inversion Herase1; subst; inversion Herase2; subst; eauto.
Case "gen". inversion Herase1; subst; inversion Herase2; subst.
pick fresh x.
apply PLC_ott.red1_abs with (L := L ∪ L0 ∪ L1 ∪ {{x}}); intros; eauto.
Qed.

Lemma erase_red0_inv : forall Γ τ e₁' e₂' e₁,
  PLC_ott.red0 e₁' e₂' →
  erase e₁ e₁' →
  wfterm Γ e₁ τ →
  exists e₂, red0 e₁ e₂.
Proof.
intros Γ τ e₁' e₂' e₁ Hred Herase Hwfterm.
inversion Hred; subst.
inversion Herase; subst.
Case "app". inversion H4; subst.
SCase "abs". eauto.
SCase "gen". inversion Hwfterm; subst. inversion H7.
Case "inst". inversion H5; subst.
SCase "abs". inversion Hwfterm; subst. inversion H10.
SCase "gen". eauto.
Qed.

Lemma erase_id :
erase (term_abs (typ_forall (typ_var_b 0)) (term_var_b 0))
     (PLC_ott.term_abs (PLC_ott.term_var_b 0)).
Proof.
pick fresh x. apply erase_abs with (L := {{x}}); intros.
constructor; intros; unfold open_typ_wrt_typ; simpl; auto.
unfold open_term_wrt_term; unfold PLC_ott.open_term_wrt_term; simpl.
auto.
Qed.
Hint Immediate erase_id.

Lemma wftyp_id : forall Γ, wfenv Γ → wftyp Γ (typ_forall (typ_var_b 0)).
Proof.
intros Γ H. apply wftyp_forall with (L := dom Γ); intros.
unfold open_typ_wrt_typ; simpl; simpl_env; auto.
Qed.
Hint Immediate wftyp_id.

Lemma wfterm_id : forall Γ, wfenv Γ →
wfterm Γ (term_abs (typ_forall (typ_var_b 0)) (term_var_b 0)) (typ_arrow (typ_forall (typ_var_b 0)) (typ_forall (typ_var_b 0))).
Proof.
intros Γ H.
apply wfterm_abs with (L := dom Γ); intros.
unfold open_term_wrt_term; simpl; simpl_env; auto.
Qed.
Hint Resolve wfterm_id.

Lemma erase_red1_inv : forall Γ τ e₁' e₂' e₁,
  PLC_ott.red1 e₁' e₂' →
  erase e₁ e₁' →
  wfterm Γ e₁ τ →
  exists e₂, e₁ ⇝ e₂.
Proof.
intros Γ τ e₁' e₂' e₁ Hred Herase Hwfterm.
generalize dependent e₁. generalize dependent τ. generalize dependent Γ.
induction Hred; intros.
Case "empty". edestruct erase_red0_inv; eauto.
Case "appL". inversion Herase; subst; inversion Hwfterm; subst; edestruct IHHred; eauto.
Case "appR". inversion Herase; subst; inversion Hwfterm; subst.
SCase "app". edestruct IHHred; eauto.
SCase "inst". edestruct IHHred with (e₁ := term_abs (typ_forall (typ_var_b 0)) (term_var_b 0)); eauto.
inversion H0; subst. inversion H1. pick fresh x. assert (term_var_b 0 ^ x ⇝ e' ^ x) as H1 by auto.
unfold open_term_wrt_term in H1; simpl in H1; inversion H1; subst. inversion H2.
Case "abs". inversion Herase; subst; inversion Hwfterm; subst.
SCase "abs". pick fresh x. edestruct (H0 x); eauto.
exists (term_abs τ0 (close_term_wrt_term x x0)).
apply red1_abs with (L := {{x}}); intros; auto.
rewrite <- subst_term_spec.
rewrite (subst_term_intro x); auto.
SCase "gen". pick fresh x. edestruct (H0 x); eauto.
exists (term_gen (close_term_wrt_typ x x0)).
apply red1_gen with (L := {{x}}); intros; auto.
rewrite <- tsubst_term_spec.
rewrite (tsubst_term_intro x); auto.
Qed.

Lemma simulation : forall Γ τ e₁ e₁',
  wfterm Γ e₁ τ →
  erase e₁ e₁' →
  ((exists e₂, e₁ ⇝ e₂) ↔ (exists e₂', PLC_ott.red1 e₁' e₂')).
Proof.
intros Γ τ e₁ e₁' Hwfterm Herase; split; intros [e H].
destruct (erase_exists e); eauto using erase_red1.
edestruct erase_red1_inv; eauto.
Qed.