Require Import LibTactics.
Require Import Metalib.Metatheory.

Require Import target_inf.

Definition relation := exp -> exp -> Prop.

Section Star.

  Variable R : relation.

  Inductive star: relation :=
  | star_refl: forall a,
      star a a
  | star_step: forall a b c,
      R a b -> star b c -> star a c.

  Lemma star_one:
    forall a b, R a b -> star a b.
  Proof.
    eauto using star.
  Qed.

  Lemma star_trans:
    forall a b, star a b -> forall c, star b c -> star a c.
  Proof.
    induction 1; eauto using star.
  Qed.

  Hypothesis R_functional:
    forall a b c, R a b -> R a c -> b = c.

  Lemma star_star_inv:
    forall a b, star a b -> forall c, star a c -> star b c \/ star c b.
  Proof.
    induction 1; intros.
    - auto.
    - inversion H1; subst.
      + right. eauto using star.
      + assert (b = b0) by (eapply R_functional; eauto). subst b0.
        apply IHstar; auto.
  Qed.

  Definition irred a : Prop := forall b, ~(R a b).

  Lemma finseq_unique:
    forall a b b',
      star a b -> irred b ->
      star a b' -> irred b' ->
      b = b'.
  Proof.
    intros. destruct (star_star_inv _ _ H _ H1).
    - inversion H3; subst. auto. elim (H0 _ H4).
    - inversion H3; subst. auto. elim (H2 _ H4).
  Qed.

End Star.

Hint Constructors star.

Hint Resolve star_trans star_one.

Lemma value_irred : forall v,
    value v -> irred step v.
Proof.
  intros.
  induction H; unfolds; try solve [intros b C; inverts C].

  intros b C.
  inverts C.
  unfolds in IHvalue1.
  tryfalse*.
  unfolds in IHvalue2.
  tryfalse*.

  intros b C.
  inverts C.
  unfolds in IHvalue.
  tryfalse*.
  intros b C.
  inverts C.
  unfolds in IHvalue.
  tryfalse*.

  unfolds in IHvalue.
  intros b C.
  inverts C.
  tryfalse*.

  unfolds in IHvalue.
  intros b C.
  inverts C.
  tryfalse*.
Qed.

Notation "[ z ~> u ] e" := (subst_exp u z e) (at level 0).
Notation "t ^^ u"       := (open_exp_wrt_exp t u) (at level 67).
Notation "e ^ x"        := (open_exp_wrt_exp e (trm_var_f x)).

Notation "c |= T1 ~> T2" := (cotyp c T1 T2) (at level 69).
Notation "E |= t ~: T" := (typing E t T) (at level 69).

