(* This file is part of the LLIR Semantics project. *)
(* Licensing information is available in the LICENSE file. *)
(* (C) 2020 Nandor Licker. All rights reserved. *)

Require Import Coq.ZArith.ZArith.
Require Import Coq.Lists.List.
Require Import Coq.Program.Equality.

Require Import LLIR.Values.
Require Import LLIR.LLIR.
Require Import LLIR.Maps.

Import ListNotations.

Section FUNCTION.
  Variable f: func.

  Definition entry: node := f.(fn_entry).

  Inductive Closure (x: node): node -> Prop :=
    | closure_refl:
      Closure x x
    | closure_step:
      forall (y: node) (STEP: SuccOf f x y),
        Closure x y
    | closure_trans:
      forall (y: node) (z: node),
        Closure x y -> Closure y z -> Closure x z
    .

  Inductive Reachable: node -> Prop :=
    | reach_entry:
      Reachable f.(fn_entry)
    | reach_succ:
      forall (a: node) (b: node)
        (HD: SuccOf f a b)
        (TL: Reachable a),
        Reachable b
    .

  Theorem reachable_closure:
    forall (n: node) (m:node),
      Reachable n -> Closure n m -> Reachable m.
  Proof.
    intros n m HreachN Hclosure.
    induction Hclosure.
    - apply HreachN.
    - apply (reach_succ x). apply STEP. apply HreachN.
    - apply IHHclosure1 in HreachN.
      apply IHHclosure2 in HreachN.
      apply HreachN.
  Qed.

  Inductive Path: node -> list node -> node -> Prop :=
    | path_nil:
      forall (n: node)
        (REACH: Reachable n),
        Path n [n] n
    | path_cons:
      forall (from: node) (next: node) (to: node) (p: list node)
        (REACH: Reachable from)
        (TL: Path from p next)
        (HD: SuccOf f next to),
        Path from (to :: p) to
    .

  Theorem path_reaches_start:
    forall (x: node) (path: list node) (y: node),
      Path x path y -> Reachable x.
  Proof.
    intros x path y Hpath.
    inversion Hpath; apply REACH.
  Qed.

  Theorem path_reaches_end:
    forall (x: node) (path: list node) (y: node),
      Path x path y -> Reachable y.
  Proof.
    intros x path y Hpath.
    induction Hpath. apply REACH.
    subst. apply (reach_succ next). apply HD. apply IHHpath.
  Qed.

  Theorem start_in_path:
    forall (x: node) (path: list node) (y: node),
      Path x path y -> In x path.
  Proof.
    intros x path y Hpath.
    induction Hpath; intuition.
  Qed.

  Theorem last_in_path:
    forall (x: node) (path: list node) (y: node),
      Path x path y -> In y path.
  Proof.
    intros x path y Hpath.
    inversion Hpath; left; auto.
  Qed.

  Theorem path_app:
    forall (zy: list node) (yx: list node) (x: node) (y: node) (z: node),
      Path x (y::yx) y ->
      Path y zy z ->
      Path x (zy ++ yx) z.
  Proof.
    induction zy; intros yx x y z Hxy Hyz.
    - simpl. inversion Hyz; subst.
    - rewrite <- app_comm_cons.
      inversion Hyz; subst.
      + simpl. apply Hxy.
      + apply (path_cons x next).
        * apply (path_reaches_start x (y::yx) y Hxy).
        * apply (IHzy yx x y next Hxy).
          inversion Hyz; subst; apply TL.
        * apply HD.
  Qed.

  Theorem path_app_inv:
    forall (zy: list node) (yx: list node) (x: node) (y: node) (z: node),
      Path x (zy ++ [y] ++ yx) z ->
      Path x (y::yx) y /\ Path y (zy ++ [y]) z.
  Proof.
    induction zy; intros yx x y z Hpath.
    {
      simpl in Hpath.
      split; inversion Hpath; subst.
      + apply path_nil. apply REACH.
      + apply Hpath.
      + simpl. apply Hpath.
      + simpl. apply path_nil.
        apply (path_reaches_end x (z :: yx) z Hpath).
    }
    {
      inversion Hpath; subst.
      {
        assert (Hcontra: [] <> zy ++ y :: yx).
        {
          destruct zy; intros contra; simpl.
          + simpl in contra. inversion contra.
          + inversion contra.
        }
        apply Hcontra in H2; inversion H2.
      }
      {
        assert (y :: yx = [y] ++ yx). auto.
        rewrite H in TL.
        generalize (IHzy yx x y next TL). intros Hind.
        destruct Hind as [Hl Hr].
        split. apply Hl.
        apply path_cons with (next := next).
        + apply (path_reaches_end x (y :: yx) y Hl).
        + apply Hr.
        + apply HD.
      }
    }
  Qed.

  Theorem path_next:
    forall (n: node) (m: node),
      Closure n m -> Reachable n -> exists p, Path n p m.
  Proof.
    intros n m Hsucc HreachX.
    induction Hsucc.
    {
      exists [x].
      apply path_nil.
      apply HreachX.
    }
    {
      exists [y;x].
      apply (path_cons x x y).
      - apply HreachX.
      - apply path_nil. apply HreachX.
      - apply STEP.
    }
    {
      assert (HreachY: Reachable y).
      { apply (reachable_closure x). apply HreachX. apply Hsucc1. }
      apply IHHsucc1 in HreachX.
      apply IHHsucc2 in HreachY.
      destruct HreachX.
      destruct HreachY.
      inversion H; subst.
      + exists x1. apply H0.
      + exists (x1 ++ p).
        apply path_app with (y := y). apply H. apply H0.
    }
  Qed.

  Theorem reachable_path:
    forall (n: node),
      Reachable n -> exists p, Path entry p n.
  Proof.
    intros n Hreach.
    apply path_next.
    {
      induction Hreach.
      - apply closure_refl.
      - apply (closure_trans entry a b).
        apply IHHreach.
        apply closure_step. apply HD.
    }
    apply reach_entry.
  Qed.

  Inductive ReversePath: node -> list node -> node -> Prop :=
    | reverse_path_nil:
      forall (n: node)
        (REACH: Reachable n),
        ReversePath n [n] n
    | reverse_path_cons:
      forall (from: node) (next: node) (to: node) (p: list node)
        (REACH: Reachable from)
        (TL: ReversePath next p to)
        (HD: SuccOf f from next),
        ReversePath from (from :: p) to.

  Theorem reverse_path_app:
    forall (xy: list node) (yz: list node) (x: node) (y: node) (z: node),
      ReversePath x xy y ->
      ReversePath y (y::yz) z ->
      ReversePath x (xy ++ yz) z.
  Proof.
    induction xy; intros yz x y z Hxy Hyz.
    { inversion Hxy. }
    {
      rewrite <- app_comm_cons.
      inversion Hxy; subst; simpl; auto.
      apply reverse_path_cons with next; auto.
      apply (IHxy yz next y z); auto.
    }
  Qed.

  Remark rev_nil_nil: forall (A: Type) (p: list A),
    rev p = [] -> p = [].
  Proof.
    intros A p Hrev.
    destruct p; auto.
    simpl in Hrev.
    apply app_eq_nil in Hrev.
    destruct Hrev; inversion H0.
  Qed.

  Theorem path_reverse_path:
    forall (from: node) (to: node) (p: list node),
      Path from p to <-> ReversePath from (rev p) to.
  Proof.
    intros from to p; split; intros Hpath.
    {
      induction Hpath; simpl.
      { constructor; auto. }
      {
        apply reverse_path_app with (y := next); auto.
        apply reverse_path_cons with (next := to); auto.
        - apply path_reaches_end with (x := from) (path := p); auto.
        - apply reverse_path_nil.
          apply reach_succ with (a := next); auto.
          apply path_reaches_end with (x := from) (path := p); auto.
      }
    }
    {
      dependent induction Hpath.
      {
        destruct p; [inversion x|].
        simpl in x; symmetry in x.
        apply app_eq_unit in x.
        destruct x as [[Hl Hr]|[_ H']].
        { apply rev_nil_nil in Hl; inversion Hr; subst; constructor; auto. }
        { inversion H'. }
      }
      {
        assert (H: rev (from :: p0) = rev (rev p)). { rewrite x; auto. }
        rewrite rev_involutive in H.
        simpl in H.
        subst p; clear x.
        apply path_app with next.
        { apply path_cons with from; auto; constructor; auto. }
        { apply IHHpath. rewrite rev_involutive. reflexivity. }
      }
    }
  Qed.

  Inductive Dominates: node -> node -> Prop :=
    | dom_self:
      forall (n: node),
        Dominates n n
    | dom_path:
      forall (a: node) (b: node)
        (PATH: forall (p: list node), Path entry p b -> In a p)
        (REACH: Reachable b),
        Dominates a b
    .

  Inductive StrictlyDominates: node -> node -> Prop :=
    | sdom_dom:
        forall (a: node) (b: node)
          (DOM: Dominates a b)
          (STRICT: a <> b),
          StrictlyDominates a b
    .

  Theorem entry_dominates_all:
    forall (n: node),
      Reachable n -> Dominates entry n.
  Proof.
    intro n.
    intro Hreach.
    destruct (Pos.eq_dec n entry).
    + rewrite e. apply dom_self.
    + inversion Hreach; subst.
      - contradiction.
      - apply dom_path.
        {
          intros p Hpath.
          inversion Hpath; subst.
          + contradiction.
          + right. apply start_in_path with (y := next). apply TL0.
        }
        {
          apply Hreach.
        }
  Qed.

  Theorem dom_of_entry:
    forall (n: node),
      Dominates n entry -> n = entry.
  Proof.
    intros n.
    destruct (Pos.eq_dec n entry); intro H. apply e.
    inversion H; auto.
    generalize (PATH [entry]).
    intros Hpath.
    assert (Hentry: Path entry [entry] entry). apply path_nil. apply reach_entry.
    apply Hpath in Hentry.
    inversion Hentry; intuition.
  Qed.

  Theorem dom_reaches:
    forall (n: node),
      Dominates entry n -> Reachable n.
  Proof.
    intros n Hdom.
    inversion Hdom. apply reach_entry. apply REACH.
  Qed.

  Lemma sdom_not_dom:
    forall n m,
      StrictlyDominates n m -> ~Dominates m n.
  Admitted.

  Theorem dom_antisym:
    forall (n: node) (m: node),
      Dominates n m ->
      Dominates m n ->
      m = n.
  Proof.
    intros n m Hnm Hmn.
    destruct (Pos.eq_dec m n) as [|Ene]. apply e.
    apply sdom_not_dom in Hnm. inversion Hnm.
    apply sdom_dom. apply Hmn. apply Ene.
  Qed.

  Theorem in_path_split_app:
    forall (n: node) (m: node) (p: list node) (mid: node),
      Path n p m ->
      In mid p ->
      exists (l: list node) (r: list node),
        Path n (mid::l) mid
        /\
        p = r ++ [mid] ++ l.
  Proof.
    intros n m p mid Hpath Hin.
    induction Hpath.
    {
      inversion Hin; subst; [|inversion H].
      exists []. exists [].
      split; auto. constructor; auto.
    }
    {
      destruct (Pos.eq_dec mid to); subst.
      {
        exists p. exists [].
        split; auto.
        apply path_cons with (next := next); auto.
      }
      {
        destruct Hin.
        { symmetry in H. contradiction. }
        {
          apply IHHpath in H.
          destruct H as [l [r [Hpath' Happ]]].
          exists l. exists (to :: r).
          split; auto.
          rewrite <- app_comm_cons.
          rewrite Happ.
          reflexivity.
        }
      }
    }
  Qed.

  Theorem dom_trans:
    forall (n: node) (m: node) (p: node),
      Dominates n m -> Dominates m p -> Dominates n p.
  Proof.
    intros n m p Hnm Hmp.
    inversion Hmp; subst; auto.
    inversion Hnm; [subst; auto|].
    destruct (Pos.eq_dec m p); [subst; auto|].
    apply dom_path; auto.
    intros p' Hpath. remember Hpath as Hin; clear HeqHin.
    apply PATH in Hin.
    generalize (in_path_split_app entry p p' m Hpath Hin); intros Hsplit.
    destruct Hsplit as [l [r [Hl Happ]]].
    rewrite Happ.
    apply in_or_app.
    right. apply PATH0. rewrite <- app_comm_cons. rewrite app_nil_l. auto.
  Qed.

  Theorem dom_step:
    forall (n: node) (m: node),
      Reachable n
      /\
      SuccOf f n m
      /\
      entry <> m
      /\
      (forall (n': node), SuccOf f n' m -> n = n') ->
      Dominates n m.
  Proof.
    intros n m [Hreach [Hsucc [Hne Huniq]]].
    destruct (Pos.eq_dec n m). subst n. apply dom_self.
    apply dom_path.
    {
      intros path Hpath.
      inversion Hpath; subst. contradiction.
      apply Huniq in HD.
      subst.
      right.
      apply last_in_path with (x := entry). apply TL.
    }
    {
      apply reach_succ with (a := n). apply Hsucc. apply Hreach.
    }
  Qed.

  Theorem sdom_trans:
    forall (n: node) (m: node) (p: node),
      StrictlyDominates n m -> StrictlyDominates m p -> StrictlyDominates n p.
  Proof.
    intros n m p Hnm Hmp.
    inversion Hnm.
    inversion Hmp.
    constructor.
    apply (dom_trans n m p); auto.
    intro contra. subst.
    assert (Heq: m = p). { apply (dom_antisym p m); auto. }
    auto.
  Qed.

  Theorem sdom_irrefl:
    forall (n: node), ~(StrictlyDominates n n).
  Proof.
    intros n contra.
    inversion contra.
    apply STRICT.
    reflexivity.
  Qed.

  Theorem sdom_dominates:
    forall (n: node) (m: node),
      StrictlyDominates n m ->
      Dominates n m.
  Proof.
    intros n m Hsdom.
    inversion Hsdom.
    apply DOM.
  Qed.
End FUNCTION.

Lemma eq_cfg_reach:
  forall (f: func) (f': func),
    f.(fn_entry) = f'.(fn_entry) ->
    (forall (src: node) (dst: node), SuccOf f src dst <-> SuccOf f' src dst) ->
    forall (n: node),
      Reachable f n <-> Reachable f' n.
Proof.
  intros f f' Hentry Heq n.
  split; intros H.
  {
    induction H.
    { rewrite Hentry; constructor. }
    {
      apply reach_succ with (a := a); auto.
      apply Heq; auto.
    }
  }
  {
    induction H.
    { rewrite <- Hentry; constructor. }
    {
      apply reach_succ with (a := a); auto.
      apply Heq; auto.
    }
  }
Qed.

Lemma eq_cfg_path:
  forall (f: func) (f': func),
    f.(fn_entry) = f'.(fn_entry) ->
    (forall (src: node) (dst: node), SuccOf f src dst <-> SuccOf f' src dst) ->
    forall (src: node) (path: list node) (dst: node),
      Path f src path dst <-> Path f' src path dst.
Proof.
  intros f f' Hentry Heq src path dst.
  split; (intros H;induction H;
     [ apply path_nil;
       generalize (eq_cfg_reach f f' Hentry Heq n); intros Hr; apply Hr; auto
     | apply path_cons with (next := next); auto;
        [ generalize (eq_cfg_reach f f' Hentry Heq from); intros Hr; apply Hr; auto
        | apply Heq; auto
        ]
     ]).
Qed.

Lemma eq_cfg_dom:
  forall (f: func) (f': func),
    f.(fn_entry) = f'.(fn_entry) ->
    (forall (src: node) (dst: node), SuccOf f src dst <-> SuccOf f' src dst) ->
    forall (src: node) (dst: node),
      Dominates f src dst <-> Dominates f' src dst.
Proof.
  intros f f' Hentry Heq n.
  split; intros H.
  {
    induction H; constructor.
    {
      intros p Hpath. apply PATH.
      generalize (eq_cfg_path f f' Hentry Heq (entry f) p b); intros Hp; apply Hp.
      unfold entry; rewrite Hentry; auto.
    }
    {
      generalize (eq_cfg_reach f f' Hentry Heq b); intros Hr; apply Hr; auto.
    }
  }
  {
    induction H; constructor.
    {
      intros p Hpath. apply PATH.
      generalize (eq_cfg_path f f' Hentry Heq (entry f') p b); intros Hp; apply Hp.
      unfold entry; rewrite <- Hentry; auto.
    }
    {
      generalize (eq_cfg_reach f f' Hentry Heq b); intros Hr; apply Hr; auto.
    }
  }
Qed.


Require Import Bedrock.Platform.Cito.SyntaxExpr.

(* The depth of stack actually used by compileExpr *)
Fixpoint depth expr :=
  match expr with
    | Var _ => 0
    | Const _ => 0
    | Binop _ a b => max (depth a) (S (depth b))
    | TestE _ a b => max (depth a) (S (depth b))
  end.


From Hammer Require Import Hammer.

Require Import Wellfounded.
Require Import Permutation.
Require Import Mergesort.
From compcert Require Import Coqlib.
From compcert Require Import Maps.
From compcert Require Import Iteration.

Definition node: Type := positive.

Definition graph: Type := PTree.t (list node).

Module PositiveOrd.
Definition t := positive.
Definition leb (x y: t): bool := if plt y x then false else true.

Theorem leb_total : forall x y, is_true (leb x y) \/ is_true (leb y x).
Proof. hammer_hook "Postorder" "Postorder.PositiveOrd.leb_total".
unfold leb, is_true; intros.
destruct (plt x y); auto. destruct (plt y x); auto.
elim (Plt_strict x). eapply Plt_trans; eauto.
Qed.
End PositiveOrd.

Module Sort := Mergesort.Sort(PositiveOrd).

Record state : Type := mkstate {
gr: graph;
wrk: list (node * list node);
map: PTree.t positive;
next: positive
}.

Definition init_state (g: graph) (root: node) :=
match g!root with
| Some succs =>
{| gr := PTree.remove root g;
wrk := (root, Sort.sort succs) :: nil;
map := PTree.empty positive;
next := 1%positive |}
| None =>
{| gr := g;
wrk := nil;
map := PTree.empty positive;
next := 1%positive |}
end.

Definition transition (s: state) : PTree.t positive + state :=
match s.(wrk) with
| nil =>
inl _ s.(map)
| (x, nil) :: l =>
inr _ {| gr := s.(gr);
wrk := l;
map := PTree.set x s.(next) s.(map);
next := Pos.succ s.(next) |}
| (x, y :: succs_x) :: l =>
match s.(gr)!y with
| None =>
inr _ {| gr := s.(gr);
wrk := (x, succs_x) :: l;
map := s.(map);
next := s.(next) |}
| Some succs_y =>
inr _ {| gr := PTree.remove y s.(gr);
wrk := (y, Sort.sort succs_y) :: (x, succs_x) :: l;
map := s.(map);
next := s.(next) |}
end
end.

Section POSTORDER.

Variable ginit: graph.
Variable root: node.

Inductive invariant (s: state) : Prop :=
Invariant

(SUB: forall x y, s.(gr)!x = Some y -> ginit!x = Some y)

(ROOT: s.(gr)!root = None)

(BELOW: forall x y, s.(map)!x = Some y -> Plt y s.(next))

(INJ: forall x1 x2 y, s.(map)!x1 = Some y -> s.(map)!x2 = Some y -> x1 = x2)

(REM: forall x y, s.(gr)!x = Some y -> s.(map)!x = None)

(COLOR: forall x succs n y,
ginit!x = Some succs -> s.(map)!x = Some n ->
In y succs -> s.(gr)!y = None)

(WKLIST: forall x l, In (x, l) s.(wrk) ->
s.(gr)!x = None /\
exists l', ginit!x = Some l'
/\ forall y, In y l' -> ~In y l -> s.(gr)!y = None)

(GREY: forall x, ginit!x <> None -> s.(gr)!x = None -> s.(map)!x = None ->
exists l, In (x,l) s.(wrk)).

Inductive postcondition (map: PTree.t positive) : Prop :=
Postcondition
(INJ: forall x1 x2 y, map!x1 = Some y -> map!x2 = Some y -> x1 = x2)
(ROOT: ginit!root <> None -> map!root <> None)
(SUCCS: forall x succs y, ginit!x = Some succs -> map!x <> None -> In y succs -> ginit!y <> None -> map!y <> None).

Remark In_sort:
forall x l, In x l <-> In x (Sort.sort l).
Proof. hammer_hook "Postorder" "Postorder.In_sort".
intros; split; intros.
apply Permutation_in with l. apply Sort.Permuted_sort. auto.
apply Permutation_in with (Sort.sort l). apply Permutation_sym. apply Sort.Permuted_sort. auto.
Qed.

Lemma transition_spec:
forall s, invariant s ->
match transition s with inr s' => invariant s' | inl m => postcondition m end.
Proof. hammer_hook "Postorder" "Postorder.transition_spec".
intros. inv H. unfold transition. destruct (wrk s) as [ | [x succ_x] l].

constructor; intros.
eauto.
caseEq (s.(map)!root); intros. congruence. exploit GREY; eauto. intros [? ?]; contradiction.
destruct (s.(map)!x) eqn:?; try congruence.
destruct (s.(map)!y) eqn:?; try congruence.
exploit COLOR; eauto. intros. exploit GREY; eauto. intros [? ?]; contradiction.

destruct succ_x as [ | y succ_x ].

constructor; simpl; intros.

eauto.

eauto.

rewrite PTree.gsspec in H. destruct (peq x0 x). inv H.
apply Plt_succ.
apply Plt_trans_succ. eauto.

rewrite PTree.gsspec in H. rewrite PTree.gsspec in H0.
destruct (peq x1 x); destruct (peq x2 x); subst.
auto.
inv H. exploit BELOW; eauto. intros. eelim Plt_strict; eauto.
inv H0. exploit BELOW; eauto. intros. eelim Plt_strict; eauto.
eauto.

intros. rewrite PTree.gso; eauto. red; intros; subst x0.
exploit (WKLIST x nil); auto with coqlib. intros [A B]. congruence.

rewrite PTree.gsspec in H0. destruct (peq x0 x).
inv H0.  exploit (WKLIST x nil); auto with coqlib.
intros [A [l' [B C]]].
assert (l' = succs) by congruence. subst l'.
apply C; auto.
eauto.

apply WKLIST. auto with coqlib.

rewrite PTree.gsspec in H1. destruct (peq x0 x). inv H1.
exploit GREY; eauto. intros [l' A]. simpl in A; destruct A.
congruence.
exists l'; auto.

destruct ((gr s)!y) as [ succs_y | ] eqn:?.

constructor; simpl; intros.

rewrite PTree.grspec in H. destruct (PTree.elt_eq x0 y); eauto. inv H.

rewrite PTree.gro. auto. congruence.

eauto.

eauto.

rewrite PTree.grspec in H. destruct (PTree.elt_eq x0 y); eauto. inv H.

rewrite PTree.grspec. destruct (PTree.elt_eq y0 y); eauto.

destruct H.
inv H. split. apply PTree.grs. exists succs_y; split. eauto.
intros. rewrite In_sort in H. tauto.
destruct H.
inv H. exploit WKLIST; eauto with coqlib. intros [A [l' [B C]]].
split. rewrite PTree.grspec. destruct (PTree.elt_eq x0 y); auto.
exists l'; split. auto. intros. rewrite PTree.grspec. destruct (PTree.elt_eq y0 y); auto.
apply C; auto. simpl. intuition congruence.
exploit (WKLIST x0 l0); eauto with coqlib. intros [A [l' [B C]]].
split. rewrite PTree.grspec. destruct (PTree.elt_eq x0 y); auto.
exists l'; split; auto. intros.
rewrite PTree.grspec. destruct (PTree.elt_eq y0 y); auto.

rewrite PTree.grspec in H0. destruct (PTree.elt_eq x0 y) in H0.
subst. exists (Sort.sort succs_y); auto with coqlib.
exploit GREY; eauto. simpl. intros [l1 A]. destruct A.
inv H2. exists succ_x; auto.
exists l1; auto.

constructor; simpl; intros; eauto.

destruct H. inv H.
exploit (WKLIST x0); eauto with coqlib. intros [A [l' [B C]]].
split. auto. exists l'; split. auto.
intros. destruct (peq y y0). congruence. apply C; auto. simpl. intuition congruence.
eapply WKLIST; eauto with coqlib.

exploit GREY; eauto. intros [l1 A]. simpl in A. destruct A.
inv H2. exists succ_x; auto.
exists l1; auto.
Qed.

Lemma initial_state_spec:
invariant (init_state ginit root).
Proof. hammer_hook "Postorder" "Postorder.initial_state_spec".
unfold init_state. destruct (ginit!root) as [succs|] eqn:?.

constructor; simpl; intros.

rewrite PTree.grspec in H. destruct (PTree.elt_eq x root). inv H. auto.

apply PTree.grs.

rewrite PTree.gempty in H; inv H.

rewrite PTree.gempty in H; inv H.

apply PTree.gempty.

rewrite PTree.gempty in H0; inv H0.

destruct H; inv H.
split. apply PTree.grs. exists succs; split; auto.
intros. rewrite In_sort in H. intuition.

rewrite PTree.grspec in H0. destruct (PTree.elt_eq x root).
subst. exists (Sort.sort succs); auto.
contradiction.

constructor; simpl; intros.

auto.

auto.

rewrite PTree.gempty in H; inv H.

rewrite PTree.gempty in H; inv H.

apply PTree.gempty.

rewrite PTree.gempty in H0; inv H0.

contradiction.

contradiction.

Qed.

Fixpoint size_worklist (w: list (positive * list positive)) : nat :=
match w with
| nil => 0%nat
| (x, succs) :: w' => (S (List.length succs) + size_worklist w')%nat
end.

Definition lt_state (s1 s2: state) : Prop :=
lex_ord lt lt (PTree_Properties.cardinal s1.(gr), size_worklist s1.(wrk))
(PTree_Properties.cardinal s2.(gr), size_worklist s2.(wrk)).

Lemma lt_state_wf: well_founded lt_state.
Proof. hammer_hook "Postorder" "Postorder.lt_state_wf".
set (f := fun s => (PTree_Properties.cardinal s.(gr), size_worklist s.(wrk))).
change (well_founded (fun s1 s2 => lex_ord lt lt (f s1) (f s2))).
apply wf_inverse_image.
apply wf_lex_ord.
apply lt_wf. apply lt_wf.
Qed.

Lemma transition_decreases:
forall s s', transition s = inr _ s' -> lt_state s' s.
Proof. hammer_hook "Postorder" "Postorder.transition_decreases".
unfold transition, lt_state; intros.
destruct (wrk s) as [ | [x succs] l].
discriminate.
destruct succs as [ | y succs ].
inv H. simpl. apply lex_ord_right. omega.
destruct ((gr s)!y) as [succs'|] eqn:?.
inv H. simpl. apply lex_ord_left. eapply PTree_Properties.cardinal_remove; eauto.
inv H. simpl. apply lex_ord_right. omega.
Qed.

End POSTORDER.

Definition postorder (g: graph) (root: node) :=
WfIter.iterate _ _ transition lt_state lt_state_wf transition_decreases (init_state g root).

Inductive reachable (g: graph) (root: positive) : positive -> Prop :=
| reachable_root:
reachable g root root
| reachable_succ: forall x succs y,
reachable g root x -> g!x = Some succs -> In y succs ->
reachable g root y.

Theorem postorder_correct:
forall g root,
let m := postorder g root in
(forall x1 x2 y, m!x1 = Some y -> m!x2 = Some y -> x1 = x2)
/\ (forall x, reachable g root x -> g!x <> None -> m!x <> None).
Proof. hammer_hook "Postorder" "Postorder.postorder_correct".
intros.
assert (postcondition g root m).
unfold m. unfold postorder.
apply WfIter.iterate_prop with (P := invariant g root).
apply transition_spec.
apply initial_state_spec.
inv H.
split. auto.
induction 1; intros.

apply ROOT; auto.

eapply SUCCS; eauto. apply IHreachable. congruence.
Qed.


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

  An attempt at a variable module in a context.

*)

Require Import List.
Export ListNotations.
Require Import ZArith.
Require Import Init.Datatypes.
Require Import Coq.Init.Logic.

Require Export BoolEqualitySigDef.

Set Implicit Arguments.

Module Type VariablesSig <: BoolEqualitySig.
  Inductive Var : Set :=
  | var   : nat -> Var.

 Axiom beq_t : Var -> Var -> bool.
 Hint Resolve beq_t.

 Axiom beq_t_refl:  forall a,     beq_t a a = true.
 Hint Resolve beq_t_refl.
 Hint Rewrite beq_t_refl.

 Axiom beq_t_sym:   forall a b,   beq_t a b = beq_t b a.
 Hint Immediate beq_t_sym.
 Axiom beq_t_trans: forall a b c, beq_t a b = true -> beq_t b c = true -> beq_t a c = true.
 Hint Resolve beq_t_trans.
 Axiom beq_t_eq:    forall a b, beq_t a b = true -> a = b.

 Hint Resolve beq_t_eq.
 Axiom beq_t_neq:   forall a b, beq_t a b = false -> a <> b.
 Hint Resolve beq_t_neq.

 Axiom beq_t_iff_eq:    forall a b, beq_t a b = true <-> a = b.
 Hint Resolve beq_t_iff_eq.

 Axiom beq_t_iff_neq:   forall a b, beq_t a b = false <-> a <> b.
 Hint Resolve beq_t_iff_neq.

 Definition T := Var.
End VariablesSig.


Require Export ProjectiveGeometry.Dev.psoh_equiv_rk_lemmas.

(*****************************************************************************)
(** Proof of projective space rank axioms **)

Section s_psEquivToRk.

Context `{PSR : ProjectiveSpaceRank}.
Context `{EP : EqDecidability Point}.
Context `{OP : OrderedType Point}.
Context `{EL : EqDecidabilityL Line}.
Context `{ELI : EqDecidabilityP Line Intersect}.

Lemma matroid1a : forall e, rkl e >= 0.
Proof.
my_rank.
Qed.

Lemma matroid1b : forall e, rkl e <= cardinal e.
Proof.
intros.
induction e.
simpl.
intuition.
unfold rkl.
case_eq e.
intros.
simpl.
intuition.
intros.
case_eq (contains_four_non_coplanar_points (a :: p :: l)).
intros.
assert( HH0 := matroid3_aux3_bis_bis (a :: p :: l) H0).
assert( HH1 := list_cardinal_aux4 (a :: p :: l) HH0).
intuition.
intros.
case_eq (contains_three_non_collinear_points (a :: p :: l)).
intros.
assert( HH0 := matroid3_aux2_cop (a :: p :: l) H1 H0).
assert( HH1 := list_cardinal_aux3 (a :: p :: l) HH0).
intuition.
intros.
case_eq (contains_two_distinct_points (a :: p :: l)).
intros.
assert( HH0 := matroid3_aux2_col (a :: p :: l) H2 H1).
assert( HH1 := list_cardinal_aux2 (a :: p :: l) HH0).
intuition.
intros.
assert( HH0 := matroid3_aux3 (a :: p :: l) H2).
destruct HH0.
rewrite <-H in H3.
assert( HH1 : (a :: e) <> nil).
intro.
inversion H4.
assert( HH2 := matroid3_aux3_bis (a :: e) HH1).
destruct HH2.
rewrite H4 in H3.
inversion H3.
destruct H4.
rewrite H4 in H3.
inversion H3.
destruct H4.
rewrite H4 in H3.
inversion H3.
rewrite H4 in H3.
inversion H3.
assert( HH1 := list_cardinal_aux1 (a :: p :: l) H3).
intuition.
Qed.

Lemma matroid2 : forall e e', inclA eq e e' -> rkl(e)<=rkl(e').
Proof.
intros;case_eq e;case_eq e';

try my_inAO;my_rank.

my_rank;subst;unfold inclA in *;assert( HH := H p);my_inAO.
unfold rkl;my_rank;subst.
assert( HH := contains_four_non_coplanar_points_sublist (p0 :: p1 :: l1) (p :: nil) H H3);simpl in HH;my_rank.
assert( HH := contains_four_non_coplanar_points_sublist (p0 :: p1 :: l1) (p :: p2 :: l2) H H3);rewrite HH in H5;my_rank.
assert( HH := contains_four_non_coplanar_points_sublist (p0 :: p1 :: l1) (p :: p2 :: l2) H H3);rewrite HH in H5;my_rank.
assert( HH := contains_four_non_coplanar_points_sublist (p0 :: p1 :: l1) (p :: p2 :: l2) H H3);rewrite HH in H5;my_rank.
assert( HH := contains_three_non_collinear_points_sublist (p0 :: p1 :: l1) (p :: nil) H H4);simpl in HH;my_rank.
assert( HH := contains_three_non_collinear_points_sublist (p0 :: p1 :: l1) (p :: p2 :: l2) H H4);rewrite H7 in HH;my_rank.
assert( HH := contains_three_non_collinear_points_sublist (p0 :: p1 :: l1) (p :: p2 :: l2) H H4);rewrite H7 in HH;my_rank.
assert( HH := contains_two_distinct_points_sublist (p0 :: p1 :: l1) (p :: nil) H H5);simpl in HH;my_rank.
assert( HH := contains_two_distinct_points_sublist (p0 :: p1 :: l1) (p :: p2 :: l2) H H5);rewrite H9 in HH;my_rank.
Qed.

Lemma matroid3:
forall e e',
 rkl(e ++ e') + rkl(list_inter e e') <= rkl(e) + rkl(e').
Proof.
my_rank.
assert(HH0 := all_rank e).
assert(HH1 := all_rank e').
progress intuition.
- assert(HH0 := rk_nil e H);assert(HH1 := rk_nil e' H0);
subst;my_rank.
- assert(HH0 := rk_nil e H);subst;simpl;my_rank.
- assert(HH0 := rk_nil e H);subst;simpl;my_rank.
- assert(HH0 := rk_nil e H);subst;simpl;my_rank.
- assert(HH0 := rk_nil e H);subst;simpl;my_rank.
- assert(HH0 := rk_nil e' H0);
  assert(HH1 := list_inter_reverse e nil);
  assert(HH2 := list_concat_reverse e nil);
  subst;rewrite HH1;rewrite HH2;simpl;my_rank.
- assert(HH0 := rk_nil e' H0);
  assert(HH1 := list_inter_reverse e nil);
  assert(HH2 := list_concat_reverse e nil);
  subst;rewrite HH1;rewrite HH2;simpl;my_rank.
- assert(HH0 := rk_nil e' H0);
  assert(HH1 := list_inter_reverse e nil);
  assert(HH2 := list_concat_reverse e nil);
  subst;rewrite HH1;rewrite HH2;simpl;my_rank.
- assert(HH0 := rk_nil e' H0);
  assert(HH1 := list_inter_reverse e nil);
  assert(HH2 := list_concat_reverse e nil);
  subst;rewrite HH1;rewrite HH2;simpl;my_rank.
- rewrite H;rewrite H1;apply matroid3_aux24;my_rank.
- rewrite H0;rewrite H1;apply matroid3_aux17;my_rank.
- rewrite H;rewrite H1;apply matroid3_aux29;my_rank.
- rewrite H;rewrite H1;apply matroid3_aux34;my_rank.
- rewrite H;rewrite H0;apply matroid3_aux24_bis;my_rank.
- rewrite H;rewrite H1;apply matroid3_aux24_bis_bis;my_rank.
- rewrite H;rewrite H1;apply matroid3_aux24_bis_bis_bis;my_rank.
- rewrite H0;rewrite H1;apply matroid3_aux17_bis;my_rank.
- rewrite H;rewrite H0;apply matroid3_aux29_bis;my_rank.
- rewrite H;rewrite H0;apply matroid3_aux34_bis;my_rank.
- rewrite H;rewrite H1;apply matroid3_aux17_bis_bis;my_rank.
- rewrite H;rewrite H1;apply matroid3_aux17_bis_bis_bis;my_rank.
- rewrite H;rewrite H0;apply matroid3_aux29_bis_bis;my_rank.
- rewrite H;rewrite H0;apply matroid3_aux34_bis_bis;my_rank.
- rewrite H;rewrite H0;apply matroid3_aux29_bis_bis_bis;my_rank.
- rewrite H;rewrite H0;apply matroid3_aux34_bis_bis_bis;my_rank.
Qed.

Lemma rk_singleton_ge : forall p:Point, rkl (p::nil) >=1.
Proof.
my_rank.
Qed.

Lemma rk_couple_ge : forall p q:Point,~(p[==]q)-> rkl(p::q::nil)>=2.
Proof.
my_rank;
case (eq_dec_u p q);
my_rank;simpl;my_rank.
Qed.

Lemma rk_pasch : forall a b c d,
rkl (a :: b :: c :: d :: nil) <= 3 ->
exists e, rkl (a :: b :: e :: nil) = 2 /\ rkl (c :: d :: e :: nil) = 2.
Proof.
intros.
unfold rkl in H.
generalize H.
case_eq(contains_four_non_coplanar_points (a :: b :: c :: d :: nil)).
intros.
inversion H1. inversion H3. inversion H5. inversion H7.
case_eq(contains_three_non_collinear_points (a :: b :: c :: d :: nil)).
intros.
rewrite contains_1 in H0.
rewrite contains_2_cop in H1.
destruct H0.
destruct H0.
destruct H0.
destruct H0.
destruct H3.
destruct H4.
assert(HH : InA eq a (a :: b :: c :: d :: nil));[my_inA|].
assert(HH0 : InA eq b (a :: b :: c :: d :: nil));[my_inA|].
assert(HH1 : InA eq c (a :: b :: c :: d :: nil));[my_inA|].
assert(HH2 : InA eq d (a :: b :: c :: d :: nil));[my_inA|].
inversion H0;subst.
inversion H3;subst.
assert(HH3 := col_1 a x1).
rewrite HH3 in H5;inversion H5.
inversion H7;subst.
inversion H4;subst.
assert(HH3 := col_1 a b).
rewrite <-col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H8;subst.
assert(HH3 := col_2 a b).
rewrite HH3 in H5;inversion H5.
inversion H9;subst.
generalize H5.
unfold collinear.
case_eq(eq_dec_u a b).
intros.
inversion H10.
intros.
assert(HH3 := H1 a b c d HH HH0 HH1 HH2).
assert(HH4 := rk_pasch_aux2 a b c d HH3 H5);my_rank.
inversion H10;subst.
assert(HH3 := H1 a b d c HH HH0 HH2 HH1).
assert(HH4 := rk_pasch_aux2 a b d c HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H11.
inversion H8;subst.
inversion H4;subst.
assert(HH3 := col_1 a c).
rewrite <-col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H9;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 a b c d HH HH0 HH1 HH2).
assert(HH4 := rk_pasch_aux2 a b c d HH3 H5);my_rank.
inversion H10;subst.
assert(HH3 := col_2 a c).
rewrite HH3 in H5;inversion H5.
inversion H11;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 c d a b HH1 HH2 HH HH0).
assert(HH4 := rk_pasch_aux2 c d a b HH3 H5).
destruct HH4. exists x.
my_rank.
inversion H12.
inversion H9;subst.
inversion H4;subst.
assert(HH3 := col_1 a d).
rewrite <-col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H10;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 a b d c HH HH0 HH2 HH1).
assert(HH4 := rk_pasch_aux2 a b d c HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H11;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 d c a b HH2 HH1 HH HH0).
assert(HH4 := rk_pasch_aux2 d c a b HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H12;subst.
assert(HH3 := col_2 a d).
rewrite HH3 in H5;inversion H5.
inversion H13.
inversion H10.
inversion H7;subst.
inversion H3;subst.
inversion H4;subst.
assert(HH3 := col_2 b a).
rewrite HH3 in H5;inversion H5.
inversion H8;subst.
assert(HH3 := col_1 b a).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H9;subst.
assert(HH3 := H1 b a c d HH0 HH HH1 HH2).
assert(HH4 := rk_pasch_aux2 b a c d HH3 H5);my_rank.
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H10;subst.
assert(HH3 := H1 b a d c HH0 HH HH2 HH1).
assert(HH4 := rk_pasch_aux2 b a d c HH3 H5);my_rank.
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;
assert(HH6 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH6;my_rank.
inversion H11.
inversion H8;subst.
assert(HH3 := col_1 b x1).
rewrite HH3 in H5;inversion H5.
inversion H9;subst.
inversion H4;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 b a c d HH0 HH HH1 HH2).
assert(HH4 := rk_pasch_aux2 b a c d HH3 H5);my_rank.
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H10;subst.
assert(HH3 := col_1 b c).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H11;subst.
assert(HH3 := col_2 b c).
rewrite HH3 in H5;inversion H5.
inversion H12;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 c d b a HH1 HH2 HH0 HH).
assert(HH4 := rk_pasch_aux2 c d b a HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H13.
inversion H10;subst.
inversion H4;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 b a d c HH0 HH HH2 HH1).
assert(HH4 := rk_pasch_aux2 b a d c HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;
assert(HH6 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH6;my_rank.
inversion H11;subst.
assert(HH3 := col_1 b d).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H12;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 d c b a HH2 HH1 HH0 HH).
assert(HH4 := rk_pasch_aux2 d c b a HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;
assert(HH6 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH6;my_rank.
inversion H13;subst.
assert(HH3 := col_2 b d).
rewrite HH3 in H5;inversion H5.
inversion H14.
inversion H11.
inversion H8;subst.
inversion H3;subst.
inversion H4;subst.
assert(HH3 := col_2 c a).
rewrite HH3 in H5;inversion H5.
inversion H9;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 a b c d HH HH0 HH1 HH2).
assert(HH4 := rk_pasch_aux2 a b c d HH3 H5);my_rank.
inversion H10;subst.
assert(HH3 := col_1 c a).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H11;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 c d a b HH1 HH2 HH HH0).
assert(HH4 := rk_pasch_aux2 c d a b HH3 H5).
destruct HH4. exists x.
my_rank.
inversion H12.
inversion H9;subst.
inversion H4;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 b a c d HH0 HH HH1 HH2).
assert(HH4 := rk_pasch_aux2 b a c d HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H10;subst.
assert(HH3 := col_2 c b).
rewrite HH3 in H5;inversion H5.
inversion H11;subst.
assert(HH3 := col_1 c b).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H12;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 c d b a HH1 HH2 HH0 HH).
assert(HH4 := rk_pasch_aux2 c d b a HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H13.
inversion H10;subst.
assert(HH3 := col_1 c x1).
rewrite HH3 in H5;inversion H5.
inversion H11;subst.
inversion H4;subst.
assert(HH3 := H1 c d a b HH1 HH2 HH HH0).
assert(HH4 := rk_pasch_aux2 c d a b HH3 H5).
destruct HH4. exists x.
my_rank.
inversion H12;subst.
assert(HH3 := H1 c d b a HH1 HH2 HH0 HH).
assert(HH4 := rk_pasch_aux2 c d b a HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H13;subst.
assert(HH3 := col_1 c d).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H14;subst.
assert(HH3 := col_2 c d).
rewrite HH3 in H5;inversion H5.
inversion H15.
inversion H12.
inversion H9;subst.
inversion H3;subst.
inversion H4;subst.
assert(HH3 := col_2 d a).
rewrite HH3 in H5;inversion H5.
inversion H10;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 a b d c HH HH0 HH2 HH1).
assert(HH4 := rk_pasch_aux2 a b d c HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H11;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 d c a b HH2 HH1 HH HH0).
assert(HH4 := rk_pasch_aux2 d c a b HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H12;subst.
assert(HH3 := col_1 d a).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H13.
inversion H10;subst.
inversion H4;subst.
rewrite col_exchange in H5;rewrite col_exchange2 in H5.
assert(HH3 := H1 b a d c HH0 HH HH2 HH1).
assert(HH4 := rk_pasch_aux2 b a d c HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;
assert(HH6 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH6;my_rank.
inversion H11;subst.
assert(HH3 := col_2 d b).
rewrite HH3 in H5;inversion H5.
inversion H12;subst.
rewrite col_exchange2 in H5.
assert(HH3 := H1 d c b a HH2 HH1 HH0 HH).
assert(HH4 := rk_pasch_aux2 d c b a HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;
assert(HH6 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH6;my_rank.
inversion H13;subst.
assert(HH3 := col_1 d b).
rewrite col_exchange2 in HH3.
rewrite HH3 in H5;inversion H5.
inversion H14.
inversion H11;subst.
inversion H4;subst.
assert(HH3 := H1 d c a b HH2 HH1 HH HH0).
assert(HH4 := rk_pasch_aux2 d c a b HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH5;my_rank.
inversion H12;subst.
assert(HH3 := H1 d c b a HH2 HH1 HH0 HH).
assert(HH4 := rk_pasch_aux2 d c b a HH3 H5).
destruct HH4. exists x.
assert(HH5 : equivlistA eq (a :: b :: x :: nil) (b :: a :: x :: nil));[my_inA|];rewrite HH5;
assert(HH6 : equivlistA eq (c :: d :: x :: nil) (d :: c :: x :: nil));[my_inA|];rewrite HH6;my_rank.
inversion H13;subst.
assert(HH3 := col_2 d c).
rewrite HH3 in H5;inversion H5.
inversion H14;subst.
assert(HH3 := col_1 d c).
rewrite col_exchange2 in HH3;rewrite HH3 in H5;inversion H5.
inversion H15.
inversion H12;subst.
assert(HH3 := col_1 d x1).
rewrite HH3 in H5;inversion H5.
inversion H13.
inversion H10.
case_eq(contains_two_distinct_points (a :: b :: c :: d :: nil)).
intros.
assert(HH := matroid3_aux17_bis_aux1 (a :: b :: c :: d :: nil) H0).
rewrite contains_2 in H1.
assert(HH0 : InA eq a (a :: b :: c :: d :: nil));[my_inA|].
assert(HH1 : InA eq b (a :: b :: c :: d :: nil));[my_inA|].
assert(HH2 : InA eq c (a :: b :: c :: d :: nil));[my_inA|].
assert(HH3 : InA eq d (a :: b :: c :: d :: nil));[my_inA|].
destruct HH.
destruct H4.
my_rank.
case_eq(eq_dec_u a b);case_eq(eq_dec_u c d).
assert(HH4 := a1_exist a b).
destruct HH4.
assert(HH4 := a3_1 x1).
destruct HH4.
destruct s.
destruct s.
destruct a1.
destruct H8.
destruct H9.
destruct H10.
destruct H11.
intros.
rewrite e.
rewrite e0.
case_eq(eq_dec_u b x2);case_eq(eq_dec_u b x3);
case_eq(eq_dec_u d x2);case_eq(eq_dec_u d x3).
intros;clear H15;rewrite e2 in e1;contradiction.
intros;clear H17;rewrite e3 in e2;contradiction.
intros;clear H17;rewrite e3 in e2;contradiction.
intros;clear H17;rewrite e2 in e1;contradiction.
intros;clear H15;rewrite e2 in e1;contradiction.
intros;rewrite e1;rewrite e2;exists x3;
split;apply rk_pasch_aux0;my_rank.
intros;rewrite e1;rewrite e2;exists x4;
split;apply rk_pasch_aux0;my_rank.
intros;rewrite e1;exists x3;
split;apply rk_pasch_aux0;my_rank.
intros;rewrite e1;rewrite e3;exists x4;
split;apply rk_pasch_aux0;my_rank.
intros;rewrite e1;rewrite e2;exists x4;
split;apply rk_pasch_aux0;my_rank.
intros;rewrite e1;rewrite e2;exists x2;
split;apply rk_pasch_aux0;my_rank.
intros;rewrite e1;exists x2;
split;apply rk_pasch_aux0;my_rank.
intros;clear H15;rewrite e2 in e1;contradiction.
intros;rewrite e1;exists x3;
split;apply rk_pasch_aux0;my_rank.
intros;rewrite e1;exists x2;
split;apply rk_pasch_aux0;my_rank.
intros;exists x3;
split;apply rk_pasch_aux0;my_rank.
intros.
case_eq(eq_dec_u a c).
intros.
exists d.
rewrite <-e;rewrite e0.
split;apply rk_pasch_aux0;my_rank.
intros.
exists c.
assert(HH4 : equivlistA eq (a :: b :: c :: nil) (a :: c :: b :: nil));[my_inA|].
split.
rewrite HH4;apply rk_pasch_aux3;my_rank.
apply rk_pasch_aux0;my_rank.
intros.
case_eq(eq_dec_u a c).
intros.
exists b.
rewrite <-e;rewrite <-e0.
split;apply rk_pasch_aux0;my_rank.
intros.
exists a.
split.
apply rk_pasch_aux0;my_rank.
rewrite <-e.
apply rk_pasch_aux0;my_rank.
intros.
exists a.
split.
apply rk_pasch_aux0;my_rank.
assert(HH4 := H1 c d a HH2 HH3 HH0).
apply rk_pasch_aux3;my_rank.

intros.
assert(HH4 := a1_exist a b).
destruct HH4.
assert(HH4 := a3_1 x).
destruct HH4;destruct s;destruct s;destruct a1.
destruct H5;destruct H6;destruct H7;destruct H8.
simpl in H0.
generalize H0.
case_eq(eq_dec_u a b);case_eq(eq_dec_u b c);case_eq(eq_dec_u c d).
intros.
rewrite e1;rewrite e0;rewrite e.
case_eq(eq_dec_u d x0);case_eq(eq_dec_u d x1).
intros;clear H14;rewrite e3 in e2;my_rank.
intros;exists x1;split;apply rk_pasch_aux0;my_rank.
intros;exists x0;split;apply rk_pasch_aux0;my_rank.
intros;exists x1;split;apply rk_pasch_aux0;my_rank.
intros;inversion H13.
intros;inversion H13.
intros;inversion H13.
intros;inversion H13.
intros;inversion H13.
intros;inversion H13.
intros;inversion H13.
Qed.

Lemma rk_three_points : forall a b, exists c,
rkl(a :: b :: c :: nil) = 2 /\ rkl(b :: c :: nil) = 2 /\ rkl(a :: c :: nil) = 2.
Proof.
intros.
assert( HH0 := a1_exist a b).
destruct HH0.
destruct a0.
assert( HH0 := a3_1 x).
destruct HH0.
destruct s.
destruct s.
destruct a0.
destruct H2.
destruct H3.
destruct H4.
destruct H5.
case_eq (eq_dec_u a x0).
case_eq (eq_dec_u b x1).
exists x2.
intros.
rewrite e.
rewrite e0.
simpl.
case_eq (coplanar x0 x1 x2 x2).
intros.
case_eq (collinear x0 x1 x2).
intros.
case_eq (eq_dec_u x0 x1).
intros.
contradiction.
intros.
case_eq (eq_dec_u x1 x2).
intros.
contradiction.
intros.
case_eq (eq_dec_u x0 x2).
intros.
contradiction.
intros.
split.
reflexivity.
split.
reflexivity.
reflexivity.
unfold collinear.
case_eq (eq_dec_u x0 x1).
intros.
inversion H11.
destruct (a1_exist x0 x1).
simpl.
case_eq (incid_dec x2 x3).
intros.
inversion H12.
intros.
destruct a0.
assert( HH0 := uniqueness x0 x1 x x3 H4 H5 H13 H14).
destruct HH0.
contradiction.
clear H10.
rewrite <-H15 in *.
contradiction.
unfold coplanar.
case_eq (eq_dec_u x0 x1).
intros.
inversion H10.
case_eq (eq_dec_u x2 x2).
intros.
inversion H11.
intros.
apply False_ind.
apply n.
reflexivity.
intros.
exists x1.
simpl.
split.
case_eq (coplanar a b x1 x1).
case_eq (collinear a b x1).
case_eq (eq_dec_u a b).
case_eq (eq_dec_u b x1).
intros.
clear H7 H8 H9 H10.
rewrite e in e1.
rewrite e0 in e1.
contradiction.
intros.
reflexivity.
intros.
reflexivity.
unfold collinear.
case_eq (eq_dec_u a b).
intros.
inversion H10.
destruct (a1_exist a b).
simpl.
case_eq (incid_dec x1 x3).
intros.
inversion H11.
intros.
destruct a0.
assert( HH0 := uniqueness a b x x3 H H0 H13 H14).
destruct HH0.
contradiction.
clear H9.
rewrite H15 in *.
contradiction.
intros.
assert(HH := cop_3 a b x1).
rewrite HH in H9.
inversion H9.
case_eq (eq_dec_u b x1).
intros.
contradiction.
intros.
split.
reflexivity.
case_eq (eq_dec_u a x1).
intros.
clear H10.
rewrite e in e0.
contradiction.
intros.
reflexivity.
intros.
case_eq (eq_dec_u b x1).
intros.
exists x0.
simpl.
split.
case_eq (coplanar a b x0 x0).
intros.
case_eq (collinear a b x0).
intros.
case_eq (eq_dec_u a b).
case_eq (eq_dec_u b x0).
intros.
clear H8.
rewrite e0 in e.
contradiction.
intros.
reflexivity.
intros.
reflexivity.
unfold collinear.
case_eq (eq_dec_u a b).
intros.
inversion H11.
destruct (a1_exist a b).
simpl.
case_eq (incid_dec x0 x3).
intros.
inversion H12.
intros.
destruct a0.
assert( HH0 := uniqueness a b x x3 H H0 H13 H14).
destruct HH0.
contradiction.
clear H10.
rewrite <-H15 in n0.
contradiction.
intros.
assert(HH := cop_3 a b x0).
rewrite HH in H9.
inversion H9.
case_eq (eq_dec_u b x0).
intros.
clear H8.
rewrite e0 in e.
contradiction.
intros.
split.
reflexivity.
case_eq (eq_dec_u a x0).
intros.
contradiction.
reflexivity.
intros.
case_eq (eq_dec_u b x0).
case_eq (eq_dec_u a x1).
intros.
exists x2.
simpl.
split.
case_eq (coplanar a b x2 x2).
case_eq (collinear a b x2).
case_eq (eq_dec_u a b).
case_eq (eq_dec_u b x2).
intros.
clear H11.
rewrite e0 in e1.
contradiction.
intros.
reflexivity.
intros.
reflexivity.
unfold collinear.
case_eq (eq_dec_u a b).
intros.
inversion H12.
destruct (a1_exist a b).
simpl.
case_eq (incid_dec x2 x3).
intros.
inversion H13.
intros.
destruct a0.
assert( HH0 := uniqueness a b x x3 H H0 H15 H16).
destruct HH0.
contradiction.
clear H11.
rewrite H17 in *.
contradiction.
intros.
assert(HH := cop_3 a b x2).
rewrite HH in H11.
inversion H11.
case_eq (eq_dec_u b x2).
intros.
clear H11.
rewrite e0 in e1.
contradiction.
intros.
split.
reflexivity.
case_eq (eq_dec_u a x2).
intros.
clear H12.
rewrite e in e1.
contradiction.
intros.
reflexivity.
intros.
exists x1.
split.
simpl.
case_eq (coplanar a b x1 x1).
intros.
case_eq (collinear a b x1).
intros.
case_eq (eq_dec_u a b).
intros.
case_eq (eq_dec_u b x1).
intros.
contradiction.
intros.
reflexivity.
intros.
reflexivity.
intros.
generalize H12.
unfold collinear.
case_eq (eq_dec_u a b).
intros.
inversion H14.
destruct (a1_exist a b).
simpl.
case_eq( incid_dec x1 x3).
intros.
inversion H15.
intros.
destruct a0.
assert( HH0 := uniqueness a b x x3 H H0 H16 H17).
destruct HH0.
contradiction.
clear H13.
rewrite <-H18 in n2.
contradiction.
intros.
assert(HH0 := cop_3 a b x1).
rewrite HH0 in H11.
inversion H11.
split.
simpl.
case_eq (eq_dec_u b x1).
intros.
contradiction.
intros.
reflexivity.
simpl.
case_eq (eq_dec_u a x1).
intros.
contradiction.
intros.
reflexivity.
intros.
exists x0.
split.
simpl.
case_eq (coplanar a b x0 x0).
intros.
case_eq (collinear a b x0).
intros.
case_eq (eq_dec_u a b).
intros.
case_eq (eq_dec_u b x0).
intros.
contradiction.
intros.
reflexivity.
intros.
reflexivity.
intros.
generalize H11.
unfold collinear.
case_eq (eq_dec_u a b).
intros.
inversion H13.
intro.
destruct (a1_exist a b).
simpl.
case_eq(incid_dec x0 x3).
intros.
inversion H14.
intros.
destruct a0.
assert( HH0 := uniqueness a b x x3 H H0 H15 H16).
destruct HH0.
contradiction.
clear H12.
rewrite <-H17 in n3.
contradiction.
intros.
assert(HH := cop_3 a b x0).
rewrite HH in H10.
inversion H10.
split.
simpl.
case_eq (eq_dec_u b x0).
intros.
contradiction.
intros.
reflexivity.
simpl.
case_eq (eq_dec_u a x0).
intros.
contradiction.
intros.
reflexivity.
Qed.

Lemma rk_lower_dim : exists a b c d, rkl(a :: b :: c :: d :: nil) = 4.
Proof.
intros.
assert( HH0 := a3_2).
destruct HH0.
destruct s.
case_eq(eq_dec_p x x0).
intros.
clear H.
unfold Intersect in i.
destruct i.
my_rank.
assert(HH := n x1).
apply False_ind.
apply HH.
my_rank.
intros.
assert(HH := a3_1 x).
assert(HH0 := a3_1 x0).
destruct HH. destruct s. destruct s. destruct a.
destruct HH0. destruct s. destruct s. destruct a.
my_rank.
exists x1. exists x2. exists x4. exists x5.
simpl.
case_eq(coplanar x1 x2 x4 x4).
case_eq(coplanar x1 x2 x5 x4).
case_eq(coplanar x1 x2 x4 x5).
case_eq(coplanar x1 x2 x5 x5).
case_eq(coplanar x1 x4 x5 x5).
case_eq(coplanar x2 x4 x5 x5).
intros.
generalize H13.
unfold coplanar.
case_eq(eq_dec_u x2 x4).
intros.
rewrite e in *.
assert(Intersect x x0).
unfold Intersect.
exists x4.
solve[intuition].
contradiction.
case_eq(eq_dec_u x5 x5).
intros.
case_eq(collinear x1 x2 x4).
unfold collinear.
case_eq(eq_dec_u x1 x2).
intros.
contradiction.
destruct (a1_exist x1 x2).
simpl.
case_eq(incid_dec x4 x7).
intros.
destruct a.
assert(HH0 := uniqueness x1 x2 x x7 H9 H10 H24 H25).
destruct HH0.
contradiction.
clear H21.
rewrite <-H26 in *.
assert(HH : Intersect x x0).
unfold Intersect.
exists x4.
solve[intuition].
contradiction.
intros.
inversion H23.
intros.
generalize H13.
unfold coplanar.
case_eq(eq_dec_u x1 x4).
intros.
rewrite e0 in *.
assert(Intersect x x0).
unfold Intersect.
exists x4.
solve[intuition].
contradiction.
case_eq(eq_dec_u x5 x5).
intros.
generalize H14.
unfold coplanar.
case_eq(eq_dec_u x1 x2).
intros.
contradiction.
case_eq(eq_dec_u x5 x5).
intros.
generalize H15.
unfold coplanar.
case_eq(eq_dec_u x1 x2).
intros.
contradiction.
case_eq(eq_dec_u x4 x5).
intros.
contradiction.
destruct(a1_exist x1 x2).
destruct(a1_exist x4 x5).
simpl.
case_eq(eq_dec_l x7 x8).
intros.
rewrite e2 in *.
destruct a.
assert(HH := uniqueness x1 x2 x x8 H9 H10 H32 H33).
destruct HH.
contradiction.
rewrite <-H34 in *.
assert(Intersect x x0).
unfold Intersect.
exists x4.
solve[intuition].
contradiction.
case_eq(eq_dec_p x7 x8).
intros.
destruct a.
destruct a0.
assert(HH := uniqueness x1 x2 x x7 H9 H10 H33 H34).
destruct HH.
contradiction.
assert(HH := uniqueness x4 x5 x0 x8 H5 H6 H35 H36).
destruct HH.
contradiction.
clear H28.
rewrite <-H37 in *.
rewrite <-H38 in *.
contradiction.
intros.
inversion H32.
intros.
contradiction.
intros.
contradiction.
intros.
apply False_ind.
apply n1.
reflexivity.
solve[intuition].
solve[intuition].
solve[intuition].
solve[intuition].
solve[intuition].
solve[intuition].
Qed.

Lemma rk_upper_dim : forall a b c d e f,
rkl(a :: b :: nil) = 2 /\ rkl(c :: d :: nil) = 2 /\ rkl(e :: f :: nil) = 2 /\
rkl(a :: b :: c :: d :: nil) >= 3 /\ rkl(a :: b :: e :: f :: nil) >= 3 /\ rkl(c :: d :: e :: f :: nil) >= 3 ->
exists j1 : Point, exists j2 : Point, exists j3 : Point,
rkl (a :: b :: j1 :: nil) = 2 /\ rkl (c :: d :: j2 :: nil) = 2 /\ rkl (e :: f :: j3 :: nil) = 2 /\ rkl (j1 :: j2 :: j3 :: nil) <= 2.
Proof.
intros.
destruct H.
destruct H0.
destruct H1.
destruct H2.
destruct H3.
assert(H00 := H);clear H.
assert(H01 := H0);clear H0.
assert(H02 := H1);clear H1.
assert(H := H2);clear H2.
assert(H0 := H3);clear H3.
assert(H1 := H4);clear H4.
assert(HH := a3_3).
assert(HH0 := a1_exist a b).
destruct HH0.
assert(HH1 := a1_exist c d).
destruct HH1.
assert(HH2 := a1_exist e f).
destruct HH2.
assert(HH3 := HH x x0 x1);clear HH.
destruct a0.
destruct a1.
destruct a2.

case_eq(eq_dec_l x x0).
intros.
rewrite e0 in *;clear e0;clear H8.

generalize H.
unfold rkl.
case_eq(contains_four_non_coplanar_points (a :: b :: c :: d :: nil)).
intros.
clear H9.
assert(H9 := contains_four_to_three_aux' (a :: b :: c :: d :: nil) H8).
assert(HH4 := rk_upper_dim_aux a b c d H9).
destruct HH4.
assert(HH5 := rk_upper_dim_aux2 a b c x0 H2 H3 H4 H10).
inversion HH5.
destruct H10.
assert(HH5 := rk_upper_dim_aux2 a b d x0 H2 H3 H5 H10).
inversion HH5.
destruct H10.
assert(HH5 := rk_upper_dim_aux2 a c d x0 H2 H4 H5 H10).
inversion HH5.
assert(HH5 := rk_upper_dim_aux2 b c d x0 H3 H4 H5 H10).
inversion HH5.
intro.
case_eq(contains_three_non_collinear_points (a :: b :: c :: d :: nil)).
intros.
assert(HH4 := rk_upper_dim_aux a b c d H9).
destruct HH4.
assert(HH5 := rk_upper_dim_aux2 a b c x0 H2 H3 H4 H11).
inversion HH5.
destruct H11.
assert(HH5 := rk_upper_dim_aux2 a b d x0 H2 H3 H5 H11).
inversion HH5.
destruct H11.
assert(HH5 := rk_upper_dim_aux2 a c d x0 H2 H4 H5 H11).
inversion HH5.
assert(HH5 := rk_upper_dim_aux2 b c d x0 H3 H4 H5 H11).
inversion HH5.
intro.
case_eq(contains_two_distinct_points (a :: b :: c :: d :: nil)).
intros.
inversion H11.
inversion H13.
inversion H15.
intros.
inversion H11.
inversion H13.
intros.

case_eq(eq_dec_l x x1).
intros.
rewrite e0 in *;clear e0;clear H9.

generalize H0.
unfold rkl.
case_eq(contains_four_non_coplanar_points (a :: b :: e :: f :: nil)).
intros.
clear H10.
assert(H10 := contains_four_to_three_aux' (a :: b :: e :: f :: nil) H9).
assert(HH4 := rk_upper_dim_aux a b e f H10).
destruct HH4.
assert(HH5 := rk_upper_dim_aux2 a b e x1 H2 H3 H6 H11).
inversion HH5.
destruct H11.
assert(HH5 := rk_upper_dim_aux2 a b f x1 H2 H3 H7 H11).
inversion HH5.
destruct H11.
assert(HH5 := rk_upper_dim_aux2 a e f x1 H2 H6 H7 H11).
inversion HH5.
assert(HH5 := rk_upper_dim_aux2 b e f x1 H3 H6 H7 H11).
inversion HH5.
intro.
case_eq(contains_three_non_collinear_points (a :: b :: e :: f :: nil)).
intros.
assert(HH4 := rk_upper_dim_aux a b e f H10).
destruct HH4.
assert(HH5 := rk_upper_dim_aux2 a b e x1 H2 H3 H6 H12).
inversion HH5.
destruct H12.
assert(HH5 := rk_upper_dim_aux2 a b f x1 H2 H3 H7 H12).
inversion HH5.
destruct H12.
assert(HH5 := rk_upper_dim_aux2 a e f x1 H2 H6 H7 H12).
inversion HH5.
assert(HH5 := rk_upper_dim_aux2 b e f x1 H3 H6 H7 H12).
inversion HH5.
intro.
case_eq(contains_two_distinct_points (a :: b :: e :: f :: nil)).
intros.
inversion H12.
inversion H14.
inversion H16.
intros.
inversion H12.
inversion H14.
intros.

case_eq(eq_dec_l x0 x1).
intros.
rewrite e0 in *;clear e0;clear H10.

generalize H1.
unfold rkl.
case_eq(contains_four_non_coplanar_points (c :: d :: e :: f :: nil)).
intros.
clear H11.
assert(H11 := contains_four_to_three_aux' (c :: d :: e :: f :: nil) H10).
assert(HH4 := rk_upper_dim_aux c d e f H11).
destruct HH4.
assert(HH5 := rk_upper_dim_aux2 c d e x1 H4 H5 H6 H12).
inversion HH5.
destruct H12.
assert(HH5 := rk_upper_dim_aux2 c d f x1 H4 H5 H7 H12).
inversion HH5.
destruct H12.
assert(HH5 := rk_upper_dim_aux2 c e f x1 H4 H6 H7 H12).
inversion HH5.
assert(HH5 := rk_upper_dim_aux2 d e f x1 H5 H6 H7 H12).
inversion HH5.
intro.
case_eq(contains_three_non_collinear_points (c :: d :: e :: f :: nil)).
intros.
assert(HH4 := rk_upper_dim_aux c d e f H11).
destruct HH4.
assert(HH5 := rk_upper_dim_aux2 c d e x1 H4 H5 H6 H13).
inversion HH5.
destruct H13.
assert(HH5 := rk_upper_dim_aux2 c d f x1 H4 H5 H7 H13).
inversion HH5.
destruct H13.
assert(HH5 := rk_upper_dim_aux2 c e f x1 H4 H6 H7 H13).
inversion HH5.
assert(HH5 := rk_upper_dim_aux2 d e f x1 H5 H6 H7 H13).
inversion HH5.
intro.
case_eq(contains_two_distinct_points (c :: d :: e :: f :: nil)).
intros.
inversion H13.
inversion H15.
inversion H17.
intros.
inversion H13.
inversion H15.
intros.

clear H8 H9 H10.
assert(HH4 : x <> x0 /\ x <> x1 /\ x0 <> x1).
intuition.
assert(HH5 := HH3 HH4).
destruct HH5.
destruct H8.
destruct H8.
destruct H8.
destruct H8.
destruct H9.
exists x3.
exists x4.
exists x5.
unfold Intersect_In in *.
destruct H8.
destruct H9.
destruct H10.
split.

unfold rkl.
case_eq(contains_four_non_coplanar_points (a :: b :: x3 :: nil)).
intros.
assert(H15 := contains_four_to_three_aux' (a :: b :: x3 :: nil) H14).
assert(H16 := rk_upper_dim_aux3 a b x3 H15).
assert(HH5 := rk_upper_dim_aux2 a b x3 x H2 H3 H8 H16).
inversion HH5.
intro.
case_eq(contains_three_non_collinear_points (a :: b :: x3 :: nil)).
intros.
assert(H16 := rk_upper_dim_aux3 a b x3 H15).
assert(HH5 := rk_upper_dim_aux2 a b x3 x H2 H3 H8 H16).
inversion HH5.
intros.
case_eq(contains_two_distinct_points (a :: b :: x3 :: nil)).
reflexivity.
intros.
assert(HH5 : contains_two_distinct_points (a :: b :: nil) = false).
unfold contains_two_distinct_points.
case_eq(eq_dec_u a b).
reflexivity.
intros.
generalize H16.
unfold contains_two_distinct_points.
case_eq(eq_dec_u a b).
case_eq(eq_dec_u b x3).
intros.
contradiction.
intros;assumption.
intros;assumption.
assert(HH6 := matroid3_aux9_bis_bis_reverse (a :: b :: nil) H00).
rewrite HH5 in HH6;inversion HH6.

split.
unfold rkl.
case_eq(contains_four_non_coplanar_points (c :: d :: x4 :: nil)).
intros.
assert(H15 := contains_four_to_three_aux' (c :: d :: x4 :: nil) H14).
assert(H16 := rk_upper_dim_aux3 c d x4 H15).
assert(HH5 := rk_upper_dim_aux2 c d x4 x0 H4 H5 H9 H16).
inversion HH5.
intro.
case_eq(contains_three_non_collinear_points (c :: d :: x4 :: nil)).
intros.
assert(H16 := rk_upper_dim_aux3 c d x4 H15).
assert(HH5 := rk_upper_dim_aux2 c d x4 x0 H4 H5 H9 H16).
inversion HH5.
intros.
case_eq(contains_two_distinct_points (c :: d :: x4 :: nil)).
reflexivity.
intros.
assert(HH5 : contains_two_distinct_points (c :: d :: nil) = false).
unfold contains_two_distinct_points.
case_eq(eq_dec_u c d).
reflexivity.
intros.
generalize H16.
unfold contains_two_distinct_points.
case_eq(eq_dec_u c d).
case_eq(eq_dec_u d x4).
intros.
contradiction.
intros;assumption.
intros;assumption.
assert(HH6 := matroid3_aux9_bis_bis_reverse (c :: d :: nil) H01).
rewrite HH5 in HH6;inversion HH6.

split.
unfold rkl.
case_eq(contains_four_non_coplanar_points (e :: f :: x5 :: nil)).
intros.
assert(H15 := contains_four_to_three_aux' (e :: f :: x5 :: nil) H14).
assert(H16 := rk_upper_dim_aux3 e f x5 H15).
assert(HH5 := rk_upper_dim_aux2 e f x5 x1 H6 H7 H10 H16).
inversion HH5.
intro.
case_eq(contains_three_non_collinear_points (e :: f :: x5 :: nil)).
intros.
assert(H16 := rk_upper_dim_aux3 e f x5 H15).
assert(HH5 := rk_upper_dim_aux2 e f x5 x1 H6 H7 H10 H16).
inversion HH5.
intros.
case_eq(contains_two_distinct_points (e :: f :: x5 :: nil)).
reflexivity.
intros.
assert(HH5 : contains_two_distinct_points (e :: f :: nil) = false).
unfold contains_two_distinct_points.
case_eq(eq_dec_u e f).
reflexivity.
intros.
generalize H16.
unfold contains_two_distinct_points.
case_eq(eq_dec_u e f).
case_eq(eq_dec_u f x5).
intros.
contradiction.
intros;assumption.
intros;assumption.
assert(HH6 := matroid3_aux9_bis_bis_reverse (e :: f :: nil) H02).
rewrite HH5 in HH6;inversion HH6.

unfold rkl.
case_eq(contains_four_non_coplanar_points (x3 :: x4 :: x5 :: nil)).
intros.
assert(H15 := contains_four_to_three_aux' (x3 :: x4 :: x5 :: nil) H14).
assert(H16 := rk_upper_dim_aux3 x3 x4 x5 H15).
assert(HH5 := rk_upper_dim_aux2 x3 x4 x5 x2 H11 H12 H13 H16).
inversion HH5.
intro.
case_eq(contains_three_non_collinear_points (x3 :: x4 :: x5 :: nil)).
intros.
assert(H16 := rk_upper_dim_aux3 x3 x4 x5 H15).
assert(HH5 := rk_upper_dim_aux2 x3 x4 x5 x2 H11 H12 H13 H16).
inversion HH5.
intros.
case_eq(contains_two_distinct_points (x3 :: x4 :: x5 :: nil)).
reflexivity.
intros.
intuition.
Qed.

Class MatroidRkEquiv `(Op : ObjectPoint) `(S : FSetSpecs Point) := {
rk : set Point -> nat
}.

End s_psEquivToRk.


(* Copyright 2012-2015 by Adam Petcher.				*
 * Use of this source code is governed by the license described	*
 * in the LICENSE file at the root of the source tree.		*)

(* An efficiency predicate that characterizes of non-uniform PPT turing machines.  *)

Require Import FCF.Crypto.
Set Implicit Arguments.

Definition CostModel := forall (A B : Type), (A -> B) -> nat -> Prop.

Local Open Scope nat_scope.

Class constant_cost_relation(cost : CostModel) :={

  constant_cost_const :
  forall (A B : Type)(b : B),
    cost _ _ (fun (_ : A) => b) 0;

  constant_cost_pair_args :
  forall (A B C : Type)
    (f : A -> B -> C) c,
    cost _ _ (fun p => f (fst p) (snd p)) c ->
    exists c1 c2,
    cost _ _ f c1 /\ (forall a, cost _ _ (f a) c2) /\ c1 + c2 <= c;

  constant_cost_unpair_args :
  forall (A B C : Type)
    (f : (A * B) -> C) c,
    cost _ _ f c ->
    cost _ _ (fun a b => f (a, b)) 0 /\
    (forall a, cost _ _ (fun b => f (a, b)) c);

  constant_cost_compose :
  forall (A B C : Type)
    (f1 : A -> B)(f2 : A -> B -> C) c1 c2 c3,
    cost _ _ f1 c1 ->
    cost _ _ f2 c2 ->
    (forall a, cost _ _ (f2 a) c3) ->
    cost _ _ (fun a => f2 a (f1 a)) (c1 + c2 + c3);

  constant_cost_bind :
    forall (Z : Type)(A B : Set)(f1 : Z -> Comp A) (f2 : Z -> A -> Comp B) c1 c2 c3,
      cost _ _ f1 c1 ->
      cost _ _ f2 c2 ->
      (forall z, cost _ _ (f2 z) c3) ->
      cost _ _ (fun a => Bind (f1 a) (f2 a)) (c1 + c2 + c3);

  constant_cost_ret :
    forall (A : Set)(eqd : eq_dec A),
      cost _ _ (@Ret A eqd) 0;

  constant_cost_le :
    forall A B (f : A -> B) c1 c2,
      cost _ _ f c1 ->
      c1 <= c2 ->
      cost _ _ f c2;

  constant_cost_fst :
    forall (A B : Type),
      cost _ _ (@fst A B) 0;

  constant_cost_snd :
    forall (A B : Type),
      cost _ _ (@snd A B) 0;

  constant_cost_pair_1 :
    forall (A B : Type),
      cost _ _ (@pair A B) 0;

  constant_cost_pair_2 :
    forall (A B : Type) a,
      cost _ _ (@pair A B a) 0;

  constant_cost_pair :
    forall (A B : Type),
      cost _ _ (fun p => @pair A B (fst p) (snd p)) 0;

  constant_cost_eqb_bool :
    cost _ _ (fun p => @eqb bool _ (fst p) (snd p)) 1;

  constant_cost_bvxor :
    forall eta,
      cost _ _ (fun p => BVxor eta (fst p) (snd p)) eta;

  constant_cost_firstn :
    forall k (A : Type),
      cost _ _ (@firstn A k) k;

  constant_cost_skipn :
    forall k (A : Type),
      cost _ _ (@skipn A k) k;

  constant_cost_tl :
    forall (A : Type),
      cost _ _ (@tl A) 1;

  constant_cost_hd :
    forall (A : Type)(a : A),
      cost _ _ (hd a) 1;

  constant_cost_if_bool_f :
    forall (A B : Type)(f1 : A -> bool)(f2 f3 : A -> B) c1 c2 c3,
      cost _ _ f1 c1 ->
      cost _ _ f2 c2 ->
      cost _ _ f3 c3 ->
      cost _ _ (fun a => if (f1 a) then (f2 a) else (f3 a)) (c1 + c2 + c3)

}.

Section constant_cost_theory.
  Context `(constant_cost_relation).

  Theorem constant_cost_pair_args_weak :
    forall (A B C : Type)
      (f : A -> B -> C) c,
      cost (fun p => f (fst p) (snd p)) c ->
      cost f c.

    intuition.

    apply constant_cost_pair_args in H0.
    destruct H0.
    destruct H0.
    intuition.
    eapply constant_cost_le.
    eauto.
    lia.

  Qed.

  Theorem constant_cost_compose_unary :
  forall (A B C: Type)
    (f1 : A -> B)(f2 : B ->C) c1 c2,
    cost f1 c1 ->
    cost f2 c2 ->
    cost (fun a => f2 (f1 a)) (c1 + c2).

    intuition.
    eapply constant_cost_le.
    eapply (constant_cost_compose f1 _ ).
    eauto.
    eapply constant_cost_const.
    intuition.
    eauto.
    lia.

  Qed.

  Theorem constant_cost_compose_binary :
  forall (A B C D: Type)
    (f1 : A -> B)(f2 : A ->C)(f3 : B -> C -> D) c1 c2 c3 c4,
    cost f1 c1 ->
    cost f2 c2 ->
    cost f3 c3 ->
    (forall b, cost (f3 b) c4) ->
    cost (fun a => f3 (f1 a) (f2 a)) (c1 + c2 + c3 + c4).

    intuition.
    eapply constant_cost_le.
    eapply (constant_cost_compose f2 (fun a x => f3 (f1 a) x)).
    eauto.
    eapply (constant_cost_compose f1 (fun a y x => f3 y x)).
    eauto.
    eapply constant_cost_const.
    intuition.
    eauto.

    intuition.
    lia.

  Qed.

  Theorem constant_cost_compose_binary_const_r :
  forall (A B C D: Type)
    (f1 : A -> B)(c : C)(f3 : B -> C -> D) c1 c2,
    cost f1 c1 ->
    cost (fun x => f3 x c) c2 ->
    cost (fun a => f3 (f1 a) c) (c1 + c2).

    intuition.
    eapply constant_cost_le.
    eapply (constant_cost_compose f1 (fun _ x => f3 x c)).
    eauto.
    eapply constant_cost_const.
    intuition.
    eauto.
    lia.
  Qed.

  Theorem constant_cost_compose_binary_const_l :
  forall (A B C D: Type)
    (b : B)(f2 : A -> C)(f3 : B -> C -> D) c1 c2,
    cost f2 c1 ->
    cost (f3 b) c2 ->
    cost (fun a => f3 b (f2 a)) (c1 + c2).

    intuition.
    eapply constant_cost_le.
    eapply (constant_cost_compose f2 (fun _ x => f3 b x)).
    eauto.
    eapply constant_cost_const.
    intuition.
    eauto.
    lia.

  Qed.

  Theorem constant_cost_bind_const1 :
      forall (A  : Type)(B C: Set)
        (f1 : Comp B)(f2 : A -> B -> Comp C) c1 c2,
        cost f2 c1 ->
        (forall a, cost (f2 a) c2) ->
        cost (fun a => Bind f1 (f2 a)) (c1 + c2).

      intuition.
      eapply constant_cost_le.
      eapply constant_cost_bind; eauto.
      eapply constant_cost_const.
      lia.
    Qed.

    Theorem constant_cost_bind_const1_pair :
      forall (A  : Type)(B C: Set)
        (f1 : Comp B)(f2 : A -> B -> Comp C) c,
        cost (fun p => f2 (fst p) (snd p)) c ->
        cost (fun a => Bind f1 (f2 a)) c.

      intuition.
      apply constant_cost_pair_args in H0.
      destruct H0.
      destruct H0.
      intuition.
      eapply constant_cost_le.
      eapply constant_cost_bind; eauto.
      eapply constant_cost_const.
      lia.
    Qed.

    Theorem constant_cost_bind_const2 :
      forall (A  : Type)(B C: Set)
        (f1 : A -> (Comp B))(f2 : B -> Comp C) c1 c2,
        cost f1 c1 ->
        cost f2 c2 ->
        cost (fun a => Bind (f1 a) f2) (c1 + c2).

      intuition.
      eapply constant_cost_le.
      eapply constant_cost_bind; eauto.
      eapply constant_cost_const.
      lia.
    Qed.

    Theorem constant_cost_bind_pair :
      forall (A  : Type)(B C: Set)
        (f1 : A -> Comp B)(f2 : A -> B -> Comp C) c1 c2,
        cost f1 c1 ->
        cost (fun p => f2 (fst p) (snd p)) c2 ->
        cost (fun a => Bind (f1 a) (f2 a)) (c1 + c2).

      intuition.
      apply constant_cost_pair_args in H1.
      destruct H1.
      destruct H1.
      intuition.
      eapply constant_cost_le.
      eapply constant_cost_bind; eauto.
      lia.
    Qed.

    Theorem constant_cost_compose_binary_pair :
      forall (A B C D: Type)
        (f1 : A -> B)(f2 : A ->C)(f3 : B -> C -> D) c1 c2 c3,
        cost f1 c1 ->
        cost f2 c2 ->
        cost (fun p => f3 (fst p) (snd p)) c3 ->
        cost (fun a => f3 (f1 a) (f2 a)) (c1 + c2 + c3).

      intuition.
      apply constant_cost_pair_args in H2.
      destruct H2.
      destruct H2.
      intuition.
      eapply constant_cost_le.
      eapply (constant_cost_compose f2 (fun a x => f3 (f1 a) x)).
      eauto.
      eapply (constant_cost_compose f1 (fun a y x => f3 y x)).
      eauto.
      eapply constant_cost_const.
      intuition.
      eauto.

      intuition.
      lia.

    Qed.

End constant_cost_theory.

Require Import FCF.Asymptotic.

Definition poly_time_nonuniform(cost : CostModel)(A B : nat -> Type)(f : forall n, (A n) -> (B n)) :=
  exists x, polynomial x /\
  forall n,
    (exists c, (cost _ _ (f n)) c /\ c <= x n).


Require Import Coq.Arith.Compare_dec.

Require Import
        Essentials.Facts_Tactics
        Essentials.Notations
        Essentials.Types
        Essentials.Omega.
Require Import Metrics.Mappings Metrics.Cauchy.
Require Import Metrics.Complete_UltraMetric.
Require Import
        Categories.Category.Main
        Categories.Functor.Main
        Categories.Archetypal.Discr.Discr
        Categories.Archetypal.PreOrder_Cat.OmegaCat
        Categories.Limits.Limit
.
Require Import MCat.MCat MCat.Opposite MCat.Product MCat.MFunc.
Require Import MCat.IncreasingCauchyTower.IncreasingCauchyTower
        MCat.IncreasingCauchyTower.Related_CoCone_Cone_Limit
        MCat.IncreasingCauchyTower.Cone_Limit_Related_CoCone
.

Local Open Scope order_scope.
Local Open Scope metric_scope.
Local Open Scope lattice_scope.

(** In this section define shifting of increasing cauchy towers (ICTs) and
show that if a cone is the limit of an ICT, there is a cone (with the same apex)
that is the limit of the shifted version. *)
Section Shift_One.
  Context {L : MLattice} {M : MCat L} (ICT : IncreasingCauchyTower M).

  (** The increasing cauchy tower obtained by shifting the given cauchy tower by one.
In other words,

#

              f₀        f₁
            ————→     ————→      ......>
       A₀          A₁        A₂  ......
            ←————     ←————      <......
              g₀        g₁

#

is turned into:

#

              f₁        f₂
            ————→     ————→      ......>
       A₁          A₂        A₃  ......
            ←————     ←————      <......
              g₁        g₂

#

*)
  Program Definition ICT_Shift_One : IncreasingCauchyTower M :=
    {|
      ICT_Objs := fun n => ICT (S n);
      ICT_fs := fun n => ICT_fs ICT (S n);
      ICT_gs := fun n => ICT_gs ICT (S n);
      ICT_gs_split_epi := fun n => ICT_gs_split_epi ICT (S n);
      ICT_approach_id :=
        fun ε : ApprType L =>
          let (N, Hε) := ICT_approach_id ICT ε in
          exist
            _
            _
            (fun m H =>
               Hε (S m)
                 (Nat.le_trans _ _ _ (le_S _ _ (le_n N)) (le_S _ _ H)))
    |}.

  (** Interaction of ICT_Funct with its shifted counterpart. *)
  Theorem ICT_Func_Shift_One
          {m n : nat}
          (h : (m ≤ n)%omegacat)
          (h' : (S m ≤ S n)%omegacat) :
    ((ICT_Func ICT) _a h' = (ICT_Func ICT_Shift_One) _a h)%morphism.
  Proof.
    cbn.
    induction h as [|u t IHt].
    {
      replace h' with (Tle_n (S m)) by apply Tle_is_HProp; trivial.
    }
    {
      dependent destruction h'.
      + exfalso; eapply Not_S_Tle; eauto.
      +
        cbn.
        rewrite IHt.
        trivial.
    }
  Qed.

  (** Interaction of ICT_inv_Funct with its shifted counterpart. *)
  Theorem ICT_inv_Func_Shift_One
          {m n : nat}
          (h : (m ≤ n)%omegacat)
          (h' : (S m ≤ S n)%omegacat) :
    ((ICT_inv_Func ICT) _a h' = (ICT_inv_Func ICT_Shift_One) _a h)%morphism.
  Proof.
    cbn.
    induction h as [|u t IHt].
    {
      replace h' with (Tle_n (S m)) by apply Tle_is_HProp; trivial.
    }
    {
      dependent destruction h'.
      + exfalso; eapply Not_S_Tle; eauto.
      + cbn.
        rewrite IHt.
        trivial.
    }
  Qed.

  Context (Cn : Cone (ICT_Func ICT)).

  (** A cone to an ICT can be turned into a cone to its shifted version. *)
  Program Definition Cone_To_ICT_Shift_One : Cone (ICT_Func ICT_Shift_One) :=
    {|
      cone_apex := Cn;
      cone_edge :=
        {|
          Trans := fun n => Trans Cn (S n)
        |}
    |}.

  Local Obligation Tactic := idtac.

  Next Obligation.
  Proof.
    intros c c' h; cbn in *.
    assert (h' := Tle_le h).
    assert (h'' : (S c' ≤ S c)%omegacat) by (apply le_Tle; abstract omega).
    cbn_rewrite (Trans_com Cn h'').
    cbn_rewrite (ICT_Func_Shift_One h h'').
    trivial.
  Qed.

  Next Obligation.
  Proof.
    symmetry.
    apply Cone_To_ICT_Shift_One_obligation_1.
  Qed.

  (** A cocone interacting with a cone to an ICT can be turned into a cocone interacting with
the cone to its shifted version obtained from that cone. *)
  Section CoCone_Interacting_With_Cone_To_ICT_Shift_One.
    Context (CCn : CoCone_Interacting_With Cn).

    Program Definition CoCone_Interacting_With_Cone_To_ICT_Shift_One :
      CoCone_Interacting_With Cone_To_ICT_Shift_One :=
      {|
        CCIW_injs := fun n => CCn (S n)
      |}.

    Next Obligation.
    Proof.
      intros c c' h; cbn in *.
      assert (h' := Tle_le h).
      assert (h'' : (S c' ≤ S c)%omegacat) by (apply le_Tle; abstract omega).
      etransitivity; [apply (CCIW_injs_form_cocone _ _ CCn _ _ h'')|].
      cbn.
      cbn_rewrite (ICT_inv_Func_Shift_One h h'').
      trivial.
    Qed.

    Next Obligation.
    Proof.
      intros; apply (CCIW_split_epi _ _ CCn).
    Qed.

  End CoCone_Interacting_With_Cone_To_ICT_Shift_One.

  Context (CCn : CoCone_Related_To Cn).

  (** A cocone related to a cone to an ICT can be turned into a cocone related to
the cone to its shifted version obtained from that cone. *)
  Program Definition CoCone_Related_To_Cone_To_ICT_Shift_One :
    CoCone_Related_To Cone_To_ICT_Shift_One :=
    {|
      TRCC_CoCone := CoCone_Interacting_With_Cone_To_ICT_Shift_One (TRCC_CoCone _ _ CCn);
      TRCC_approach_id :=
        fun ε : ApprType L =>
          let (N, Hε) := TRCC_approach_id ICT _ _ ε in
          exist
            _
            _
            (fun m H =>
               Hε (S m)
                 (Nat.le_trans _ _ _ (le_S _ _ (le_n N)) (le_S _ _ H)))
    |}.

  Context (il : is_Limit _ Cn).

  (** If a cone is limit of an ICT, then its converted version is the limit of the
shifted ICT. *)
  Definition is_Limit_Cone_To_ICT_Shift_One_is_Limit :
    is_Limit _ Cone_To_ICT_Shift_One :=
    Related_CoCone_Cone_Limit
      _
      _
      Cone_To_ICT_Shift_One
      CoCone_Related_To_Cone_To_ICT_Shift_One
  .

End Shift_One.

Section Locally_Contractive_Func.
  Context {L : MLattice}
          {M : MCat L}
          (ICT : IncreasingCauchyTower M)
          (F : LocallyContractive (MCat_Prod (MCat_Op M) M) M).

  (** The increasing cauchy tower obtained by applying the given functor to the given ICT.
In other words,

#

              f₀        f₁
            ————→     ————→      ......>
       A₀          A₁        A₂  ......
            ←————     ←————      <......
              g₀        g₁

#

is turned into:

#

           F(g₀,f₀)         F(g₁,f₁)
            ————→            ————→            ......>
  F(A₀,A₀)           F(A₁,A₁)       F(A₂,A₂)  ......
            ←————            ←————            <......
           F(f₀,g₀)         F(f₁,g₁)

#
*)
  Program Definition Locally_Contractive_Func_ICT : IncreasingCauchyTower M :=
    {|
      ICT_Objs := fun n => (F _o (ICT n, ICT n))%object;
      ICT_fs := fun n => (F @_a (_,_) (_,_) (ICT_gs ICT n, ICT_fs ICT n))%morphism;
      ICT_gs := fun n => (F @_a (_,_) (_,_) (ICT_fs ICT n, ICT_gs ICT n))%morphism
    |}.

  Next Obligation.
  Proof.
    cbn_rewrite <- (@F_compose _ _ F); cbn.
    cbn_rewrite (ICT_gs_split_epi ICT).
    apply (@F_id _ _ F).
  Qed.

  Local Obligation Tactic := idtac.

  Next Obligation.
  Proof.
    cbn in *.
    intros ε.
    destruct (ML_bottom_dichotomy L) as [dicht|dicht].
    {
      destruct (dicht _ (projT2 ε)) as [y' Hd1 [Hd2 Hd3]].
      destruct (ICT_approach_id ICT (existT _ _ Hd1)) as [N H1].
      cbn in H1.
      exists N.
      intros n H2.
      specialize (H1 _ H2).
      cbn.
      cbn_rewrite <- (@F_compose _ _ F); cbn.
      cbn_rewrite <- (@F_id _ _ F).
      eapply LE_LT_Trans;[eapply (CCN_contractive (@LCN_FA _ _ _ F _ _))|]; cbn.
      eapply LE_LT_Trans; [apply CR_non_expansive|].
      eapply LE_LT_Trans; [|apply Hd3].
      apply lub_lst; intros [|]; apply H1.
    }
    {
      destruct dicht as [ab Hd1 Hd2].
      destruct (ICT_approach_id ICT (existT _ _ Hd1)) as [N H1].
      cbn in H1.
      exists N.
      intros n H2.
      specialize (H1 _ H2).
      apply Hd2 in H1.
      cbn.
      cbn_rewrite <- (@F_compose _ _ F); cbn.
      cbn_rewrite <- (@F_id _ _ F).
      eapply LE_LT_Trans;[eapply (CCN_contractive (@LCN_FA _ _ _ F _ _))|]; cbn.
      eapply LE_LT_Trans; [apply CR_non_expansive|].
      rewrite H1.
      rewrite lub_bot.
      apply ML_appr_pos.
      exact (projT2 ε).
    }
  Qed.

  Section Cone_and_Cone_interacting_with.
    Context
      (Cn : Cone (ICT_Func ICT))
      (CCn : CoCone_Interacting_With Cn).

    (** A cone to an ICT can be turned into a cone to the version where
F is applied to the ICT. *)
    Program Definition Cone_To_Locally_Contractive_Func_ICT :
      Cone (ICT_Func Locally_Contractive_Func_ICT) :=
      {|
        cone_apex := Func_From_SingletonCat (F _o (Cn, Cn))%object;
        cone_edge :=
          {|
            Trans :=
              fun n =>
                (
                  F @_a
                    (_, _)
                    (_, _)
                    (Trans (CCIW_CoCone _ _ CCn) n, Trans Cn n)
                )%morphism
          |}
      |}.

    Local Ltac rewrite_Trans_com Cn h W :=
      set (W := Trans_com Cn h);
      cbn in W;
      repeat rewrite From_Term_Cat in W; cbn in W;
      repeat rewrite MC_id_unit_right in W;
      repeat rewrite MC_id_unit_left in W
    .

    Next Obligation.
    Proof.
      intros c c' h; cbn in *.
      rewrite_Trans_com Cn h W; rewrite W; clear W.
      rewrite_Trans_com (CCIW_CoCone _ _ CCn) h W; rewrite W; clear W.
      rewrite MC_id_unit_right.
      induction h as [|m t IHt].
      + cbn; repeat rewrite MC_id_unit_right; repeat rewrite MC_id_unit_left.
        trivial.
      + cbn in *.
        rewrite_Trans_com Cn (Tle_S _ _ (Tle_n m)) W; rewrite W in IHt; clear W.
        rewrite_Trans_com (CCIW_CoCone _ _ CCn) (Tle_S _ _ (Tle_n m)) W; rewrite W in IHt; clear W.
        rewrite (MC_assoc _ _ _ _ _ (Trans Cn (S m))).
        rewrite MC_assoc_sym.
        etransitivity; [apply IHt|].
        cbn_rewrite
          (
            @F_compose
              _
              _
              F
              (_, _)
              (_, _)
              (_,_)
              (CCn (S m), Trans Cn (S m))
              (ICT_fs ICT m, ICT_gs ICT m)
          ).
        rewrite MC_assoc.
        trivial.
    Qed.

    Next Obligation.
    Proof.
      symmetry.
      apply Cone_To_Locally_Contractive_Func_ICT_obligation_1.
    Qed.

    (** A cocone interacting with a cone Cn can be turned into a cocone
interacting with the corresponding cone in the version where F is applied to the ICT *)
    Program Definition CoCone_Interacting_With_Cone_To_Locally_Contractive_Func_ICT :
      CoCone_Interacting_With Cone_To_Locally_Contractive_Func_ICT :=
      {|
        CCIW_injs :=
          fun n =>
            (
              F @_a
                (_, _)
                (_, _)
                (Trans Cn n, Trans (CCIW_CoCone _ _ CCn) n)
            )%morphism
      |}.

    Next Obligation.
    Proof.
      intros c c' h; cbn in *.
      rewrite_Trans_com Cn h W; rewrite W; clear W.
      rewrite_Trans_com (CCIW_CoCone _ _ CCn) h W; rewrite W; clear W.
      rewrite MC_id_unit_left.
      induction h as [|m t IHt].
      + cbn; repeat rewrite MC_id_unit_right; repeat rewrite MC_id_unit_left.
        trivial.
      + cbn in *.
        rewrite_Trans_com Cn (Tle_S _ _ (Tle_n m)) W; rewrite W in IHt; clear W.
        rewrite_Trans_com (CCIW_CoCone _ _ CCn) (Tle_S _ _ (Tle_n m)) W; rewrite W in IHt; clear W.
        rewrite (MC_assoc _ _ _ _ _ (Trans Cn (S m))).
        rewrite (MC_assoc_sym _ _ _ _ _ (@OmegaCat.FA_fx (M^op) ICT (ICT_fs ICT) c' m t)).
        etransitivity; [apply IHt|].
        cbn_rewrite
          (
            @F_compose
              _
              _
              F
              (_, _)
              (_, _)
              (_,_)
              (ICT_gs ICT m, ICT_fs ICT m)
              (Trans Cn (S m), CCn (S m))
          ).
        rewrite MC_assoc.
        trivial.
    Qed.

    Next Obligation.
    Proof.
      intros n; cbn.
      cbn_rewrite <- (@F_compose _ _ F); cbn.
      do 2 cbn_rewrite (CCIW_split_epi _ _ CCn).
      apply (@F_id _ _ F).
    Qed.

  End Cone_and_Cone_interacting_with.

  Context
    (Cn : Cone (ICT_Func ICT))
    (CCn : CoCone_Related_To Cn).

  (** A cocone related to a cone to an ICT can be turned into a cocone related to
the cone to the version where F is applied to that ICT. *)
  Program Definition CoCone_Related_To_Cone_To_Locally_Contractive_Func_ICT :
    CoCone_Related_To (Cone_To_Locally_Contractive_Func_ICT Cn CCn) :=
    {|
      TRCC_CoCone :=
        CoCone_Interacting_With_Cone_To_Locally_Contractive_Func_ICT Cn (TRCC_CoCone _ _ CCn)
    |}.

  Next Obligation.
  Proof.
    cbn.
    intros ε.
    destruct (ML_bottom_dichotomy L) as [dicht|dicht].
    {
      destruct (dicht _ (projT2 ε)) as [y' Hd1 [Hd2 Hd3]].
      destruct (TRCC_approach_id _ _ CCn (existT _ _ Hd1)) as [N H1].
      cbn in H1.
      exists N.
      intros n H2.
      specialize (H1 _ H2).
      cbn_rewrite <- (@F_compose _ _ F); cbn.
      cbn_rewrite <- (@F_id _ _ F).
      eapply LE_LT_Trans;[eapply (CCN_contractive (@LCN_FA _ _ _ F _ _))|]; cbn.
      eapply LE_LT_Trans; [apply CR_non_expansive|].
      eapply LE_LT_Trans; [|apply Hd3].
      apply lub_lst; intros [|]; apply H1.
    }
    {
      destruct dicht as [ab Hd1 Hd2].
      destruct (TRCC_approach_id _ _ CCn (existT _ _ Hd1)) as [N H1].
      cbn in H1.
      exists N.
      intros n H2.
      specialize (H1 _ H2).
      apply Hd2 in H1.
      cbn_rewrite <- (@F_compose _ _ F); cbn.
      cbn_rewrite <- (@F_id _ _ F); cbn.
      eapply LE_LT_Trans;[eapply (CCN_contractive (@LCN_FA _ _ _ F _ _))|]; cbn.
      eapply LE_LT_Trans; [apply CR_non_expansive|].
      eapply LE_LT_Trans; [|apply (ML_appr_pos _ _ (projT2 ε))].
      apply lub_lst; intros [|]; match goal with [|- ?A ⊑ ?B] => replace B with A; trivial end.
    }
  Qed.

  Context (il : is_Limit _ Cn).

  (** If a cone is limit of an ICT, then its converted version is the limit of the
version where F is applied to that ICT. *)
  Definition is_Limit_Cone_To_Locally_Contractive_Func_ICT_is_Limit :
    is_Limit _ (Cone_To_Locally_Contractive_Func_ICT Cn CCn) :=
    Related_CoCone_Cone_Limit
      _
      _
      (Cone_To_Locally_Contractive_Func_ICT Cn CCn)
      CoCone_Related_To_Cone_To_Locally_Contractive_Func_ICT
  .

End Locally_Contractive_Func.


Set Implicit Arguments.

Require Import Coq.Strings.String.
Require Import Bedrock.Platform.Cito.NatFacts.

Lemma length_append : forall s1 s2, String.length (s1 ++ s2) = String.length s1 + String.length s2.
  induction s1; simpl; intuition.
Qed.

Local Open Scope string.

Lemma prefix_neq : forall (s1 s2 : string), s1 <> "" -> (s1 ++ s2)%string <> s2.
  intros.
  intuition.
  contradict H.
  eapply f_equal with (f := String.length) in H0.
  rewrite length_append in H0.
  eapply plus_eq_right_0 in H0.
  destruct s1; simpl in *; intuition.
  discriminate.
Qed.

Lemma append_inj_2 : forall a b c, (a ++ b = a ++ c -> b = c)%string.
  induction a; simpl; intuition.
  injection H; intros.
  eauto.
Qed.


From Coq Require Import Arith.Arith.
From volume1 Require Import Imp Maps.

Open Scope imp_scope.
Fixpoint ceval_step1 (st : state) (c : com) : state :=
  match c with
    | SKIP =>
        st
    | l ::= a1 =>
        (l !-> aeval st a1 ; st)
    | c1 ;; c2 =>
        let st' := ceval_step1 st c1 in
        ceval_step1 st' c2
    | TEST b THEN c1 ELSE c2 FI =>
        if (beval st b)
          then ceval_step1 st c1
          else ceval_step1 st c2
    | WHILE b1 DO c1 END =>
        st
  end.
Close Scope imp_scope.

Open Scope imp_scope.
Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state :=
  match i with
  | O => empty_st
  | S i' =>
    match c with
      | SKIP =>
          st
      | l ::= a1 =>
          (l !-> aeval st a1 ; st)
      | c1 ;; c2 =>
          let st' := ceval_step2 st c1 i' in
          ceval_step2 st' c2 i'
      | TEST b THEN c1 ELSE c2 FI =>
          if (beval st b)
            then ceval_step2 st c1 i'
            else ceval_step2 st c2 i'
      | WHILE b1 DO c1 END =>
          if (beval st b1)
          then let st' := ceval_step2 st c1 i' in
               ceval_step2 st' c i'
          else st
    end
  end.
Close Scope imp_scope.

Open Scope imp_scope.
Fixpoint ceval_step3 (st : state) (c : com) (i : nat)
                    : option state :=
  match i with
  | O => None
  | S i' =>
    match c with
      | SKIP =>
          Some st
      | l ::= a1 =>
          Some (l !-> aeval st a1 ; st)
      | c1 ;; c2 =>
          match (ceval_step3 st c1 i') with
          | Some st' => ceval_step3 st' c2 i'
          | None => None
          end
      | TEST b THEN c1 ELSE c2 FI =>
          if (beval st b)
            then ceval_step3 st c1 i'
            else ceval_step3 st c2 i'
      | WHILE b1 DO c1 END =>
          if (beval st b1)
          then match (ceval_step3 st c1 i') with
               | Some st' => ceval_step3 st' c i'
               | None => None
               end
          else Some st
    end
  end.
Close Scope imp_scope.

Notation "'LETOPT' x <== e1 'IN' e2"
   := (match e1 with
         | Some x => e2
         | None => None
       end)
   (right associativity, at level 60).

Open Scope imp_scope.
Fixpoint ceval_step (st : state) (c : com) (i : nat)
                    : option state :=
  match i with
  | O => None
  | S i' =>
    match c with
      | SKIP =>
          Some st
      | l ::= a1 =>
          Some (l !-> aeval st a1 ; st)
      | c1 ;; c2 =>
          LETOPT st' <== ceval_step st c1 i' IN
          ceval_step st' c2 i'
      | TEST b THEN c1 ELSE c2 FI =>
          if (beval st b)
            then ceval_step st c1 i'
            else ceval_step st c2 i'
      | WHILE b1 DO c1 END =>
          if (beval st b1)
          then LETOPT st' <== ceval_step st c1 i' IN
               ceval_step st' c i'
          else Some st
    end
  end.
Close Scope imp_scope.

Definition test_ceval (st:state) (c:com) :=
  match ceval_step st c 500 with
  | None => None
  | Some st => Some (st X, st Y, st Z)
  end.

(*standard, recommended (pup_to_n)*)
Definition pup_to_n : com   :=
  (Y ::= 0;;
  WHILE ~(X = 0) DO
    Y ::= Y + X;;
    X ::= X - 1
  END)%imp.

Example pup_to_n_1 :
  test_ceval (X !-> 5) pup_to_n
  = Some (0, 15, 0).
Proof. reflexivity. Qed.

Example pup_to_n_1 :
  test_ceval (X !-> 5) pup_to_n
  = Some (0, 15, 0).
Proof. reflexivity. Qed.
(*/standard, recommended (pup_to_n)*)

Theorem ceval_step__ceval: forall c st st',
      (exists i, ceval_step st c i = Some st') ->
      st =[ c ]=> st'.
Proof.
  intros c st st' H.
  inversion H as [i E].
  clear H.
  generalize dependent st'.
  generalize dependent st.
  generalize dependent c.
  induction i as [| i' ].

  -
    intros c st st' H. discriminate H.

  -
    intros c st st' H.
    destruct c;
           simpl in H; inversion H; subst; clear H.
      + apply E_Skip.
      + apply E_Ass. reflexivity.

      +
        destruct (ceval_step st c1 i') eqn:Heqr1.
        *
          apply E_Seq with s.
            apply IHi'. rewrite Heqr1. reflexivity.
            apply IHi'. simpl in H1. assumption.
        *
          discriminate H1.

      +
        destruct (beval st b) eqn:Heqr.
        *
          apply E_IfTrue. rewrite Heqr. reflexivity.
          apply IHi'. assumption.
        *
          apply E_IfFalse. rewrite Heqr. reflexivity.
          apply IHi'. assumption.

      + destruct (beval st b) eqn :Heqr.
        *
         destruct (ceval_step st c i') eqn:Heqr1.
         {
           apply E_WhileTrue with s. rewrite Heqr.
           reflexivity.
           apply IHi'. rewrite Heqr1. reflexivity.
           apply IHi'. simpl in H1. assumption. }
         { discriminate H1. }
        *
          injection H1. intros H2. rewrite <- H2.
          apply E_WhileFalse. apply Heqr. Qed.

Theorem ceval_step_more: forall i1 i2 st st' c,
  i1 <= i2 ->
  ceval_step st c i1 = Some st' ->
  ceval_step st c i2 = Some st'.
Proof.
induction i1 as [|i1']; intros i2 st st' c Hle Hceval.
  -
    simpl in Hceval. discriminate Hceval.
  -
    destruct i2 as [|i2']. inversion Hle.
    assert (Hle': i1' <= i2') by omega.
    destruct c.
    +
      simpl in Hceval. inversion Hceval.
      reflexivity.
    +
      simpl in Hceval. inversion Hceval.
      reflexivity.
    +
      simpl in Hceval. simpl.
      destruct (ceval_step st c1 i1') eqn:Heqst1'o.
      *
        apply (IHi1' i2') in Heqst1'o; try assumption.
        rewrite Heqst1'o. simpl. simpl in Hceval.
        apply (IHi1' i2') in Hceval; try assumption.
      *
        discriminate Hceval.

    +
      simpl in Hceval. simpl.
      destruct (beval st b); apply (IHi1' i2') in Hceval;
        assumption.

    +
      simpl in Hceval. simpl.
      destruct (beval st b); try assumption.
      destruct (ceval_step st c i1') eqn: Heqst1'o.
      *
        apply (IHi1' i2') in Heqst1'o; try assumption.
        rewrite -> Heqst1'o. simpl. simpl in Hceval.
        apply (IHi1' i2') in Hceval; try assumption.
      *
        simpl in Hceval. discriminate Hceval. Qed.

(*standard, recommended (ceval__ceval_step)*)
Theorem ceval__ceval_step: forall c st st',
      st =[ c ]=> st' ->
      exists i, ceval_step st c i = Some st'.
Proof.
  intros c st st' Hce.
  induction Hce.
  - exists 10. reflexivity.
  - exists 10. simpl. rewrite -> H. reflexivity.
  - exists 10. simpl.
Admitted.
(*/standard, recommended (ceval__ceval_step)*)

Theorem ceval_deterministic' : forall c st st1 st2,
     st =[ c ]=> st1 ->
     st =[ c ]=> st2 ->
     st1 = st2.
Proof.
  intros c st st1 st2 He1 He2.
  apply ceval__ceval_step in He1.
  apply ceval__ceval_step in He2.
  inversion He1 as [i1 E1].
  inversion He2 as [i2 E2].
  apply ceval_step_more with (i2 := i1 + i2) in E1.
  apply ceval_step_more with (i2 := i1 + i2) in E2.
  rewrite E1 in E2. inversion E2. reflexivity.
  omega. omega. Qed.