Require Import Bool.
Require Import RelationClasses.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import DataStructure.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Loc.
From PromisingLib Require Import Language.
From PromisingLib Require Import Event.

Require Import Time.
Require Import View.
Require Import BoolMap.
Require Import Promises.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Global.
Require Import Local.
Require Import Thread.
Require Import Configuration.

Require Import OrdStep.
Require Import Writes.

Set Implicit Arguments.

Module WThread.
  Section WThread.
    Variable lang: language.
    Variable L: Loc.t -> bool.
    Variable ordcr: Ordering.t.
    Variable ordcw: Ordering.t.

    Variant step rels1: forall (rels2: Writes.t) (e: ThreadEvent.t) (e1 e2: Thread.t lang), Prop :=
    | step_intro
        e e1 e2
        (STEP: @OrdThread.step lang L ordcr ordcw e e1 e2):
        step rels1 (Writes.append L e rels1) e e1 e2
    .

    (* Inducitve steps rels1: forall (rels2: Writes.t) (e1 e2: Thread.t lang), Prop := *)
    (* | steps_refl *)
    (*     e: *)
    (*     steps rels1 rels1 e e *)
    (* | steps_step *)
    (*     rels2 rels3 e e1 e2 e3 *)
    (*     (STEP: step rels1 rels2 e e1 e2) *)
    (*     (STEPS: steps rels2 rels3 e2 e3): *)
    (*     steps rels1 rels3 e1 e3 *)
    (* . *)
    (* Hint Constructors steps: core. *)

    (* Inductive tau_steps rels1: forall (rels2: Writes.t) (e1 e2: Thread.t lang), Prop := *)
    (* | tau_steps_refl *)
    (*     e: *)
    (*     tau_steps rels1 rels1 e e *)
    (* | tau_steps_step *)
    (*     rels2 rels3 e e1 e2 e3 *)
    (*     (STEP: step rels1 rels2 e e1 e2) *)
    (*     (SILENT: ThreadEvent.get_machine_event e = MachineEvent.silent) *)
    (*     (STEPS: tau_steps rels2 rels3 e2 e3): *)
    (*     tau_steps rels1 rels3 e1 e3 *)
    (* . *)
    (* Hint Constructors tau_steps: core. *)

    Variant opt_step rels1: forall (rels2: Writes.t) (e: ThreadEvent.t) (e1 e2: Thread.t lang), Prop :=
    | step_none
        e:
        opt_step rels1 rels1 ThreadEvent.silent e e
    | step_some
        rels2 e e1 e2
        (STEP: step rels1 rels2 e e1 e2):
        opt_step rels1 rels2 e e1 e2
    .
    Hint Constructors opt_step: core.

    Lemma step_ord_step
          rels1 rels2 e e1 e2
          (STEP: step rels1 rels2 e e1 e2):
      OrdThread.step L ordcr ordcw e e1 e2.
    Proof.
      inv STEP. eauto.
    Qed.

    Lemma opt_step_ord_opt_step
          rels1 rels2 e e1 e2
          (STEP: opt_step rels1 rels2 e e1 e2):
      OrdThread.opt_step L ordcr ordcw e e1 e2.
    Proof.
      inv STEP; [econs 1|].
      exploit step_ord_step; eauto. i. des.
      econs 2. eauto.
    Qed.

    (* Lemma steps_ord_steps *)
    (*       rels1 rels2 e1 e2 *)
    (*       (STEPS: steps rels1 rels2 e1 e2): *)
    (*   rtc (OrdThread.all_step L ordcr ordcw) e1 e2. *)
    (* Proof. *)
    (*   induction STEPS; eauto. *)
    (*   exploit step_ord_step; eauto. i. des. *)
    (*   econs 2; eauto. econs. econs. eauto. *)
    (* Qed. *)

    (* Lemma tau_steps_ord_tau_steps *)
    (*       rels1 rels2 e1 e2 *)
    (*       (STEPS: tau_steps rels1 rels2 e1 e2): *)
    (*   rtc (@OrdThread.tau_step lang L ordcr ordcw) e1 e2. *)
    (* Proof. *)
    (*   induction STEPS; eauto. *)
    (*   inv STEP; ss. *)
    (*   econs 2; eauto. econs; eauto. econs. eauto. *)
    (* Qed. *)

    (* Lemma ord_tau_steps_tau_steps *)
    (*       e1 e2 *)
    (*       (STEPS: rtc (@OrdThread.tau_step lang L ordcr ordcw) e1 e2): *)
    (*   forall rels1, exists rels2, *)
    (*       tau_steps rels1 rels2 e1 e2. *)
    (* Proof. *)
    (*   induction STEPS; eauto. inv H. inv TSTEP. i. *)
    (*   specialize (IHSTEPS (Writes.append L e rels1)). des. *)
    (*   esplits. econs 2; eauto. econs; eauto. *)
    (* Qed. *)

    (* Lemma tau_steps_steps *)
    (*       rels1 rels2 e1 e2 *)
    (*       (STEPS: tau_steps rels1 rels2 e1 e2): *)
    (*   steps rels1 rels2 e1 e2. *)
    (* Proof. *)
    (*   induction STEPS; eauto. *)
    (* Qed. *)

    (* Lemma reserve_steps_tau_steps *)
    (*       rels e1 e2 *)
    (*       (STEPS: rtc (@Thread.reserve_step _) e1 e2): *)
    (*   tau_steps rels rels e1 e2. *)
    (* Proof. *)
    (*   induction STEPS; eauto. *)
    (*   inv H. inv STEP; [|inv STEP0; inv LOCAL]. *)
    (*   econs 2; eauto. *)
    (*   - replace rels with *)
    (*         (Writes.append *)
    (*            L (ThreadEvent.promise loc from to Message.reserve Memory.op_kind_add) rels) *)
    (*         at 2 by ss. *)
    (*     econs. econs 1; eauto. *)
    (*     ii. inv PROMISE. ss. *)
    (*   - ss. *)
    (* Qed. *)

    (* Lemma cancel_steps_tau_steps *)
    (*       rels e1 e2 *)
    (*       (STEPS: rtc (@Thread.cancel_step _) e1 e2): *)
    (*   tau_steps rels rels e1 e2. *)
    (* Proof. *)
    (*   induction STEPS; eauto. *)
    (*   inv H. inv STEP; [|inv STEP0; inv LOCAL]. *)
    (*   econs 2; eauto. *)
    (*   - replace rels with *)
    (*         (Writes.append *)
    (*            L (ThreadEvent.promise loc from to Message.reserve Memory.op_kind_cancel) rels) *)
    (*         at 2 by ss. *)
    (*     econs. econs 1; eauto. *)
    (*     ii. inv PROMISE; ss. *)
    (*   - ss. *)
    (* Qed. *)

    (* Lemma tau_steps_rtc_tau_step *)
    (*       rels1 rels2 e1 e2 *)
    (*       (STEPS: tau_steps rels1 rels2 e1 e2): *)
    (*   rtc (@OrdThread.tau_step lang L ordcr ordcw) e1 e2. *)
    (* Proof. *)
    (*   induction STEPS; eauto. *)
    (*   econs 2; eauto. inv STEP; ss. *)
    (*   econs; eauto. econs. eauto. *)
    (* Qed. *)

    (* Lemma opt_step_steps *)
    (*       rels1 rels2 e e1 e2 *)
    (*       (STEP: opt_step rels1 rels2 e e1 e2): *)
    (*   steps rels1 rels2 e1 e2. *)
    (* Proof. *)
    (*   inv STEP; eauto. *)
    (* Qed. *)

    (* Lemma steps_trans *)
    (*       rels1 rels2 rels3 e1 e2 e3 *)
    (*       (STEPS1: steps rels1 rels2 e1 e2) *)
    (*       (STEPS2: steps rels2 rels3 e2 e3): *)
    (*   steps rels1 rels3 e1 e3. *)
    (* Proof. *)
    (*   revert rels3 e3 STEPS2. *)
    (*   induction STEPS1; i; eauto. *)
    (* Qed. *)

    (* Lemma tau_steps_trans *)
    (*       rels1 rels2 rels3 e1 e2 e3 *)
    (*       (STEPS1: tau_steps rels1 rels2 e1 e2) *)
    (*       (STEPS2: tau_steps rels2 rels3 e2 e3): *)
    (*   tau_steps rels1 rels3 e1 e3. *)
    (* Proof. *)
    (*   revert rels3 e3 STEPS2. *)
    (*   induction STEPS1; i; eauto. *)
    (* Qed. *)

    Lemma step_future
          rels1 rels2 e e1 e2
          (STEP: step rels1 rels2 e e1 e2)
          (LC_WF1: Local.wf (Thread.local e1) (Thread.global e1))
          (GL_WF1: Global.wf (Thread.global e1)):
      <<LC_WF2: Local.wf (Thread.local e2) (Thread.global e2)>> /\
      <<GL_WF2: Global.wf (Thread.global e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<GL_FUTURE: Global.future (Thread.global e1) (Thread.global e2)>>.
    Proof.
      inv STEP; eauto using OrdThread.step_future.
    Qed.

    Lemma opt_step_future
          rels1 rels2 e e1 e2
          (STEP: opt_step rels1 rels2 e e1 e2)
          (LC_WF1: Local.wf (Thread.local e1) (Thread.global e1))
          (GL_WF1: Global.wf (Thread.global e1)):
      <<LC_WF2: Local.wf (Thread.local e2) (Thread.global e2)>> /\
      <<GL_WF2: Global.wf (Thread.global e2)>> /\
      <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\
      <<GL_FUTURE: Global.future (Thread.global e1) (Thread.global e2)>>.
    Proof.
      inv STEP.
      - esplits; eauto; refl.
      - inv STEP0; eauto using OrdThread.step_future.
    Qed.

    (* Lemma steps_future *)
    (*       rels1 rels2 e1 e2 *)
    (*       (STEPS: steps rels1 rels2 e1 e2) *)
    (*       (WF1: Local.wf (Thread.local e1) (Thread.memory e1)) *)
    (*       (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1)) *)
    (*       (CLOSED1: Memory.closed (Thread.memory e1)): *)
    (*   <<WF2: Local.wf (Thread.local e2) (Thread.memory e2)>> /\ *)
    (*   <<SC2: Memory.closed_timemap (Thread.sc e2) (Thread.memory e2)>> /\ *)
    (*   <<CLOSED2: Memory.closed (Thread.memory e2)>> /\ *)
    (*   <<TVIEW_FUTURE: TView.le (Local.tview (Thread.local e1)) (Local.tview (Thread.local e2))>> /\ *)
    (*   <<SC_FUTURE: TimeMap.le (Thread.sc e1) (Thread.sc e2)>> /\ *)
    (*   <<MEM_FUTURE: Memory.future (Thread.memory e1) (Thread.memory e2)>>. *)
    (* Proof. *)
    (*   revert WF1 SC1 CLOSED1. induction STEPS; i. *)
    (*   - splits; ss; refl. *)
    (*   - exploit step_future; eauto. i. des. *)
    (*     exploit IHSTEPS; eauto. i. des. *)
    (*     splits; ss; etrans; eauto. *)
    (* Qed. *)

    Lemma step_disjoint
          rels1 rels2 e e1 e2 lc
          (STEP: step rels1 rels2 e e1 e2)
          (LC_WF1: Local.wf (Thread.local e1) (Thread.global e1))
          (GL_WF1: Global.wf (Thread.global e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (LC_WF: Local.wf lc (Thread.global e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<LC_WF: Local.wf lc (Thread.global e2)>>.
    Proof.
      inv STEP; eauto using OrdThread.step_disjoint.
    Qed.

    Lemma opt_step_disjoint
          rels1 rels2 e e1 e2 lc
          (STEP: opt_step rels1 rels2 e e1 e2)
          (LC_WF1: Local.wf (Thread.local e1) (Thread.global e1))
          (GL_WF1: Global.wf (Thread.global e1))
          (DISJOINT1: Local.disjoint (Thread.local e1) lc)
          (LC_WF: Local.wf lc (Thread.global e1)):
      <<DISJOINT2: Local.disjoint (Thread.local e2) lc>> /\
      <<LC_WF: Local.wf lc (Thread.global e2)>>.
    Proof.
      inv STEP; eauto.
      inv STEP0; eauto using OrdThread.step_disjoint.
    Qed.

    (* Writes.wf *)

    Lemma step_writes_wf
          rels1 rels2 e e1 e2
          (ORDCW: Ordering.le Ordering.plain ordcw)
          (RELS1: Writes.wf L rels1 (Global.memory (Thread.global e1)))
          (STEP: step rels1 rels2 e e1 e2):
      Writes.wf L rels2 (Global.memory (Thread.global e2)).
    Proof.
      inv STEP. eapply Writes.step_wf; eauto.
    Qed.

    (* Lemma steps_writes_wf *)
    (*       rels1 rels2 e1 e2 *)
    (*       (ORDCW: Ordering.le Ordering.plain ordcw) *)
    (*       (RELS1: Writes.wf L rels1 (Thread.memory e1)) *)
    (*       (STEPS: steps rels1 rels2 e1 e2): *)
    (*   Writes.wf L rels2 (Thread.memory e2). *)
    (* Proof. *)
    (*   induction STEPS; eauto. *)
    (*   apply IHSTEPS. eapply step_writes_wf; eauto. *)
    (* Qed. *)

    (* Lemma step_rels_disjoint *)
    (*       rels1 rels2 e e1 e2 promises *)
    (*       (RELS1: Writes.wf L rels1 (Local.promises (Thread.local e1)) (Thread.memory e1)) *)
    (*       (STEP: step rels1 rels2 e e1 e2) *)
    (*       (DISJOINT: Memory.disjoint (Local.promises (Thread.local e1)) promises) *)
    (*       (LE: Memory.le promises (Thread.memory e1)) *)
    (*       (RELS: Writes.wf L rels1 promises (Thread.memory e1)): *)
    (*   Writes.wf L rels2 promises (Thread.memory e2). *)
    (* Proof. *)
    (*   inv STEP. eauto using Writes.step_disjoint. *)
    (* Qed. *)

    (* Lemma steps_rels_disjoint *)
    (*       rels1 rels2 e1 e2 lc *)
    (*       (RELS1: Writes.wf L rels1 (Local.promises (Thread.local e1)) (Thread.memory e1)) *)
    (*       (STEPS: steps rels1 rels2 e1 e2) *)
    (*       (WF1: Local.wf (Thread.local e1) (Thread.memory e1)) *)
    (*       (SC1: Memory.closed_timemap (Thread.sc e1) (Thread.memory e1)) *)
    (*       (CLOSED1: Memory.closed (Thread.memory e1)) *)
    (*       (DISJOINT: Local.disjoint (Thread.local e1) lc) *)
    (*       (WF: Local.wf lc (Thread.memory e1)) *)
    (*       (RELS: Writes.wf L rels1 (Local.promises lc) (Thread.memory e1)): *)
    (*   Writes.wf L rels2 (Local.promises lc) (Thread.memory e2). *)
    (* Proof. *)
    (*   induction STEPS; ss. *)
    (*   hexploit step_rels_disjoint; eauto; try apply DISJOINT; try apply WF. i. *)
    (*   hexploit step_writes_wf; eauto. i. *)
    (*   inv STEP. *)
    (*   exploit OrdThread.step_future; eauto. i. des. *)
    (*   exploit OrdThread.step_disjoint; eauto. i. des. *)
    (*   eapply IHSTEPS; eauto. *)
    (* Qed. *)

    Lemma step_rels_incl
          rels1 rels2 e e1 e2
          (STEP: step rels1 rels2 e e1 e2):
      rels2 = rels1 \/ exists a, rels2 = a :: rels1.
    Proof.
      inv STEP. unfold Writes.append. des_ifs; eauto.
    Qed.
  End WThread.
End WThread.

Module WConfiguration.
  Section WConfiguration.
    Variable L: Loc.t -> bool.
    Variable ordcr ordcw: Ordering.t.

    Variant step:
      forall (e: ThreadEvent.t) (tid: Ident.t) (rels1 rels2: Writes.t) (c1 c2: Configuration.t), Prop :=
    | step_intro
        rels1 rels2
        e tid c1 lang st1 lc1 st2 lc2 gl2
        (TID: IdentMap.find tid (Configuration.threads c1) = Some (existT _ lang st1, lc1))
        (STEP: WThread.step L ordcr ordcw rels1 rels2 e
                            (Thread.mk _ st1 lc1 (Configuration.global c1))
                            (Thread.mk _ st2 lc2 gl2)):
        step e tid rels1 rels2
             c1 (Configuration.mk (IdentMap.add tid (existT _ _ st2, lc2) (Configuration.threads c1)) gl2)
    .

    Inductive steps rels1: forall (rels2: Writes.t) (c1 c2: Configuration.t), Prop :=
    | steps_refl
        c:
        steps rels1 rels1 c c
    | steps_step
        rels2 rels3 e tid c1 c2 c3
        (STEP: step e tid rels1 rels2 c1 c2)
        (STEPS: steps rels2 rels3 c2 c3):
        steps rels1 rels3 c1 c3
    .
    Hint Constructors steps: core.

    Lemma steps_trans
          rels1 rels2 rels3 c1 c2 c3
          (STEPS1: steps rels1 rels2 c1 c2)
          (STEPS2: steps rels2 rels3 c2 c3):
      steps rels1 rels3 c1 c3.
    Proof.
      revert c3 STEPS2. induction STEPS1; i; eauto.
    Qed.

    Lemma step_ord_step
          e tid rels1 rels2 c1 c2
          (STEP: step e tid rels1 rels2 c1 c2):
      OrdConfiguration.estep L ordcr ordcw e tid c1 c2.
    Proof.
      inv STEP. econs; eauto. inv STEP0. ss.
    Qed.

    Lemma steps_ord_steps
          rels1 rels2 c1 c2
          (STEPS: steps rels1 rels2 c1 c2):
      rtc (@OrdConfiguration.all_step L ordcr ordcw) c1 c2.
    Proof.
      induction STEPS; eauto.
      exploit step_ord_step; eauto. i. econs 2; eauto.
      econs. eauto.
    Qed.

    Lemma step_future
          e tid rels1 rels2 c1 c2
          (WF1: Configuration.wf c1)
          (STEP: step e tid rels1 rels2 c1 c2):
      <<WF2: Configuration.wf c2>> /\
      <<GL_FUTURE: Global.future (Configuration.global c1) (Configuration.global c2)>>.
    Proof.
      apply step_ord_step in STEP.
      eapply OrdConfiguration.estep_future; eauto.
    Qed.

    Lemma steps_future
          rels1 rels2 c1 c2
          (WF1: Configuration.wf c1)
          (STEPS: steps rels1 rels2 c1 c2):
      <<WF2: Configuration.wf c2>> /\
      <<GL_FUTURE: Global.future (Configuration.global c1) (Configuration.global c2)>>.
    Proof.
      induction STEPS; ss.
      - split; ss. econs; refl.
      - exploit step_future; eauto. i. des.
        exploit IHSTEPS; eauto. i. des.
        splits; ss; etrans; eauto.
    Qed.

    Lemma step_rels
          e tid rels1 rels2 c1 c2
          (STEP: WConfiguration.step e tid rels1 rels2 c1 c2):
      rels2 = Writes.append L e rels1.
    Proof.
      unfold Writes.append.
      inv STEP. inv STEP0; ss.
    Qed.

    Lemma step_rels_incl
          e tid rels1 rels2 c1 c2
          (STEP: step e tid rels1 rels2 c1 c2):
      rels2 = rels1 \/ exists a, rels2 = a :: rels1.
    Proof.
      inv STEP. inv STEP0; eauto. inv STEP.
      unfold Writes.append. des_ifs; eauto.
    Qed.

    Lemma steps_rels_incl
          rels1 rels2 c1 c2
          (STEPS: steps rels1 rels2 c1 c2):
      exists rels, rels2 = rels ++ rels1.
    Proof.
      induction STEPS.
      - exists []. ss.
      - des. exploit step_rels_incl; eauto. i. des; subst.
        + exists rels. ss.
        + exists (rels ++ [a]). rewrite <- List.app_assoc. ss.
    Qed.
  End WConfiguration.
End WConfiguration.

Module RARaceW.
  Section RARaceW.
    Variable L: Loc.t -> bool.
    Variable ordcr ordcw: Ordering.t.

    Definition wr_race (rels: Writes.t) (tview: TView.t) (loc: Loc.t) (ord: Ordering.t): Prop :=
      exists to ordw,
        (<<LOC: L loc>>) /\
        (<<HIGHER: Time.lt ((View.rlx (TView.cur tview)) loc) to>>) /\
        (<<IN: List.In (loc, to, ordw) rels>>) /\
        ((<<ORDW: Ordering.le ordw Ordering.strong_relaxed>>) \/
         (<<ORDR: Ordering.le ord Ordering.strong_relaxed>>)).

    Definition ww_race (rels: Writes.t) (tview: TView.t) (loc: Loc.t) (ord: Ordering.t): Prop :=
      exists to ordw,
        (<<LOC: L loc>>) /\
        (<<HIGHER: Time.lt ((View.rlx (TView.cur tview)) loc) to>>) /\
        (<<IN: List.In (loc, to, ordw) rels>>) /\
        ((<<ORDW1: Ordering.le ordw Ordering.na>>) \/
         (<<ORDW2: Ordering.le ord Ordering.na>>)).

    Definition ra_race (rels: Writes.t) (tview: TView.t) (e: ProgramEvent.t): Prop :=
      (exists loc val ord,
          (<<READ: ProgramEvent.is_reading e = Some (loc, val, ord)>>) /\
          (<<WRRACE: wr_race rels tview loc ord>>)) \/
      (exists loc val ord,
          (<<WRITE: ProgramEvent.is_writing e = Some (loc, val, ord)>>) /\
          (<<WWRACE: ww_race rels tview loc ord>>)).

    Definition ra_race_steps (rels: Writes.t) (c: Configuration.t): Prop :=
      exists tid rels2 c2 lang st2 lc2 e st3,
        (<<STEPS: WConfiguration.steps L ordcr ordcw rels rels2 c c2>>) /\
        (<<TID: IdentMap.find tid (Configuration.threads c2) = Some (existT _ lang st2, lc2)>>) /\
        (<<THREAD_STEP: lang.(Language.step) e st2 st3>>) /\
        (<<RARACE: ra_race rels2 (Local.tview lc2) e>>).

    Definition racefree (rels: Writes.t) (c: Configuration.t): Prop :=
      forall tid rels2 c2 lang st2 lc2 e st3
        (STEPS: WConfiguration.steps L ordcr ordcw rels rels2 c c2)
        (TID: IdentMap.find tid (Configuration.threads c2) = Some (existT _ lang st2, lc2))
        (THREAD_STEP: lang.(Language.step) e st2 st3)
        (RARACE: ra_race rels2 (Local.tview lc2) e),
        False.

    Definition racefree_syn (syn: Threads.syntax): Prop :=
      racefree [] (Configuration.init syn).

    Lemma step_racefree
          e tid rels1 rels2 c1 c2
          (RACEFREE: racefree rels1 c1)
          (STEP: WConfiguration.step L ordcr ordcw e tid rels1 rels2 c1 c2):
      racefree rels2 c2.
    Proof.
      ii. eapply RACEFREE; eauto. econs 2; eauto.
    Qed.
  End RARaceW.
End RARaceW.


Definition fwd (b: bool) A (e2: A): A. Admitted.

Ltac destruct_refinement_aux T :=
  let m := fresh "mres" in
  let r := fresh "r" in
  let P := fresh "P" in
  pose T as m;
  destruct m as [ r P ].

Ltac destruct_refinement :=
  match goal with
  | |- context[proj1_sig ?T] => destruct_refinement_aux T
  end.

Ltac t_base := discriminate || destruct_refinement.

Inductive List (T: Type) :=
| Cons_construct: T -> List T -> List T
| Nil_construct: List T.

Definition t (T: Type): List T. Admitted.
Definition size (T: Type) (src: List T): nat. Admitted.
Definition filter1_rt1_type (T: Type): Type := { res: List T | false = true }.
Definition filter1 (T: Type): filter1_rt1_type T. Admitted.

Definition hh_1:
  forall T : Type,
    (forall (T0 : Type),
     False -> filter1_rt1_type T0) ->
     False.
Admitted.

Definition hh_2:
  forall (T : Type),
    filter1_rt1_type T ->
    filter1_rt1_type T.
Admitted.

Definition hh:
  forall (T : Type) (f1 : forall (T0 : Type), False -> filter1_rt1_type T0),
       fwd
         (Nat.leb
               (size T
                  (fwd false (List T)
                     (fwd false (List T)
                        (proj1_sig
                           (hh_2 T
                              (f1 T (hh_1 T f1))))))) 0) bool
         false = true.
Admitted.

Set Program Mode. (* removing this line prevents the bug *)
Obligation Tactic := repeat t_base.

Goal
  forall T (h17: T),
    filter1 T =
    exist
      _
      (Nil_construct T)
      (hh T (fun (T : Type) (_ : False) => filter1 T)).
Abort.


Require Import Crypto.Compilers.Named.PositiveContext.
Require Import Crypto.Compilers.Named.PositiveContext.DefaultsProperties.
Require Import Crypto.Compilers.Named.ContextDefinitions.
Require Import Crypto.Compilers.Named.InterpretToPHOASInterp.
Require Import Crypto.Compilers.Named.CompileWf.
Require Import Crypto.Compilers.Named.CompileInterp.
Require Import Crypto.Compilers.Named.WfFromUnit.
Require Import Crypto.Compilers.Named.DeadCodeEliminationInterp.
Require Import Crypto.Compilers.Named.WfInterp.
Require Import Crypto.Compilers.Syntax.
Require Import Crypto.Compilers.Wf.
Require Import Crypto.Compilers.Z.Syntax.
Require Import Crypto.Compilers.Z.RewriteAddToAdc.
Require Import Crypto.Compilers.Z.Named.RewriteAddToAdcInterp.
Require Import Crypto.Util.Tactics.BreakMatch.
Require Import Crypto.Util.Decidable.
Require Import Crypto.Util.Bool.

Section language.
  Local Notation PContext var := (PositiveContext _ var _ internal_base_type_dec_bl).

  Lemma InterpRewriteAdc
        {t} (e : Expr t) (Hwf : Wf e)
  : forall x, Compilers.Syntax.Interp interp_op (RewriteAdc e) x = Compilers.Syntax.Interp interp_op e x.
  Proof.
    intro x; unfold RewriteAdc, option_map; break_innermost_match; try reflexivity;
      match goal with |- ?x = ?y => cut (Some x = Some y); [ congruence | ] end;
      (etransitivity; [ symmetry; eapply @Interp_InterpToPHOAS with (t:=Arrow _ _) | ]);
      repeat
        repeat
        first [ lazymatch goal with
                | [ H : DeadCodeElimination.EliminateDeadCode _ _ = Some ?e |- Syntax.Named.Interp ?e _ = Some _ ]
                  => let lhs := match goal with |- ?lhs = _ => lhs end in
                     let v := fresh in
                     (destruct lhs as [v|] eqn:?);
                     [ apply f_equal; eapply @InterpEliminateDeadCode with (Name_beq:=BinPos.Pos.eqb);
                       [ .. | eassumption | try eassumption | try eassumption ]; clear H | ]
                | [ |- Syntax.Named.Interp (RewriteAddToAdc.rewrite_expr _ ?e) _ = Some _ ]
                  => let lhs := match goal with |- ?lhs = _ => lhs end in
                     let H := fresh in
                     destruct lhs eqn:H; [ apply (f_equal (@Some _)); eapply @Interp_rewrite_expr in H | ]
                | [ H : Compile.compile (?e _) _ = Some ?e'', H' : Syntax.Named.Interp ?e'' ?x = Some ?v' |- ?v' = Compilers.Syntax.Interp ?interp_op' ?e ?x ]
                  => eapply @Interp_compile with (v:=x) (interp_op:=interp_op') in H
                end
              | intros; exact (@PositiveContextOk _ _ base_type_beq internal_base_type_dec_bl internal_base_type_dec_lb)
              | progress split_andb
              | congruence
              | tauto
              | solve [ auto | eapply @BinPos.Pos.eqb_eq; auto ]
              | eapply @Wf_from_unit
              | eapply @dec_rel_of_bool_dec_rel
              | eapply @internal_base_type_dec_lb
              | eapply @internal_base_type_dec_bl
              | eapply @InterpEliminateDeadCode; [ .. | eassumption | eassumption | ]
              | apply name_list_unique_DefaultNamesFor
              | progress intros
              | rewrite !@lookupb_empty
              | eapply @wf_from_unit with (uContext:=PContext _); [ .. | eassumption ]
              | match goal with
                | [ H : Syntax.Named.Interp ?e ?x = Some ?a, H' : Syntax.Named.Interp ?e ?x = Some ?b |- _ ]
                  => assert (a = b) by congruence; (subst a || subst b)
                end
              | lazymatch goal with
                | [ |- Some _ = Some _ ] => fail
                | [ |- None = Some _ ] => exfalso; eapply @wf_interp_not_None; [ .. | unfold Syntax.Named.Interp in *; eassumption ]
                | [ |- ?x = Some _ ] => destruct x eqn:?; [ apply f_equal | ]
                end ].
  Qed.
End language.

Hint Rewrite @InterpRewriteAdc using solve_wf_side_condition : reflective_interp.


Require Import CodeProofDeps.
Require Import Ident.
Require Import Constants.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import CommonLib.
Require Import PSCIHandler.Layer.
Require Import RVIC.Code.is_untrusted_intid.

Require Import RVIC.LowSpecs.is_untrusted_intid.

Local Open Scope Z_scope.

Section CodeProof.

  Context `{real_params: RealParams}.
  Context {memb} `{Hmemx: Mem.MemoryModelX memb}.
  Context `{Hmwd: UseMemWithData memb}.

  Let mem := mwd (cdata RData).

  Context `{Hstencil: Stencil}.
  Context `{make_program_ops: !MakeProgramOps Clight.function type Clight.fundef type}.
  Context `{Hmake_program: !MakeProgram Clight.function type Clight.fundef type}.

  Let L : compatlayer (cdata RData) :=
    ∅.

  Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.
  Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

  Section BodyProof.

    Context `{Hwb: WritableBlockOps}.
    Variable (sc: stencil).
    Variables (ge: genv) (STENCIL_MATCHES: stencil_matches sc ge).

    Lemma is_untrusted_intid_body_correct:
      forall m d env le intid res
             (Henv: env = PTree.empty _)
             (Hinv: high_level_invariant d)
             (HPTintid: PTree.get _intid le = Some (Vlong intid))
             (Hspec: is_untrusted_intid_spec0 (VZ64 (Int64.unsigned intid)) d = Some (Int.unsigned res)),
           exists le', (exec_stmt ge env le ((m, d): mem) is_untrusted_intid_body E0 le' (m, d) (Out_return (Some (Vint res, tuint)))).
    Proof.
      solve_code_proof Hspec is_untrusted_intid_body; eexists; solve_proof_low.
    Qed.

  End BodyProof.

End CodeProof.


From iris Require Import program_logic.weakestpre.
From iris Require Import base_logic.lib.invariants.
From st.STLCmuST Require Import types typing.
From st.STLCmuVS Require Import lang wkpre generic.lift tactics.
From st.backtranslations.st_sem.well_defined.logrel Require Import definition.
From iris.proofmode Require Import tactics.
From st.backtranslations.st_sem Require Import ghost heap_emul.base heap_emul.spec expressions.
From st.prelude Require Import big_op_three.
From st Require Import resources.

Section compat_lemmas_easy.

  Context `{Σ : !gFunctors} `{semΣ_inst : !semΣ Σ}.

  Lemma compat_Var (Γ : list type) (x : var) (τ : type) :
    Γ !! x = Some τ → open_exprel_typed Γ (%x)%Eₙₒ (%x)%Eₙₒ τ.
  Proof.
    intros H. iIntros (Δ vs vs') "Hvsvs".
    iDestruct (big_sepL3_length _ _ _ _ with "Hvsvs") as "[%eq %eq']".
    destruct (Var_subst_list_closed_n_length vs x) as [v [eqv ->]]. apply ids_lt_Closed_n. rewrite -eq. by eapply lookup_lt_Some.
    destruct (Var_subst_list_closed_n_length vs' x) as [v' [eqv' ->]]. apply ids_lt_Closed_n. rewrite -eq' -eq. by eapply lookup_lt_Some.
    rewrite /exprel_typed /=. iApply lift_val.
    iApply ((big_sepL3_lookup _ _ _ _ x _ _ _ H eqv eqv') with "Hvsvs").
  Qed.

  Lemma lift_bind (Kᵢ Kₛ : list ectx_item) (Φ Ψ : valO -n> valO -n> iPropO Σ) (eᵢ eₛ : expr) :
    ⊢ lift MaybeStuck Φ eᵢ eₛ -∗ (∀ vᵢ vₛ, Φ vᵢ vₛ -∗ lift MaybeStuck Ψ (fill Kᵢ (of_val vᵢ)) (fill Kₛ (of_val vₛ))) -∗ lift MaybeStuck Ψ (fill Kᵢ eᵢ) (fill Kₛ eₛ).
  Proof. iIntros "H H2". iApply lift.lift_bind. iFrame. Qed.

  Lemma compat_Unit (Γ : list type) :
    open_exprel_typed Γ ()%Eₙₒ ()%Eₙₒ TUnit.
  Proof.
    iIntros (Δ vs vs') "Hvsvs". asimpl.
    change ()%Eₙₒ with (of_val ()%Vₙₒ). iApply lift_val.
    by rewrite valrel_typed_TUnit_unfold.
  Qed.

  Lemma compat_Bool (Γ : list type) (b : bool) :
    open_exprel_typed Γ b b TBool.
  Proof.
    iIntros (Δ vs vs') "Hvsvs". asimpl.
    change (Lit b)%Eₙₒ with (of_val b). iApply lift_val.
    rewrite valrel_typed_TBool_unfold. by iExists _.
  Qed.

  Lemma compat_Int (Γ : list type) (z : Z) :
    open_exprel_typed Γ z z TInt.
  Proof.
    iIntros (Δ vs vs') "Hvsvs". asimpl.
    change (Lit z)%Eₙₒ with (of_val z). iApply lift_val.
    rewrite valrel_typed_TInt_unfold. by iExists _.
  Qed.

  Lemma compat_BinOp (Γ : list type) (op : bin_op) (e1 e1' e2 e2' : expr) :
      open_exprel_typed Γ e1 e1' TInt → open_exprel_typed Γ e2 e2' TInt →
      open_exprel_typed Γ (BinOp op e1 e2) (BinOp op e1' e2') (binop_res_type op).
  Proof.
    intros IHe1 IHe2.
    iIntros (Δ vs vs') "#Hvsvs". simpl.
    iApply (lift_bind [BinOpLCtx op _] [BinOpLCtx op _]). by iApply IHe1. iIntros (v1 v1') "#Hv1".
    iApply (lift_bind [BinOpRCtx op _] [BinOpRCtx op _]). by iApply IHe2. iIntros (v2 v2') "#Hv2".
    rewrite !valrel_typed_TInt_unfold. iDestruct "Hv1" as (z1) "[-> ->]". iDestruct "Hv2" as (z2) "[-> ->]".
    iApply lift_step. simpl. auto_STLCmuVS_step.
    iApply lift_step_later. auto_STLCmuVS_step. iNext. simpl.
    iApply lift_val.
    destruct op; simpl; (rewrite valrel_typed_TInt_unfold || rewrite valrel_typed_TBool_unfold); by iExists _.
  Qed.

  Lemma compat_Seq (Γ : list type) (e1 e1' e2 e2' : expr) (τ : type) :
      open_exprel_typed Γ e1 e1' TUnit → open_exprel_typed Γ e2 e2' τ →
      open_exprel_typed Γ (Seq e1 e2) (Seq e1' e2') τ.
  Proof.
    intros IHe1 IHe2.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [SeqCtx _] [SeqCtx _]). by iApply IHe1. iIntros (v1 v1') "#Hv1".
    rewrite !valrel_typed_TUnit_unfold. iDestruct "Hv1" as "[-> ->]".
    iApply lift_step. auto_STLCmuVS_step.
    iApply lift_step_later. auto_STLCmuVS_step. iNext. simpl.
    by iApply IHe2.
  Qed.

  Lemma compat_Pair (Γ : list type) (e1 e1' e2 e2' : expr) (τ1 τ2 : type) :
      open_exprel_typed Γ e1 e1' τ1 → open_exprel_typed Γ e2 e2' τ2 →
      open_exprel_typed Γ (e1, e2)%Eₙₒ (e1', e2')%Eₙₒ (τ1 × τ2)%Tₛₜ.
  Proof.
    intros IHe1 IHe2.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [PairLCtx _] [PairLCtx _]). by iApply IHe1. iIntros (v1 v1') "#Hv1".
    iApply (lift_bind [PairRCtx _] [PairRCtx _]). by iApply IHe2. iIntros (v2 v2') "#Hv2".
    simpl. change (of_val ?v1, of_val ?v2)%Eₙₒ with (of_val (PairV v1 v2)). iApply lift_val.
    rewrite valrel_typed_TProd_unfold. repeat iExists _; eauto.
  Qed.

  Lemma compat_Fst (Γ : list type) (e e' : expr) (τ1 τ2 : type) :
      open_exprel_typed Γ e e' (τ1 × τ2)%Tₛₜ → open_exprel_typed Γ (Fst e) (Fst e') τ1.
  Proof.
    intros IHe.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [FstCtx] [FstCtx]). by iApply IHe. iIntros (v v') "#Hv".
    rewrite !valrel_typed_TProd_unfold. iDestruct "Hv" as (v1 v2 v1' v2') "(-> & -> & H1 & H2)".
    iApply lift_step. auto_STLCmuVS_step.
    iApply lift_step_later. auto_STLCmuVS_step. iNext. simplify_custom. by iApply lift_val.
  Qed.

  Lemma compat_Snd (Γ : list type) (e e' : expr) (τ1 τ2 : type) :
      open_exprel_typed Γ e e' (τ1 × τ2)%Tₛₜ → open_exprel_typed Γ (Snd e) (Snd e') τ2.
  Proof.
    intros IHe.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [SndCtx] [SndCtx]). by iApply IHe. iIntros (v v') "#Hv".
    rewrite !valrel_typed_TProd_unfold. iDestruct "Hv" as (v1 v2 v1' v2') "(-> & -> & H1 & H2)".
    iApply lift_step. auto_STLCmuVS_step.
    iApply lift_step_later. auto_STLCmuVS_step. iNext. simplify_custom. by iApply lift_val.
  Qed.

  Lemma compat_InjL (Γ : list type) (e e' : expr) (τ1 τ2 : type) :
    open_exprel_typed Γ e e' τ1 → open_exprel_typed Γ (InjL e) (InjL e') (τ1 + τ2)%Tₛₜ.
  Proof.
    intros IHe.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [InjLCtx] [InjLCtx]). by iApply IHe. iIntros (v1 v1') "#Hv1".
    simpl. change (InjL (of_val ?v))%Eₙₒ with (of_val (InjLV v)). iApply lift_val.
    rewrite valrel_typed_TSum_unfold. repeat iExists _; eauto.
  Qed.

  Lemma compat_InjR (Γ : list type) (e e' : expr) (τ1 τ2 : type) :
    open_exprel_typed Γ e e' τ2 → open_exprel_typed Γ (InjR e) (InjR e') (τ1 + τ2)%Tₛₜ.
  Proof.
    intros IHe.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [InjRCtx] [InjRCtx]). by iApply IHe. iIntros (v2 v2') "#Hv2".
    simpl. change (InjR (of_val ?v))%Eₙₒ with (of_val (InjRV v)). iApply lift_val.
    rewrite valrel_typed_TSum_unfold. repeat iExists _; eauto.
  Qed.

  Lemma compat_Case (Γ : list type) (e0 e0' e1 e1' e2 e2' : expr) (τ1 τ2 τ3 : type) :
      open_exprel_typed Γ e0 e0' (τ1 + τ2)%Tₛₜ
      → open_exprel_typed (τ1 :: Γ) e1 e1' τ3
      → open_exprel_typed (τ2 :: Γ) e2 e2' τ3 → open_exprel_typed Γ (Case e0 e1 e2) (Case e0' e1' e2') τ3.
  Proof.
    intros IHe0 IHe1 IHe2.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [CaseCtx _ _] [CaseCtx _ _]). by iApply IHe0. iIntros (v v') "#Hv".
    rewrite !valrel_typed_TSum_unfold. iDestruct "Hv" as (vi vi') "[(-> & -> & H) | (-> & -> & H)]".
    - iApply lift_step. auto_STLCmuVS_step. iApply lift_step_later. auto_STLCmuVS_step. iNext. simplify_custom.
      rewrite !subst_list_val_cons. iApply IHe1. simpl. auto.
    - iApply lift_step. auto_STLCmuVS_step. iApply lift_step_later. auto_STLCmuVS_step. iNext. simplify_custom.
      rewrite !subst_list_val_cons. iApply IHe2. simpl. auto.
  Qed.

  Lemma compat_If (Γ : list type) (e0 e0' e1 e1' e2 e2' : expr) (τ : type) :
    open_exprel_typed Γ e0 e0' TBool → open_exprel_typed Γ e1 e1' τ → open_exprel_typed Γ e2 e2' τ →
    open_exprel_typed Γ (If e0 e1 e2) (If e0' e1' e2') τ.
  Proof.
    intros IHe0 IHe1 IHe2.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [IfCtx _ _] [IfCtx _ _]). by iApply IHe0. iIntros (v v') "#Hv".
    rewrite !valrel_typed_TBool_unfold. iDestruct "Hv" as (b) "[-> ->]".
    destruct b; (iApply lift_step; first by auto_STLCmuVS_step); (iApply lift_step_later; first by auto_STLCmuVS_step); iNext; simpl;
      [by iApply IHe1 | by iApply IHe2].
  Qed.

  Lemma compat_LetIn (Γ : list type) (e1 e1' e2 e2' : expr) (τ1 τ2 : type) :
      open_exprel_typed Γ e1 e1' τ1 → open_exprel_typed (τ1 :: Γ) e2 e2' τ2 →
      open_exprel_typed Γ (LetIn e1 e2) (LetIn e1' e2') τ2.
  Proof.
    intros IHe1 IHe2.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [LetInCtx _] [LetInCtx _]). by iApply IHe1. iIntros (v1 v1') "#Hv1".
    iApply lift_step; first by auto_STLCmuVS_step. iApply lift_step_later; first by auto_STLCmuVS_step. iNext. simplify_custom.
    rewrite !subst_list_val_cons. iApply IHe2. simpl. auto.
  Qed.

  Lemma compat_Lam (Γ : list type) (e e' : expr) (τ1 τ2 : type) :
    open_exprel_typed (τ1 :: Γ) e e' τ2 →
    open_exprel_typed Γ (Lam e) (Lam e') (τ1 ⟶ τ2)%Tₛₜ.
  Proof.
    intros IHe.
    iIntros (Δ vs vs') "#Hvsvs". simpl.
    change (Lam ?e) with (of_val (LamV e)). iApply lift_val.
    rewrite valrel_typed_TArrow_unfold. iModIntro. iIntros (w w') "Hww".
    iApply lift_step; first by auto_STLCmuVS_step. iApply lift_step_later; first by auto_STLCmuVS_step. iNext. simplify_custom.
    rewrite !subst_list_val_cons. iApply IHe. simpl. auto.
  Qed.

  Lemma compat_App (Γ : list type) (e1 e1' e2 e2' : expr) (τ1 τ2 : type) :
      open_exprel_typed Γ e1 e1' (τ1 ⟶ τ2)%Tₛₜ → open_exprel_typed Γ e2 e2' τ1 →
      open_exprel_typed Γ (e1 e2) (e1' e2') τ2.
  Proof.
    intros IHe1 IHe2.
    iIntros (Δ vs vs') "#Hvsvs".
    iApply (lift_bind [AppLCtx _] [AppLCtx _]). by iApply IHe1. iIntros (v1 v1') "#Hv1".
    iApply (lift_bind [AppRCtx _] [AppRCtx _]). by iApply IHe2. iIntros (v2 v2') "#Hv2".
    rewrite /= valrel_typed_TArrow_unfold. by iApply "Hv1".
  Qed.

  Lemma compat_Fold (Γ : list type) (e e' : expr) (τ : {bind type}) :
      open_exprel_typed Γ e e' τ.[TRec τ/] → open_exprel_typed Γ (Fold e) (Fold e') (TRec τ).
  Proof.
    intros IHe.
    iIntros (Δ vs vs') "#Hvsvs". simpl.
    iApply (lift_bind [FoldCtx] [FoldCtx]). by iApply IHe. iLöb as "IHlob". iIntros (v v') "#Hv".
    simpl. change (Fold (of_val ?v)) with (of_val (FoldV v)). iApply lift_val.
    rewrite valrel_typed_TRec_unfold. repeat iExists _; eauto.
  Qed.

  Lemma compat_Unfold (Γ : list type) (e e' : expr) (τ : {bind type}) :
    open_exprel_typed Γ e e' (TRec τ) → open_exprel_typed Γ (Unfold e) (Unfold e') τ.[TRec τ/].
  Proof.
    intros IHe.
    iIntros (Δ vs vs') "#Hvsvs". simpl.
    iApply (lift_bind [UnfoldCtx] [UnfoldCtx]). by iApply IHe. iIntros (v v') "#Hv".
    rewrite valrel_typed_TRec_unfold. iDestruct "Hv" as (w w') "(-> & -> & Hw)".
    iApply lift_step; first by auto_STLCmuVS_step. iApply lift_step_later; first by auto_STLCmuVS_step. iNext. simplify_custom.
    by iApply lift_val.
  Qed.

End compat_lemmas_easy.


From SFS Require Import cps cps_util set_util identifiers ctx Ensembles_util
     List_util functions tactics map_util.

From SFS Require Import heap heap_impl heap_defs heap_equiv space_sem
     cc_log_rel closure_conversion closure_conversion_util bounds
     invariants GC closure_conversion_correct.

From Coq Require Import ZArith.Znumtheory Relations.Relations Arith.Wf_nat
                        Lists.List MSets.MSets MSets.MSetRBT Numbers.BinNums NArith.Ndist
                        NArith.BinNat PArith.BinPos Sets.Ensembles Omega Permutation.

Import ListNotations.

Open Scope ctx_scope.
Open Scope fun_scope.
Close Scope Z_scope.

Module Top.

  Module CC := ClosureConversionCorrect MHeap.

  Import MHeap CC.Inv.Size.Util.C.LR.Sem.GC.Equiv
         CC.Inv.Size.Util.C.LR.Sem.GC.Equiv.Defs
         CC.Inv.Size.Util.C.LR.Sem.GC CC.Inv.Size.Util.C.LR.Sem
         CC.Inv.Size.Util.C.LR CC.Inv.Size.Util.C CC.Inv.Size.Util
         CC.Inv.Size CC.Inv CC.

  Definition ct := CC.Inv.Size.Util.clo_tag.

  Definition install_env Γ :=
    let (lenv, H1) := alloc (Constr ct []) emp in
    (M.set Γ (Loc lenv) (M.empty _), H1).

  Lemma key_set_empty A :
    key_set (M.empty A) <--> Empty_set _.
  Proof.
    split; eauto with Ensembles_DB.
    intros x k. unfold In, key_set in *.
    rewrite M.gempty in k. contradiction.
  Qed.

  Lemma closure_conversion_correct_lr_closed (k : nat) (e1 e2 : exp) (C : exp_ctx) (Γ : var) K rho2 H2 :
    (rho2, H2) = install_env Γ ->
    ~ Γ \in bound_var e1 ->
    unique_bindings e1 ->
    has_true_mut e1 ->

    Closure_conversion ct (Empty_set _) (Empty_set _) id ct Γ [] e1 e2 C ->

    (forall j, (e1, M.empty _, emp) ⪯ ^ (k ; j ;
                              Pre (Empty_set _) 0 K; PreG;
                              Post 0 0 K; PostG)
          (C |[ e2 ]|, rho2, H2)).
  Proof with (now eauto with Ensembles_DB).
    unfold install_env.
    destruct (alloc (Constr ct []) emp) as [lenv Η2] eqn:Ha.
    intros Ha' Hnin Hun Htm Hcc. inv Ha'.
    intros j.
    eapply Closure_conversion_correct in Hcc.
    eapply cc_approx_exp_rel_mon_pre.
    - eassumption.
    - intros [[H1 rho1] e1'] [[H2 rho2] e2'] Hpre.
      eapply PreSubsetCompat with (Funs := Empty_set var).
      eassumption. rewrite Intersection_Empty_set_abs_l...
    - intros j1. eapply cc_approx_env_Empty_set.
    - intros j2. split.
      + rewrite env_locs_set_In, <- env_locs_Empty; [| reflexivity ].
        rewrite !Union_Empty_set_neut_r.
        rewrite reach_unfold.
        simpl. rewrite post_Singleton; [| eapply gas; eassumption ].
        simpl. rewrite reach'_Empty_set.
        rewrite !Union_Empty_set_neut_r.
        intros x b Hi Hget; inv Hi. eapply gas in Ha.
        subst_exp...
      + split.
        * unfold FV.
          rewrite key_set_empty.
          rewrite FromList_nil, !Setminus_Empty_set_neut_r.
          rewrite !Union_Empty_set_neut_r at 1.
          rewrite Setminus_Empty_set_neut_r, !Union_Empty_set_neut_r.
          reflexivity.
        * do 2 eexists. split; [| split ].
          rewrite M.gss. reflexivity.
          eapply gas. eassumption.
          now constructor.
    - intros j1 x _ Hin. inv Hin.
    - unfold FV.
      rewrite FromList_nil, !Setminus_Empty_set_neut_r, !image_Empty_set, !Union_Empty_set_neut_r at 1.
      rewrite Setminus_Empty_set_neut_r, !Union_Empty_set_neut_r.
      eapply Disjoint_Singleton_l. eassumption.
    - unfold FV.
      rewrite FromList_nil, !Setminus_Empty_set_neut_r.
      rewrite !Union_Empty_set_neut_r at 1.
      rewrite Setminus_Empty_set_neut_r, !Union_Empty_set_neut_r.
      intros x Hin. inv Hin.
    - eassumption.
    - eassumption.
    - unfold FV.
      rewrite FromList_nil, !Setminus_Empty_set_neut_r.
      rewrite !Union_Empty_set_neut_r at 1.
      rewrite Setminus_Empty_set_neut_r, !Union_Empty_set_neut_r.
      now eauto with Ensembles_DB.

      Grab Existential Variables.
      tci. tci. exact id.
  Qed.

  Lemma key_set_get {A} rho1 x (v : A) :
    M.get x rho1 = Some v ->
    x \in key_set rho1.
  Proof.
    intros. unfold key_set, In. rewrite H. eauto.
  Qed.

  Lemma key_set_getlist {A} rho1 xs (vs : list A) :
    getlist xs rho1 = Some vs ->
    FromList xs \subset key_set rho1.
  Proof with (now eauto with Ensembles_DB).
    revert rho1 vs. induction xs; intros rho1 vs1 Hget; inv Hget.
    - normalize_sets...
    - normalize_sets.
      destruct (M.get a rho1) eqn:Hgeta; try congruence.
      destruct (getlist xs rho1) eqn:Hgetl; try congruence.
      inv H0.
      eapply Union_Included.
      + eapply Singleton_Included. eapply key_set_get.
        eassumption.
      + eauto.
  Qed.

  (** ** Top-level theorem *)
  Lemma closure_conversion_correct_top
        (k : nat) (j : nat) (e1 e2 : exp) (C : exp_ctx) (Γ : var) (* dummy varaiable for environment *)
        r1 c1 m1 :

    (* The source program has unique binders *)
    unique_bindings e1 ->
    (* Requirement for mutual rec function blocks *)
    has_true_mut e1 ->
    (* dummy var is fresh *)
    ~ Γ \in bound_var e1 ->

    (* C[e2] is the closure converted program *)
    Closure_conversion ct (Empty_set _) (Empty_set _) id ct Γ [] e1 e2 C ->

    (* the source evaluates *)
    big_step emp (M.empty _) e1 r1 c1 m1 ->

    (* and it is not a stuck program -- because currently we don't assume that r1 is a value (it can be out-of-time-exception) *)
    not_stuck emp (M.empty _) e1 ->

    exists (r2 : ans) (c2 m2 : nat) (b : Inj),
      (* the target evaluates *)
      big_step_GC_cc emp (M.empty _) (C |[ e2 ]|) r2 c2 m2 /\
      (* time bounds *)
      c1 <= c2 <= Ktime * c1 /\
      (* space bounds *)
      m2 <= m1 + (cost_space_exp e1) + 1 /\
      (* the results are related *)
      r1 ≺ ^ (k ; j ; PreG ; PostG ; b ) r2.
  Proof with (now eauto with Ensembles_DB).
    unfold install_env.
    destruct (alloc (Constr ct []) emp) as [lenv H2'] eqn:Ha.
    intros Hun Htm Hnin Hcc Hbs Hns.
    assert (Heq : (e1, M.empty _, emp) ⪯ ^ (k + c1 ; j ;
                                            Pre (Empty_set _) 0 1; PreG;
                                            Post 0 0 1; PostG)
                                             (C |[ e2 ]|, (M.set Γ (Loc lenv) (M.empty value)), H2')).
    { eapply closure_conversion_correct_lr_closed; try eassumption.
      unfold install_env. rewrite Ha. reflexivity. }

    edestruct Heq with (rho2' := M.empty value) (H2'0 := @emp block) (b2 := @id var)
      as (r2 & c2 & m2 & b & Hbs2 & Hin & Hres); [ | | | | | | eassumption | | ].
    - reflexivity.
    - clear; now firstorder.
    - eapply Closure_conversion_toplevel_closed_cc in Hcc. unfold closed_exp in *.
      rewrite Hcc. split; intros x v Hin; inv Hin.
    - clear; now firstorder.
    - unfold Pre. unfold size_heap.
      rewrite !plus_O_n at 1.
      rewrite PS_cardinal_empty.
      simpl. rewrite <- plus_n_O.
      rewrite HL.size_with_measure_emp. omega.
      eapply PS_cardinal_empty_l.
      rewrite <- mset_eq. reflexivity.
    - eapply le_plus_r.
    - eassumption.
    - unfold Post in Hin. destruct Hin as [[Ht1 Ht2] Hm]. do 4 eexists. split. eassumption.
      split; [| split ].
      + omega.
      + rewrite !plus_O_n in *. eapply le_trans. eassumption.
        eapply Nat.max_lub. omega.
        unfold cost_space_heap, cost_heap in *.
        rewrite HL.max_with_measure_emp in *.
        rewrite Nat_as_OT.max_0_r. omega.
      + rewrite cc_approx_val_eq in Hres.
        eapply cc_approx_val_monotonic. eassumption. omega.
  Qed.

  Lemma closure_conversion_correct_top_div
        (k : nat) (j : nat) (e1 e2 : exp) (C : exp_ctx) (Γ : var) (* dummy varaiable for environment *)
        m1 :

     (* The source program has unique binders *)
     unique_bindings e1 ->
     has_true_mut e1 ->
     ~ Γ \in bound_var e1 ->

     (* C[e2] is the closure converted program *)
     Closure_conversion ct (Empty_set _) (Empty_set _) id ct Γ [] e1 e2 C ->

     (* the source diverges *)
     div_src emp (M.empty _) e1 m1 ->

    exists (m2 : natinf),
      (* the target diverges *)
      div_trg emp (M.empty _) (C |[ e2 ]|) m2 /\
      match m1, m2 with
      | ni m1, ni m2 => m2 <= m1 + (cost_space_exp e1) + 1
      | ni _, inf => False
      | inf, _ => True
      end.
  Proof with (now eauto with Ensembles_DB).
    destruct (alloc (Constr ct []) emp) as [lenv H2'] eqn:Ha.
    intros Hun Htm Hnin Hcc Hdiv.

    assert (Hns: not_stuck emp (M.empty _)  e1).
    { intros j'. eexists OOT. edestruct (Hdiv j') as [m' [Hbs Hleq]].
      eexists. eassumption. }

    eexists (match m1 with
             | infty => infty
             | ni m0 => ni (m0 + cost_space_exp e1 + 1)
             end).

    split; [| now  destruct m1; eauto ].

    intros i. destruct (Hdiv i) as [m1' [Hbs Hleq]].
    assert (Heq : (e1, M.empty _, emp) ⪯ ^ (i ; j ;
                                              Pre (Empty_set _) 0 1; PreG;
                                              Post 0 0 1; PostG)
                                               (C |[ e2 ]|, (M.set Γ (Loc lenv) (M.empty value)), H2')).
      { eapply closure_conversion_correct_lr_closed; try eassumption.
        unfold install_env. rewrite Ha. reflexivity. }

      edestruct Heq with (rho2' := M.empty value) (H2'0 := @emp block) (b2 := @id var)
      as (r2 & c2 & m2 & b & Hbs2 & Hin & Hres); [ | | | | | | eassumption | | ].
    - reflexivity.
    - clear; now firstorder.
    - eapply Closure_conversion_toplevel_closed_cc in Hcc. unfold closed_exp in *.
      rewrite Hcc. split; intros x v Hin; inv Hin.
    - clear; now firstorder.
    - unfold Pre. unfold size_heap.
      rewrite !plus_O_n at 1.
      rewrite PS_cardinal_empty.
      simpl. rewrite HL.size_with_measure_emp. omega.
      eapply PS_cardinal_empty_l.
      rewrite <- mset_eq. reflexivity.
    - reflexivity.
    - eassumption.
    - rewrite cc_approx_val_eq in Hres. simpl in Hres.
      destruct r2; try contradiction.

      assert (Hmon : exists m2', m2' <= m2 /\ big_step_GC_cc emp (M.empty _) (C |[ e2 ]|) OOT i m2' ).
      { eapply big_step_GC_cc_OOT_mon. eassumption.
        unfold Post in *. omega. }
      edestruct Hmon as [m2' [Hm1 Hm2]]. eexists. split. eassumption.
      destruct m1; eauto. now constructor.
      destruct Hin as [_ Hmem]. eapply le_ni_le. eapply le_trans. eassumption.
      eapply le_trans. eassumption. simpl.
      eapply Nat_as_DT.max_lub. omega.
      unfold cost_space_heap, cost_heap in *.
      rewrite HL.max_with_measure_emp in *.
      rewrite Nat_as_OT.max_0_r.
      eapply ni_le_le in Hleq. omega.
  Qed.

End Top.

Print Assumptions Top.closure_conversion_correct_top.

Print Assumptions Top.closure_conversion_correct_top_div.


From mathcomp
Require Import ssreflect ssrbool ssrnat eqtype seq ssrfun.
From fcsl
Require Import prelude pred pcm unionmap heap.
From HTT
Require Import stmod stsep stlog stlogR.
From SSL
Require Import core.
From Hammer Require Import Hammer.
(* Configure Hammer *)
Set Hammer ATPLimit 60.
Unset Hammer Eprover.
Unset Hammer Vampire.
Add Search Blacklist "fcsl.".
Add Search Blacklist "HTT.".
Add Search Blacklist "Coq.ssr.ssrfun".
Add Search Blacklist "mathcomp.ssreflect.ssrfun".
Add Search Blacklist "mathcomp.ssreflect.bigop".
Add Search Blacklist "mathcomp.ssreflect.choice".
Add Search Blacklist "mathcomp.ssreflect.div".
Add Search Blacklist "mathcomp.ssreflect.finfun".
Add Search Blacklist "mathcomp.ssreflect.fintype".
Add Search Blacklist "mathcomp.ssreflect.path".
Add Search Blacklist "mathcomp.ssreflect.tuple".

Require Import common.

Lemma pure1 : (1) = (1). intros; hammer. Qed.
Hint Resolve pure1: ssl_pure.
Lemma pure2 (k1 : nat) : (k1) <= (7) -> (0) <= (k1) -> ((if (0) <= (k1) then k1 else 0)) = ((if (0) <= (k1) then k1 else 0)). intros; hammer. Qed.
Hint Resolve pure2: ssl_pure.
Lemma pure3 (k1 : nat) : (k1) <= (7) -> (0) <= (k1) -> ((if (k1) <= (7) then k1 else 7)) = ((if (k1) <= (7) then k1 else 7)). intros; hammer. Qed.
Hint Resolve pure3: ssl_pure.
Lemma pure4 (a : nat) : (a) < ((a) + (3)).
  (* intros; hammer. *)
  scongruence use: addSnnS, leq_addr.
Qed.
Hint Resolve pure4: ssl_pure.
Lemma pure5 (a : nat) : (a) < ((a) + (3)).
  (* intros; hammer. *)
  scongruence use: addSnnS, leq_addr.
Qed.
Hint Resolve pure5: ssl_pure.
Lemma pure6 (sz1x : nat) (sz2x : nat) : (0) <= (sz1x) -> (0) <= (sz2x) -> (0) <= (((1) + (sz1x)) + (sz2x)) -> (0) <= ((sz1x) + (1)). intros; hammer. Qed.
Hint Resolve pure6: ssl_pure.
Lemma pure7 (sz1x : nat) (sz2x : nat) : (0) <= (((1) + (sz1x)) + (sz2x)) -> (0) <= (sz1x) -> (0) <= (sz2x) -> ((((1) + (sz1x)) + (sz2x)) + (1)) = (((1) + ((sz1x) + (1))) + (sz2x)). intros; hammer. Qed.
Hint Resolve pure7: ssl_pure.
Lemma pure8 (k1 : nat) (lo2x : nat) (vx1 : nat) (hi1x : nat) (hi2x : nat) : (k1) <= (vx1) -> (vx1) <= (lo2x) -> (vx1) <= (7) -> (k1) <= (7) -> (hi1x) <= (vx1) -> (0) <= (vx1) -> (0) <= (k1) -> ((if ((if (hi2x) <= (vx1) then vx1 else hi2x)) <= (k1) then k1 else (if (hi2x) <= (vx1) then vx1 else hi2x))) = ((if (hi2x) <= (vx1) then vx1 else hi2x)).
  (* intros; hammer. *)
  intros.
  destruct (hi2x <= vx1) eqn:H6;
  sauto.
Qed.
Hint Resolve pure8: ssl_pure.
Lemma pure9 (k1 : nat) (lo2x : nat) (vx1 : nat) (hi1x : nat) (lo1x : nat) : (k1) <= (vx1) -> (vx1) <= (lo2x) -> (vx1) <= (7) -> (k1) <= (7) -> (hi1x) <= (vx1) -> (0) <= (vx1) -> (0) <= (k1) -> ((if (k1) <= ((if (vx1) <= (lo1x) then vx1 else lo1x)) then k1 else (if (vx1) <= (lo1x) then vx1 else lo1x))) = ((if (vx1) <= ((if (k1) <= (lo1x) then k1 else lo1x)) then vx1 else (if (k1) <= (lo1x) then k1 else lo1x))).
  (* intros; hammer. *)
  intros.
  destruct (vx1 <= lo1x) eqn:H6;
  destruct (k1 <= lo1x) eqn:H7;
  sauto.
Qed.
Hint Resolve pure9: ssl_pure.
Lemma pure10 (hi1x : nat) (k1 : nat) (vx1 : nat) (lo2x : nat) : (k1) <= (vx1) -> (vx1) <= (lo2x) -> (vx1) <= (7) -> (k1) <= (7) -> (hi1x) <= (vx1) -> (0) <= (vx1) -> (0) <= (k1) -> ((if (hi1x) <= (k1) then k1 else hi1x)) <= (vx1). intros; hammer. Qed.
Hint Resolve pure10: ssl_pure.
Lemma pure11 (sz2x : nat) (sz1x : nat) : (0) <= (((1) + (sz1x)) + (sz2x)) -> (0) <= (sz1x) -> (0) <= (sz2x) -> (0) <= ((sz2x) + (1)). intros; hammer. Qed.
Hint Resolve pure11: ssl_pure.
Lemma pure12 (sz1x : nat) (sz2x : nat) : (0) <= (((1) + (sz1x)) + (sz2x)) -> (0) <= (sz1x) -> (0) <= (sz2x) -> ((((1) + (sz1x)) + (sz2x)) + (1)) = (((1) + (sz1x)) + ((sz2x) + (1))). intros; hammer. Qed.
Hint Resolve pure12: ssl_pure.
Lemma pure13 (k1 : nat) (lo2x : nat) (vx1 : nat) (hi1x : nat) (lo1x : nat) : (vx1) <= (lo2x) -> (vx1) <= (7) -> ~~ ((k1) <= (vx1)) -> (k1) <= (7) -> (hi1x) <= (vx1) -> (0) <= (vx1) -> (0) <= (k1) -> ((if (k1) <= ((if (vx1) <= (lo1x) then vx1 else lo1x)) then k1 else (if (vx1) <= (lo1x) then vx1 else lo1x))) = ((if (vx1) <= (lo1x) then vx1 else lo1x)).
  (* intros; hammer. *)
  intros.
  destruct (vx1 <= lo1x) eqn:H6;
  sauto.
Qed.
Hint Resolve pure13: ssl_pure.
Lemma pure14 (k1 : nat) (lo2x : nat) (vx1 : nat) (hi1x : nat) (hi2x : nat) : (vx1) <= (lo2x) -> (vx1) <= (7) -> ~~ ((k1) <= (vx1)) -> (k1) <= (7) -> (hi1x) <= (vx1) -> (0) <= (vx1) -> (0) <= (k1) -> ((if ((if (hi2x) <= (vx1) then vx1 else hi2x)) <= (k1) then k1 else (if (hi2x) <= (vx1) then vx1 else hi2x))) = ((if ((if (hi2x) <= (k1) then k1 else hi2x)) <= (vx1) then vx1 else (if (hi2x) <= (k1) then k1 else hi2x))).
  (* intros; hammer. *)
  intros.
  destruct (hi2x <= vx1) eqn:H6;
  destruct (hi2x <= k1) eqn:H7;
  sauto.
Qed.
Hint Resolve pure14: ssl_pure.
Lemma pure15 (vx1 : nat) (k1 : nat) (lo2x : nat) (hi1x : nat) : (vx1) <= (lo2x) -> (vx1) <= (7) -> ~~ ((k1) <= (vx1)) -> (k1) <= (7) -> (hi1x) <= (vx1) -> (0) <= (vx1) -> (0) <= (k1) -> (vx1) <= ((if (k1) <= (lo2x) then k1 else lo2x)).
  (* intros; hammer. *)
  intros.
  rewrite -ltnNge in H1.
  sauto.
Qed.
Hint Resolve pure15: ssl_pure.

Definition bst_insert_type :=
  forall (vprogs : ptr * ptr),
  {(vghosts : nat * nat * nat * nat)},
  STsep (
    fun h =>
      let: (x, retv) := vprogs in
      let: (k, n, lo, hi) := vghosts in
      exists h_bst_xnlohi_a,
      (0) <= (k) /\ (0) <= (n) /\ (k) <= (7) /\ h = retv :-> (k) \+ h_bst_xnlohi_a /\ bst x n lo hi h_bst_xnlohi_a,
    [vfun (_: unit) h =>
      let: (x, retv) := vprogs in
      let: (k, n, lo, hi) := vghosts in
      exists hi1 lo1 n1 y,
      exists h_bst_yn1lo1hi1_b,
      (hi1) == ((if (hi) <= (k) then k else hi)) /\ (lo1) == ((if (k) <= (lo) then k else lo)) /\ (n1) == ((n) + (1)) /\ h = retv :-> (y) \+ h_bst_yn1lo1hi1_b /\ bst y n1 lo1 hi1 h_bst_yn1lo1hi1_b
    ]).

Program Definition bst_insert : bst_insert_type :=
  Fix (fun (bst_insert : bst_insert_type) vprogs =>
    let: (x, retv) := vprogs in
    Do (
      k1 <-- @read nat retv;
      if (x) == (null)
      then
        y1 <-- allocb null 3;
        retv ::= y1;;
        (y1 .+ 1) ::= null;;
        (y1 .+ 2) ::= null;;
        y1 ::= k1;;
        ret tt
      else
        vx1 <-- @read nat x;
        lx1 <-- @read ptr (x .+ 1);
        rx1 <-- @read ptr (x .+ 2);
        if (k1) <= (vx1)
        then
          bst_insert (lx1, retv);;
          y11 <-- @read ptr retv;
          retv ::= x;;
          (x .+ 1) ::= y11;;
          ret tt
        else
          bst_insert (rx1, retv);;
          y11 <-- @read ptr retv;
          retv ::= x;;
          (x .+ 2) ::= y11;;
          ret tt
    )).
Obligation Tactic := intro; move=>[x retv]; ssl_program_simpl.
Next Obligation.
ssl_ghostelim_pre.
move=>[[[k n] lo] hi].
ex_elim h_bst_xnlohi_a.
move=>[phi_self0] [phi_self1] [phi_self2].
move=>[sigma_self].
subst h_self.
move=>H_bst_xnlohi_a.
ssl_ghostelim_post.
try rename h_bst_yn1lo1hi1_b into h_bst_yn1lo1hi1_a.
try rename H_bst_yn1lo1hi1_b into H_bst_yn1lo1hi1_a.
try rename h_bst_yn1lo1hi1_a into h_bst_yn1lo1hikkhi_a.
try rename H_bst_yn1lo1hi1_a into H_bst_yn1lo1hikkhi_a.
try rename h_bst_yn1lo1hikkhi_a into h_bst_yn1kloklohikkhi_a.
try rename H_bst_yn1lo1hikkhi_a into H_bst_yn1kloklohikkhi_a.
try rename h_bst_yn1kloklohikkhi_a into h_bst_ynkloklohikkhi_a.
try rename H_bst_yn1kloklohikkhi_a into H_bst_ynkloklohikkhi_a.
ssl_read retv.
try rename k into k1.
try rename h_bst_ynkloklohikkhi_a into h_bst_ynk1lok1lohik1k1hi_a.
try rename H_bst_ynkloklohikkhi_a into H_bst_ynk1lok1lohik1k1hi_a.
ssl_open ((x) == (null)) H_bst_xnlohi_a.
move=>[phi_bst_xnlohi_a0] [phi_bst_xnlohi_a1] [phi_bst_xnlohi_a2].
move=>[sigma_bst_xnlohi_a].
subst h_bst_xnlohi_a.
try rename h_bst_xnlohi_a into h_bst_xnlo_a.
try rename H_bst_xnlohi_a into H_bst_xnlo_a.
try rename h_bst_ynk1lok1lohik1k1hi_a into h_bst_ynk1lok1lok1k1_a.
try rename H_bst_ynk1lok1lohik1k1hi_a into H_bst_ynk1lok1lok1k1_a.
try rename h_bst_ynk1lok1lok1k1_a into h_bst_ynk1k1k1k1_a.
try rename H_bst_ynk1lok1lok1k1_a into H_bst_ynk1k1k1k1_a.
try rename h_bst_xnlo_a into h_bst_xn_a.
try rename H_bst_xnlo_a into H_bst_xn_a.
try rename h_bst_ynk1k1k1k1_a into h_bst_yk1k1k1k1_a.
try rename H_bst_ynk1k1k1k1_a into H_bst_yk1k1k1k1_a.
try rename h_bst_xn_a into h_bst_x_a.
try rename H_bst_xn_a into H_bst_x_a.
try rename h_bst_lysz1ylo11yhi11y_0y into h_bst_lysz1ylo11y_0y.
try rename H_bst_lysz1ylo11yhi11y_0y into H_bst_lysz1ylo11y_0y.
try rename h_bst_lysz1ylo11y_0y into h_bst_lysz1y_0y.
try rename H_bst_lysz1ylo11y_0y into H_bst_lysz1y_0y.
try rename h_bst_lysz1y_0y into h_bst_sz1y_0y.
try rename H_bst_lysz1y_0y into H_bst_sz1y_0y.
try rename h_bst_sz1y_0y into h_bst__0y.
try rename H_bst_sz1y_0y into H_bst__0y.
try rename h_bst_rysz2ylo2yhi2y_1y into h_bst_rysz2ylo2y_1y.
try rename H_bst_rysz2ylo2yhi2y_1y into H_bst_rysz2ylo2y_1y.
try rename h_bst_rysz2ylo2y_1y into h_bst_rysz2y_1y.
try rename H_bst_rysz2ylo2y_1y into H_bst_rysz2y_1y.
try rename h_bst_rysz2y_1y into h_bst_sz2y_1y.
try rename H_bst_rysz2y_1y into H_bst_sz2y_1y.
try rename h_bst_sz2y_1y into h_bst__1y.
try rename H_bst_sz2y_1y into H_bst__1y.
ssl_alloc y1.
try rename y into y1.
try rename h_bst_yk1k1k1k1_a into h_bst_y1k1k1k1k1_a.
try rename H_bst_yk1k1k1k1_a into H_bst_y1k1k1k1k1_a.
ssl_write retv.
ssl_write_post retv.
ssl_write (y1 .+ 1).
ssl_write_post (y1 .+ 1).
ssl_write (y1 .+ 2).
ssl_write_post (y1 .+ 2).
ssl_write y1.
ssl_write_post y1.
try rename h_bst__0y into h_bst__a.
try rename H_bst__0y into H_bst__a.
try rename h_bst__1y into h_bst__a.
try rename H_bst__1y into H_bst__a.
ssl_emp;
exists ((if (0) <= (k1) then k1 else 0)), ((if (k1) <= (7) then k1 else 7)), ((0) + (1)), (y1);
exists (y1 :-> (k1) \+ y1 .+ 1 :-> (null) \+ y1 .+ 2 :-> (null));
sslauto.
ssl_close 2;
exists (0), (0), (k1), (0), (0), (7), (7), (null), (null), (empty), (empty);
sslauto.
ssl_close 1;
sslauto.
ssl_close 1;
sslauto.
ex_elim sz1x sz2x vx hi2x hi1x.
ex_elim lo1x lo2x lx rx.
ex_elim h_bst_lxsz1xlo1xhi1x_0x h_bst_rxsz2xlo2xhi2x_1x.
move=>[phi_bst_xnlohi_a0] [phi_bst_xnlohi_a1] [phi_bst_xnlohi_a2] [phi_bst_xnlohi_a3] [phi_bst_xnlohi_a4] [phi_bst_xnlohi_a5] [phi_bst_xnlohi_a6] [phi_bst_xnlohi_a7] [phi_bst_xnlohi_a8].
move=>[sigma_bst_xnlohi_a].
subst h_bst_xnlohi_a.
move=>[H_bst_lxsz1xlo1xhi1x_0x H_bst_rxsz2xlo2xhi2x_1x].
try rename h_bst_xnlohi_a into h_bst_xnlohi2xvxvxhi2x_a.
try rename H_bst_xnlohi_a into H_bst_xnlohi2xvxvxhi2x_a.
try rename h_bst_ynk1lok1lohik1k1hi_a into h_bst_ynk1lok1lohi2xvxvxhi2xk1k1hi2xvxvxhi2x_a.
try rename H_bst_ynk1lok1lohik1k1hi_a into H_bst_ynk1lok1lohi2xvxvxhi2xk1k1hi2xvxvxhi2x_a.
try rename h_bst_ynk1lok1lohi2xvxvxhi2xk1k1hi2xvxvxhi2x_a into h_bst_ynk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a.
try rename H_bst_ynk1lok1lohi2xvxvxhi2xk1k1hi2xvxvxhi2x_a into H_bst_ynk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a.
try rename h_bst_xnlohi2xvxvxhi2x_a into h_bst_xnvxlo1xvxlo1xhi2xvxvxhi2x_a.
try rename H_bst_xnlohi2xvxvxhi2x_a into H_bst_xnvxlo1xvxlo1xhi2xvxvxhi2x_a.
try rename h_bst_xnvxlo1xvxlo1xhi2xvxvxhi2x_a into h_bst_xsz1xsz2xvxlo1xvxlo1xhi2xvxvxhi2x_a.
try rename H_bst_xnvxlo1xvxlo1xhi2xvxvxhi2x_a into H_bst_xsz1xsz2xvxlo1xvxlo1xhi2xvxvxhi2x_a.
try rename h_bst_ynk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a into h_bst_ysz1xsz2xk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a.
try rename H_bst_ynk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a into H_bst_ysz1xsz2xk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a.
ssl_read x.
try rename vx into vx1.
try rename h_bst_xsz1xsz2xvxlo1xvxlo1xhi2xvxvxhi2x_a into h_bst_xsz1xsz2xvx1lo1xvx1lo1xhi2xvx1vx1hi2x_a.
try rename H_bst_xsz1xsz2xvxlo1xvxlo1xhi2xvxvxhi2x_a into H_bst_xsz1xsz2xvx1lo1xvx1lo1xhi2xvx1vx1hi2x_a.
try rename h_bst_ysz1xsz2xk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a into h_bst_ysz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a.
try rename H_bst_ysz1xsz2xk1vxlo1xvxlo1xk1vxlo1xvxlo1xhi2xvxvxhi2xk1k1hi2xvxvxhi2x_a into H_bst_ysz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a.
ssl_read (x .+ 1).
try rename lx into lx1.
try rename h_bst_lxsz1xlo1xhi1x_0x into h_bst_lx1sz1xlo1xhi1x_0x.
try rename H_bst_lxsz1xlo1xhi1x_0x into H_bst_lx1sz1xlo1xhi1x_0x.
ssl_read (x .+ 2).
try rename rx into rx1.
try rename h_bst_rxsz2xlo2xhi2x_1x into h_bst_rx1sz2xlo2xhi2x_1x.
try rename H_bst_rxsz2xlo2xhi2x_1x into H_bst_rx1sz2xlo2xhi2x_1x.
ssl_branch ((k1) <= (vx1)).
try rename h_bst_x1n2lo2hi2_a1 into h_bst_lx1sz1xlo1xhi1x_0x.
try rename H_bst_x1n2lo2hi2_a1 into H_bst_lx1sz1xlo1xhi1x_0x.
ssl_call_pre (retv :-> (k1) \+ h_bst_lx1sz1xlo1xhi1x_0x).
ssl_call (k1, sz1x, lo1x, hi1x).
exists (h_bst_lx1sz1xlo1xhi1x_0x);
sslauto.
ssl_frame_unfold.
move=>h_call0.
ex_elim hi11 lo11 n11 y1.
ex_elim h_bst_y1n11lo11hi11_b1.
move=>[phi_call00] [phi_call01] [phi_call02].
move=>[sigma_call0].
subst h_call0.
move=>H_bst_y1n11lo11hi11_b1.
store_valid.
try rename h_bst_y1n11lo11hi11_b1 into h_bst_y1n11lo11hi11_0x.
try rename H_bst_y1n11lo11hi11_b1 into H_bst_y1n11lo11hi11_0x.
try rename h_bst_y1n11lo11hi11_0x into h_bst_y1n11lo11hi1xk1k1hi1x_0x.
try rename H_bst_y1n11lo11hi11_0x into H_bst_y1n11lo11hi1xk1k1hi1x_0x.
try rename h_bst_y1n11lo11hi1xk1k1hi1x_0x into h_bst_y1n11k1lo1xk1lo1xhi1xk1k1hi1x_0x.
try rename H_bst_y1n11lo11hi1xk1k1hi1x_0x into H_bst_y1n11k1lo1xk1lo1xhi1xk1k1hi1x_0x.
try rename h_bst_y1n11k1lo1xk1lo1xhi1xk1k1hi1x_0x into h_bst_y1sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x.
try rename H_bst_y1n11k1lo1xk1lo1xhi1xk1k1hi1x_0x into H_bst_y1sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x.
ssl_read retv.
try rename y1 into y11.
try rename h_bst_y1sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x into h_bst_y11sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x.
try rename H_bst_y1sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x into H_bst_y11sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x.
try rename h_bst_lysz1ylo12yhi12y_0y into h_bst_y11sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x.
try rename H_bst_lysz1ylo12yhi12y_0y into H_bst_y11sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x.
try rename h_bst_rysz2ylo21yhi21y_1y into h_bst_rx1sz2xlo2xhi2x_1x.
try rename H_bst_rysz2ylo21yhi21y_1y into H_bst_rx1sz2xlo2xhi2x_1x.
try rename h_bst_ysz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a into h_bst_xsz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a.
try rename H_bst_ysz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a into H_bst_xsz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a.
ssl_write retv.
ssl_write_post retv.
ssl_write (x .+ 1).
ssl_write_post (x .+ 1).
ssl_emp;
exists ((if ((if (hi2x) <= (vx1) then vx1 else hi2x)) <= (k1) then k1 else (if (hi2x) <= (vx1) then vx1 else hi2x))), ((if (k1) <= ((if (vx1) <= (lo1x) then vx1 else lo1x)) then k1 else (if (vx1) <= (lo1x) then vx1 else lo1x))), ((((1) + (sz1x)) + (sz2x)) + (1)), (x);
exists (x :-> (vx1) \+ x .+ 1 :-> (y11) \+ x .+ 2 :-> (rx1) \+ h_bst_y11sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x \+ h_bst_rx1sz2xlo2xhi2x_1x);
sslauto.
ssl_close 2;
exists ((sz1x) + (1)), (sz2x), (vx1), (hi2x), ((if (hi1x) <= (k1) then k1 else hi1x)), ((if (k1) <= (lo1x) then k1 else lo1x)), (lo2x), (y11), (rx1), (h_bst_y11sz1xk1lo1xk1lo1xhi1xk1k1hi1x_0x), (h_bst_rx1sz2xlo2xhi2x_1x);
sslauto.
ssl_frame_unfold.
ssl_frame_unfold.
try rename h_bst_x1n2lo2hi2_a1 into h_bst_rx1sz2xlo2xhi2x_1x.
try rename H_bst_x1n2lo2hi2_a1 into H_bst_rx1sz2xlo2xhi2x_1x.
ssl_call_pre (retv :-> (k1) \+ h_bst_rx1sz2xlo2xhi2x_1x).
ssl_call (k1, sz2x, lo2x, hi2x).
exists (h_bst_rx1sz2xlo2xhi2x_1x);
sslauto.
ssl_frame_unfold.
move=>h_call0.
ex_elim hi11 lo11 n11 y1.
ex_elim h_bst_y1n11lo11hi11_b1.
move=>[phi_call00] [phi_call01] [phi_call02].
move=>[sigma_call0].
subst h_call0.
move=>H_bst_y1n11lo11hi11_b1.
store_valid.
try rename h_bst_y1n11lo11hi11_b1 into h_bst_y1n11lo11hi11_1x.
try rename H_bst_y1n11lo11hi11_b1 into H_bst_y1n11lo11hi11_1x.
try rename h_bst_y1n11lo11hi11_1x into h_bst_y1n11lo11hi2xk1k1hi2x_1x.
try rename H_bst_y1n11lo11hi11_1x into H_bst_y1n11lo11hi2xk1k1hi2x_1x.
try rename h_bst_y1n11lo11hi2xk1k1hi2x_1x into h_bst_y1n11k1lo2xk1lo2xhi2xk1k1hi2x_1x.
try rename H_bst_y1n11lo11hi2xk1k1hi2x_1x into H_bst_y1n11k1lo2xk1lo2xhi2xk1k1hi2x_1x.
try rename h_bst_y1n11k1lo2xk1lo2xhi2xk1k1hi2x_1x into h_bst_y1sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x.
try rename H_bst_y1n11k1lo2xk1lo2xhi2xk1k1hi2x_1x into H_bst_y1sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x.
ssl_read retv.
try rename y1 into y11.
try rename h_bst_y1sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x into h_bst_y11sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x.
try rename H_bst_y1sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x into H_bst_y11sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x.
try rename h_bst_lysz1ylo12yhi12y_0y into h_bst_lx1sz1xlo1xhi1x_0x.
try rename H_bst_lysz1ylo12yhi12y_0y into H_bst_lx1sz1xlo1xhi1x_0x.
try rename h_bst_rysz2ylo21yhi21y_1y into h_bst_y11sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x.
try rename H_bst_rysz2ylo21yhi21y_1y into H_bst_y11sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x.
try rename h_bst_ysz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a into h_bst_xsz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a.
try rename H_bst_ysz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a into H_bst_xsz1xsz2xk1vx1lo1xvx1lo1xk1vx1lo1xvx1lo1xhi2xvx1vx1hi2xk1k1hi2xvx1vx1hi2x_a.
ssl_write retv.
ssl_write_post retv.
ssl_write (x .+ 2).
ssl_write_post (x .+ 2).
ssl_emp;
exists ((if ((if (hi2x) <= (vx1) then vx1 else hi2x)) <= (k1) then k1 else (if (hi2x) <= (vx1) then vx1 else hi2x))), ((if (k1) <= ((if (vx1) <= (lo1x) then vx1 else lo1x)) then k1 else (if (vx1) <= (lo1x) then vx1 else lo1x))), ((((1) + (sz1x)) + (sz2x)) + (1)), (x);
exists (x :-> (vx1) \+ x .+ 1 :-> (lx1) \+ x .+ 2 :-> (y11) \+ h_bst_lx1sz1xlo1xhi1x_0x \+ h_bst_y11sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x);
sslauto.
ssl_close 2;
exists (sz1x), ((sz2x) + (1)), (vx1), ((if (hi2x) <= (k1) then k1 else hi2x)), (hi1x), (lo1x), ((if (k1) <= (lo2x) then k1 else lo2x)), (lx1), (y11), (h_bst_lx1sz1xlo1xhi1x_0x), (h_bst_y11sz2xk1lo2xk1lo2xhi2xk1k1hi2x_1x);
sslauto.
ssl_frame_unfold.
ssl_frame_unfold.
Qed.