(* Notation "t  t'" := (step t t') (at level 68). *)

Notation "R 'star'" := (star R) (at level 69).

Notation "t ->* t'" := (step star t t') (at level 68).

Notation "'|' A '|'" := (ptyp2styp A) (at level 60).

Notation "'∥' Γ '∥'" := (map ptyp2styp Γ) (at level 60).

Notation "A ≺: B ⇝ co " := (sub A B co) (at level 45).

Notation "Γ ⊢ E ⇒ A ⇝ t" := (has_type Γ E Inf A t) (at level 45).

Notation "Γ ⊢ E ⇐ A ⇝ t" := (has_type Γ E Chk A t) (at level 45).

(** [x # E] to be read x fresh from E captures the fact that
    x is unbound in E . *)

Notation "x '#' E" := (x \notin (dom E)) (at level 67) : env_scope.

Definition env := list (atom * exp).

Ltac gather_atoms ::=
  let A := gather_atoms_with (fun x : atoms => x) in
  let B := gather_atoms_with (fun x : atom => singleton x) in
  let C := gather_atoms_with (fun x : list (var * typ) => dom x) in
  let D := gather_atoms_with (fun x : exp => fv_exp x) in
  let E := gather_atoms_with (fun x : ctx => dom x) in
  let E := gather_atoms_with (fun x : sctx => dom x) in
  let F := gather_atoms_with (fun x : sctx => dom (∥ x ∥)) in
  let G := gather_atoms_with (fun x : env => dom x) in
  constr:(A `union` B `union` C `union` D `union` E `union` F `union` G).

(* ********************************************************************** *)
(** ** Regularity of relations *)

(** A typing relation holds only if the environment has no
   duplicated keys and the pre-term is locally-closed. *)

Lemma typing_regular : forall E e T,
  typing E e T -> uniq E /\ lc_exp e.
Proof.
  split; induction* H.
  pick fresh y. forwards~ : (H0 y).
  solve_uniq.
Qed.

(** The value predicate only holds on locally-closed terms. *)

Lemma value_regular : forall e,
  value e -> lc_exp e.
Proof.
  induction 1; autos*.
Qed.

(** A reduction relation only holds on pairs of locally-closed terms. *)

Lemma red_regular : forall e e',
  step e e' -> lc_exp e /\ lc_exp e'.
Proof.
  induction 1; autos* value_regular.
  splits~.
  splits~.
  splits~.
  splits~.
  apply lc_body_exp_wrt_exp; autos* value_regular.
  apply lc_body_trm_abs_1; auto.
Qed.

(** Automation for reasoning on well-formedness. *)

Hint Extern 1 (uniq ?E) =>
  match goal with
  | H: typing E _ _ |- _ => apply (proj1 (typing_regular _ _ _ H))
  end.

Hint Extern 1 (lc_exp ?t) =>
  match goal with
  | H: typing _ t _ |- _ => apply (proj2 (typing_regular _ _ _ H))
  | H: step t _ |- _ => apply (proj1 (red_regular _ _ H))
  | H: step _ t |- _ => apply (proj2 (red_regular _ _ H))
  | H: value t |- _ => apply (value_regular _ H)
  end.

(** Other properties *)

Lemma pair_type : forall v T1 T2,
    value v ->
    nil |= trm_capp co_proj1 v ~: T1 ->
    nil |= trm_capp co_proj2 v ~: T2 ->
    nil |= v ~: (a_prod T1 T2).
Proof.
  introv Val Ty1 Ty2.

  destruct* Val.

  inverts Ty1;
  inverts H2;
  inverts H4.

  inverts Ty1;
  inverts H2;
  inverts H4.

  inverts Ty1;
  inverts H3;
  inverts H5.

  inverts Ty1.
  inverts H2.
  inverts H4.
  inverts Ty2.
  inverts H2.
  inverts~ H5.

  inverts Ty1.
  inverts H2.
  inverts H4.

  inverts Ty1.
  inverts H4.
  inverts H2.
  inverts H5.

  inverts Ty1.
  inverts H4.
  inverts H2.
  inverts H5.

  inverts Ty1.
  inverts H4.
  inverts H2.
  inverts H5.
Qed.

Lemma fv_in_dom : forall G e T,
    typing G e T -> fv_exp e [<=] dom G.
Proof.
  intros G e T H.
  induction H; simpl; try fsetdec.
  - Case "typing_var".
    apply binds_In in H0.
    fsetdec.
  - Case "typing_abs".
    pick fresh x.
    assert (Fx : fv_exp (e ^ x) [<=] dom ([(x,T1)] ++ G))
      by eauto.
    simpl in Fx.
    assert (Fy : fv_exp e [<=] fv_exp (e ^ x)) by
        eapply fv_exp_open_exp_wrt_exp_lower.
    fsetdec.
Qed.

Lemma value_no_fv : forall v T,
    nil |= v ~: T ->
    fv_exp v [=] {}.
Proof.
  introv Typ.
  forwards * : fv_in_dom Typ.
  fsetdec.
Qed.

Lemma value_no_step' : forall v1 v2,
    value v1 ->
    step v1 v2 ->
    v2 = v1.
Proof.
  introv V Sp.
  induction Sp; inverts V; try rewrite* IHSp.
Qed.

Lemma value_no_step : forall v1 v2,
    value v1 ->
    v1 ->* v2 ->
    v2 = v1.
Proof.
  introv ? Red.
  induction* Red.
  lets : value_irred H.
  pose (H1 b).
  tryfalse.
Qed.

Lemma notin_trans : forall G x,
    x `notin` dom G ->
    x `notin` dom (∥ G ∥).
Proof.
  intros.
  induction G; solve_notin.
Qed.

Lemma multi_red_capp : forall c t t',
    t ->* t' -> (trm_capp c t) ->* (trm_capp c t').
Proof.
  intros.
  induction* H.
Qed.

Lemma multi_red_app : forall v t t',
    value v -> t ->* t' -> (trm_app v t) ->* (trm_app v t').
Proof.
  introv ? Red.
  induction* Red.
Qed.

Lemma multi_red_app2 : forall t1 t2 t1',
    lc_exp t2 -> t1 ->* t1' -> (trm_app t1 t2) ->* (trm_app t1' t2).
Proof.
  introv ? Red.
  induction* Red.
Qed.

Lemma multi_red_pair1 : forall t1 t2 t1',
    lc_exp t2 ->
    t1 ->* t1' ->
    (trm_pair t1 t2) ->* (trm_pair t1' t2).
Proof.
  introv ? Red.
  induction* Red.
Qed.

Lemma multi_red_pair2 : forall v1 t2 t2',
    value v1 ->
    t2 ->* t2' ->
    (trm_pair v1 t2) ->* (trm_pair v1 t2').
Proof.
  introv ? Red.
  induction* Red.
Qed.

Lemma multi_red_pair : forall t1 t2 v1 v2,
    value v1 -> lc_exp t2 ->
    t1 ->* v1 -> t2 ->* v2 ->
    (trm_pair t1 t2) ->* (trm_pair v1 v2).
Proof.
  intros.
  apply star_trans with (b := trm_pair v1 t2).
  sapply* multi_red_pair1.
  sapply* multi_red_pair2.
Qed.

Lemma multi_red_rcd : forall t t' l,
    t ->* t' ->
    trm_rcd l t ->* trm_rcd l t'.
Proof.
  intros.
  induction* H.
Qed.

Lemma multi_red_proj : forall t t' l,
    t ->* t' ->
    trm_proj t l ->* trm_proj t' l.
Proof.
  intros.
  induction* H.
Qed.

Ltac sweet :=
  match goal with
  | H : value ?t, H1 : step ?t ?e |- _ =>
    forwards * :  (value_irred _ H e)
  end.

Lemma step_unique: forall (t t1 t2 : exp),
  step t t1 -> step t t2 -> t1 = t2.
Proof.
  introv Red1.
  gen t2.
  induction Red1; introv Red2.

  (* capp *)
  inverts* Red2; sweet.
  inverts* Red2; sweet.
  inverts* Red2; sweet.
  inverts* Red2. inverts H3. inverts H4. inverts H3.
  inverts* Red2; [inverts* H5; sweet | sweet].
  inverts* Red2; sweet.
  inverts* Red2;  assert (value (trm_capp co_distArr (trm_pair v1 v2))) by auto; sweet.
  inverts* Red2; assert (value (trm_pair v1 v2)) by auto; sweet.
  inverts* Red2; assert (value (trm_pair v1 v2)) by auto; sweet.
  inverts* Red2.
  forwards * : value_irred (trm_rcd l v); apply H0 in H3; tryfalse.

  inverts* Red2.
  forwards * : value_irred (trm_unit); apply H in H2; tryfalse.

  inverts* Red2.
  forwards * : value_irred (trm_pair (trm_rcd l v1) (trm_rcd l v2)); apply H1 in H4; tryfalse.

  (* trm_proj *)
  inverts* Red2.
  forwards * : value_irred (trm_rcd l v); apply H0 in H3; tryfalse.

  (* abs *)
  inverts* Red2; assert (value (trm_abs e)) by auto; sweet.

  (* app1 *)
  inverts* Red2; try sweet.
  forwards * : value_irred (trm_capp co_topArr trm_unit); apply H0 in Red1; tryfalse.
  forwards * : value_irred (trm_capp (co_arr c1 c2) v1); apply H0 in Red1; tryfalse.
  forwards * : value_irred (trm_capp co_distArr (trm_pair v1 v2)); apply H0 in Red1; tryfalse.
  forwards * : value_irred (trm_abs e); apply H0 in Red1; tryfalse.
  erewrite IHRed1; eauto.

  (* app2 *)
  inverts* Red2; try sweet.
  inverts Red1.
  erewrite IHRed1; eauto.
  inverts* Red2; [forwards * : IHRed1; substs* | sweet].
  inverts* Red2; [sweet | forwards * : IHRed1; substs*].

  inverts* Red2; try sweet.
  forwards * : value_irred (trm_pair t2 v2); apply H in Red1; tryfalse.
  forwards * : value_irred (trm_pair v1 t2); apply H in Red1; tryfalse.
  forwards * : value_irred (trm_rcd l0 v); apply H in Red1; tryfalse.
  forwards * : value_irred (trm_unit); apply H in Red1; tryfalse.
  forwards * : value_irred (trm_pair (trm_rcd l0 v1) (trm_rcd l0 v2)); apply H in Red1; tryfalse.

  erewrite IHRed1; eauto.

  inverts* Red2.
  erewrite IHRed1; eauto.

  inverts* Red2; try sweet.
  forwards * : value_irred (trm_rcd l t2); apply H in Red1; tryfalse.

  erewrite IHRed1; eauto.

Qed.

Lemma value_unique: forall t v1 v2,
  value v1 -> value v2 -> t ->* v1 -> t ->* v2 -> v1 = v2.
Proof.
  introv Val1 Val2 ? ?.
  lets : value_irred Val1.
  lets : value_irred Val2.
  forwards * : finseq_unique step_unique H H0.
Qed.

Lemma and_false1 : forall A1 A2,
    styp_and A1 A2 = A1 -> False.
Proof.
  intros A1.
  induction A1; intros; inverts* H.
Qed.

Lemma and_false2 : forall A2 A1,
    styp_and A1 A2 = A2 -> False.
Proof.
  intros A2.
  induction A2; intros; inverts* H.
Qed.


From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq.
From Coq Require Import ssrfun.
Require Import AutosubstSsr ARS Context.
Require Import Program.Equality.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Require Import ast.
Require Import smallstep.
Require Import confluence.
Require Import typing.

(* typing, in a bidirectional style *)

Reserved Notation "[ Gamma |- s :-> A ]".

Reserved Notation "[ Gamma |- s <-: A ]".

Inductive type_infer : list term -> term -> term -> Prop :=
| ty_infer_Var ctx x :
    x < size ctx ->
    [ ctx |- (Var x) :-> (ctx `_ x) ]
| ty_infer_TT ctx :
    [ ctx |- TT :-> TT ]

| ty_infer_PI ctx A B :
    [ ctx |- A <-: TT ] ->
    [ A :: ctx |- B <-: TT ] ->
    [ ctx |- Pi A B :-> TT ]

| ty_infer_app ctx A B f a :
    [ ctx |- f :-> Pi A B ] ->
    [ ctx |- a <-: A ] ->
    [ ctx |- App f a :-> B.[a/] ]

| ty_infer_cast ctx e t: (*TODO no check that t is a type? *)
    [ ctx |- e <-: t ] ->
    [ ctx |- Cast e t :-> t ]

where "[ ctx |- s :-> A ]" := (type_infer ctx s A)

with type_checks : list term -> term -> term -> Prop :=
| ty_checks_fun ctx b A B :
     [ ctx |- Pi A B <-: TT ] ->
     [ (Pi A B).[ren (+1)] :: A :: ctx |- b <-: B.[ren (+1)] ] -> (* why +1 ? what is the orientation of gamma and the bound vars inside of it. seems more reasonable to do A+1 *)
     [ ctx |- Fun b <-: Pi A B ]
| ty_checks_conv ctx a A A' :
     A === A' ->
     [ ctx |- a :-> A ] ->
     [ ctx |- a <-: A' ]

where "[ ctx |- s <-: A ]" := (type_checks ctx s A)
.

(*TODO  type_infer is unique *)
(*TODO  bidirectional tying implies (TAS) typing *)

Theorem type_soundnes : forall s t s',
[ [::] |- s :-> t ] ->
star step s s' -> not (Stuck s').
Admitted.


Require Import CertiGraph.graph.SpaceAdjMatGraph2.
Require Export CertiGraph.priq.is_empty_lemmas.
Require Import CertiGraph.dijkstra.dijkstra_env.
Require Import CertiGraph.dijkstra.MathDijkGraph.
Require Import CertiGraph.dijkstra.dijkstra_math_proof.
Require Import CertiGraph.dijkstra.dijkstra_spec2.
Require Import CertiGraph.dijkstra.dijkstra_constants.

Local Open Scope Z_scope.

Section DijkstraProof.

  (* The invariants have been dragged out of the
   proof for readability and reuse
   *)

  Context {Z_EqDec : EquivDec.EqDec Z eq}.

  Definition dijk_setup_loop_inv g sh src dist prev v_pq arr :=
    EX i : Z,
    PROP ()
    LOCAL (temp _dist (pointer_val_val dist);
          temp _prev (pointer_val_val prev);
          temp _src (Vint (Int.repr src));
          temp _pq (pointer_val_val v_pq);
          temp _graph (pointer_val_val arr))
    SEP (data_at Tsh
                 (tarray tint size)
                 ((list_repeat (Z.to_nat i)
                               (Vint (Int.repr inf)))
                    ++ (list_repeat (Z.to_nat (size-i))
                                    Vundef)) (pointer_val_val v_pq);
        data_at Tsh
                (tarray tint size)
                ((list_repeat (Z.to_nat i)
                              (Vint (Int.repr inf)))
                   ++ (list_repeat (Z.to_nat (size-i))
                                   Vundef)) (pointer_val_val prev);
        data_at Tsh
                (tarray tint size)
                ((list_repeat (Z.to_nat i) (Vint (Int.repr inf)))
                   ++ (list_repeat (Z.to_nat (size-i))
                                   Vundef)) (pointer_val_val dist);
        @SpaceAdjMatGraph size CompSpecs sh id g (pointer_val_val arr);
        free_tok (pointer_val_val v_pq) (sizeof tint * size)).

  Definition dijk_forloop_inv (g: @DijkGG size inf) sh src
             dist_ptr prev_ptr priq_ptr graph_ptr :=
    EX prev : list V,
    EX priq : list Z,
    EX dist : list Z,
    EX popped : list V,
    PROP (
        (* The overall correctness condition *)
        dijkstra_correct g src popped prev dist;

      (* Some special facts about src *)
      Znth src dist = 0;
      Znth src prev = src;
      popped <> [] -> In src popped;
      popped = [] -> src = find priq (fold_right Z.min (hd 0 priq) priq) 0;

      (* A fact about the relationship b/w
         the priq and popped arrays *)
      forall v,
        vvalid g v ->
        In v popped <-> Znth v priq = Z.add inf 1;

      (* A fact about the relationship b/w
         dist and priq arrays *)
      forall dst, vvalid g dst ->
                  ~ In dst popped ->
                  Znth dst priq = Znth dst dist;

      (* Information about the ranges of the three arrays *)
      @inrange_prev size inf prev;
      @inrange_dist inf dist;
      @inrange_priq inf priq)

         LOCAL (temp _dist (pointer_val_val dist_ptr);
               temp _prev (pointer_val_val prev_ptr);
               temp _src (Vint (Int.repr src));
               temp _pq (pointer_val_val priq_ptr);
               temp _graph (pointer_val_val graph_ptr))
         SEP (data_at Tsh
                      (tarray tint size)
                      (map Vint (map Int.repr prev))
                      (pointer_val_val prev_ptr);
             data_at Tsh
                     (tarray tint size)
                     (map Vint (map Int.repr priq))
                       (pointer_val_val priq_ptr);
             data_at Tsh
                     (tarray tint size)
                     (map Vint (map Int.repr dist))
                     (pointer_val_val dist_ptr);
             @SpaceAdjMatGraph size CompSpecs sh id g
                               (pointer_val_val graph_ptr);
             free_tok (pointer_val_val priq_ptr) (sizeof tint * size)).

  Definition dijk_forloop_break_inv (g: @DijkGG size inf) sh
                                    src dist_ptr prev_ptr priq_ptr
                                    graph_ptr :=
    EX prev: list V,
    EX priq: list Z,
    EX dist: list Z,
    EX popped: list V,
    PROP (
        (* This fact comes from breaking while *)
        Forall (fun x => x >= inf) priq;
      (* And the correctness condition is established *)
      dijkstra_correct g src popped prev dist)
         LOCAL (temp _pq (pointer_val_val priq_ptr))
         SEP (data_at Tsh
                      (tarray tint size)
                      (map Vint (map Int.repr prev))
                      (pointer_val_val prev_ptr);
             (data_at Tsh
                      (tarray tint size)
                      (map Vint (map Int.repr priq))
                        (pointer_val_val priq_ptr));
             data_at Tsh
                     (tarray tint size)
                     (map Vint (map Int.repr dist))
                     (pointer_val_val dist_ptr);
             @SpaceAdjMatGraph size CompSpecs sh id g
                               (pointer_val_val graph_ptr);
             free_tok (pointer_val_val priq_ptr) (sizeof tint * size)).

  Definition dijk_inner_forloop_inv (g: @DijkGG size inf) sh
             src (priq dist prev : list Z)
             dist_ptr prev_ptr priq_ptr graph_ptr :=
    EX i : Z,
    EX prev' : list V,
    EX priq' : list Z,
    EX dist' : list Z,
    EX popped' : list V,
    let u :=
        find priq (fold_right Z.min (hd 0 priq) priq) 0 in
    PROP (
        (* inv_popped is not affected *)
        forall dst,
          vvalid g dst ->
          inv_popped g src popped' prev' dist' dst;

      (* inv_unpopped is restored for those vertices
         that the for loop has scanned and repaired *)
      forall dst,
        0 <= dst < i ->
        inv_unpopped g src popped' prev' dist' dst;

      (* a weaker version of inv_popped is
         true for those vertices that the
         for loop has not yet scanned *)
      forall dst,
        i <= dst < size ->
        inv_unpopped_weak g src popped' prev' dist' dst u;

      (* similarly for inv_unseen,
         the invariant has been
         restored until i:
         u has been taken into account *)
      forall dst,
        0 <= dst < i ->
        inv_unseen g src popped' prev' dist' dst;

      (* and a weaker version of inv_unseen is
         true for those vertices that the
         for loop has not yet scanned *)
      forall dst,
        i <= dst < size ->
        inv_unseen_weak g src popped' prev' dist' dst u;

      (* further, some useful facts about src... *)
      Znth src dist' = 0;
      Znth src prev' = src;
      popped' <> [] -> In src popped';
      popped' = [] -> src = find priq' (fold_right Z.min
                                                   (hd 0 priq') priq') 0;

      (* a useful fact about u *)
      In u popped';

      (* A fact about the relationship b/w
         priq and popped arrays *)
      forall v,
        vvalid g v ->
        In v popped' <-> Znth v priq' = Z.add inf 1;

      (* A fact about the relationship b/w
         dist and priq arrays *)
      forall dst,
        vvalid g dst ->
        ~ In dst popped' ->
        Znth dst priq' = Znth dst dist';

      (* the lengths of the threee arrays *)
      Zlength priq' = size;
      Zlength dist' = size;
      Zlength prev' = size;

      (* and ranges of the three arrays *)
      @inrange_prev size inf prev';
      @inrange_priq inf priq';
      @inrange_dist inf dist')

         LOCAL (temp _u (Vint (Int.repr u));
               temp _dist (pointer_val_val dist_ptr);
               temp _prev (pointer_val_val prev_ptr);
               temp _src (Vint (Int.repr src));
               temp _pq (pointer_val_val priq_ptr);
               temp _graph (pointer_val_val graph_ptr))

         SEP (data_at Tsh
                      (tarray tint size)
                      (map Vint (map Int.repr prev'))
                      (pointer_val_val prev_ptr);
             data_at Tsh
                     (tarray tint size)
                     (map Vint (map Int.repr priq'))
                     (pointer_val_val priq_ptr);
             data_at Tsh
                     (tarray tint size)
                     (map Vint (map Int.repr dist'))
                     (pointer_val_val dist_ptr);
             @SpaceAdjMatGraph size CompSpecs sh id g
                               (pointer_val_val graph_ptr);
             free_tok (pointer_val_val priq_ptr) (sizeof tint * size)).

  Lemma body_getCell: semax_body Vprog Gprog f_getCell getCell_spec.
  Proof.
    start_function.
    pose proof (size_further_restricted g).
    rename H2 into Hsz.
    unfold SpaceAdjMatGraph, SpaceAdjMatGraph'.
    rewrite <- size_eq.
    assert (0 <= u * size + i < size * size). {
      split.
      - apply Z.add_nonneg_nonneg; try ulia.
        apply Z.mul_nonneg_nonneg; try ulia.
      - replace size with (size - 1 + 1) at 2 by lia.
        rewrite Z.mul_add_distr_r, Z.mul_1_l.
        apply Z.add_le_lt_mono; try ulia.
        apply Zmult_le_compat_r; ulia.
    }
    assert (0 <= u * size + i <
            Zlength (map Int.repr (@graph_to_list size g id))). {
      rewrite Zlength_map, (graph_to_list_Zlength _ _ size); ulia.
    }
    forward. forward. entailer!. f_equal. f_equal.
    apply graph_to_list_to_mat; ulia.
  Qed.

  (* DIJKSTRA PROOF BEGINS *)

  Lemma body_dijkstra: semax_body Vprog Gprog f_dijkstra dijkstra_spec.
  Proof.
    start_function.
    rename H1 into size_sq_bounds.
    pose proof (size_further_restricted g).
    pose proof (inf_bounds g).
    rename H1 into Hsz.
    rename H2 into Hinf.
    forward_call (tt).
    1: split; [split|]; ulia.
    Intro priq_ptr.
    forward_for_simple_bound
      size
      (dijk_setup_loop_inv g sh src dist_ptr prev_ptr priq_ptr graph_ptr).
    - rewrite list_repeat_0, app_nil_l, Z.sub_0_r, data_at__tarray.
      entailer!.
    - forward. forward.
      forward_call ((pointer_val_val priq_ptr), i, inf,
                    (list_repeat (Z.to_nat i)
                                 (Vint (Int.repr inf)) ++
                                 list_repeat (Z.to_nat
                                                (size - i)) Vundef)).
      1: split; [|red]; ulia.
      repeat rewrite upd_Znth_list_repeat; try lia.
      entailer!.
    - (* At this point we are done with the
       first for loop. The arrays are all set to inf. *)
      replace (size - size) with 0 by lia;
        rewrite list_repeat_0, <- (app_nil_end).
      forward. forward.
      do 2 rewrite <- map_list_repeat.
      forward_call ((pointer_val_val priq_ptr), src, 0,
                    (list_repeat (Z.to_nat size) inf)).
      1: split; [|red]; ulia.
      do 2 rewrite map_list_repeat.
      assert (H_src_valid: vvalid g src). {
        rewrite (vvalid_meaning g); trivial.
      }

      (* Special values for src have been inserted *)

      (* We will now enter the main while loop.
       We state the invariant just below, in PROP.

       VST will first ask us to first show the
       invariant at the start of the loop
       *)

      forward_loop
      (dijk_forloop_inv g sh src dist_ptr prev_ptr priq_ptr graph_ptr)
      break: (dijk_forloop_break_inv g sh src dist_ptr prev_ptr priq_ptr graph_ptr).
      + unfold dijk_forloop_inv.
        Exists (upd_Znth src (@list_repeat V (Z.to_nat size) inf) src).
        Exists (upd_Znth src (@list_repeat V (Z.to_nat size) inf) 0).
        Exists (upd_Znth src (@list_repeat V (Z.to_nat size) inf) 0).
        Exists (@nil V).
        repeat rewrite <- upd_Znth_map; entailer!;
          clear H1 H2 H3 H4 H5 H6 H7 H8 H9 H10 H11.
        split3; [| |split3; [| |split]].
        * apply (dijkstra_correct_nothing_popped g src); trivial.
        * rewrite upd_Znth_same; trivial.
        * rewrite upd_Znth_same; trivial.
        * intros; rewrite find_src; ulia.
        * intros. split; [inversion 1 | intros; exfalso].
          destruct (Z.eq_dec src v).
          -- subst src. rewrite upd_Znth_same in H2; ulia.
          -- apply (vvalid_meaning g) in H1.
             rewrite upd_Znth_diff in H2
               by (try rewrite Zlength_list_repeat; ulia).
             rewrite Znth_list_repeat_inrange in H2; trivial.
             rewrite Z.add_1_r in H2.
             apply (Z.neq_succ_diag_l inf). lia.

        * split3; red; apply Forall_upd_Znth;
            try apply Forall_list_repeat; ulia.

      + (* Now the body of the while loop begins. *)
        unfold dijk_forloop_inv.
        Intros prev priq dist popped.
        rename H4 into H_popped_src_1.
        rename H5 into H_popped_src_2.
        rename H6 into H_popped_priq_link.
        rename H7 into H4.
        rename H8 into H5.
        rename H9 into H6.
        rename H10 into H7.
        assert_PROP (Zlength priq = size).
        { entailer!. now repeat rewrite Zlength_map in *. }
        assert_PROP (Zlength prev = size).
        { entailer!. now repeat rewrite Zlength_map in *. }
        assert_PROP (Zlength dist = size).
        { entailer!. now repeat rewrite Zlength_map in *. }

        forward_call ((pointer_val_val priq_ptr), priq).
        1: split3; [| |split3]; ulia.
        forward_if. (* checking if it's time to break *)
        * (* No, don't break. *)
          rename H11 into Htemp.
          assert (@isEmpty inf priq = Vzero). {
            destruct (@isEmptyTwoCases inf priq);
              rewrite H11 in Htemp; simpl in Htemp;
                now inversion Htemp.
          }
          clear Htemp.
          forward_call ((pointer_val_val priq_ptr), priq).
          1: split3; [| |split3; [| |split]]; ulia.

          Intros u.
          rename H12 into Hequ.
          (* u is the minimally chosen item from the
           "seen but not popped" category of vertices *)

          (* We prove a few useful facts about u: *)
          assert (H_u_valid: vvalid g u). {
            apply (vvalid_meaning g); trivial.
            subst u.
            replace size with (Zlength priq).
            apply find_range.
            apply min_in_list. apply incl_refl.
            destruct priq.
            1: rewrite Zlength_nil in H8; ulia.
            simpl; left; trivial.
          }

          assert (0 <= u < size). {
            apply (vvalid_meaning g) in H_u_valid; trivial.
          }

          assert (~ (In u popped)). {
            intro.
            rewrite H_popped_priq_link in H13; trivial.
            rewrite <- isEmpty_in' in H11.
            destruct H11 as [? [? ?]].
            subst u.
            rewrite Znth_find in H13.
            1: pose proof (fold_min _ _ H11); lia.
            rewrite <- Znth_0_hd by ulia.
            apply min_in_list;
              [ apply incl_refl | apply Znth_In; ulia].
          }

          rewrite Znth_0_hd; [|ulia].
          do 2 rewrite upd_Znth_map.

          assert (Htemp: 0 <= u < Zlength dist) by lia.
          pose proof (Znth_dist_cases _ _ Htemp H6).
          clear Htemp.

          (* This is the priq array with which
           we will enter the for loop.
           The dist and prev arrays are the same.
           Naturally, going in with this new priq
           and the old dist and prev means that
           dijkstra_correct is currently broken.
           The for loop will repair this and restore
           dijkstra_correct.
           *)
          forward_for_simple_bound
            size
            (dijk_inner_forloop_inv
               g sh src priq dist prev
               dist_ptr prev_ptr priq_ptr graph_ptr).
          -- (* We start the for loop as planned --
              with the old dist and prev arrays,
              and with a priq array where u has been popped *)
            (* We must prove the for loop's invariants for i = 0 *)
            Exists prev.
            Exists (upd_Znth u priq (inf+1)).
            Exists dist.
            Exists (u :: popped).
            repeat rewrite <- upd_Znth_map.
            entailer!.
            remember (find priq
                           (fold_right Z.min (hd 0 priq)
                                       priq) 0) as u.
            clear H15 H16 H17 H18 H19 H20 H21 H22
                  H23 H24 H25 H26 H27 H28.

            split3; [| | split3; [| |split3; [| |split3; [| |split]]]]; trivial.
            ++ intros.
               (* if popped = [], then
                prove inv_popped for [u].
                if popped <> [], then we're set
                *)
               destruct popped eqn:?.
               2: {
                 apply (inv_popped_add_u _ _ _ _ _ _ priq); try ulia.
                 apply H_popped_src_1; inversion 1.
               }
               replace u with src in *.
               2: apply H_popped_src_2; trivial.
               intro.
               simpl in H16; destruct H16; [|lia].
               subst dst; clear H15.
               destruct H14; [left | right].
               ** exfalso. rewrite H14 in H2. ulia.
               ** exists (src, []). split3.
                  --- split3; [| |split3]; trivial.
                      +++ split; trivial.
                      +++ rewrite path_cost.path_cost_zero; ulia.
                      +++ apply Forall_forall.
                          inversion 1.
                  --- unfold path_in_popped.
                      intros.
                      inversion H15.
                      +++ simpl in H16.
                          subst step. simpl; left; trivial.
                      +++ destruct H16 as [? [? _]].
                          inversion H16.
                  --- red. intros. rewrite path_cost.path_cost_zero; try ulia.
                      apply path_cost_pos; trivial.
            ++ intros.
               apply (vvalid_meaning g) in H15.
               apply inv_unpopped_weak_add_unpopped; trivial.

            ++ intros.
               apply (vvalid_meaning g) in H15.
               apply (inv_unseen_weak_add_unpopped g prev _ _ src); trivial.

            ++ intros. clear H15.
               destruct popped eqn:?.
               2: right; apply H_popped_src_1; inversion 1.
               simpl. left. symmetry.
               apply H_popped_src_2; trivial.

            ++ intros. inversion H15.

            ++ apply in_eq.

            ++ intros.
               assert (H16 := H15).
               rewrite (vvalid_meaning g v) in H16.
               split; intros; destruct (Z.eq_dec v u).
               ** subst v; rewrite upd_Znth_same; ulia.
               ** simpl in H17; destruct H17; [ulia|].
                  rewrite upd_Znth_diff; try ulia.
                  apply H_popped_priq_link; trivial.
               ** left; lia.
               ** right.
                  rewrite upd_Znth_diff in H17; try ulia.
                  apply <- H_popped_priq_link; trivial.

            ++ intros.
               assert (dst <> u). {
                 intro. subst dst. apply H16, in_eq.
               }
               assert (0 <= dst < Zlength priq). {
                 rewrite (vvalid_meaning g) in H15; lia.
               }
               rewrite upd_Znth_diff by lia.
               apply H4; trivial.
               apply not_in_cons in H16; destruct H16 as [_ ?];
                 ulia.

            ++ rewrite upd_Znth_Zlength; ulia.

            ++ apply Forall_upd_Znth; ulia.

          -- (* We now begin with the for loop's body *)
            rewrite <- Hequ.
            freeze FR := (data_at _ _ _ _) (data_at _ _ _ _) (data_at _ _ _ _).
            Intros.
            rename H16 into H_inv_popped.
            rename H17 into H_inv_unpopped.
            rename H18 into H_inv_unpopped_weak.
            rename H19 into H_inv_unseen.
            rename H20 into H_inv_unseen_weak.
            rename H21 into H16.
            rename H22 into H17.
            rename H23 into H18.
            rename H24 into H19.
            rename H25 into H20.
            rename H26 into H_priq_popped_link.
            rename H27 into H_priq_dist_link.
            rename H31 into H21.
            rename H32 into H22.
            rename H33 into H23.
            rename H28 into H24.
            rename H29 into H25.
            rename H30 into H26.

            forward_call (sh, g, graph_ptr, addresses, u, i).
            remember (Znth i (Znth u (@graph_to_mat size g id))) as cost.

            assert (H_i_valid: vvalid g i). {
              apply (vvalid_meaning g); trivial.
            }

            rewrite <- elabel_Znth_graph_to_mat in Heqcost; trivial.

            forward_if.
            ++ rename H27 into Htemp.
               assert (0 <= cost <= Int.max_signed / size - 1). {
                 pose proof (edge_representable g (u, i)).
                 rewrite Heqcost in *.
                 apply (valid_edge_bounds g).
                 rewrite (evalid_meaning g). split; trivial.
                 rewrite Int.signed_repr in Htemp; trivial.
               }
               clear Htemp.
               assert (H_ui_valid: evalid g (u,i)). {
                 apply evalid_dijk with (cost0 := cost);
                   trivial.
               }

               assert (0 <= Znth u dist' <= inf). {
                 assert (0 <= u < Zlength dist') by lia.
                 apply (sublist.Forall_Znth _ _ _ H28) in H23.
                 assumption.
               }
               assert (0 <= Znth i dist' <= inf). {
                 assert (0 <= i < Zlength dist') by lia.
                 apply (sublist.Forall_Znth _ _ _ H29) in H23.
                 assumption.
               }
               assert (0 <= Znth u dist' + cost <= Int.max_signed). {
                 (* IMPORTANT:
                  the key point where
                  we were forced to lower
                  inf's upper bound
                  *)
                 pose proof (inf_further_restricted g).
                 lia.
               }
               thaw FR.
               forward. forward. forward_if.

               ** rename H31 into H_improvement.
                  (* We know that we are definitely
                   going to make edits in the arrays:
                   we have found a better path to i, via u *)
                  rename H28 into Htemp.
                  assert (H28: 0 <= Znth u dist' < inf) by lia.
                  clear Htemp.

                  assert (H_i_not_popped: ~ In i (popped')). {
                    apply (not_in_popped g src u i cost prev' dist'); trivial.
                  }
                  assert (Htemp : 0 <= i < Zlength dist') by lia.
                  pose proof (Znth_dist_cases i dist' Htemp H23).
                  clear Htemp.
                  rename H31 into icases.
                  rewrite <- H_priq_dist_link in icases; trivial.

                  forward. forward. forward.
                  forward; rewrite upd_Znth_same; trivial.
                  1: entailer!.
                  1,3: repeat rewrite Zlength_map; lia.
                  forward_call ((pointer_val_val priq_ptr), i,
                                (Znth u dist' + cost), priq').

(* Now we must show that the for loop's invariant
   holds if we take another step,
   ie when i increments

   We will provide the arrays as they stand now:
   with the i'th cell updated in all three arrays,
   to log a new improved path via u
 *)
                  1: split; [|red]; rep_lia.

                  Exists (upd_Znth i prev' u).
                  Exists (upd_Znth i priq' (Znth u dist' + cost)).
                  Exists (upd_Znth i dist' (Znth u dist' + cost)).
                  Exists popped'.
                  repeat rewrite <- upd_Znth_map.
                  entailer!.

                  clear H31 H32 H33 H34 H35 H36
                        H37 H38 H39 H40 H41 H42.

                  remember (find priq (fold_right Z.min (hd 0 priq)
                                                  priq) 0) as u.

                  remember (Znth u dist' + elabel g (u, i)) as newcost.
                  fold V in *. simpl id in *.
                  rewrite <- Heqnewcost in *.

                  assert (u <> i) by (intro; subst; lia).

                  split3; [| | split3;
                               [| | split3;
                                    [| | split3;
                                         [| |split3;
                                             [| | split3]]]]]; intros.
                  (* 13 goals, where the 13th is
                   3 range-based goals together *)
                  --- apply inv_popped_newcost; ulia.
                  --- apply inv_unpopped_newcost with (priq0 := priq');
                        ulia.
                  --- now apply inv_unpopped_weak_newcost.
                  --- apply inv_unseen_newcost; ulia.
                  --- apply inv_unseen_weak_newcost; ulia.
                  --- rewrite upd_Znth_diff; try lia;
                        intro; subst src; lia.
                  --- rewrite upd_Znth_diff; try lia;
                        intro; subst src; lia.
                  --- assert (H33 := H32).
                      rewrite (vvalid_meaning g) in H33.
                      split; intros; destruct (Z.eq_dec v i).
                      +++ exfalso. subst v.
                          apply H_i_not_popped; trivial.
                      +++ rewrite upd_Znth_diff; try ulia.
                          apply H_priq_popped_link; trivial.
                      +++ exfalso. subst v.
                          rewrite upd_Znth_same in H34; ulia.
                      +++ rewrite upd_Znth_diff in H34; try ulia.
                          apply <- H_priq_popped_link; trivial.
                  --- destruct (Z.eq_dec dst i).
                      1: subst dst; repeat rewrite upd_Znth_same; ulia.
                      repeat rewrite upd_Znth_diff; trivial; try lia.
                      apply H_priq_dist_link; trivial.
                      all: rewrite (vvalid_meaning g) in H32; ulia.
                  --- rewrite upd_Znth_Zlength; ulia.
                  --- rewrite upd_Znth_Zlength; ulia.
                  --- rewrite upd_Znth_Zlength; ulia.
                  --- split3; apply Forall_upd_Znth; ulia.

               ** (* This is the branch where we didn't
                   make a change to the i'th vertex. *)
                 rename H31 into H_non_improvement.
                 forward.
                 (* The old arrays are just fine. *)
                 Exists prev' priq' dist' popped'.
                 entailer!.
                 remember (find priq (fold_right Z.min
                                                 (hd 0 priq) priq) 0) as u.

                 clear H31 H32 H33 H34 H35 H36
                       H37 H38 H39 H40 H41 H42 H43.

                 assert (elabel g (u, i) < inf). {
                   apply Z.le_lt_trans with (m := Int.max_signed / size - 1);
                     trivial.
                   apply H27.
                   apply (inf_further_restricted g).
                 }
                 split3; [| |split].
                 --- intros. apply inv_unpopped_new_dst
                               with (u0 := u) (i0 := i); trivial.
                 --- intros. destruct (Z.eq_dec dst i).
                     +++ subst dst. lia.
                     +++ apply H_inv_unpopped_weak; lia.
                 --- intros. destruct (Z.eq_dec dst i).
                     2: apply H_inv_unseen; lia.

                     unfold inv_unseen; intros.
                     subst dst.

                     assert (i <= i < size) by lia.
                     destruct (Z.eq_dec m u).
                     2: now apply (H_inv_unseen_weak _ H38) with (m:=m).
                     subst m.
                     rename p2m into p2u.
                     rewrite H34 in H_non_improvement.
                     assert (0 <= u < size) by lia.
                     rewrite path_cost_glue_one_step.
                     destruct H37 as [_ [_ [_ [? _]]]].
                     simpl id in *. ulia.
                 --- intros.
                     assert (i <= dst < size) by lia.
                     apply H_inv_unseen_weak; trivial.
            ++  (* i was not a neighbor of u.
                 We must prove the for loop's invariant holds *)
              forward.
              Exists prev' priq' dist' popped'.
              thaw FR.
              entailer!.
              remember (find priq (fold_right Z.min (hd 0 priq) priq) 0) as u.
              clear H28 H29 H30 H31 H32 H33
                    H34 H35 H36 H37 H38 H39 H40.

              rewrite <- inf_eq in H27. rewrite Int.signed_repr in H27.
              2: apply edge_representable.
              split3; [| |split]; intros.
              ** destruct (Z.eq_dec dst i).
                 --- subst dst.
(* Will need to use the second half of the
   for loop's invariant.
   Whatever path worked for i then will
   continue to work for i now:
   i cannot be improved by going via u
 *)
                     unfold inv_unpopped; intros.
                     assert (i <= i < size) by lia.
                     destruct (H_inv_unpopped_weak i H31 H29 H30).
                     1: left; trivial.
                     destruct H32 as [? [[? [? [? [? [? ?]]]]]?]].
                     remember (Znth i prev') as mom.

                     assert (Znth mom dist' < inf). {
                       pose proof (edge_cost_pos g (mom, i)).
                       ulia.
                     }

                     right. split3; [| |split3; [| |split3]]; trivial.

                     intros.
                     destruct (@Znth_dist_cases inf mom' dist')
                       as [e | e]; trivial.
                     1: apply (vvalid_meaning g) in H41; ulia.
                     1: { rewrite e.
                          pose proof (edge_cost_pos g (mom', i)).
                          ulia.
                     }

                     destruct (zlt (Znth mom' dist' +
                                    elabel g (mom', i)) inf).
                     2: ulia.

                     destruct (Z.eq_dec mom' u).
                     1: { subst mom'.
                          assert (0 <= Znth u dist'). {
                            apply (sublist.Forall_Znth _ _ u) in H23.
                            simpl in H23. apply H23.
                            lia.
                          }
                          simpl id in *. ulia.
                     }
                     apply H39; trivial.
                 --- apply H_inv_unpopped; lia.
              ** destruct (Z.eq_dec dst i);
                   [| apply H_inv_unpopped_weak]; lia.
              ** destruct (Z.eq_dec dst i).
                 2: apply H_inv_unseen; lia.
                 subst dst.
                 assert (i <= i < size) by lia.
                 unfold inv_unseen; intros.
                 destruct (Z.eq_dec m u).
                 2: now apply (H_inv_unseen_weak _ H29)
                   with (m:=m).

                 subst m.
                 assert (0 <= Znth u dist'). {
                   apply (sublist.Forall_Znth _ _ u) in H23.
                   apply H23.
                   ulia.
                 }
                 rewrite path_cost_glue_one_step.
                 destruct H34 as [? _].
                 pose proof (path_cost_pos _ _ H34).
                 simpl id in *. ulia.
              ** apply H_inv_unseen_weak; lia.
          -- (* From the for loop's invariant,
              prove the while loop's invariant. *)
            Intros prev' priq' dist' popped'.
            Exists prev' priq' dist' popped'.
            entailer!.
            remember (find priq (fold_right Z.min (hd 0 priq) priq) 0)
              as u.
            unfold dijkstra_correct.
            split3; [auto | apply H16 | apply H18];
              try rewrite <- (vvalid_meaning g); trivial.

        * (* After breaking from the while loop,
           prove break's postcondition *)
          assert (@isEmpty inf priq = Vone). {
            destruct (@isEmptyTwoCases inf priq); trivial;
              rewrite H12 in H11; simpl in H11; now inversion H11.
          }
          clear H11.
          forward. Exists prev priq dist popped.
          entailer!.
          pose proof (@isEmptyMeansInf inf priq).
          rewrite H26 in H12.
          rewrite Forall_forall in H12 |- *.
          intros. specialize (H12 _ H27). lia.
      + (* from the break's postcon, prove the overall postcon *)
        unfold dijk_forloop_break_inv.
        Intros prev priq dist popped.
        freeze FR := (data_at _ _ _ (pointer_val_val prev_ptr))
                       (data_at _ _ _ (pointer_val_val dist_ptr))
                       (SpaceAdjMatGraph _ _ _ _).
        forward_call (Tsh, priq_ptr, size, priq).
        entailer!.
        thaw FR.
        forward.
        Exists prev dist popped. entailer!.
        intros. destruct (H2 _ H10) as [? _]; trivial.
  Qed.

End DijkstraProof.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable tS_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable rT_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable par_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable oS_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable meet_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable congA_ : Universe -> Universe -> Universe -> Universe -> Universe -> Universe -> Prop.
Variable cong_ : Universe -> Universe -> Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.
Variable betS_ : Universe -> Universe -> Universe -> Prop.

Variable lemma_parallelNC_1 : (forall A B C D : Universe, (par_ A B C D -> (~(col_ A B C) /\ (~(col_ A C D) /\ (~(col_ B C D) /\ ~(col_ A B D)))))).
Variable defcollinear_2 : (forall A B C : Universe, (col_ A B C -> (A = B \/ (A = C \/ (B = C \/ (betS_ B A C \/ (betS_ A B C \/ betS_ A C B))))))).
Variable defcollinear2a_3 : (forall A B C : Universe, (A = B -> col_ A B C)).
Variable defcollinear2b_4 : (forall A B C : Universe, (A = C -> col_ A B C)).
Variable defcollinear2c_5 : (forall A B C : Universe, (B = C -> col_ A B C)).
Variable defcollinear2d_6 : (forall A B C : Universe, (betS_ B A C -> col_ A B C)).
Variable defcollinear2e_7 : (forall A B C : Universe, (betS_ A B C -> col_ A B C)).
Variable defcollinear2f_8 : (forall A B C : Universe, (betS_ A C B -> col_ A B C)).
Variable lemma_inequalitysymmetric_9 : (forall A B : Universe, (A <> B -> B <> A)).
Variable lemma_extension_10 : (forall A B P Q : Universe, (exists X : Universe, ((A <> B /\ P <> Q) -> (betS_ A B X /\ cong_ B X P Q)))).
Variable axiom_betweennesssymmetry_11 : (forall A B C : Universe, (betS_ A B C -> betS_ C B A)).
Variable lemma_betweennotequal_12 : (forall A B C : Universe, (betS_ A B C -> (B <> C /\ (A <> B /\ A <> C)))).
Variable lemma_collinearorder_13 : (forall A B C : Universe, (col_ A B C -> (col_ B A C /\ (col_ B C A /\ (col_ C A B /\ (col_ A C B /\ col_ C B A)))))).
Variable lemma_parallelsymmetric_14 : (forall A B C D : Universe, (par_ A B C D -> par_ C D A B)).
Variable lemma_collinearparallel_15 : (forall A B C Xc Xd : Universe, ((par_ A B Xc Xd /\ (col_ Xc Xd C /\ C <> Xd)) -> par_ A B C Xd)).
Variable lemma_parallelflip_16 : (forall A B C D : Universe, (par_ A B C D -> (par_ B A C D /\ (par_ A B D C /\ par_ B A D C)))).
Variable defparallel_17 : (forall A B C D : Universe, (exists U V Su Sv X : Universe, (par_ A B C D -> (A <> B /\ (C <> D /\ (col_ A B U /\ (col_ A B V /\ (U <> V /\ (col_ C D Su /\ (col_ C D Sv /\ (Su <> Sv /\ (~(meet_ A B C D) /\ (betS_ U X Sv /\ betS_ Su X V))))))))))))).
Variable defparallel2_18 : (forall A B C D U V Su Sv X : Universe, ((A <> B /\ (C <> D /\ (col_ A B U /\ (col_ A B V /\ (U <> V /\ (col_ C D Su /\ (col_ C D Sv /\ (Su <> Sv /\ (~(meet_ A B C D) /\ (betS_ U X Sv /\ betS_ Su X V)))))))))) -> par_ A B C D)).
Variable lemma_collinear4_19 : (forall A B C D : Universe, ((col_ A B C /\ (col_ A B D /\ A <> B)) -> col_ B C D)).
Variable defmeet_20 : (forall A B C D : Universe, (exists X : Universe, (meet_ A B C D -> (A <> B /\ (C <> D /\ (col_ A B X /\ col_ C D X)))))).
Variable defmeet2_21 : (forall A B C D X : Universe, ((A <> B /\ (C <> D /\ (col_ A B X /\ col_ C D X))) -> meet_ A B C D)).
Variable lemma_NCorder_22 : (forall A B C : Universe, (~(col_ A B C) -> (~(col_ B A C) /\ (~(col_ B C A) /\ (~(col_ C A B) /\ (~(col_ A C B) /\ ~(col_ C B A))))))).
Variable lemma_samesidesymmetric_23 : (forall A B P Q : Universe, (oS_ P Q A B -> (oS_ Q P A B /\ (oS_ P Q B A /\ oS_ Q P B A)))).
Variable defoppositeside_24 : (forall P A B Q : Universe, (exists X : Universe, (tS_ P A B Q -> (betS_ P X Q /\ (col_ A B X /\ ~(col_ A B P)))))).
Variable defoppositeside2_25 : (forall P A B Q X : Universe, ((betS_ P X Q /\ (col_ A B X /\ ~(col_ A B P))) -> tS_ P A B Q)).
Variable lemma_planeseparation_26 : (forall A B C D E : Universe, ((oS_ C D A B /\ tS_ D A B E) -> tS_ C A B E)).
Variable lemma_oppositesidesymmetric_27 : (forall A B P Q : Universe, (tS_ P A B Q -> tS_ Q A B P)).
Variable proposition_29_28 : (forall A B C D E G H : Universe, ((par_ A B C D /\ (betS_ A G B /\ (betS_ C H D /\ (betS_ E G H /\ tS_ A G H D)))) -> (congA_ A G H G H D /\ (congA_ E G B G H D /\ rT_ B G H G H D)))).

Theorem proposition_29C_29 : (forall B D E G H : Universe, ((par_ G B H D /\ (oS_ B D G H /\ betS_ E G H)) -> (congA_ E G B G H D /\ rT_ B G H G H D))).
Proof.
  time tac.
Qed.

End FOFProblem.


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

Inductive natural : Type := Succ : natural -> natural |  Zero : natural.

Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint less (less_arg0 : natural) (less_arg1 : natural) : bool
           := match less_arg0, less_arg1 with
              | x, Zero => false
              | Zero, Succ x => true
              | Succ x, Succ y => less x y
              end.

Fixpoint eqn (m n : natural) : bool :=
  match m , n with
  | Zero , Zero => true
  | Succ m' , Succ n' => eqn m' n'
  | _, _ => false
  end.

Definition leq (m n : natural) : bool :=
  orb (eqn m n) (less m n).

Fixpoint insort (insort_arg0 : natural) (insort_arg1 : lst) : lst
           := match insort_arg0, insort_arg1 with
              | i, Nil => Cons i Nil
              | i, Cons x y => if less i x then Cons i (Cons x y) else Cons x (insort i y)
              end.

Fixpoint sorted (sorted_arg0 : lst) : bool
           := match sorted_arg0 with
              | Nil => true
              | Cons x l =>
                let s := sorted l in
                match l with
                | Nil => true
                | Cons y _ => andb s (leq x y)
                end
              end.

Fixpoint sort (sort_arg0 : lst) : lst
           := match sort_arg0 with
              | Nil => Nil
              | Cons x y => insort x (sort y)
              end.

(*
Lemma lem2: forall m n, less m n = false -> leq n m = true.
(* Proof.
  induction m.
  - intros. unfold leq. unfold orb. remember (eqn n (Succ m)).
    destruct b.
    * reflexivity.
    * destruct n.
      + simpl. simpl in H.  *)
Admitted.

Lemma lem3: forall n0 n l, sorted (Cons n l) = true -> leq n0 n = true ->
    sorted (Cons n0 (Cons n l)) = true.
Admitted.
*)

Lemma lem: forall n l, sorted l = true -> sorted (insort n l) = true.
Proof.
 (*intros. induction l.
  - simpl. remember (less n n0) as lt. destruct lt.
    * remember (Cons n0 l) as l0. simpl. rewrite Heql0 in H. rewrite Heql0.
      rewrite H. simpl. unfold leq. rewrite <- Heqlt. destruct (eqn n n0).
      + auto.
      + auto.
    * assert (sorted l = true).
      + destruct l.
        ** simpl in H. unfold andb in H. remember (match l with | Cons y _ => if sorted l then leq n1 y else false
      | Nil => true end). destruct b.
          *** simpl. unfold andb. rewrite <- Heqb. reflexivity.
          *** inversion H.
        ** reflexivity.
      + remember (insort n l) as li. destruct li.
        ** apply lem3. apply IHl. assumption.
        assert ((sorted (Cons n1 li)) = true).
        ** apply IHl. apply H0.
        ** assert (leq n0 n1 = true).
           *** inversion H1. remember (leq n0 n1). destruct b.
              ++ rewrite H3. reflexivity.
              ++ destruct li.
                +++ rewrite H3.
        remember (sorted (Cons n1 li)) as r1.
        remember (leq n0 n1) as r2.
        destruct andb.
        ** reflexivity.
        **
        ** simpl. simpl in IHl. unfold andb.
           remember (match li with
  | Cons y _ => if sorted li then leq n1 y else false
  | Nil => true
  end). destruct b.
          *** *)
Admitted.

Theorem theorem0 : forall (x : lst), eq (sorted (sort x)) true.
Proof.
induction x.
  - simpl. lfind. Admitted.